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/ASTPlayground.dpr
+1 -2
View File
@@ -5,13 +5,12 @@ uses
FMX.Forms,
MainForm in 'MainForm.pas' {Form1},
Myc.Ast.Evaluator in '..\Src\AST\Myc.Ast.Evaluator.pas',
Myc.Ast.Printer in '..\Src\AST\Myc.Ast.Printer.pas',
Myc.Ast.Nodes in '..\Src\AST\Myc.Ast.Nodes.pas',
Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas',
Myc.Fmx.AstEditor in 'Myc.Fmx.AstEditor.pas',
Myc.Data.Value in 'Myc.Data.Value.pas',
Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas',
Myc.Ast.Traverser in '..\Src\AST\Myc.Ast.Traverser.pas',
Myc.Ast.Transformer in '..\Src\AST\Myc.Ast.Transformer.pas',
Myc.Ast.Binding in '..\Src\AST\Myc.Ast.Binding.pas',
Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas',
Myc.Ast.Dumper in '..\Src\AST\Myc.Ast.Dumper.pas',
ASTPlayground/ASTPlayground.dproj
+1 -2
View File
@@ -136,13 +136,12 @@
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="..\Src\AST\Myc.Ast.Evaluator.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Printer.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Nodes.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Scope.pas"/>
<DCCReference Include="Myc.Fmx.AstEditor.pas"/>
<DCCReference Include="Myc.Data.Value.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Debugger.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Traverser.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Transformer.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Binding.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.RTL.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Dumper.pas"/>
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;
ASTPlayground/Myc.Fmx.AstEditor.Text.pas
+19 -25
View File
@@ -6,40 +6,34 @@ uses
System.SysUtils,
Myc.Data.Value,
Myc.Data.Scalar,
Myc.Ast.Transformer,
Myc.Ast.Nodes;
type
// This visitor converts an AST expression subtree into a single string.
TAstToTextVisitor = class(TInterfacedObject, IAstVisitor)
TAstToTextVisitor = class(TAstVisitor)
public
{ IAstVisitor }
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
function VisitAssignment(const Node: IAssignmentNode): TDataValue;
function VisitIndexer(const Node: IIndexerNode): TDataValue;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
function VisitRecurNode(const Node: IRecurNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
end;
implementation
function TAstToTextVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
Result := RootNode.Accept(Self);
end;
{ TAstToTextVisitor }
function TAstToTextVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas
+8 -5
View File
@@ -44,7 +44,12 @@ type
procedure DblClick; override;
public
constructor Create(AOwner: TComponent); override;
procedure BuildTree(const RootNode: IAstNode; const RootScope: IExecutionScope; const Position: TPointF; AMode: TVisualizationMode);
procedure BuildTree(
const RootNode: IAstNode;
const RootDescriptor: IScopeDescriptor;
const Position: TPointF;
AMode: TVisualizationMode
);
function GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; override;
function Zoom(Factor: Single): Boolean;
@@ -109,19 +114,17 @@ end;
procedure TAuraWorkspace.BuildTree(
const RootNode: IAstNode;
const RootScope: IExecutionScope;
const RootDescriptor: IScopeDescriptor;
const Position: TPointF;
AMode: TVisualizationMode
);
var
connections: TList<TPinConnection>;
rootDescriptor: IScopeDescriptor;
begin
connections := TList<TPinConnection>.Create;
try
// Create the scope descriptor from the execution scope provided by the binder.
rootDescriptor := TAstBinder.CreateDescriptor(RootScope);
RootNode.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode, nil, nil, rootDescriptor));
RootNode.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode, nil, nil, RootDescriptor));
FConnections := FConnections + connections.ToArray;
finally
connections.Free;
ASTPlayground/Myc.Fmx.AstEditor.pas
+70 -50
View File
@@ -17,6 +17,7 @@ uses
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Scope,
Myc.Ast.Transformer, // Für TAstVisitor
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Workspace;
@@ -30,7 +31,7 @@ type
TPinShape = (psCircle, psTriangle);
TPinAlignment = (paLeft, paRight);
TAstToAuraNodeVisitor = class(TInterfacedObject, IAstVisitor)
TAstToAuraNodeVisitor = class(TAstVisitor)
public
type
TAuraNodeResult = record
@@ -101,24 +102,24 @@ type
property Connections: TList<TPinConnection> read FConnections;
{ IAstVisitor }
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
function VisitAssignment(const Node: IAssignmentNode): TDataValue;
function VisitIndexer(const Node: IIndexerNode): TDataValue;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
function VisitRecurNode(const Node: IRecurNode): TDataValue;
procedure Execute(const RootNode: IAstNode);
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
end;
implementation
@@ -128,6 +129,7 @@ uses
System.StrUtils,
FMX.Platform,
Myc.Data.Scalar,
Myc.Ast.Binding, // For TBound...Node classes
Myc.Fmx.AstEditor.Text;
{ TAstToAuraNodeVisitor }
@@ -339,9 +341,9 @@ begin
Result.TagString := Tag;
end;
function TAstToAuraNodeVisitor.Execute(const RootNode: IAstNode): TDataValue;
procedure TAstToAuraNodeVisitor.Execute(const RootNode: IAstNode);
begin
Result := RootNode.Accept(Self);
RootNode.Accept(Self)
end;
function TAstToAuraNodeVisitor.TryGetDescr(const Node: IAstNode; out Text: String): Boolean;
@@ -349,8 +351,7 @@ begin
if FMode <> vmControlFlow then
exit(false);
var textVisitor: IAstVisitor := TAstToTextVisitor.Create;
Text := Node.Accept(textVisitor).AsText;
Text := Node.Accept(TAstToTextVisitor.Create).AsText;
Result := Pos('{', Text) = 0;
end;
@@ -612,11 +613,13 @@ function TAstToAuraNodeVisitor.VisitIdentifier(const Node: IIdentifierNode): TDa
var
existingResult: TAuraNodeResult;
identifierNode: TAuraNode;
boundNode: TBoundIdentifierNode;
begin
if Node.Address.Kind <> akUnresolved then
if Node is TBoundIdentifierNode then
begin
// FindNodeForAddress now handles all cases: local cache, on-demand parameter creation, and recursive parent/upvalue lookup.
if FindNodeForAddress(Node.Address, existingResult) then
boundNode := Node as TBoundIdentifierNode;
// FindNodeForAddress handles all cases: local cache, on-demand parameter creation, and recursive parent/upvalue lookup.
if FindNodeForAddress(boundNode.Address, existingResult) then
begin
FLastResult := existingResult;
end
@@ -632,7 +635,7 @@ begin
end
else
begin
identifierNode := CreateNodeControl('Identifier', Node.Name);
identifierNode := CreateNodeControl('Identifier (unbound)', Node.Name);
FLastResult.LayoutNode := identifierNode;
FLastResult.OutputPin := CreateOutput(identifierNode);
FinalizeNodeLayout(identifierNode);
@@ -756,12 +759,14 @@ var
originalAddress: TResolvedAddress;
targetVisitor: TAstToAuraNodeVisitor;
i: Integer;
boundLambda: TBoundLambdaExpressionNode;
begin
if (Address.Kind = akUpvalue) and Assigned(FCurrentLambda) then
if (Address.Kind = akUpvalue) and Assigned(FCurrentLambda) and (FCurrentLambda is TBoundLambdaExpressionNode) then
begin
if Address.SlotIndex < Length(FCurrentLambda.Upvalues) then
boundLambda := FCurrentLambda as TBoundLambdaExpressionNode;
if Address.SlotIndex < Length(boundLambda.Upvalues) then
begin
originalAddress := FCurrentLambda.Upvalues[Address.SlotIndex];
originalAddress := boundLambda.Upvalues[Address.SlotIndex];
if Assigned(FParentVisitor) then
exit(FParentVisitor.FindNodeForAddress(originalAddress, NodeResult));
end;
@@ -799,14 +804,26 @@ var
control: TControl;
childLastResult: TAuraNodeResult;
entryNode, exitNode: TAuraNode;
boundNode: TBoundLambdaExpressionNode;
begin
// This visitor must operate on a bound AST.
if not (Node is TBoundLambdaExpressionNode) then
begin
lambdaNode := CreateNodeControl(#$03BB, '(unbound)');
FinalizeNodeLayout(lambdaNode);
FLastResult.LayoutNode := lambdaNode;
FLastResult.OutputPin := CreateOutput(lambdaNode);
exit(TDataValue.Void);
end;
boundNode := Node as TBoundLambdaExpressionNode;
// Parameter string for the title
paramStr := '(';
if Length(Node.Parameters) > 0 then
if Length(boundNode.Parameters) > 0 then
begin
paramStr := paramStr + Node.Parameters[0].Name;
for i := 1 to High(Node.Parameters) do
paramStr := paramStr + ', ' + Node.Parameters[i].Name;
paramStr := paramStr + boundNode.Parameters[0].Name;
for i := 1 to High(boundNode.Parameters) do
paramStr := paramStr + ', ' + boundNode.Parameters[i].Name;
end;
paramStr := paramStr + ')';
@@ -822,8 +839,6 @@ begin
entryNode.Parent := lambdaNode;
entryNode.Position.Point := TPointF.Create(0, 0);
entryNode.Height := pinNodeHeight;
// A lambda expression is a value, it doesn't connect to the parent execution flow.
// Its internal flow starts with the exit of the 'call' node.
var internalExec: TArray<TControl> := [CreateExit(entryNode, '')];
FinalizeNodeLayout(entryNode);
@@ -831,24 +846,25 @@ begin
childStartPos := TPointF.Create(FSpacing.X, FSpacing.Y + pinNodeHeight);
childVisitor :=
TAstToAuraNodeVisitor
.Create(FWorkspace, lambdaNode, childStartPos, FConnections, internalExec, FMode, Self, Node, Node.ScopeDescriptor);
.Create(FWorkspace, lambdaNode, childStartPos, FConnections, internalExec, FMode, Self, Node, boundNode.ScopeDescriptor);
FCurrentExec.Clear;
// 4. Let the child visitor create parameter nodes and visit the lambda body.
for var param in Node.Parameters do
for var param in boundNode.Parameters do
begin
if param.Address.Kind <> akUnresolved then
begin
var paramNode := childVisitor.CreateNodeControl('Parameter', param.Name);
var paramResult: TAuraNodeResult;
paramResult.LayoutNode := paramNode;
paramResult.OutputPin := childVisitor.CreateOutput(paramNode);
childVisitor.FinalizeNodeLayout(paramNode);
childVisitor.FSlotCache[param.Address.SlotIndex] := paramResult;
end;
if param is TBoundIdentifierNode then
with (param as TBoundIdentifierNode) do
begin
var paramNode := childVisitor.CreateNodeControl('Parameter', Name);
var paramResult: TAuraNodeResult;
paramResult.LayoutNode := paramNode;
paramResult.OutputPin := childVisitor.CreateOutput(paramNode);
childVisitor.FinalizeNodeLayout(paramNode);
childVisitor.FSlotCache[Address.SlotIndex] := paramResult;
end;
end;
Node.Body.Accept(childVisitor);
boundNode.Body.Accept(childVisitor);
childLastResult := childVisitor.FLastResult;
// 5. Resize container to fit all internally generated nodes.
@@ -1138,6 +1154,7 @@ var
oldParentControl: TControl;
oldPos: TPointF;
control: TControl;
boundIdentifier: TBoundIdentifierNode;
begin
if (FMode = vmControlFlow) and TryGetDescr(Node, details) then
begin
@@ -1194,8 +1211,11 @@ begin
FCurrentPos.Y := varDeclNode.Position.Y + varDeclNode.Height + FSpacing.Y;
// 8. Die neue Variable im Cache des aktuellen Scopes registrieren.
if Node.Identifier.Address.Kind <> akUnresolved then
FSlotCache[Node.Identifier.Address.SlotIndex] := FLastResult;
if Node.Identifier is TBoundIdentifierNode then
begin
boundIdentifier := Node.Identifier as TBoundIdentifierNode;
FSlotCache[boundIdentifier.Address.SlotIndex] := FLastResult;
end;
end;
Result := TDataValue.Void;
end;