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
+64 -44
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
if param is TBoundIdentifierNode then
with (param as TBoundIdentifierNode) do
begin
var paramNode := childVisitor.CreateNodeControl('Parameter', param.Name);
var paramNode := childVisitor.CreateNodeControl('Parameter', Name);
var paramResult: TAuraNodeResult;
paramResult.LayoutNode := paramNode;
paramResult.OutputPin := childVisitor.CreateOutput(paramNode);
childVisitor.FinalizeNodeLayout(paramNode);
childVisitor.FSlotCache[param.Address.SlotIndex] := paramResult;
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;
Src/AST/Myc.Ast.Binding.pas
+316 -315
View File
@@ -8,16 +8,25 @@ uses
System.Generics.Collections,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Traverser,
Myc.Ast.Scope;
Myc.Ast.Transformer,
Myc.Ast.Scope,
Myc.Ast;
type
TAstBinder = class(TAstTraverser)
// The binder is a transformer that enriches the AST with semantic information
// like resolved addresses, scopes, and tail-call annotations.
IAstBinder = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
end;
TAstBinder = class(TAstTransformer, IAstBinder)
private
type
// Helper class to track upvalues for a lambda expression.
TUpvalueMapping = class
public
Map: TDictionary<TResolvedAddress, Integer>;
Nodes: TList<IIdentifierNode>;
public
constructor Create;
destructor Destroy; override;
end;
@@ -27,60 +36,87 @@ type
FNestedLambdaCount: Integer;
FIsTailStack: TStack<Boolean>;
FNextIsTail: Boolean;
procedure EnterScope;
procedure ExitScope;
protected
function Accept(const Node: IAstNode): TDataValue; override;
function GetCurrentDescriptor: IScopeDescriptor;
function IsValidIdentifier(const Name: string): Boolean;
protected
// Stack management for tail-call state is centralized here.
function Accept(const Node: IAstNode): TDataValue; override;
public
constructor Create(const AInitialScope: IExecutionScope);
destructor Destroy; override;
class function Bind(const RootNode: IAstNode; const ParentScope: IExecutionScope): IScopeDescriptor;
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; static;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
// The binder overrides specific transform methods to enrich the AST.
function TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; override;
function TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; override;
function TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; override;
function TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; override;
function TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; override;
function TransformRecur(const Node: IRecurNode): IRecurNode; override;
function TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; override;
function TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; override;
function TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; override;
function TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; override;
function TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; override;
property CurrentDescriptor: IScopeDescriptor read FCurrentDescriptor;
property CurrentDescriptor: IScopeDescriptor read GetCurrentDescriptor;
end;
TBoundIdentifierNode = class(TIdentifierNode)
private
FAddress: TResolvedAddress;
public
constructor Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress);
property Address: TResolvedAddress read FAddress;
end;
TBoundLambdaExpressionNode = class(TLambdaExpressionNode)
private
FScopeDescriptor: IScopeDescriptor;
FUpvalues: TArray<TResolvedAddress>;
FHasNestedLambdas: Boolean;
public
constructor Create(
const AUnboundNode: ILambdaExpressionNode;
const ABody: IAstNode;
const AParameters: TArray<IIdentifierNode>;
const AScopeDescriptor: IScopeDescriptor;
const AUpvalues: TArray<TResolvedAddress>;
AHasNestedLambdas: Boolean
);
property ScopeDescriptor: IScopeDescriptor read FScopeDescriptor;
property Upvalues: TArray<TResolvedAddress> read FUpvalues;
property HasNestedLambdas: Boolean read FHasNestedLambdas;
end;
TBoundFunctionCallNode = class(TFunctionCallNode)
private
FIsTailCall: Boolean;
public
constructor Create(
const AUnboundNode: IFunctionCallNode;
const ACallee: IAstNode;
const AArguments: TArray<IAstNode>;
AIsTailCall: Boolean
);
property IsTailCall: Boolean read FIsTailCall;
end;
implementation
uses
System.Generics.Defaults,
System.Character,
Myc.Ast;
System.Character;
type
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
private
FParent: IScopeDescriptor;
FSymbols: TDictionary<string, Integer>;
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
public
constructor Create(const AParent: IScopeDescriptor);
destructor Destroy; override;
function Define(const Name: string): Integer;
function FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(Scope: TExecutionScope);
property Symbols: TDictionary<string, Integer> read FSymbols;
end;
// A custom equality comparer for TResolvedAddress to ensure correct behavior in TDictionary.
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
public
@@ -88,73 +124,68 @@ type
function GetHashCode(const Value: TResolvedAddress): Integer; override;
end;
{ TResolvedAddressComparer }
{ TBoundIdentifierNode }
constructor TBoundIdentifierNode.Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress);
begin
inherited Create(AUnboundNode.Name);
FAddress := AAddress;
end;
{ TBoundLambdaExpressionNode }
constructor TBoundLambdaExpressionNode.Create(
const AUnboundNode: ILambdaExpressionNode;
const ABody: IAstNode;
const AParameters: TArray<IIdentifierNode>;
const AScopeDescriptor: IScopeDescriptor;
const AUpvalues: TArray<TResolvedAddress>;
AHasNestedLambdas: Boolean
);
begin
inherited Create(AParameters, ABody);
FScopeDescriptor := AScopeDescriptor;
FUpvalues := AUpvalues;
FHasNestedLambdas := AHasNestedLambdas;
end;
{ TBoundFunctionCallNode }
constructor TBoundFunctionCallNode.Create(
const AUnboundNode: IFunctionCallNode;
const ACallee: IAstNode;
const AArguments: TArray<IAstNode>;
AIsTailCall: Boolean
);
begin
inherited Create(ACallee, AArguments);
FIsTailCall := AIsTailCall;
end;
{ TResolvedAddressComparer }
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
begin
// Use the existing equality operator for the record.
Result := (Left = Right);
end;
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
begin
// Classic hash combining algorithm using prime numbers.
Result := 17;
Result := Result * 23 + Ord(Value.Kind);
Result := Result * 23 + Value.ScopeDepth;
Result := Result * 23 + Value.SlotIndex;
end;
{ TAstBinder }
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
{ TAstBinder.TUpvalueMapping }
constructor TAstBinder.TUpvalueMapping.Create;
begin
inherited Create;
FCurrentDescriptor := CreateDescriptor(AInitialScope);
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(true);
FNestedLambdaCount := 0;
FIsTailStack := TStack<Boolean>.Create;
// The content of the root node is in a tail position.
FNextIsTail := true;
Map := TDictionary<TResolvedAddress, Integer>.Create(TResolvedAddressComparer.Create);
Nodes := TList<IIdentifierNode>.Create();
end;
destructor TAstBinder.Destroy;
destructor TAstBinder.TUpvalueMapping.Destroy;
begin
FIsTailStack.Free;
FUpvalueStack.Free;
inherited;
end;
function TAstBinder.Accept(const Node: IAstNode): TDataValue;
begin
if not Assigned(Node) or Done then
exit;
FIsTailStack.Push(FNextIsTail);
try
Result := inherited Accept(Node);
finally
FNextIsTail := FIsTailStack.Pop;
end;
end;
class function TAstBinder.Bind(const RootNode: IAstNode; const ParentScope: IExecutionScope): IScopeDescriptor;
var
binder: TAstBinder;
begin
binder := TAstBinder.Create(ParentScope);
try
binder.EnterScope;
try
// Start the traversal
binder.Accept(RootNode);
Result := binder.CurrentDescriptor;
finally
binder.ExitScope;
end;
finally
binder.Free;
end;
Nodes.Free;
Map.Free;
inherited Destroy;
end;
class function TAstBinder.CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor;
@@ -169,156 +200,190 @@ begin
Result := TScopeDescriptor.Create(nil);
end;
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
begin
inherited Create;
FCurrentDescriptor := CreateDescriptor(AInitialScope);
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True);
FNestedLambdaCount := 0;
FIsTailStack := TStack<Boolean>.Create;
FNextIsTail := True;
end;
destructor TAstBinder.Destroy;
begin
FIsTailStack.Free;
FUpvalueStack.Free;
inherited;
end;
function TAstBinder.Accept(const Node: IAstNode): TDataValue;
begin
if (not Assigned(Node)) or Done then
exit;
FIsTailStack.Push(FNextIsTail);
try
Result := inherited Accept(Node);
finally
FNextIsTail := FIsTailStack.Pop;
end;
end;
procedure TAstBinder.EnterScope;
begin
FCurrentDescriptor := TScopeDescriptor.Create(FCurrentDescriptor);
end;
function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
EnterScope;
try
Result := Accept(RootNode).AsIntf<IAstNode>;
Descriptor := FCurrentDescriptor;
finally
ExitScope;
end;
end;
procedure TAstBinder.ExitScope;
begin
FCurrentDescriptor := FCurrentDescriptor.Parent;
end;
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
function TAstBinder.GetCurrentDescriptor: IScopeDescriptor;
begin
FNextIsTail := False;
inherited;
Result := FCurrentDescriptor;
end;
function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
function TAstBinder.IsValidIdentifier(const Name: string): Boolean;
var
c: Char;
begin
FNextIsTail := False;
inherited;
if Name.IsEmpty then
exit(False);
c := Name[1];
if not (c.IsLetter or (c = '_')) then
exit(False);
for c in Name do
begin
if not (c.IsLetterOrDigit or (c = '_') or (c = '-')) then
exit(False);
end;
Result := True;
end;
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
begin
FNextIsTail := False;
var n := Node.Expressions.Count - 1;
for var i := 0 to n do
begin
// The last expression is in a tail position IF the block itself is.
if i = n then
FNextIsTail := FIsTailStack.Peek;
Accept(Node.Expressions[i]);
end;
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
begin
// Annotate this node based on its context, which is on top of the stack.
(Node as TFunctionCallNode).IsTailCall := FIsTailStack.Peek;
// Let the default traverser visit children (callee, args), but ensure
// their context is non-tail.
FNextIsTail := False;
inherited;
end;
function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
// Check if the current context is a tail position.
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
// Arguments to recur are not in a tail position.
FNextIsTail := False;
inherited;
end;
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
function TAstBinder.TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode;
var
depth, idx: Integer;
identNode: TIdentifierNode;
upvalue: TUpvalueMapping;
originalAddress: TResolvedAddress;
upvalueIndex: Integer;
begin
identNode := Node as TIdentifierNode;
if identNode.Address.Kind <> akUnresolved then
exit;
if FCurrentDescriptor.FindSymbol(identNode.Name, depth, idx) then
if FCurrentDescriptor.FindSymbol(Node.Name, depth, idx) then
begin
if (depth > 0) and (FUpvalueStack.Count > 0) then
begin
upvalue := FUpvalueStack.Peek;
// Address is relative to the lambda's parent scope.
var upvalue := FUpvalueStack.Peek;
dec(depth);
originalAddress := TResolvedAddress.Create(akLocalOrParent, depth, idx);
var originalAddress := TResolvedAddress.Create(akLocalOrParent, depth, idx);
var upvalueIndex: Integer;
if not upvalue.Map.TryGetValue(originalAddress, upvalueIndex) then
begin
upvalueIndex := upvalue.Map.Count;
upvalue.Map.Add(originalAddress, upvalueIndex);
end;
(Node as TIdentifierNode).Address := TResolvedAddress.Create(akUpvalue, 0, upvalueIndex);
var address := TResolvedAddress.Create(akUpvalue, 0, upvalueIndex);
Result := TBoundIdentifierNode.Create(Node, address);
end
else
begin
// 1. case: depth=0 - this is a local var
// 2. case: UpvalueStack is empty - there is no surrounding lambda, we need to reference (and capture) the whole parent scope
(Node as TIdentifierNode).Address := TResolvedAddress.Create(akLocalOrParent, depth, idx);
end;
var address := TResolvedAddress.Create(akLocalOrParent, depth, idx);
Result := TBoundIdentifierNode.Create(Node, address);
end
end
else
raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]);
raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
end;
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
// The condition is never in a tail position.
FNextIsTail := False;
Accept(Node.Condition);
// The branches are in a tail position if the if-expression itself is.
FNextIsTail := FIsTailStack.Peek;
Accept(Node.ThenBranch);
if Assigned(Node.ElseBranch) then
Accept(Node.ElseBranch);
end;
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
function TAstBinder.TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode;
var
param: IIdentifierNode;
sourceAddresses: TArray<TResolvedAddress>;
sortedPairs: TArray<TPair<TResolvedAddress, Integer>>;
initializer: IAstNode;
slotIndex: Integer;
address: TResolvedAddress;
boundIdentifier: IIdentifierNode;
begin
if not IsValidIdentifier(Node.Identifier.Name) then
raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);
FNextIsTail := False;
if Node.Initializer <> nil then
initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name);
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
Result := TAst.VarDecl(boundIdentifier, initializer);
end;
function TAstBinder.TransformAssignment(const Node: IAssignmentNode): IAssignmentNode;
begin
FNextIsTail := False;
Result := inherited TransformAssignment(Node);
end;
function TAstBinder.TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode;
begin
FNextIsTail := False;
Result := inherited TransformBinaryExpression(Node);
end;
function TAstBinder.TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode;
begin
FNextIsTail := False;
Result := inherited TransformUnaryExpression(Node);
end;
function TAstBinder.TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode;
var
i: integer;
boundParams: TArray<IIdentifierNode>;
boundBody: IAstNode;
lambdaScope: IScopeDescriptor;
upvalues: TArray<TResolvedAddress>;
hasNestedLambdas: Boolean;
lastNestedLambdaCount: Integer;
begin
FUpvalueStack.Push(TUpvalueMapping.Create);
try
EnterScope;
try
// Reserve slot 0 for the closure itself (for 'recur'),
// using a name that cannot be accessed from source code.
FCurrentDescriptor.Define('<self>');
for param in Node.Parameters do
FCurrentDescriptor.Define(param.Name);
SetLength(boundParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
var paramNode := Node.Parameters[i];
var slotIndex := FCurrentDescriptor.Define(paramNode.Name);
var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundParams[i] := TBoundIdentifierNode.Create(paramNode, address);
end;
var lastNestedLambdaCount := FNestedLambdaCount;
lastNestedLambdaCount := FNestedLambdaCount;
// Parameters are never in a tail position.
FNextIsTail := False;
for param in Node.Parameters do
Accept(param);
// The body of a lambda is always in a tail position.
FNextIsTail := True;
Accept(Node.Body);
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
(Node as TLambdaExpressionNode).HasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
(Node as TLambdaExpressionNode).ScopeDescriptor := FCurrentDescriptor;
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
lambdaScope := FCurrentDescriptor;
finally
ExitScope;
end;
finally
var upvalue := FUpvalueStack.Peek;
try
sortedPairs := upvalue.Map.ToArray;
var upvalueMapping := FUpvalueStack.Peek;
var sortedPairs := upvalueMapping.Map.ToArray;
TArray.Sort<TPair<TResolvedAddress, Integer>>(
sortedPairs,
TComparer<TPair<TResolvedAddress, Integer>>.Construct(
@@ -326,161 +391,97 @@ begin
)
);
SetLength(sourceAddresses, Length(sortedPairs));
for var i := 0 to High(sortedPairs) do
sourceAddresses[i] := sortedPairs[i].Key;
SetLength(upvalues, Length(sortedPairs));
for i := 0 to High(sortedPairs) do
upvalues[i] := sortedPairs[i].Key;
(Node as TLambdaExpressionNode).Upvalues := sourceAddresses;
finally
FUpvalueStack.Pop;
end;
inc(FNestedLambdaCount);
end;
Result := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
end;
function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
// The condition is never in a tail position.
FNextIsTail := False;
Accept(Node.Condition);
// The branches are in a tail position if the ternary expression itself is.
FNextIsTail := FIsTailStack.Peek;
Accept(Node.ThenBranch);
Accept(Node.ElseBranch);
end;
function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
FNextIsTail := False;
inherited;
end;
function TAstBinder.IsValidIdentifier(const Name: string): Boolean;
function TAstBinder.TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode;
var
isTailCall: Boolean;
callee: IAstNode;
args: TArray<IAstNode>;
begin
isTailCall := FIsTailStack.Peek;
FNextIsTail := False;
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := TransformNodes<IAstNode>(Node.Arguments);
Result := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
end;
function TAstBinder.TransformRecur(const Node: IRecurNode): IRecurNode;
begin
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
FNextIsTail := False;
Result := inherited TransformRecur(Node);
end;
function TAstBinder.TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode;
var
exprs: TArray<IAstNode>;
i: Integer;
c: Char;
isContextTail: Boolean;
begin
if Name.IsEmpty then
exit(False);
isContextTail := FIsTailStack.Peek;
// First character must be a letter or underscore.
c := Name[1];
if not (c.IsLetter or (c = '_')) then
exit(False);
// Subsequent characters can be letters, numbers, underscore, or hyphen.
for i := 2 to Length(Name) do
SetLength(exprs, Node.Expressions.Count);
for i := 0 to Node.Expressions.Count - 1 do
begin
c := Name[i];
if not (c.IsLetterOrDigit or (c = '_') or (c = '-')) then
exit(False);
FNextIsTail := isContextTail and (i = Node.Expressions.Count - 1);
exprs[i] := Accept(Node.Expressions[i]).AsIntf<IAstNode>;
end;
Result := TAst.Block(exprs);
end;
Result := True;
end;
function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
function TAstBinder.TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode;
var
slotIndex: Integer;
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
begin
// The initializer expression is never in a tail position.
FNextIsTail := False;
if Assigned(Node.Initializer) then
Accept(Node.Initializer);
// Reject identifiers that contain special characters or reserved operator characters.
if not IsValidIdentifier(Node.Identifier.Name) then
raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name);
(Node.Identifier as TIdentifierNode).Address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
Accept(Node.Identifier);
condition := Accept(Node.Condition).AsIntf<IAstNode>;
FNextIsTail := isContextTail;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
Result := TAst.IfExpr(condition, thenBranch, elseBranch)
else
Result := Node;
end;
{ TScopeDescriptor }
constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor);
begin
inherited Create;
FParent := AParent;
FSymbols := TDictionary<string, Integer>.Create;
end;
destructor TScopeDescriptor.Destroy;
begin
FSymbols.Free;
inherited;
end;
function TScopeDescriptor.Define(const Name: string): Integer;
begin
Result := FSymbols.Count;
FSymbols.Add(Name, Result);
end;
function TScopeDescriptor.FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
function TAstBinder.TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode;
var
currentDescriptor: TScopeDescriptor;
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
begin
Depth := 0;
currentDescriptor := Self;
while currentDescriptor <> nil do
begin
if currentDescriptor.FSymbols.TryGetValue(Name, Index) then
exit(true);
inc(Depth);
currentDescriptor := currentDescriptor.FParent as TScopeDescriptor;
end;
Result := False;
end;
isContextTail := FIsTailStack.Peek;
function TScopeDescriptor.GetParent: IScopeDescriptor;
begin
Result := FParent;
end;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
function TScopeDescriptor.GetSlotCount: Integer;
begin
Result := FSymbols.Count;
end;
FNextIsTail := isContextTail;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
function TScopeDescriptor.GetSymbols: TDictionary<string, Integer>;
begin
Result := FSymbols;
end;
function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
begin
Result := TExecutionScope.Create(Parent, Self, nil);
end;
procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope);
begin
for var pair in Scope.NameToIndex do
begin
var name := Scope.NameStrings[pair.Key];
if not FSymbols.ContainsKey(name) then
FSymbols.Add(name, pair.Value);
end;
end;
constructor TAstBinder.TUpvalueMapping.Create;
begin
inherited Create;
// Use the custom equality comparer to ensure correct dictionary behavior.
Map := TDictionary<TResolvedAddress, Integer>.Create(TResolvedAddressComparer.Create);
Nodes := TList<IIdentifierNode>.Create();
end;
destructor TAstBinder.TUpvalueMapping.Destroy;
begin
Nodes.Free;
Map.Free;
inherited Destroy;
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
Result := TAst.TernaryExpr(condition, thenBranch, elseBranch)
else
Result := Node;
end;
end.
Src/AST/Myc.Ast.Debugger.pas
+1 -2
View File
@@ -52,8 +52,7 @@ type
implementation
uses
System.TypInfo,
Myc.Ast.Printer;
System.TypInfo;
{ TDebugEvaluatorVisitor }
Src/AST/Myc.Ast.Dumper.pas
+78 -45
View File
@@ -7,13 +7,18 @@ uses
System.Classes,
System.Generics.Collections,
Myc.Ast.Nodes,
Myc.Ast.Traverser,
Myc.Ast.Transformer, // Wird für TAstVisitor benötigt
Myc.Data.Value,
Myc.Data.Scalar;
type
// Dumps a bound AST into a human-readable format for debugging purposes.
TAstDumper = class(TAstTraverser)
// It inherits from the abstract TAstVisitor to implement the IAstVisitor interface.
IAstDumper = interface(IAstVisitor)
procedure Execute(const RootNode: IAstNode);
end;
TAstDumper = class(TAstVisitor)
private
FOutput: TStrings;
FIndent: Integer;
@@ -22,8 +27,6 @@ type
procedure Log(const Text: string); overload;
procedure LogFmt(const Fmt: string; const Args: array of const); overload;
function FormatAddress(const Addr: TResolvedAddress): string;
protected
function Accept(const Node: IAstNode): TDataValue; override;
public
// Creates a new instance of the AST dumper.
constructor Create(const AOutput: TStrings);
@@ -31,6 +34,9 @@ type
// Traverses the given root node and writes the structural information into the output.
class procedure Dump(const RootNode: IAstNode; const Output: TStrings);
procedure Execute(const RootNode: IAstNode);
// IAstVisitor implementation
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
@@ -52,19 +58,22 @@ type
implementation
uses
Myc.Ast.Binding; // For TBound...Node classes
{ TAstDumper }
class procedure TAstDumper.Dump(const RootNode: IAstNode; const Output: TStrings);
var
dumper: TAstDumper;
begin
if not Assigned(Output) then
if (not Assigned(Output)) or (not Assigned(RootNode)) then
exit;
Output.Clear;
dumper := TAstDumper.Create(Output);
try
dumper.Accept(RootNode);
dumper.Execute(RootNode);
finally
dumper.Free;
end;
@@ -77,11 +86,10 @@ begin
FIndent := 0;
end;
function TAstDumper.Accept(const Node: IAstNode): TDataValue;
procedure TAstDumper.Execute(const RootNode: IAstNode);
begin
Result := TDataValue.Void;
if Assigned(Node) then
Result := inherited Accept(Node);
if Assigned(RootNode) then
RootNode.Accept(Self);
end;
procedure TAstDumper.Indent;
@@ -123,7 +131,10 @@ end;
function TAstDumper.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(Node.Address)]);
if Node is TBoundIdentifierNode then
LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress((Node as TBoundIdentifierNode).Address)])
else
LogFmt('Identifier: %s (unbound)', [Node.Name]);
Result := TDataValue.Void;
end;
@@ -131,8 +142,8 @@ function TAstDumper.VisitBinaryExpression(const Node: IBinaryExpressionNode): TD
begin
LogFmt('BinaryExpression: %s', [Node.Operator.ToString]);
Indent;
Accept(Node.Left);
Accept(Node.Right);
Node.Left.Accept(Self);
Node.Right.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -141,7 +152,7 @@ function TAstDumper.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDat
begin
LogFmt('UnaryExpression: %s', [Node.Operator.ToString]);
Indent;
Accept(Node.Right);
Node.Right.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -151,13 +162,13 @@ begin
Log('IfExpression');
Indent;
Log('Condition:');
Accept(Node.Condition);
Node.Condition.Accept(Self);
Log('Then:');
Accept(Node.ThenBranch);
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
begin
Log('Else:');
Accept(Node.ElseBranch);
Node.ElseBranch.Accept(Self);
end;
Unindent;
Result := TDataValue.Void;
@@ -168,11 +179,11 @@ begin
Log('TernaryExpression');
Indent;
Log('Condition:');
Accept(Node.Condition);
Node.Condition.Accept(Self);
Log('Then:');
Accept(Node.ThenBranch);
Node.ThenBranch.Accept(Self);
Log('Else:');
Accept(Node.ElseBranch);
Node.ElseBranch.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -182,35 +193,53 @@ var
param: IIdentifierNode;
upvalueAddr: TResolvedAddress;
pair: TPair<string, Integer>;
boundNode: TBoundLambdaExpressionNode;
begin
LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString(TUseBoolStrs.True)]);
if Node is TBoundLambdaExpressionNode then
begin
boundNode := Node as TBoundLambdaExpressionNode;
LogFmt('LambdaExpression (HasNested: %s)', [boundNode.HasNestedLambdas.ToString(TUseBoolStrs.True)]);
Indent;
Log('Parameters:');
Indent;
for param in Node.Parameters do
Accept(param);
for param in boundNode.Parameters do
param.Accept(Self);
Unindent;
LogFmt('Upvalues (%d):', [Length(Node.Upvalues)]);
LogFmt('Upvalues (%d):', [Length(boundNode.Upvalues)]);
Indent;
for upvalueAddr in Node.Upvalues do
for upvalueAddr in boundNode.Upvalues do
Log(FormatAddress(upvalueAddr));
Unindent;
Log('Scope Descriptor:');
Indent;
if Assigned(Node.ScopeDescriptor) then
for pair in Node.ScopeDescriptor.Symbols do
if Assigned(boundNode.ScopeDescriptor) then
for pair in boundNode.ScopeDescriptor.Symbols do
LogFmt('"%s" -> Slot %d', [pair.Key, pair.Value])
else
Log('(none)');
Unindent;
Log('Body:');
Accept(Node.Body);
boundNode.Body.Accept(Self);
Unindent;
end
else
begin
Log('LambdaExpression (unbound)');
Indent;
Log('Parameters:');
Indent;
for param in Node.Parameters do
param.Accept(Self);
Unindent;
Log('Body:');
Node.Body.Accept(Self);
Unindent;
end;
Result := TDataValue.Void;
end;
@@ -218,14 +247,18 @@ function TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue
var
arg: IAstNode;
begin
LogFmt('FunctionCall (IsTailCall: %s)', [Node.IsTailCall.ToString(TUseBoolStrs.True)]);
if Node is TBoundFunctionCallNode then
LogFmt('FunctionCall (IsTailCall: %s)', [(Node as TBoundFunctionCallNode).IsTailCall.ToString(TUseBoolStrs.True)])
else
Log('FunctionCall (unbound)');
Indent;
Log('Callee:');
Accept(Node.Callee);
Node.Callee.Accept(Self);
LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
Indent;
for arg in Node.Arguments do
Accept(arg);
arg.Accept(Self);
Unindent;
Unindent;
Result := TDataValue.Void;
@@ -240,7 +273,7 @@ begin
LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
Indent;
for arg in Node.Arguments do
Accept(arg);
arg.Accept(Self);
Unindent;
Unindent;
Result := TDataValue.Void;
@@ -253,7 +286,7 @@ begin
Log('BlockExpression');
Indent;
for expr in Node.Expressions do
Accept(expr);
expr.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -262,11 +295,11 @@ function TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNod
begin
Log('VariableDeclaration');
Indent;
Accept(Node.Identifier);
Node.Identifier.Accept(Self);
if Assigned(Node.Initializer) then
begin
Log('Initializer:');
Accept(Node.Initializer);
Node.Initializer.Accept(Self);
end;
Unindent;
Result := TDataValue.Void;
@@ -276,9 +309,9 @@ function TAstDumper.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Log('Assignment');
Indent;
Accept(Node.Identifier);
Node.Identifier.Accept(Self);
Log('Value:');
Accept(Node.Value);
Node.Value.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -288,9 +321,9 @@ begin
Log('Indexer');
Indent;
Log('Base:');
Accept(Node.Base);
Node.Base.Accept(Self);
Log('Index:');
Accept(Node.Index);
Node.Index.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -300,9 +333,9 @@ begin
Log('MemberAccess');
Indent;
Log('Base:');
Accept(Node.Base);
Node.Base.Accept(Self);
Log('Member:');
Accept(Node.Member);
Node.Member.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -318,13 +351,13 @@ begin
Log('AddSeriesItem');
Indent;
Log('Series:');
Accept(Node.Series);
Node.Series.Accept(Self);
Log('Value:');
Accept(Node.Value);
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
begin
Log('Lookback:');
Accept(Node.Lookback);
Node.Lookback.Accept(Self);
end;
Unindent;
Result := TDataValue.Void;
@@ -335,7 +368,7 @@ begin
Log('SeriesLength');
Indent;
Log('Series:');
Accept(Node.Series);
Node.Series.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
Src/AST/Myc.Ast.Evaluator.pas
+55 -51
View File
@@ -9,14 +9,20 @@ uses
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Transformer, // Neu
Myc.Ast.Binding,
Myc.Ast.Scope;
type
// A factory for creating visitors, primarily used by the debugger subsystem.
TVisitorFactory = reference to function(const Scope: IExecutionScope): IAstVisitor;
IEvaluatorVisitor = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): TDataValue;
end;
// The standard AST evaluator for production use.
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
TEvaluatorVisitor = class(TAstVisitor, IEvaluatorVisitor)
private
FScope: IExecutionScope;
protected
@@ -34,23 +40,23 @@ type
// Executes an AST with proper TCO handling. This is the main entry point.
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual;
function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual;
function VisitRecurNode(const Node: IRecurNode): TDataValue; virtual;
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;
// Registers native Delphi functions into a scope.
@@ -161,30 +167,33 @@ end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
boundNode: TBoundLambdaExpressionNode;
capturedCells: TArray<IValueCell>;
i: Integer;
sourceAddresses: TArray<TResolvedAddress>;
closureScope: IExecutionScope;
visitorFactory: TVisitorFactory;
begin
sourceAddresses := Node.Upvalues;
// Cast to the bound node to access binder-specific information.
boundNode := Node as TBoundLambdaExpressionNode;
sourceAddresses := boundNode.Upvalues;
SetLength(capturedCells, Length(sourceAddresses));
for i := 0 to High(sourceAddresses) do
capturedCells[i] := FScope.Capture(sourceAddresses[i]);
if Node.HasNestedLambdas then
if boundNode.HasNestedLambdas then
closureScope := FScope
else
closureScope := nil;
// Get the appropriate factory via virtual dispatch.
visitorFactory := CreateVisitorFactory();
var scopeDescriptor := Node.ScopeDescriptor;
var params := Node.Parameters;
var scopeDescriptor := boundNode.ScopeDescriptor;
var params := boundNode.Parameters;
// declare closure as weak to break cyclic referencing when it is captured by itself
var [weak] closure: TDataValue.TFunc;
var cNode: ILambdaExpressionNode := Node;
closure :=
TDataValue.TFunc(
@@ -204,21 +213,19 @@ begin
adr.ScopeDepth := 0;
// Capture the closure itself in slot 0 for 'recur' to find it.
// The name 'Self' is no longer exposed to the user by the binder.
adr.SlotIndex := 0;
lambdaScope[adr] := TDataValue(closure);
// Populate the actual parameters.
for i := 0 to High(ArgValues) do
begin
adr.SlotIndex := params[i].Address.SlotIndex;
// Parameters in a bound lambda must be bound identifiers.
adr.SlotIndex := (params[i] as TBoundIdentifierNode).Address.SlotIndex;
lambdaScope[adr] := ArgValues[i];
end;
// Use the injected factory to create the visitor for the lambda's body.
bodyVisitor := visitorFactory(lambdaScope);
Result := Node.Body.Accept(bodyVisitor);
Result := cNode.Body.Accept(bodyVisitor);
end
);
@@ -229,6 +236,7 @@ function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDa
var
calleeValue: TDataValue;
argValues: TArray<TDataValue>;
boundNode: TBoundFunctionCallNode;
begin
calleeValue := Node.Callee.Accept(Self);
if calleeValue.Kind <> vkMethod then
@@ -239,19 +247,16 @@ begin
for var i := 0 to High(argNodes) do
argValues[i] := argNodes[i].Accept(Self);
if Node.IsTailCall then
boundNode := Node as TBoundFunctionCallNode;
if boundNode.IsTailCall then
begin
// This is a tail call. Return a thunk to be processed
// by an outer trampoline loop (either in Execute or a parent non-tail-call).
// This is a tail call. Return a thunk to be processed by the trampoline.
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues));
end
else
begin
// This is a non-tail call. It must execute the call and act as
// the trampoline for any subsequent tail calls it may trigger.
// This is a non-tail call. It must execute the call and act as the trampoline.
Result := (calleeValue.AsMethod)(argValues);
HandleTCO(Result);
end;
end;
@@ -263,23 +268,21 @@ var
calleeValue: TDataValue;
i: Integer;
begin
// The binder ensures this is only in a tail position.
if not Node.IsTailCall then
raise EInvalidOperation.Create('Recur has to be a tail call');
// Evaluate all arguments for the recursive call.
SetLength(argValues, Length(Node.Arguments));
for i := 0 to High(Node.Arguments) do
argValues[i] := Node.Arguments[i].Accept(Self);
// The callee is the current function, which is stored by the lambda
// expression visitor in slot 0 of the current scope.
// The callee is the current function, stored in slot 0 of the current scope.
calleeAddress.Kind := akLocalOrParent;
calleeAddress.ScopeDepth := 0;
calleeAddress.SlotIndex := 0;
calleeValue := FScope[calleeAddress];
// Recur must be in a tail position, so we always return a thunk.
// The binder is responsible for enforcing the tail position rule.
// Recur always returns a thunk for the trampoline.
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues));
end;
@@ -288,7 +291,7 @@ var
itemValue, lookbackValue, seriesVar: TDataValue;
lookback: Int64;
begin
seriesVar := FScope[Node.Series.Address];
seriesVar := FScope[(Node.Series as TBoundIdentifierNode).Address];
itemValue := Node.Value.Accept(Self);
lookback := -1;
@@ -297,7 +300,6 @@ begin
lookbackValue := Node.Lookback.Accept(Self);
if (lookbackValue.Kind <> vkScalar) or (lookbackValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then
raise EArgumentException.Create('Lookback parameter must be an integer.');
lookback := lookbackValue.AsScalar.Value.AsInt64;
end;
@@ -321,7 +323,7 @@ end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Result := Node.Value.Accept(Self);
FScope[Node.Identifier.Address] := Result;
FScope[(Node.Identifier as TBoundIdentifierNode).Address] := Result;
end;
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
@@ -334,13 +336,11 @@ var
def: string;
begin
def := Node.Definition.Trim;
if def.StartsWith('[') then
begin
var recordDef := TRttiAstHelper.JsonToRecordDefinition(def);
if Length(recordDef.Fields) = 0 then
raise EArgumentException.Create('Failed to parse record definition from JSON array.');
var recordSeries := TScalarRecordSeries.Create(recordDef);
Result := TDataValue.FromRecordSeries(recordSeries);
end
@@ -353,7 +353,7 @@ end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Result := FScope[Node.Address];
Result := FScope[(Node as TBoundIdentifierNode).Address];
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
@@ -411,9 +411,11 @@ end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
if Assigned(Node.Initializer) then
Result := Node.Initializer.Accept(Self);
Result := Node.Initializer.Accept(Self)
else
Result := TDataValue.Void;
FScope[Node.Identifier.Address] := Result;
FScope[(Node.Identifier as TBoundIdentifierNode).Address] := Result;
end;
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
@@ -457,7 +459,9 @@ begin
if IsTruthy(Node.Condition.Accept(Self)) then
Result := Node.ThenBranch.Accept(Self)
else if Assigned(Node.ElseBranch) then
Result := Node.ElseBranch.Accept(Self);
Result := Node.ElseBranch.Accept(Self)
else
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
@@ -482,7 +486,7 @@ var
seriesValue: TDataValue;
len: Int64;
begin
seriesValue := FScope[Node.Series.Address];
seriesValue := FScope[(Node.Series as TBoundIdentifierNode).Address];
case seriesValue.Kind of
vkSeries: len := seriesValue.AsSeries.Count;
Src/AST/Myc.Ast.Nodes.pas
-12
View File
@@ -86,8 +86,6 @@ type
end;
IAstVisitor = interface
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
@@ -121,11 +119,9 @@ type
IIdentifierNode = interface(IAstNode)
{$region 'private'}
function GetAddress: TResolvedAddress;
function GetName: string;
{$endregion}
property Name: string read GetName;
property Address: TResolvedAddress read GetAddress;
end;
IBinaryExpressionNode = interface(IAstNode)
@@ -174,26 +170,18 @@ type
{$region 'private'}
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
{$endregion}
property Parameters: TArray<IIdentifierNode> read GetParameters;
property Body: IAstNode read GetBody;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
property Upvalues: TArray<TResolvedAddress> read GetUpvalues;
property HasNestedLambdas: Boolean read GetHasNestedLambdas;
end;
IFunctionCallNode = interface(IAstNode)
{$region 'private'}
function GetCallee: IAstNode;
function GetArguments: TArray<IAstNode>;
function GetIsTailCall: Boolean;
{$endregion}
property Callee: IAstNode read GetCallee;
property Arguments: TArray<IAstNode> read GetArguments;
property IsTailCall: Boolean read GetIsTailCall;
end;
// A node representing a tail-recursive call.
Src/AST/Myc.Ast.Printer.pas
-327
View File
@@ -1,327 +0,0 @@
unit Myc.Ast.Printer;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast;
type
// A visitor that converts an AST into a LISP-like (Clojure-style) string representation.
TPrettyPrintVisitor = class(TInterfacedObject, IAstVisitor)
private
FBuilder: TStringBuilder;
FIndentLevel: Integer;
procedure Indent;
procedure Unindent;
procedure Append(const S: string);
procedure NewLine;
public
constructor Create;
destructor Destroy; override;
function GetResult: string;
// 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;
end;
implementation
uses
Myc.Data.Scalar;
{ TPrettyPrintVisitor }
constructor TPrettyPrintVisitor.Create;
begin
inherited Create;
FBuilder := TStringBuilder.Create;
FIndentLevel := 0;
end;
destructor TPrettyPrintVisitor.Destroy;
begin
FBuilder.Free;
inherited Destroy;
end;
function TPrettyPrintVisitor.GetResult: string;
begin
Result := FBuilder.ToString;
end;
procedure TPrettyPrintVisitor.Indent;
begin
inc(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Unindent;
begin
dec(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Append(const S: string);
begin
FBuilder.Append(S);
end;
procedure TPrettyPrintVisitor.NewLine;
begin
FBuilder.AppendLine;
FBuilder.Append(''.PadLeft(FIndentLevel));
end;
function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
if Assigned(RootNode) then
RootNode.Accept(Self);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
var
val: TDataValue;
begin
val := Node.Value;
if val.Kind = vkText then
Append('"' + val.AsText + '"')
else
Append(val.ToString);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Append(Node.Name);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
Append('(' + Node.Operator.ToString);
Append(' ');
Node.Left.Accept(Self);
Append(' ');
Node.Right.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
Append('(' + Node.Operator.ToString);
Append(' ');
Node.Right.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
Append('(if ');
Node.Condition.Accept(Self);
Indent;
NewLine;
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
begin
NewLine;
Node.ElseBranch.Accept(Self);
end;
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
Append('(if ');
Node.Condition.Accept(Self);
Indent;
NewLine;
Node.ThenBranch.Accept(Self);
NewLine;
Node.ElseBranch.Accept(Self);
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
param: IIdentifierNode;
sb: TStringBuilder;
begin
sb := TStringBuilder.Create;
try
for param in Node.Parameters do
sb.Append(param.Name + ' ');
if sb.Length > 0 then
sb.Remove(sb.Length - 1, 1);
Append('(fn [' + sb.ToString + ']');
finally
sb.Free;
end;
Indent;
NewLine;
Node.Body.Accept(Self);
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
arg: IAstNode;
begin
Append('(');
Node.Callee.Accept(Self);
Indent;
for arg in Node.Arguments do
begin
NewLine;
arg.Accept(Self);
end;
Unindent;
if Length(Node.Arguments) > 0 then
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
arg: IAstNode;
begin
Append('(recur');
Indent;
for arg in Node.Arguments do
begin
NewLine;
arg.Accept(Self);
end;
Unindent;
if Length(Node.Arguments) > 0 then
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
expr: IAstNode;
begin
Append('(do');
Indent;
for expr in Node.Expressions do
begin
NewLine;
expr.Accept(Self);
end;
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
Append('(def ');
Node.Identifier.Accept(Self);
if Assigned(Node.Initializer) then
begin
Append(' ');
Node.Initializer.Accept(Self);
end;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Append('(assign ');
Node.Identifier.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
Append('(get ');
Node.Base.Accept(Self);
Append(' ');
Node.Index.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
Append('(.');
Node.Member.Accept(Self);
Append(' ');
Node.Base.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
Append(Format('(new-series "%s")', [Node.Definition]));
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
Append('(add-item ');
Node.Series.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
begin
Append(' ');
Node.Lookback.Accept(Self);
end;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
Append('(count ');
Node.Series.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
end.
Src/AST/Myc.Ast.Scope.pas
+89
View File
@@ -60,6 +60,25 @@ type
property Parent: IExecutionScope read FParent;
end;
// Describes the layout of a scope: variable names and their slot indices.
// This is generated by the binder and used to create TExecutionScope instances at runtime.
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
private
FParent: IScopeDescriptor;
FSymbols: TDictionary<string, Integer>;
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
public
constructor Create(const AParent: IScopeDescriptor);
destructor Destroy; override;
function Define(const Name: string): Integer;
function FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(Scope: TExecutionScope);
property Symbols: TDictionary<string, Integer> read FSymbols;
end;
implementation
uses
@@ -339,4 +358,74 @@ begin
FValues[FIdx] := AValue;
end;
{ TScopeDescriptor }
constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor);
begin
inherited Create;
FParent := AParent;
FSymbols := TDictionary<string, Integer>.Create;
end;
destructor TScopeDescriptor.Destroy;
begin
FSymbols.Free;
inherited;
end;
function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
begin
// Creates a runtime scope instance based on this descriptor's layout.
Result := TExecutionScope.Create(Parent, Self, nil);
end;
function TScopeDescriptor.Define(const Name: string): Integer;
begin
Result := FSymbols.Count;
FSymbols.Add(Name, Result);
end;
function TScopeDescriptor.FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
var
currentDescriptor: TScopeDescriptor;
begin
Depth := 0;
currentDescriptor := Self;
while currentDescriptor <> nil do
begin
if currentDescriptor.FSymbols.TryGetValue(Name, Index) then
exit(True);
inc(Depth);
currentDescriptor := currentDescriptor.FParent as TScopeDescriptor;
end;
Result := False;
end;
function TScopeDescriptor.GetParent: IScopeDescriptor;
begin
Result := FParent;
end;
function TScopeDescriptor.GetSlotCount: Integer;
begin
Result := FSymbols.Count;
end;
function TScopeDescriptor.GetSymbols: TDictionary<string, Integer>;
begin
Result := FSymbols;
end;
procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope);
begin
// This method is likely used to create a descriptor from an existing, dynamically populated scope.
// Note: This relies on internal details of TExecutionScope (NameToIndex, NameStrings).
for var pair in Scope.NameToIndex do
begin
var name := Scope.NameStrings[pair.Key];
if not FSymbols.ContainsKey(name) then
FSymbols.Add(name, pair.Value);
end;
end;
end.
Src/AST/Myc.Ast.Transformer.pas
+427
View File
@@ -0,0 +1,427 @@
unit Myc.Ast.Transformer;
interface
uses
System.SysUtils,
System.Generics.Collections,
Myc.Data.Value,
Myc.Ast,
Myc.Ast.Nodes;
type
// A fully abstract base class for any visitor of the AST.
TAstVisitor = class abstract(TInterfacedObject, IAstVisitor)
public
function VisitConstant(const Node: IConstantNode): TDataValue; virtual; abstract;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual; abstract;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual; abstract;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual; abstract;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual; abstract;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual; abstract;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual; abstract;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual; abstract;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual; abstract;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual; abstract;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual; abstract;
function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual; abstract;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual; abstract;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual; abstract;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual; abstract;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual; abstract;
function VisitRecurNode(const Node: IRecurNode): TDataValue; virtual; abstract;
end;
IAstTransformer = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): IAstNode;
end;
// A base visitor that walks the AST and rebuilds it node by node.
// This class uses the Template Method pattern:
// - The Visit... methods are the template and should not be overridden.
// - The virtual Transform... methods are the hooks for derived classes to customize behavior.
TAstTransformer = class abstract(TAstVisitor, IAstTransformer)
private
FDone: Boolean;
protected
// Dispatch methods for each node type. Derived classes override these to change the transformation.
function TransformConstant(const Node: IConstantNode): IConstantNode; virtual;
function TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; virtual;
function TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; virtual;
function TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; virtual;
function TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; virtual;
function TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; virtual;
function TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; virtual;
function TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; virtual;
function TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; virtual;
function TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; virtual;
function TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; virtual;
function TransformIndexer(const Node: IIndexerNode): IIndexerNode; virtual;
function TransformMemberAccess(const Node: IMemberAccessNode): IMemberAccessNode; virtual;
function TransformCreateSeries(const Node: ICreateSeriesNode): ICreateSeriesNode; virtual;
function TransformAddSeriesItem(const Node: IAddSeriesItemNode): IAddSeriesItemNode; virtual;
function TransformSeriesLength(const Node: ISeriesLengthNode): ISeriesLengthNode; virtual;
function TransformRecur(const Node: IRecurNode): IRecurNode; virtual;
// Helper to transform an array of nodes.
function TransformNodes<T: IAstNode>(const Nodes: TArray<T>): TArray<T>;
function Accept(const Node: IAstNode): TDataValue; virtual;
property Done: Boolean read FDone write FDone;
public
// This is the main entry point for the transformer, returning a transformed node.
function Execute(const RootNode: IAstNode): IAstNode;
// Final Visit methods - these should not be overridden. They call the virtual Transform methods.
function VisitConstant(const Node: IConstantNode): TDataValue; override; final;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; final;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; final;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; final;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; final;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; final;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; final;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; final;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; final;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; final;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; final;
function VisitIndexer(const Node: IIndexerNode): TDataValue; override; final;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; final;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; final;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override; final;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; final;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override; final;
end;
// TAstTraverser simply inherits the identity-transform (cloning) behavior from TAstTransformer.
TAstTraverser = class(TAstTransformer);
// Generic traverser for managing state during AST walks.
TAstTraverser<T> = class(TAstTraverser)
private
FData: TStack<T>;
protected
function Accept(const Node: IAstNode): TDataValue; override;
// Called before a node is visited. The returned value is pushed onto the state stack.
function EnterNode(const Node: IAstNode): T; virtual; abstract;
// Called after a node has been visited.
procedure ExitNode(const Node: IAstNode; const Data: T); virtual;
property Data: TStack<T> read FData;
public
constructor Create;
destructor Destroy; override;
end;
implementation
{ TAstTransformer }
function TAstTransformer.Accept(const Node: IAstNode): TDataValue;
begin
if (not Assigned(Node)) or FDone then
exit;
Result := Node.Accept(Self);
end;
function TAstTransformer.Execute(const RootNode: IAstNode): IAstNode;
begin
Result := Accept(RootNode).AsIntf<IAstNode>;
end;
// --- Default implementations for Transform... methods (Identity Transformation / Cloning) ---
function TAstTransformer.TransformConstant(const Node: IConstantNode): IConstantNode;
begin
// The node itself is immutable, return it directly.
Result := Node;
end;
function TAstTransformer.TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode;
begin
Result := Node;
end;
function TAstTransformer.TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode;
begin
var left := Accept(Node.Left).AsIntf<IAstNode>;
var right := Accept(Node.Right).AsIntf<IAstNode>;
if (left = Node.Left) and (right = Node.Right) then
Result := Node
else
Result := TAst.BinaryExpr(left, Node.Operator, right);
end;
function TAstTransformer.TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode;
begin
var right := Accept(Node.Right).AsIntf<IAstNode>;
if right = Node.Right then
Result := Node
else
Result := TAst.UnaryExpr(Node.Operator, right);
end;
function TAstTransformer.TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode;
begin
var condition := Accept(Node.Condition).AsIntf<IAstNode>;
var thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
var elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
if (condition = Node.Condition) and (thenBranch = Node.ThenBranch) and (elseBranch = Node.ElseBranch) then
Result := Node
else
Result := TAst.IfExpr(condition, thenBranch, elseBranch);
end;
function TAstTransformer.TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode;
begin
var condition := Accept(Node.Condition).AsIntf<IAstNode>;
var thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
var elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
if (condition = Node.Condition) and (thenBranch = Node.ThenBranch) and (elseBranch = Node.ElseBranch) then
Result := Node
else
Result := TAst.TernaryExpr(condition, thenBranch, elseBranch);
end;
function TAstTransformer.TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode;
begin
var parameters := TransformNodes<IIdentifierNode>(Node.Parameters);
var body := Accept(Node.Body).AsIntf<IAstNode>;
if (parameters = Node.Parameters) and (body = Node.Body) then
Result := Node
else
Result := TAst.LambdaExpr(parameters, body);
end;
function TAstTransformer.TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode;
begin
var callee := Accept(Node.Callee).AsIntf<IAstNode>;
var args := TransformNodes<IAstNode>(Node.Arguments);
if (callee = Node.Callee) and (args = Node.Arguments) then
Result := Node
else
Result := TAst.FunctionCall(callee, args);
end;
function TAstTransformer.TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode;
begin
// TList is mutable, so we always transform.
var exprs: TArray<IAstNode>;
var i: Integer;
SetLength(exprs, Node.Expressions.Count);
for i := 0 to Node.Expressions.Count - 1 do
exprs[i] := Accept(Node.Expressions[i]).AsIntf<IAstNode>;
Result := TAst.Block(exprs);
end;
function TAstTransformer.TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode;
begin
var identifier := Accept(Node.Identifier).AsIntf<IIdentifierNode>;
var initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
if (identifier = Node.Identifier) and (initializer = Node.Initializer) then
Result := Node
else
Result := TAst.VarDecl(identifier, initializer);
end;
function TAstTransformer.TransformAssignment(const Node: IAssignmentNode): IAssignmentNode;
begin
var identifier := Accept(Node.Identifier).AsIntf<IIdentifierNode>;
var value := Accept(Node.Value).AsIntf<IAstNode>;
if (identifier = Node.Identifier) and (value = Node.Value) then
Result := Node
else
Result := TAst.Assign(identifier, value);
end;
function TAstTransformer.TransformIndexer(const Node: IIndexerNode): IIndexerNode;
begin
var base := Accept(Node.Base).AsIntf<IAstNode>;
var index := Accept(Node.Index).AsIntf<IAstNode>;
if (base = Node.Base) and (index = Node.Index) then
Result := Node
else
Result := TAst.Indexer(base, index);
end;
function TAstTransformer.TransformMemberAccess(const Node: IMemberAccessNode): IMemberAccessNode;
begin
var base := Accept(Node.Base).AsIntf<IAstNode>;
var member := Node.Member;
if (base = Node.Base) and (member = Node.Member) then
Result := Node
else
Result := TAst.MemberAccess(base, member);
end;
function TAstTransformer.TransformCreateSeries(const Node: ICreateSeriesNode): ICreateSeriesNode;
begin
Result := Node;
end;
function TAstTransformer.TransformAddSeriesItem(const Node: IAddSeriesItemNode): IAddSeriesItemNode;
begin
var series := Accept(Node.Series).AsIntf<IIdentifierNode>;
var value := Accept(Node.Value).AsIntf<IAstNode>;
var lookback := Accept(Node.Lookback).AsIntf<IAstNode>;
if (series = Node.Series) and (value = Node.Value) and (lookback = Node.Lookback) then
Result := Node
else
Result := TAst.AddSeriesItem(series, value, lookback);
end;
function TAstTransformer.TransformSeriesLength(const Node: ISeriesLengthNode): ISeriesLengthNode;
begin
var series := Accept(Node.Series).AsIntf<IIdentifierNode>;
if series = Node.Series then
Result := Node
else
Result := TAst.SeriesLength(series);
end;
function TAstTransformer.TransformRecur(const Node: IRecurNode): IRecurNode;
begin
var args := TransformNodes<IAstNode>(Node.Arguments);
if args = Node.Arguments then
Result := Node
else
Result := TAst.Recur(args);
end;
function TAstTransformer.TransformNodes<T>(const Nodes: TArray<T>): TArray<T>;
var
i: Integer;
hasChanged: boolean;
begin
hasChanged := False;
SetLength(Result, Length(Nodes));
for i := 0 to High(Nodes) do
begin
Result[i] := Accept(Nodes[i]).AsIntf<T>;
if Result[i] <> Nodes[i] then
hasChanged := True;
end;
if not hasChanged then
Result := Nodes;
end;
function TAstTransformer.VisitConstant(const Node: IConstantNode): TDataValue;
begin
Result := TDataValue.FromIntf<IConstantNode>(TransformConstant(Node));
end;
function TAstTransformer.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Result := TDataValue.FromIntf<IIdentifierNode>(TransformIdentifier(Node));
end;
function TAstTransformer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<IBinaryExpressionNode>(TransformBinaryExpression(Node));
end;
function TAstTransformer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<IUnaryExpressionNode>(TransformUnaryExpression(Node));
end;
function TAstTransformer.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<IIfExpressionNode>(TransformIfExpression(Node));
end;
function TAstTransformer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<ITernaryExpressionNode>(TransformTernaryExpression(Node));
end;
function TAstTransformer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<ILambdaExpressionNode>(TransformLambdaExpression(Node));
end;
function TAstTransformer.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
begin
Result := TDataValue.FromIntf<IFunctionCallNode>(TransformFunctionCall(Node));
end;
function TAstTransformer.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<IBlockExpressionNode>(TransformBlockExpression(Node));
end;
function TAstTransformer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
Result := TDataValue.FromIntf<IVariableDeclarationNode>(TransformVariableDeclaration(Node));
end;
function TAstTransformer.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Result := TDataValue.FromIntf<IAssignmentNode>(TransformAssignment(Node));
end;
function TAstTransformer.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
Result := TDataValue.FromIntf<IIndexerNode>(TransformIndexer(Node));
end;
function TAstTransformer.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
Result := TDataValue.FromIntf<IMemberAccessNode>(TransformMemberAccess(Node));
end;
function TAstTransformer.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
Result := TDataValue.FromIntf<ICreateSeriesNode>(TransformCreateSeries(Node));
end;
function TAstTransformer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
Result := TDataValue.FromIntf<IAddSeriesItemNode>(TransformAddSeriesItem(Node));
end;
function TAstTransformer.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
Result := TDataValue.FromIntf<ISeriesLengthNode>(TransformSeriesLength(Node));
end;
function TAstTransformer.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
Result := TDataValue.FromIntf<IRecurNode>(TransformRecur(Node));
end;
{ TAstTraverser<T> }
constructor TAstTraverser<T>.Create;
begin
inherited Create;
FData := TStack<T>.Create;
end;
destructor TAstTraverser<T>.Destroy;
begin
FData.Free;
inherited;
end;
function TAstTraverser<T>.Accept(const Node: IAstNode): TDataValue;
begin
if not Assigned(Node) then
exit;
FData.Push(EnterNode(Node));
try
// Call the inherited Accept, which will dispatch to the virtual Visit... methods
// in the base TAstTransformer, performing the transformation/cloning.
Result := inherited Accept(Node);
finally
var data := FData.Pop;
ExitNode(Node, data);
end;
end;
procedure TAstTraverser<T>.ExitNode(const Node: IAstNode; const Data: T);
begin
end;
end.
Src/AST/Myc.Ast.Traverser.pas
-233
View File
@@ -1,233 +0,0 @@
unit Myc.Ast.Traverser;
interface
uses
System.Classes,
System.Generics.Collections,
Myc.Data.Value,
Myc.Ast.Nodes;
type
// TAstTraverser provides a default AST traversal implementation.
TAstTraverser = class abstract(TInterfacedObject, IAstVisitor)
private
FDone: Boolean;
protected
function Accept(const Node: IAstNode): TDataValue; virtual;
property Done: Boolean read FDone write FDone;
public
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual;
function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual;
function VisitRecurNode(const Node: IRecurNode): TDataValue; virtual;
end;
// Generic traverser for managing state during AST walks.
TAstTraverser<T> = class abstract(TAstTraverser)
private
FData: TStack<T>;
protected
function Accept(const Node: IAstNode): TDataValue; override;
// Called before a node is visited. The returned value is pushed onto the state stack.
function EnterNode(const Node: IAstNode): T; virtual; abstract;
// Called after a node has been visited.
procedure ExitNode(const Node: IAstNode; const Data: T); virtual;
property Data: TStack<T> read FData;
public
constructor Create;
destructor Destroy; override;
end;
implementation
{ TAstTraverser }
function TAstTraverser.Accept(const Node: IAstNode): TDataValue;
begin
if not Assigned(Node) or FDone then
exit;
Result := Node.Accept(Self);
end;
function TAstTraverser.Execute(const RootNode: IAstNode): TDataValue;
begin
Result := RootNode.Accept(Self);
end;
function TAstTraverser.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
Accept(Node.Series);
Accept(Node.Value);
if Assigned(Node.Lookback) then
Accept(Node.Lookback);
end;
function TAstTraverser.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Accept(Node.Value);
Accept(Node.Identifier);
end;
function TAstTraverser.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
Accept(Node.Left);
Accept(Node.Right);
end;
function TAstTraverser.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
expr: IAstNode;
begin
for expr in Node.Expressions do
begin
if FDone then
break;
Accept(expr);
end;
end;
function TAstTraverser.VisitConstant(const Node: IConstantNode): TDataValue;
begin
end;
function TAstTraverser.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
end;
function TAstTraverser.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
arg: IAstNode;
begin
Accept(Node.Callee);
for arg in Node.Arguments do
begin
if FDone then
break;
Accept(arg);
end;
end;
function TAstTraverser.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
arg: IAstNode;
begin
for arg in Node.Arguments do
begin
if FDone then
break;
Accept(arg);
end;
end;
function TAstTraverser.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
end;
function TAstTraverser.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
Accept(Node.Condition);
Accept(Node.ThenBranch);
if Assigned(Node.ElseBranch) then
Accept(Node.ElseBranch);
end;
function TAstTraverser.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
Accept(Node.Base);
Accept(Node.Index);
end;
function TAstTraverser.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
param: IIdentifierNode;
begin
for param in Node.Parameters do
begin
if FDone then
break;
Accept(param);
end;
Accept(Node.Body);
end;
function TAstTraverser.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
// Do not visit the member identifier, as it's not a variable in the current scope.
Accept(Node.Base);
end;
function TAstTraverser.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
Accept(Node.Series);
end;
function TAstTraverser.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
Accept(Node.Condition);
Accept(Node.ThenBranch);
Accept(Node.ElseBranch);
end;
function TAstTraverser.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
Accept(Node.Right);
end;
function TAstTraverser.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
if Assigned(Node.Initializer) then
Accept(Node.Initializer);
Accept(Node.Identifier);
end;
{ TAstTraverser<T> }
constructor TAstTraverser<T>.Create;
begin
inherited Create;
FData := TStack<T>.Create;
end;
destructor TAstTraverser<T>.Destroy;
begin
FData.Free;
inherited;
end;
function TAstTraverser<T>.Accept(const Node: IAstNode): TDataValue;
begin
if not Assigned(Node) or Done then
exit;
FData.Push(EnterNode(Node));
try
Result := inherited Accept(Node);
finally
var data := FData.Pop;
ExitNode(Node, data);
end;
end;
procedure TAstTraverser<T>.ExitNode(const Node: IAstNode; const Data: T);
begin
end;
end.
Src/AST/Myc.Ast.pas
+5 -51
View File
@@ -27,7 +27,7 @@ type
class procedure RegisterLibrary(const AProc: TRegisterLibraryProc); static;
class function CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil): IExecutionScope; static;
// --- Existing factory functions ---
// --- Factory functions ---
class function Constant(const AValue: TDataValue): IConstantNode; overload; static;
class function Constant(const AValue: TScalar): IConstantNode; overload; static;
class function Constant(const AValue: String): IConstantNode; overload; static;
@@ -72,15 +72,11 @@ type
TIdentifierNode = class(TAstNode, IIdentifierNode)
private
FName: string;
// --- Annotation fields added for the binder ---
FResolvedAddress: TResolvedAddress;
function GetName: string;
function GetAddress: TResolvedAddress; inline;
public
constructor Create(AName: string);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property Name: string read FName;
property Address: TResolvedAddress read FResolvedAddress write FResolvedAddress;
end;
TBinaryExpressionNode = class(TAstNode, IBinaryExpressionNode)
@@ -137,46 +133,34 @@ type
private
FParameters: TArray<IIdentifierNode>;
FBody: IAstNode;
FScopeDescriptor: IScopeDescriptor;
FUpvalues: TArray<TResolvedAddress>;
FHasNestedLambdas: Boolean;
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
public
constructor Create(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property HasNestedLambdas: Boolean read FHasNestedLambdas write FHasNestedLambdas;
property ScopeDescriptor: IScopeDescriptor read FScopeDescriptor write FScopeDescriptor;
property Upvalues: TArray<TResolvedAddress> read FUpvalues write FUpvalues;
property Body: IAstNode read FBody;
property Parameters: TArray<IIdentifierNode> read FParameters;
end;
TFunctionCallNode = class(TAstNode, IFunctionCallNode)
private
FCallee: IAstNode;
FArguments: TArray<IAstNode>;
FIsTailCall: Boolean;
function GetCallee: IAstNode;
function GetArguments: TArray<IAstNode>;
function GetIsTailCall: Boolean;
public
constructor Create(const ACallee: IAstNode; const AArguments: TArray<IAstNode>);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property IsTailCall: Boolean read FIsTailCall write FIsTailCall;
end;
TRecurNode = class(TAstNode, IRecurNode)
private
FArguments: TArray<IAstNode>;
FIsTailCall: Boolean;
function GetArguments: TArray<IAstNode>;
function GetIsTailCall: Boolean;
public
constructor Create(const AArguments: TArray<IAstNode>);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property IsTailCall: Boolean read FIsTailCall write FIsTailCall;
end;
TBlockExpressionNode = class(TAstNode, IBlockExpressionNode)
@@ -266,9 +250,6 @@ type
implementation
uses
Myc.Ast.Traverser;
{ TConstantNode }
constructor TConstantNode.Create(const AValue: TDataValue);
@@ -308,11 +289,6 @@ begin
Result := FName;
end;
function TIdentifierNode.GetAddress: TResolvedAddress;
begin
Result := FResolvedAddress;
end;
{ TBinaryExpressionNode }
constructor TBinaryExpressionNode.Create(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode);
@@ -434,12 +410,6 @@ begin
inherited Create;
FBody := ABody;
FParameters := AParameters;
FScopeDescriptor := nil;
end;
function TLambdaExpressionNode.GetUpvalues: TArray<TResolvedAddress>;
begin
Result := FUpvalues;
end;
function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue;
@@ -452,21 +422,11 @@ begin
Result := FBody;
end;
function TLambdaExpressionNode.GetHasNestedLambdas: Boolean;
begin
Result := FHasNestedLambdas;
end;
function TLambdaExpressionNode.GetParameters: TArray<IIdentifierNode>;
begin
Result := FParameters;
end;
function TLambdaExpressionNode.GetScopeDescriptor: IScopeDescriptor;
begin
Result := FScopeDescriptor;
end;
{ TFunctionCallNode }
constructor TFunctionCallNode.Create(const ACallee: IAstNode; const AArguments: TArray<IAstNode>);
@@ -474,7 +434,6 @@ begin
inherited Create;
FCallee := ACallee;
FArguments := AArguments;
FIsTailCall := False;
end;
function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TDataValue;
@@ -492,18 +451,12 @@ begin
Result := FCallee;
end;
function TFunctionCallNode.GetIsTailCall: Boolean;
begin
Result := FIsTailCall;
end;
{ TRecurNode }
constructor TRecurNode.Create(const AArguments: TArray<IAstNode>);
begin
inherited Create;
FArguments := AArguments;
FIsTailCall := True;
end;
function TRecurNode.Accept(const Visitor: IAstVisitor): TDataValue;
@@ -518,7 +471,8 @@ end;
function TRecurNode.GetIsTailCall: Boolean;
begin
Result := FIsTailCall;
// 'recur' is always a tail call by definition.
Result := True;
end;
{ TBlockExpressionNode }
Src/Data/Myc.Data.Value.pas
+19 -1
View File
@@ -9,7 +9,7 @@ uses
Myc.Data.Series;
type
TDataValueKind = (vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkGeneric);
TDataValueKind = (vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric);
TDataValue = record
type
@@ -58,6 +58,9 @@ type
class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline;
class operator Implicit(const AValue: TObject): TDataValue; overload; inline;
class function FromIntf<T: IInterface>(const AValue: T): TDataValue; static;
function AsIntf<T: IInterface>: T; inline;
class function FromGeneric<T>(const [ref] AValue: T): TDataValue; static; inline;
function AsGeneric<T>: T; inline;
@@ -222,6 +225,15 @@ begin
Result := TVal<T>(FInterface).Value;
end;
function TDataValue.AsIntf<T>: T;
begin
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsGeneric<T>);
if FKind <> Ord(vkInterface) then
raise EInvalidCast.Create('Cannot read value as interface.');
Result := T(FInterface);
end;
function TDataValue.AsObject: TObject;
begin
if FKind = Ord(vkLazy) then
@@ -296,6 +308,12 @@ begin
end;
end;
class function TDataValue.FromIntf<T>(const AValue: T): TDataValue;
begin
Result.FKind := Ord(vkInterface);
Result.FInterface := IInterface(AValue);
end;
class function TDataValue.FromGeneric<T>(const [ref] AValue: T): TDataValue;
begin
Result.FKind := Ord(vkGeneric);