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

Major refactoring, split Bound Ast from source Ast

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-22 19:56:51 +02:00
parent 8041f7355f
commit c573628fe5
17 changed files with 1231 additions and 1291 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.pas
+100 -128
View File
@@ -26,7 +26,6 @@ uses
Myc.Ast.Nodes,
Myc.Ast,
Myc.Ast.Evaluator,
Myc.Ast.Printer,
Myc.Ast.Dumper,
Myc.Data.Decimal,
Myc.Ast.Binding,
@@ -100,14 +99,14 @@ type
procedure TailCallButtenClick(Sender: TObject);
procedure ToJSONButtonClick(Sender: TObject);
private
// Stores the last AST generated by Test1 or Test2 button clicks.
FLastAst: IAstNode;
FCurrAst: IAstNode;
FCurrDesc: IScopeDescriptor;
FGScope: IExecutionScope;
FWorkspace: TAuraWorkspace;
FTriggerScope: IExecutionScope;
FScriptUpdate: Boolean;
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
function CreateVisitor(Scope: IExecutionScope): IAstVisitor;
function CreateEvaluator(Scope: IExecutionScope): IEvaluatorVisitor;
// Helper function to encapsulate the Bind -> Evaluate pattern
function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
procedure UpdateScript;
@@ -131,65 +130,50 @@ uses
procedure TForm1.InnerLambdaButtonClick(Sender: TObject);
var
// Only the root node is needed as a local variable.
mainBlock: IAstNode;
// Execution and result variables
resultValue: TDataValue;
begin
// Build the entire AST inline to ensure no node instances are shared.
mainBlock :=
TAst.Block(
[
// var outer = lambda() { ... };
TAst.VarDecl(
TAst.Identifier('outer'),
TAst.LambdaExpr(
[],
TAst.Block(
[
// var x = 10;
TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(10)),
// var inner = lambda() { ... };
TAst.VarDecl(
TAst.Identifier('inner'),
TAst.LambdaExpr(
[],
TAst.Block(
[
// var innermost = lambda() { ... };
TAst.VarDecl(
TAst.Identifier('innermost'),
TAst.LambdaExpr(
[],
// x = x + 5;
TAst.Assign(
TAst.Identifier('x'),
TAst.BinaryExpr(TAst.Identifier('x'), TScalar.TBinaryOp.Add, TAst.Constant(5))
)
)
),
// innermost();
TAst.FunctionCall(TAst.Identifier('innermost'), [])
]
)
)
),
// inner();
TAst.FunctionCall(TAst.Identifier('inner'), []),
// return x;
TAst.Identifier('x')
]
)
)
),
// var finalResult = outer();
TAst.VarDecl(TAst.Identifier('finalResult'), TAst.FunctionCall(TAst.Identifier('outer'), []))
]
);
FLastAst := mainBlock;
resultValue := ExecuteAst(mainBlock, FGScope);
Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15, but is ' + resultValue.AsScalar.ToString);
@@ -201,18 +185,22 @@ begin
FWorkspace.DeleteChildren;
FWorkspace.Repaint;
// Create and prepare the global scope once
FGScope := TAst.CreateScope(nil);
RegisterNativeFunctions(FGScope);
end;
function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
var
binder: IAstBinder;
scriptScope: IExecutionScope;
visitor: IEvaluatorVisitor;
begin
// This helper function handles simple, one-off script executions.
// It binds the AST and then decides whether to run a debug session or a standard evaluation.
var scriptScope := TAstBinder.Bind(ANode, AParentScope).CreateScope(AParentScope);
var visitor := CreateVisitor(scriptScope);
Result := visitor.Execute(ANode);
binder := TAstBinder.Create(AParentScope);
FCurrAst := binder.Execute(ANode, FCurrDesc);
scriptScope := FCurrDesc.CreateScope(AParentScope);
visitor := CreateEvaluator(scriptScope);
Result := visitor.Execute(FCurrAst);
end;
procedure TForm1.FormCreate(Sender: TObject);
@@ -221,13 +209,18 @@ begin
FWorkspace.Parent := Panel2;
FWorkspace.Align := TAlignLayout.Client;
FWorkspace.ClipChildren := true;
FWorkspace.OnMouseDown := WorkspaceMouseDown;
Tast.RegisterLibrary(
procedure(const Scope: IExecutionScope)
var
smaAst, boundSmaAst: IAstNode;
binder: IAstBinder;
smaDescriptor: IScopeDescriptor;
smaScope: IExecutionScope;
smaVisitor: IEvaluatorVisitor;
begin
var smaAst :=
smaAst :=
TAst.LambdaExpr(
[TAst.Identifier('len')],
TAst.Block(
@@ -278,28 +271,32 @@ begin
)
);
Scope.Define('CreateSMA', CreateVisitor(TAstBinder.Bind(smaAst, FGScope).CreateScope(FGScope)).Execute(smaAst));
binder := TAstBinder.Create(FGScope);
boundSmaAst := binder.Execute(smaAst, smaDescriptor);
smaScope := smaDescriptor.CreateScope(FGScope);
smaVisitor := CreateEvaluator(smaScope);
Scope.Define('CreateSMA', smaVisitor.Execute(boundSmaAst));
end
);
// Setup global scope
ClearButtonClick(Self);
end;
procedure TForm1.FibonacciButtonClick(Sender: TObject);
var
root: IAstNode;
root, fibAst, boundFibAst: IAstNode;
result: TDataValue;
sw: TStopwatch;
fibScope: IExecutionScope;
visitor: IEvaluatorVisitor;
binder: IAstBinder;
begin
// This script defines a naive, slow recursive 'fib' function (on purpose!).
// The lambda captures its own name ('fib') from the parent scope to perform recursion.
var fibAst :=
fibAst :=
TAst.Block(
[
// 1. var fib; (Declare the name so it can be captured by the lambda)
TAst.VarDecl(TAst.Identifier('fib')),
// 2. fib = lambda(n) { ... fib(n-1) + fib(n-2) ... };
TAst.Assign(
TAst.Identifier('fib'),
TAst.LambdaExpr(
@@ -308,13 +305,11 @@ begin
TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Less, TAst.Constant(2)),
TAst.Identifier('n'),
TAst.BinaryExpr(
// Naive recursive call using the variable name 'fib'
TAst.FunctionCall(
TAst.Identifier('fib'),
[TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))]
),
TScalar.TBinaryOp.Add,
// Second naive recursive call
TAst.FunctionCall(
TAst.Identifier('fib'),
[TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(2))]
@@ -326,25 +321,22 @@ begin
]
);
// Create a new scope and define the 'fib' function within it.
var fibScope := TAstBinder.Bind(fibAst, FGScope).CreateScope(FGScope);
var visitor := CreateVisitor(fibScope);
visitor.Execute(fibAst);
binder := TAstBinder.Create(FGScope);
var desc: IScopeDescriptor;
boundFibAst := binder.Execute(fibAst, desc);
fibScope := desc.CreateScope(FGScope);
visitor := CreateEvaluator(fibScope);
visitor.Execute(boundFibAst);
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Naive recursive fib with AST---');
sw := TStopwatch.StartNew;
// The script to execute is just the call to the function.
root := TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]);
FLastAst := root;
// Execute within the scope where 'fib' is defined.
result := ExecuteAst(root, fibScope);
sw.Stop;
Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
Memo1.Lines.Add(Format('Result: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
Memo1.Lines.Add('');
Memo1.Lines.Add('--- Memoized naive fib with AST (using global fib)---');
@@ -353,37 +345,29 @@ begin
root :=
TAst.Block(
[
// Create a memoized version by calling the RTL function on 'fib'
TAst.Assign(TAst.Identifier('fib'), TAst.FunctionCall(TAst.Identifier('Memoize'), [TAst.Identifier('fib')])),
// Call the new, memoized function
TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)])
]
);
FLastAst := root;
result := ExecuteAst(root, fibScope);
sw.Stop;
Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
Memo1.Lines.Add(Format('Result: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
UpdateScript;
end;
procedure TForm1.PrettyPrintButtonClick(Sender: TObject);
var
visitor: TPrettyPrintVisitor;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- AST Pretty Print ---');
if not Assigned(FLastAst) then
if not Assigned(FCurrAst) then
begin
Memo1.Lines.Add('No AST has been generated yet.');
exit;
end;
visitor := TPrettyPrintVisitor.Create;
visitor.Execute(FLastAst);
Memo1.Lines.Add(visitor.GetResult);
Memo1.Lines.Add(TAstScript.Print(FCurrAst));
end;
procedure TForm1.RecursionButtonClick(Sender: TObject);
@@ -430,7 +414,6 @@ begin
]
);
FLastAst := root;
// Execute with FGScope as parent.
result := ExecuteAst(root, FGScope);
@@ -459,14 +442,12 @@ begin
for i := 0 to 4 do
begin
// TScalar can no longer hold TDateTime, convert to Int64 for the test.
values[0].AsInt64 := Round((Now + i) * 24 * 60 * 60 * 1000);
values[1].AsDouble := 100.0 + i;
values[2].AsDouble := 105.0 + i;
values[3].AsDouble := 98.0 + i;
values[4].AsDouble := 102.0 + i;
values[5].AsInt64 := 10000 * (i + 1);
series.Add(TScalarRecord.Create(recordDef, values));
end;
scope.Define('ohlcvSeries', TDataValue.FromRecordSeries(series));
@@ -485,7 +466,6 @@ begin
)
);
FLastAst := ast;
callAst := TAst.FunctionCall(ast, []);
resultValue := ExecuteAst(callAst, scope);
@@ -515,7 +495,6 @@ begin
)
);
FLastAst := main;
callAst := TAst.FunctionCall(main, []);
result := ExecuteAst(callAst, FGScope);
@@ -554,7 +533,6 @@ begin
]
);
FLastAst := root;
result := ExecuteAst(root, FGScope);
sw.Stop;
@@ -566,7 +544,6 @@ procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift
begin
if Button <> TMouseButton.mbMiddle then
exit;
ShowVizualization(X, Y);
end;
@@ -580,11 +557,15 @@ var
scope: IExecutionScope;
values: TArray<TScalar.TValue>;
recordValue: TScalarRecord;
binder: IAstBinder;
setupAst, boundSetupAst, callAst, boundCallAst: IAstNode;
setupDescriptor, callDescriptor: IScopeDescriptor;
seriesAddress: TResolvedAddress;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs]));
var sw := TStopwatch.StartNew;
var setupAst :=
setupAst :=
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('smaFast'), TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(smaFastLength)])),
@@ -633,27 +614,34 @@ begin
]
);
FLastAst := setupAst;
// 1. Bind and execute the setup script.
scope := TAstBinder.Bind(setupAst, FGScope).CreateScope(FGScope);
binder := TAstBinder.Create(FGScope);
boundSetupAst := binder.Execute(setupAst, setupDescriptor);
// This is a temporary visitor just for the setup execution.
var setupVisitor := CreateVisitor(scope);
setupVisitor.Execute(setupAst);
scope := setupDescriptor.CreateScope(FGScope);
var setupVisitor := CreateEvaluator(scope);
setupVisitor.Execute(boundSetupAst);
// 2. Prepare for the simulation loop by modifying the now-populated scope.
// 2. Prepare for the simulation loop
scope.Define('current_series', TDataValue.Void);
var currentSeriesIdent := TAst.Identifier('current_series');
var callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
// 3. Re-bind the scope with the new AST. This creates the FINAL scope for the loop.
scope := TAstBinder.Bind(callAst, scope).CreateScope(scope);
var seriesAddress := currentSeriesIdent.Address;
// 3. Re-bind the call AST within the now-populated scope to resolve the new variable.
binder := TAstBinder.Create(scope);
boundCallAst := binder.Execute(callAst, callDescriptor);
var visitor := CreateVisitor(scope);
// 4. Get the address of 'current_series' from the new descriptor.
var depth, index: Integer;
if not callDescriptor.FindSymbol('current_series', depth, index) then
raise Exception.Create('Could not resolve current_series address.');
seriesAddress := TResolvedAddress.Create(akLocalOrParent, depth, index);
// 5. Simulation Loop
// 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.Add('Starting simulation...');
Application.ProcessMessages;
@@ -686,8 +674,8 @@ begin
if series.AsRecordSeries.TotalCount >= smaSlowLength then
begin
scope[seriesAddress] := series;
var resultValue := visitor.Execute(callAst);
loopScope[seriesAddress] := series;
var resultValue := visitor.Execute(boundCallAst);
if i mod 50 = 0 then
begin
Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
@@ -704,7 +692,6 @@ end;
procedure TForm1.TailCallButtenClick(Sender: TObject);
const
// A large number to prove TCO prevents stack overflow
RecursionDepth = 1000000;
var
root: IAstNode;
@@ -719,27 +706,21 @@ begin
root :=
TAst.Block(
[
// var countDown = lambda(n) { ... };
TAst.VarDecl(
TAst.Identifier('countDown'),
TAst.LambdaExpr(
[TAst.Identifier('n')],
// if (n > 0) then recur(n-1) else 0
TAst.IfExpr(
TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Greater, TAst.Constant(0)),
// This is the tail call position, now using recur.
TAst.Recur([TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))]),
// Base case of the recursion returns 0
TAst.Constant(0)
)
)
),
// Initial call to start the recursion
TAst.FunctionCall(TAst.Identifier('countDown'), [TAst.Constant(RecursionDepth)])
]
);
FLastAst := root;
result := ExecuteAst(root, FGScope);
sw.Stop;
@@ -751,6 +732,8 @@ end;
procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject);
var
blk: IAstNode;
binder: IAstBinder;
visitor: IEvaluatorVisitor;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
@@ -771,20 +754,19 @@ begin
]
);
FTriggerScope := TAstBinder.Bind(blk, FGScope).CreateScope(FGScope);
binder := TAstBinder.Create(FGScope);
FCurrAst := binder.Execute(blk, FCurrDesc);
FTriggerScope := FCurrDesc.CreateScope(FGScope);
// This case is simple enough to just inline the logic from ExecuteAst
var visitor := CreateVisitor(FTriggerScope);
visitor.Execute(blk);
FLastAst := blk;
visitor := CreateEvaluator(FTriggerScope);
visitor.Execute(FCurrAst);
Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.');
Memo1.Lines.Add('Click "Do Trigger" to execute.');
UpdateScript;
end;
function TForm1.CreateVisitor(Scope: IExecutionScope): IAstVisitor;
function TForm1.CreateEvaluator(Scope: IExecutionScope): IEvaluatorVisitor;
begin
if DebugBox.IsChecked then
Result := TDebugEvaluatorVisitor.Create(Scope, Memo1.Lines, ShowScopeBox.IsChecked)
@@ -797,7 +779,6 @@ var
callAst: IFunctionCallNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(1)]);
FLastAst := callAst;
var X := ExecuteAst(callAst, FTriggerScope);
@@ -810,7 +791,6 @@ var
callAst: IFunctionCallNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(2)]);
FLastAst := callAst;
var X := ExecuteAst(callAst, FTriggerScope);
@@ -819,18 +799,21 @@ begin
end;
procedure TForm1.DumpButtonClick(Sender: TObject);
var
binder: IAstBinder;
boundNode: IAstNode;
begin
// Call the dumper for the last AST.
Memo1.Lines.Clear;
Memo1.Lines.Add('--- AST Dump ---');
if not Assigned(FLastAst) then
if not Assigned(FCurrAst) then
begin
Memo1.Lines.Add('No AST has been generated yet. Click a test button first.');
exit;
end;
TAstDumper.Dump(FLastAst, Memo1.Lines);
boundNode := binder.Execute(FCurrAst, FCurrDesc);
TAstDumper.Dump(boundNode, Memo1.Lines);
end;
procedure TForm1.ExternalFuncButtonClick(Sender: TObject);
@@ -860,7 +843,6 @@ begin
callAst := TAst.FunctionCall(TAst.Identifier('delphiAdd'), [TAst.Constant(100), TAst.Constant(123)]);
FLastAst := callAst;
resultValue := ExecuteAst(callAst, scope);
Memo1.Lines.Add(Format('Result from delphiAdd(100, 123): %s', [resultValue.ToString]));
UpdateScript;
@@ -874,10 +856,7 @@ begin
mainBlock :=
TAst.Block(
[
// 1. Define the shared variable.
TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)),
// 2. Define a function that returns a closure that MODIFIES 'a'.
// This creates the multi-level capture scenario.
TAst.VarDecl(
TAst.Identifier('modifier'),
TAst.LambdaExpr(
@@ -891,34 +870,23 @@ begin
)
)
),
// 3. Define a simple closure that READS 'a'.
TAst.VarDecl(TAst.Identifier('reader'), TAst.LambdaExpr([], TAst.Identifier('a'))),
// --- Execute the test ---
// 4. Get the inner modifier closure.
TAst.VarDecl(TAst.Identifier('innermost_closure'), TAst.FunctionCall(TAst.Identifier('modifier'), [])),
// 5. Call the inner closure to modify 'a'.
TAst.FunctionCall(TAst.Identifier('innermost_closure'), []),
// 6. Call the reader to get the final value.
TAst.FunctionCall(TAst.Identifier('reader'), [])
]
);
FLastAst := mainBlock;
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Executing Corrected Upvalue Test ---');
resultValue := ExecuteAst(mainBlock, FGScope);
// With a correct binder and evaluator, the result must be 15.
var res := resultValue.AsScalar.Value.AsInt64;
if res = 15 then
begin
Memo1.Lines.Add('SUCCESS: The result is 15.');
end
Memo1.Lines.Add('SUCCESS: The result is 15.')
else
begin
Memo1.Lines.Add(Format('FAILURE: Expected 15, but got %s.', [resultValue.ToString]));
end;
Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15.');
Memo1.Lines.Add('Please check the new dump.');
@@ -946,13 +914,15 @@ begin
end;
try
FLastAst := TAstJson.Deserialize(jsonString);
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
FLastAst := nil;
FCurrAst := nil;
FCurrDesc := nil;
Memo1.Lines.Add('Error deserializing AST from JSON:');
Memo1.Lines.Add(E.Message);
Memo1.Lines.Add('--- Original JSON ---');
@@ -970,7 +940,10 @@ begin
try
FScriptUpdate := true;
try
ScriptMemo.Lines.Text := ScriptMemo.Lines.Text + #10#13 + TAstScript.Print(Node);
if Assigned(Node) then
ScriptMemo.Lines.Text := TAstScript.Print(Node)
else
ScriptMemo.Lines.Clear;
finally
FScriptUpdate := false;
end;
@@ -987,7 +960,8 @@ begin
Memo1.Lines.Clear;
try
FLastAst := TAstScript.Parse(ScriptMemo.Lines.Text);
var binder := TAstBinder.Create(FGScope);
FCurrAst := binder.Execute(TAstScript.Parse(ScriptMemo.Lines.Text), FCurrDesc);
FWorkspace.DeleteChildren;
ShowVizualization(14, 14);
@@ -1003,14 +977,14 @@ var
begin
Memo1.Lines.Clear;
if not Assigned(FLastAst) then
if not Assigned(FCurrAst) then
begin
Memo1.Lines.Add('No AST available to serialize. Please generate one first.');
exit;
end;
try
jsonString := TAstJson.Serialize(FLastAst);
jsonString := TAstJson.Serialize(FCurrAst);
Memo1.Lines.Text := jsonString;
except
on E: Exception do
@@ -1023,8 +997,7 @@ end;
procedure TForm1.UpdateScript;
begin
Memo1.Lines.Clear;
PrintScript(FLastAst);
PrintScript(FCurrAst);
FWorkspace.DeleteChildren;
ShowVizualization(14, 14);
@@ -1032,14 +1005,13 @@ end;
procedure TForm1.ShowVizualization(X, Y: Single);
begin
if FLastAst <> nil then
if FCurrAst <> nil then
begin
var visu := TVisualizationMode.vmDetailed;
if FlowOnlyBox.IsChecked then
visu := TVisualizationMode.vmControlFlow;
var descr := TAstBinder.Bind(FLastAst, FGScope);
FWorkspace.BuildTree(FLastAst, descr.CreateScope(FGScope), TPointF.Create(X, Y), visu);
FWorkspace.BuildTree(FCurrAst, FCurrDesc, TPointF.Create(X, Y), visu);
end;
end;