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

Added user library

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-24 10:03:10 +02:00
parent 5a1919ec07
commit 624af31243
14 changed files with 585 additions and 305 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.pas
+281 -88
View File
@@ -11,6 +11,7 @@ uses
System.Variants,
System.Generics.Collections,
System.Math,
System.JSON,
FMX.Types,
FMX.Controls,
FMX.Forms,
@@ -24,6 +25,7 @@ uses
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Scope,
Myc.Ast,
Myc.Ast.Evaluator,
Myc.Ast.Dumper,
@@ -36,7 +38,8 @@ uses
Myc.Ast.Debugger,
Myc.Fmx.AstEditor,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Workspace;
Myc.Fmx.AstEditor.Workspace,
FMX.DialogService; // Added for platform-independent dialogs
type
// A test record
@@ -77,6 +80,8 @@ type
Splitter1: TSplitter;
Splitter2: TSplitter;
ScriptMemo: TMemo;
LoadUserLibButton: TButton;
SaveUserLibButton: TButton;
procedure InnerLambdaButtonClick(Sender: TObject);
procedure ClearButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
@@ -98,6 +103,8 @@ type
procedure ScriptMemoChange(Sender: TObject);
procedure TailCallButtenClick(Sender: TObject);
procedure ToJSONButtonClick(Sender: TObject);
procedure SaveUserLibButtonClick(Sender: TObject);
procedure LoadUserLibButtonClick(Sender: TObject);
private
FCurrAst: IAstNode;
FCurrDesc: IScopeDescriptor;
@@ -116,6 +123,9 @@ type
{ Public declarations }
end;
const
UserLibName = 'T:\Myc\ASTPlayground\UserLib.json';
var
Form1: TForm1;
@@ -124,7 +134,8 @@ implementation
uses
Myc.Data.Scalar.JSON,
System.Diagnostics, // For TStopwatch
Myc.Ast.Json; // For TAstJson serialization
Myc.Ast.Json, // For TAstJson serialization
System.IOUtils; // For TFile
{$R *.fmx}
@@ -187,6 +198,14 @@ begin
FGScope := TAst.CreateScope(nil);
RegisterNativeFunctions(FGScope);
ScriptMemo.Lines.Text :=
'''
(do
(def my-add (fn [a b] (+ a b)))
(def my-square (fn [x] (* x x)))
)
''';
end;
function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
@@ -271,10 +290,10 @@ begin
)
);
binder := TAstBinder.Create(FGScope);
binder := TAstBinder.Create(Scope);
boundSmaAst := binder.Execute(smaAst, smaDescriptor);
smaScope := smaDescriptor.CreateScope(FGScope);
smaScope := smaDescriptor.CreateScope(Scope);
smaVisitor := CreateEvaluator(smaScope);
Scope.Define('CreateSMA', smaVisitor.Execute(boundSmaAst));
@@ -284,6 +303,257 @@ begin
ClearButtonClick(Self);
end;
procedure TForm1.LoadUserLibButtonClick(Sender: TObject);
var
jsonString: string;
jsonObj: TJSONObject;
pair: TJSONPair;
funcAst: IAstNode;
funcValue: TDataValue;
converter: IJsonAstConverter;
begin
// Load definitions from JSON and populate the global scope.
if not TFile.Exists(UserLibName) then
begin
Memo1.Lines.Add(Format('Library file "%s" not found.', [UserLibName]));
exit;
end;
try
converter := TJsonAstConverter.Create;
jsonString := TFile.ReadAllText(UserLibName);
jsonObj := TJSONObject.ParseJSONValue(jsonString) as TJSONObject;
if not Assigned(jsonObj) then
raise Exception.Create('Invalid JSON format for library file.');
try
Memo1.Lines.Add(Format('--- Loading User Library from %s ---', [ExtractFileName(UserLibName)]));
var scopeDescr := FGScope.CreateDescriptor;
for pair in jsonObj do
begin
if not (pair.JsonValue is TJSONObject) then
continue;
funcAst := converter.Deserialize(pair.JsonValue as TJSONObject);
// Execute the lambda to get a callable function value
var adr := scopeDescr.FindSymbol(pair.JsonString.Value);
if adr.Kind = akUnresolved then
begin
funcValue := ExecuteAst(funcAst, FGScope);
FGScope.Define(pair.JsonString.Value, funcValue);
Memo1.Lines.Add(Format('Defined function "%s"', [pair.JsonString.Value]));
end
else
Memo1.Lines.Add(Format('Function "%s" already defined', [pair.JsonString.Value]));
end;
finally
jsonObj.Free;
end;
except
on E: Exception do
Memo1.Lines.Add('Error loading library: ' + E.Message);
end;
end;
procedure TForm1.SaveUserLibButtonClick(Sender: TObject);
var
rootNode: IAstNode;
definitions: TDictionary<string, IAstNode>;
jsonLib: TJSONObject;
converter: IJsonAstConverter;
jsonString: string;
updatedCount: Integer;
addedList: TList<String>;
begin
// Extract definitions from the current script and merge them into the JSON library.
try
rootNode := TAstScript.Parse(ScriptMemo.Lines.Text);
if not Assigned(rootNode) then
raise Exception.Create('Script is empty or invalid.');
definitions := TDictionary<string, IAstNode>.Create;
try
// Check if the root is a block and extract top-level definitions
if rootNode is TBlockExpressionNode then
begin
for var expr in (rootNode as TBlockExpressionNode).Expressions do
begin
if expr is TVariableDeclarationNode then
begin
var decl := expr as TVariableDeclarationNode;
definitions.Add(decl.Identifier.Name, decl.Initializer);
end;
end;
end
else if rootNode is TVariableDeclarationNode then // Handle single definition
begin
var decl := rootNode as TVariableDeclarationNode;
definitions.Add(decl.Identifier.Name, decl.Initializer);
end;
if definitions.Count = 0 then
begin
Memo1.Lines.Add('No top-level "(def ...)" definitions found in the script to save.');
exit;
end;
// Load existing library file or create a new JSON object if it doesn't exist
jsonLib := nil;
if TFile.Exists(UserLibName) then
begin
jsonString := TFile.ReadAllText(UserLibName);
if not jsonString.IsEmpty then
jsonLib := TJSONObject.ParseJSONValue(jsonString) as TJSONObject;
end;
if not Assigned(jsonLib) then
jsonLib := TJSONObject.Create;
addedList := TList<String>.Create;
try
// Serialize and merge the definitions from the script into the JSON object
converter := TJsonAstConverter.Create;
updatedCount := 0;
for var pair in definitions do
begin
// Track if we are adding or updating a function
if jsonLib.Values[pair.Key] <> nil then
begin
Inc(updatedCount);
jsonLib.RemovePair(pair.Key);
end
else
addedList.Add(pair.Key);
jsonLib.AddPair(pair.Key, converter.Serialize(pair.Value));
end;
TFile.WriteAllText(UserLibName, jsonLib.Format(4));
// Provide more detailed feedback to the user
Memo1.Lines.Add(Format('--- Library "%s" updated ---', [ExtractFileName(UserLibName)]));
if updatedCount > 0 then
Memo1.Lines.Add(Format('%d existing definitions updated.', [updatedCount]));
if addedList.Count > 0 then
begin
Memo1.Lines.Add(Format('%d new definitions added:', [addedList.Count]));
for var n in addedList do
Memo1.Lines.Add(n);
end;
finally
jsonLib.Free;
addedList.Free;
end;
finally
definitions.Free;
end;
except
on E: Exception do
Memo1.Lines.Add('Error saving library: ' + E.Message);
end;
end;
procedure TForm1.FromJSONButtonClick(Sender: TObject);
var
jsonString: string;
jsonObj: TJSONObject;
converter: IJsonAstConverter;
begin
Memo1.Lines.BeginUpdate;
try
jsonString := Memo1.Lines.Text;
Memo1.Lines.Clear;
if jsonString.IsEmpty then
begin
Memo1.Lines.Add('Memo is empty. Please paste an AST JSON string.');
exit;
end;
try
converter := TJsonAstConverter.Create;
jsonObj := TJSONObject.ParseJSONValue(jsonString) as TJSONObject;
if not Assigned(jsonObj) then
raise EJSONParseException.Create('Invalid JSON format.');
try
var binder := TAstBinder.Create(FGScope);
var unboundAst := converter.Deserialize(jsonObj);
FCurrAst := binder.Execute(unboundAst, FCurrDesc);
Memo1.Lines.Add('AST deserialized successfully from JSON.');
Memo1.Lines.Add('You can now visualize it (Middle Mouse Click) or pretty-print it.');
finally
jsonObj.Free;
end;
except
on E: Exception do
begin
FCurrAst := nil;
FCurrDesc := nil;
Memo1.Lines.Add('Error deserializing AST from JSON:');
Memo1.Lines.Add(E.Message);
Memo1.Lines.Add('--- Original JSON ---');
Memo1.Lines.Text := Memo1.Lines.Text + sLineBreak + jsonString;
end;
end;
finally
Memo1.Lines.EndUpdate;
end;
UpdateScript;
end;
procedure TForm1.ToJSONButtonClick(Sender: TObject);
var
jsonObj: TJSONObject;
converter: IJsonAstConverter;
begin
Memo1.Lines.Clear;
if not Assigned(FCurrAst) then
begin
Memo1.Lines.Add('No AST available to serialize. Please generate one first.');
exit;
end;
try
converter := TJsonAstConverter.Create;
jsonObj := converter.Serialize(FCurrAst);
try
Memo1.Lines.Text := jsonObj.Format(4);
finally
jsonObj.Free;
end;
except
on E: Exception do
begin
Memo1.Lines.Add('Error serializing AST to JSON:');
Memo1.Lines.Add(E.Message);
end;
end;
end;
procedure TForm1.DumpButtonClick(Sender: TObject);
var
binder: IAstBinder;
boundNode: IAstNode;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- AST Dump ---');
if not Assigned(FCurrAst) then
begin
Memo1.Lines.Add('No AST has been generated yet. Click a test button first.');
exit;
end;
// Re-bind the current AST against the global scope to ensure up-to-date binding info for the dump.
binder := TAstBinder.Create(FGScope);
boundNode := binder.Execute(FCurrAst, FCurrDesc);
TAstDumper.Dump(boundNode, Memo1.Lines);
end;
procedure TForm1.FibonacciButtonClick(Sender: TObject);
var
root, fibAst, boundFibAst: IAstNode;
@@ -632,16 +902,16 @@ begin
boundCallAst := binder.Execute(callAst, callDescriptor);
// 4. Get the address of 'current_series' from the new descriptor.
var depth, index: Integer;
if not callDescriptor.FindSymbol('current_series', depth, index) then
seriesAddress := callDescriptor.FindSymbol('current_series');
if seriesAddress.Kind = akUnresolved then
raise Exception.Create('Could not resolve current_series address.');
seriesAddress := TResolvedAddress.Create(akLocalOrParent, depth, index);
// 5. Create the final scope and visitor for the simulation loop.
var loopScope := callDescriptor.CreateScope(scope);
var visitor := CreateEvaluator(loopScope);
// 6. Simulation Loop
Memo1.Lines.Clear;
Memo1.Lines.Add('Starting simulation...');
Application.ProcessMessages;
@@ -798,24 +1068,6 @@ begin
UpdateScript;
end;
procedure TForm1.DumpButtonClick(Sender: TObject);
var
binder: IAstBinder;
boundNode: IAstNode;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- AST Dump ---');
if not Assigned(FCurrAst) then
begin
Memo1.Lines.Add('No AST has been generated yet. Click a test button first.');
exit;
end;
boundNode := binder.Execute(FCurrAst, FCurrDesc);
TAstDumper.Dump(boundNode, Memo1.Lines);
end;
procedure TForm1.ExternalFuncButtonClick(Sender: TObject);
var
scope: IExecutionScope;
@@ -898,43 +1150,6 @@ begin
UpdateScript;
end;
procedure TForm1.FromJSONButtonClick(Sender: TObject);
var
jsonString: string;
begin
Memo1.Lines.BeginUpdate;
try
jsonString := Memo1.Lines.Text;
Memo1.Lines.Clear;
if jsonString.IsEmpty then
begin
Memo1.Lines.Add('Memo is empty. Please paste an AST JSON string.');
exit;
end;
try
var binder := TAstBinder.Create(FGScope);
FCurrAst := binder.Execute(TAstJson.Deserialize(jsonString), FCurrDesc);
Memo1.Lines.Add('AST deserialized successfully from JSON.');
Memo1.Lines.Add('You can now visualize it (Middle Mouse Click) or pretty-print it.');
except
on E: Exception do
begin
FCurrAst := nil;
FCurrDesc := nil;
Memo1.Lines.Add('Error deserializing AST from JSON:');
Memo1.Lines.Add(E.Message);
Memo1.Lines.Add('--- Original JSON ---');
Memo1.Lines.Text := Memo1.Lines.Text + sLineBreak + jsonString;
end;
end;
finally
Memo1.Lines.EndUpdate;
end;
UpdateScript;
end;
procedure TForm1.PrintScript(const Node: IAstNode);
begin
try
@@ -960,9 +1175,11 @@ begin
Memo1.Lines.Clear;
try
var binder := TAstBinder.Create(FGScope);
FCurrAst := binder.Execute(TAstScript.Parse(ScriptMemo.Lines.Text), FCurrDesc);
// Execute the entire script block when it changes
var result := ExecuteAst(TAstScript.Parse(ScriptMemo.Lines.Text), FGScope);
Memo1.Lines.Add(Format('Script executed. Final result: %s', [result.ToString]));
// After execution, the FCurrAst is set by ExecuteAst, so we can visualize it
FWorkspace.DeleteChildren;
ShowVizualization(14, 14);
except
@@ -971,30 +1188,6 @@ begin
end;
end;
procedure TForm1.ToJSONButtonClick(Sender: TObject);
var
jsonString: string;
begin
Memo1.Lines.Clear;
if not Assigned(FCurrAst) then
begin
Memo1.Lines.Add('No AST available to serialize. Please generate one first.');
exit;
end;
try
jsonString := TAstJson.Serialize(FCurrAst);
Memo1.Lines.Text := jsonString;
except
on E: Exception do
begin
Memo1.Lines.Add('Error serializing AST to JSON:');
Memo1.Lines.Add(E.Message);
end;
end;
end;
procedure TForm1.UpdateScript;
begin
PrintScript(FCurrAst);