Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Accessing RTL symbols

Browse Source
This commit is contained in:
Michael Schimmel
2025-10-07 13:21:25 +02:00
parent 51265ce945
commit e0c4cf7ee4
4 changed files with 7325 additions and 153 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.fmx
+19 -5
View File
@@ -81,7 +81,7 @@ object Form1: TForm1
end end
object ClearButton: TButton object ClearButton: TButton
Position.X = 24.000000000000000000 Position.X = 24.000000000000000000
Position.Y = 554.000000000000000000 Position.Y = 539.000000000000000000
Size.Width = 80.000000000000000000 Size.Width = 80.000000000000000000
Size.Height = 22.000000000000000000 Size.Height = 22.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
@@ -121,14 +121,14 @@ object Form1: TForm1
end end
object FromJSONButton: TButton object FromJSONButton: TButton
Position.X = 24.000000000000000000 Position.X = 24.000000000000000000
Position.Y = 602.000000000000000000 Position.Y = 569.000000000000000000
TabOrder = 16 TabOrder = 16
Text = 'From JSON' Text = 'From JSON'
OnClick = FromJSONButtonClick OnClick = FromJSONButtonClick
end end
object ToJSONButton: TButton object ToJSONButton: TButton
Position.X = 24.000000000000000000 Position.X = 24.000000000000000000
Position.Y = 632.000000000000000000 Position.Y = 599.000000000000000000
TabOrder = 17 TabOrder = 17
Text = 'To JSON' Text = 'To JSON'
OnClick = ToJSONButtonClick OnClick = ToJSONButtonClick
@@ -170,18 +170,32 @@ object Form1: TForm1
end end
object SaveUserLibButton: TButton object SaveUserLibButton: TButton
Position.X = 24.000000000000000000 Position.X = 24.000000000000000000
Position.Y = 680.000000000000000000 Position.Y = 629.000000000000000000
TabOrder = 24 TabOrder = 24
Text = 'Save Lib' Text = 'Save Lib'
OnClick = SaveUserLibButtonClick OnClick = SaveUserLibButtonClick
end end
object LoadUserLibButton: TButton object LoadUserLibButton: TButton
Position.X = 24.000000000000000000 Position.X = 24.000000000000000000
Position.Y = 710.000000000000000000 Position.Y = 659.000000000000000000
TabOrder = 25 TabOrder = 25
Text = 'LoadLib' Text = 'LoadLib'
OnClick = LoadUserLibButtonClick OnClick = LoadUserLibButtonClick
end end
object RTLListView: TListView
ItemAppearanceClassName = 'TListItemAppearance'
ItemEditAppearanceClassName = 'TListItemShowCheckAppearance'
HeaderAppearanceClassName = 'TListHeaderObjects'
FooterAppearanceClassName = 'TListHeaderObjects'
Anchors = [akLeft, akBottom]
Position.X = 8.000000000000000000
Position.Y = 689.000000000000000000
Size.Width = 113.000000000000000000
Size.Height = 184.000000000000000000
Size.PlatformDefault = False
TabOrder = 26
OnChange = RTLListViewChange
end
end end
object Panel2: TPanel object Panel2: TPanel
Align = Client Align = Client
ASTPlayground/MainForm.pas
+107 -37
View File
@@ -39,7 +39,11 @@ uses
Myc.Fmx.AstEditor, Myc.Fmx.AstEditor,
Myc.Fmx.AstEditor.Node, Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Workspace, Myc.Fmx.AstEditor.Workspace,
FMX.DialogService; // Added for platform-independent dialogs FMX.DialogService,
FMX.ListView.Types,
FMX.ListView.Appearances,
FMX.ListView.Adapters.Base,
FMX.ListView; // Added for platform-independent dialogs
type type
// A test record // A test record
@@ -82,6 +86,7 @@ type
ScriptMemo: TMemo; ScriptMemo: TMemo;
LoadUserLibButton: TButton; LoadUserLibButton: TButton;
SaveUserLibButton: TButton; SaveUserLibButton: TButton;
RTLListView: TListView;
procedure InnerLambdaButtonClick(Sender: TObject); procedure InnerLambdaButtonClick(Sender: TObject);
procedure ClearButtonClick(Sender: TObject); procedure ClearButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
@@ -105,6 +110,7 @@ type
procedure ToJSONButtonClick(Sender: TObject); procedure ToJSONButtonClick(Sender: TObject);
procedure SaveUserLibButtonClick(Sender: TObject); procedure SaveUserLibButtonClick(Sender: TObject);
procedure LoadUserLibButtonClick(Sender: TObject); procedure LoadUserLibButtonClick(Sender: TObject);
procedure RTLListViewChange(Sender: TObject);
private private
FCurrAst: IAstNode; FCurrAst: IAstNode;
FCurrDesc: IScopeDescriptor; FCurrDesc: IScopeDescriptor;
@@ -198,14 +204,6 @@ begin
FGScope := TAst.CreateScope(nil); FGScope := TAst.CreateScope(nil);
RegisterNativeFunctions(FGScope); RegisterNativeFunctions(FGScope);
ScriptMemo.Lines.Text :=
'''
(do
(def my-add (fn [a b] (+ a b)))
(def my-square (fn [x] (* x x)))
)
''';
end; end;
function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue; function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
@@ -241,7 +239,7 @@ begin
FWorkspace.ClipChildren := true; FWorkspace.ClipChildren := true;
FWorkspace.OnMouseDown := WorkspaceMouseDown; FWorkspace.OnMouseDown := WorkspaceMouseDown;
Tast.RegisterLibrary( TAst.RegisterLibrary(
procedure(const Scope: IExecutionScope) procedure(const Scope: IExecutionScope)
var var
smaAst, boundSmaAst: IAstNode; smaAst, boundSmaAst: IAstNode;
@@ -340,34 +338,42 @@ begin
try try
Memo1.Lines.Add(Format('--- Loading User Library from %s ---', [ExtractFileName(UserLibName)])); Memo1.Lines.Add(Format('--- Loading User Library from %s ---', [ExtractFileName(UserLibName)]));
var scopeDescr := FGScope.CreateDescriptor; var scopeDescr := FGScope.CreateDescriptor;
for pair in jsonObj do // Populate the list view with loaded functions and macros.
begin RTLListView.Items.BeginUpdate;
if not (pair.JsonValue is TJSONObject) then try
continue; for pair in jsonObj do
// First, deserialize the AST node from JSON.
funcAst := converter.Deserialize(pair.JsonValue as TJSONObject);
var adr := scopeDescr.FindSymbol(pair.JsonString.Value);
if adr.Kind = akUnresolved then
begin begin
// Distinguish between loading a macro and loading a function. if not (pair.JsonValue is TJSONObject) then
if funcAst is TMacroDefinitionNode then continue;
// First, deserialize the AST node from JSON.
funcAst := converter.Deserialize(pair.JsonValue as TJSONObject);
var adr := scopeDescr.FindSymbol(pair.JsonString.Value);
if adr.Kind = akUnresolved then
begin begin
// Macros are stored as raw AST nodes in the scope. // Distinguish between loading a macro and loading a function.
FGScope.Define(pair.JsonString.Value, TDataValue.FromIntf<IAstNode>(funcAst)); if funcAst is TMacroDefinitionNode then
Memo1.Lines.Add(Format('Defined macro "%s"', [pair.JsonString.Value])); begin
// Macros are stored as raw AST nodes in the scope.
FGScope.Define(pair.JsonString.Value, TDataValue.FromIntf<IAstNode>(funcAst));
Memo1.Lines.Add(Format('Defined macro "%s"', [pair.JsonString.Value]));
end
else
begin
// Functions (lambdas) must be executed to create a callable closure.
funcValue := ExecuteAst(funcAst, FGScope);
FGScope.Define(pair.JsonString.Value, funcValue);
Memo1.Lines.Add(Format('Defined function "%s"', [pair.JsonString.Value]));
end;
end end
else else
begin Memo1.Lines.Add(Format('Symbol "%s" already defined', [pair.JsonString.Value]));
// Functions (lambdas) must be executed to create a callable closure. // Add the new function/macro to the RTL list view.
funcValue := ExecuteAst(funcAst, FGScope); RTLListView.Items.Add.Text := pair.JsonString.Value;
FGScope.Define(pair.JsonString.Value, funcValue); end;
Memo1.Lines.Add(Format('Defined function "%s"', [pair.JsonString.Value])); finally
end; RTLListView.Items.EndUpdate;
end
else
Memo1.Lines.Add(Format('Symbol "%s" already defined', [pair.JsonString.Value]));
end; end;
finally finally
jsonObj.Free; jsonObj.Free;
@@ -474,10 +480,18 @@ begin
if addedList.Count > 0 then if addedList.Count > 0 then
begin begin
Memo1.Lines.Add(Format('%d new definitions added:', [addedList.Count])); Memo1.Lines.Add(Format('%d new definitions added:', [addedList.Count]));
for var n in addedList do // Add the new item to the RTL list view.
Memo1.Lines.Add(n); RTLListView.Items.BeginUpdate;
try
for var n in addedList do
begin
Memo1.Lines.Add(n);
RTLListView.Items.Add.Text := n;
end;
finally
RTLListView.Items.EndUpdate;
end;
end; end;
finally finally
jsonLib.Free; jsonLib.Free;
addedList.Free; addedList.Free;
@@ -1204,6 +1218,62 @@ begin
end; end;
end; end;
procedure TForm1.RTLListViewChange(Sender: TObject);
var
itemName: string;
jsonString: string;
jsonLib, jsonObj: TJSONObject;
converter: IJsonAstConverter;
AItem: TListViewItem;
begin
if RTLListView.ItemIndex < 0 then
exit;
AItem := RTLListView.Items[RTLListView.ItemIndex];
itemName := AItem.Text;
Memo1.Lines.Clear;
Memo1.Lines.Add(Format('Loading "%s" from library...', [itemName]));
if not TFile.Exists(UserLibName) then
begin
Memo1.Lines.Add(Format('Library file "%s" not found.', [UserLibName]));
exit;
end;
jsonLib := nil;
try
try
jsonString := TFile.ReadAllText(UserLibName);
jsonLib := TJSONObject.ParseJSONValue(jsonString) as TJSONObject;
if not Assigned(jsonLib) then
raise Exception.Create('Invalid JSON library format.');
var jsonValue := jsonLib.GetValue(itemName);
if not Assigned(jsonValue) or not (jsonValue is TJSONObject) then
raise Exception.Create(Format('Definition for "%s" not found in library.', [itemName]));
jsonObj := jsonValue as TJSONObject;
converter := TJsonAstConverter.Create;
FCurrAst := converter.Deserialize(jsonObj);
// Update the UI
UpdateScript; // This will print to ScriptMemo and show visualization
Memo1.Lines.Add(Format('"%s" loaded into script editor and workspace.', [itemName]));
except
on E: Exception do
begin
Memo1.Lines.Add('Error: ' + E.Message);
end;
end;
finally
if Assigned(jsonLib) then
jsonLib.Free;
end;
end;
procedure TForm1.ScriptMemoChange(Sender: TObject); procedure TForm1.ScriptMemoChange(Sender: TObject);
begin begin
if FScriptUpdate then if FScriptUpdate then
ASTPlayground/UserLib.json
+272 -46
View File
@@ -1,50 +1,4 @@
{ {
"my-add": {
"NodeType": "LambdaExpr",
"Parameters": [
{
"NodeType": "Identifier",
"Name": "a"
},
{
"NodeType": "Identifier",
"Name": "b"
}
],
"Body": {
"NodeType": "BinaryExpr",
"Operator": "+",
"Left": {
"NodeType": "Identifier",
"Name": "a"
},
"Right": {
"NodeType": "Identifier",
"Name": "b"
}
}
},
"my-square": {
"NodeType": "LambdaExpr",
"Parameters": [
{
"NodeType": "Identifier",
"Name": "x"
}
],
"Body": {
"NodeType": "BinaryExpr",
"Operator": "*",
"Left": {
"NodeType": "Identifier",
"Name": "x"
},
"Right": {
"NodeType": "Identifier",
"Name": "x"
}
}
},
"my-3": { "my-3": {
"NodeType": "LambdaExpr", "NodeType": "LambdaExpr",
"Parameters": [ "Parameters": [
@@ -315,5 +269,277 @@
} }
] ]
} }
},
"my-add": {
"NodeType": "LambdaExpr",
"Parameters": [
{
"NodeType": "Identifier",
"Name": "a"
},
{
"NodeType": "Identifier",
"Name": "b"
}
],
"Body": {
"NodeType": "FunctionCall",
"Callee": {
"NodeType": "Identifier",
"Name": "+"
},
"Arguments": [
{
"NodeType": "Identifier",
"Name": "a"
},
{
"NodeType": "Identifier",
"Name": "b"
}
]
}
},
"my-square": {
"NodeType": "LambdaExpr",
"Parameters": [
{
"NodeType": "Identifier",
"Name": "x"
}
],
"Body": {
"NodeType": "FunctionCall",
"Callee": {
"NodeType": "Identifier",
"Name": "*"
},
"Arguments": [
{
"NodeType": "Identifier",
"Name": "x"
},
{
"NodeType": "Identifier",
"Name": "x"
}
]
}
},
"CreateSMA": {
"NodeType": "LambdaExpr",
"Parameters": [
{
"NodeType": "Identifier",
"Name": "len"
}
],
"Body": {
"NodeType": "Block",
"Expressions": [
{
"NodeType": "VarDecl",
"Identifier": {
"NodeType": "Identifier",
"Name": "sum"
},
"Initializer": {
"NodeType": "Constant",
"Value": {
"Kind": "Scalar",
"Value": {
"Kind": "Ordinal",
"Value": 0
}
}
}
},
{
"NodeType": "VarDecl",
"Identifier": {
"NodeType": "Identifier",
"Name": "count"
},
"Initializer": {
"NodeType": "Constant",
"Value": {
"Kind": "Scalar",
"Value": {
"Kind": "Ordinal",
"Value": 0
}
}
}
},
{
"NodeType": "LambdaExpr",
"Parameters": [
{
"NodeType": "Identifier",
"Name": "series"
},
{
"NodeType": "Identifier",
"Name": "val"
}
],
"Body": {
"NodeType": "Block",
"Expressions": [
{
"NodeType": "Assignment",
"Identifier": {
"NodeType": "Identifier",
"Name": "sum"
},
"Value": {
"NodeType": "FunctionCall",
"Callee": {
"NodeType": "Identifier",
"Name": "+"
},
"Arguments": [
{
"NodeType": "Identifier",
"Name": "sum"
},
{
"NodeType": "Identifier",
"Name": "val"
}
]
}
},
{
"NodeType": "Assignment",
"Identifier": {
"NodeType": "Identifier",
"Name": "count"
},
"Value": {
"NodeType": "FunctionCall",
"Callee": {
"NodeType": "Identifier",
"Name": "+"
},
"Arguments": [
{
"NodeType": "Identifier",
"Name": "count"
},
{
"NodeType": "Constant",
"Value": {
"Kind": "Scalar",
"Value": {
"Kind": "Ordinal",
"Value": 1
}
}
}
]
}
},
{
"NodeType": "Assignment",
"Identifier": {
"NodeType": "Identifier",
"Name": "sum"
},
"Value": {
"NodeType": "TernaryExpr",
"Condition": {
"NodeType": "FunctionCall",
"Callee": {
"NodeType": "Identifier",
"Name": ">"
},
"Arguments": [
{
"NodeType": "Identifier",
"Name": "count"
},
{
"NodeType": "Identifier",
"Name": "len"
}
]
},
"ThenBranch": {
"NodeType": "FunctionCall",
"Callee": {
"NodeType": "Identifier",
"Name": "-"
},
"Arguments": [
{
"NodeType": "Identifier",
"Name": "sum"
},
{
"NodeType": "Indexer",
"Base": {
"NodeType": "Identifier",
"Name": "series"
},
"Index": {
"NodeType": "Identifier",
"Name": "len"
}
}
]
},
"ElseBranch": {
"NodeType": "Identifier",
"Name": "sum"
}
}
},
{
"NodeType": "FunctionCall",
"Callee": {
"NodeType": "Identifier",
"Name": "/"
},
"Arguments": [
{
"NodeType": "Identifier",
"Name": "sum"
},
{
"NodeType": "TernaryExpr",
"Condition": {
"NodeType": "FunctionCall",
"Callee": {
"NodeType": "Identifier",
"Name": "<"
},
"Arguments": [
{
"NodeType": "Identifier",
"Name": "count"
},
{
"NodeType": "Identifier",
"Name": "len"
}
]
},
"ThenBranch": {
"NodeType": "Identifier",
"Name": "count"
},
"ElseBranch": {
"NodeType": "Identifier",
"Name": "len"
}
}
]
}
]
}
}
]
}
} }
} }
KI/FMX_Intf.txt
+6927 -65
View File
File diff suppressed because it is too large Load Diff