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

Ast Binding

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-04 01:41:09 +02:00
parent de052cab64
commit 9c90a92b04
6 changed files with 394 additions and 382 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.fmx
+1 -1
View File
@@ -135,7 +135,7 @@ object Form1: TForm1
object DebugBox: TCheckBox
Position.X = 24.000000000000000000
Position.Y = 360.000000000000000000
TabOrder = 17
TabOrder = 16
Text = 'Debug'
end
end
ASTPlayground/MainForm.pas
+140 -271
View File
@@ -28,7 +28,8 @@ uses
Myc.Ast.Evaluator,
Myc.Ast.Printer,
FMX.Layouts,
FMX.Objects; // Added for TExecutionScope
FMX.Objects,
Myc.Ast.Scope; // Added for TExecutionScope
type
// A test record
@@ -80,6 +81,8 @@ type
FWorkspace: TAuraWorkspace;
function CreateVisitor(const AScope: IExecutionScope): IAstVisitor;
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
// New helper function to encapsulate the Bind -> Evaluate pattern
function ExecuteAst(const ANode: IExpressionNode; const AScope: IExecutionScope): TAstValue;
public
{ Public declarations }
end;
@@ -90,7 +93,7 @@ var
implementation
uses
Myc.Ast.Scope,
// Myc.Ast.Scope is now in the interface uses
Myc.Data.Scalar.JSON,
Myc.Data.Decimal,
System.Diagnostics; // For TStopwatch
@@ -115,6 +118,17 @@ begin
Result := TEvaluatorVisitor.Create(AScope);
end;
function TForm1.ExecuteAst(const ANode: IExpressionNode; const AScope: IExecutionScope): TAstValue;
begin
// STEP 1: BIND
// The binder uses the provided scope to know about native functions etc.
TAst.Bind(ANode, AScope);
// STEP 2: EVALUATE
var visitor := CreateVisitor(AScope);
Result := ANode.Accept(visitor);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FWorkspace := TAuraWorkspace.Create(Panel2);
@@ -124,7 +138,9 @@ begin
FWorkspace.OnMouseDown := WorkspaceMouseDown;
// Create and prepare the global scope once
FGScope := TExecutionScope.Create(nil);
RegisterNativeFunctions(FGScope);
end;
procedure TForm1.DebugButtonClick(Sender: TObject);
@@ -137,7 +153,6 @@ begin
if not Assigned(FLastAst) then
begin
Memo1.Lines.Add('No AST has been generated yet.');
Memo1.Lines.Add('Click "Test 1" or "Test 2" first.');
exit;
end;
@@ -146,7 +161,9 @@ begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Debug Evaluator Trace ---');
// This button ALWAYS uses the debug visitor, regardless of the checkbox.
// Manually bind and evaluate to use the debug visitor
TAst.Bind(FLastAst, scope);
visitor := TDebugEvaluatorVisitor.Create(scope, Memo1.Lines, ShowScopeBox.IsChecked, 0);
sw := TStopwatch.StartNew;
@@ -156,67 +173,18 @@ begin
Memo1.Lines.Add('-----------------------------');
Memo1.Lines.Add(Format('Final script result: %s', [result.ToString]));
Memo1.Lines.Add(Format('Execution time: %d ms', [sw.ElapsedMilliseconds]));
Memo1.Lines.Add('');
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
end;
procedure TForm1.FibonacciButtonClick(Sender: TObject);
function NativeFib(n: Integer): Int64;
begin
// The identical, naive recursive algorithm in native Delphi code.
if (n < 2) then
Result := n
else
Result := NativeFib(n - 1) + NativeFib(n - 2);
end;
var
scope: IExecutionScope;
visitor: IAstVisitor;
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
result20, result30, result40: Int64;
time20, time30, time40: Int64;
scope: IExecutionScope;
begin
FGScope.Clear;
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Native Delphi Fibonacci Performance ---');
Memo1.Lines.Add('Calculating fib(30) and fib(40)...');
Application.ProcessMessages; // Update UI before blocking
// --- Calculate fib(30) ---
sw := TStopwatch.StartNew;
result20 := NativeFib(20);
sw.Stop;
time20 := sw.ElapsedMilliseconds;
// --- Calculate fib(30) ---
sw := TStopwatch.StartNew;
result30 := NativeFib(30);
sw.Stop;
time30 := sw.ElapsedMilliseconds;
// --- Calculate fib(40) ---
sw.Reset;
sw.Start;
result40 := NativeFib(40);
sw.Stop;
time40 := sw.ElapsedMilliseconds;
sw.Reset;
Memo1.Lines.Add('');
Memo1.Lines.Add(Format('fib(20) = %d (calculated in %d ms)', [result20, time20]));
Memo1.Lines.Add(Format('fib(30) = %d (calculated in %d ms)', [result30, time30]));
Memo1.Lines.Add(Format('fib(40) = %d (calculated in %d ms)', [result40, time40]));
Memo1.Lines.Add('');
Memo1.Lines.Add('');
Memo1.Lines.Add('--- Recursive fib with AST---');
Application.ProcessMessages; // Update UI before blocking
sw.Start;
sw := TStopwatch.StartNew;
root :=
TAst.Block(
@@ -225,12 +193,9 @@ begin
TAst.Identifier('fib'),
TAst.LambdaExpr(
[TAst.Identifier('n')],
// The body is now a single ternary expression that returns a value.
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
// The value if true.
TAst.Identifier('n'),
// The value if false.
TAst.BinaryExpr(
TAst.FunctionCall(
TAst.Identifier('fib'),
@@ -250,21 +215,17 @@ begin
);
FLastAst := root;
scope := TExecutionScope.Create(nil);
scope := TExecutionScope.Create(nil); // No global scope needed for this pure function
result := ExecuteAst(root, scope);
visitor := CreateVisitor(scope);
result := root.Accept(visitor);
sw.Stop;
Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
Memo1.Lines.Add('');
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)');
end;
procedure TForm1.PrettyPrintButtonClick(Sender: TObject);
var
visitor: TPrettyPrintVisitor;
sw: TStopwatch;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- AST Pretty Print ---');
@@ -272,38 +233,24 @@ begin
if not Assigned(FLastAst) then
begin
Memo1.Lines.Add('No AST has been generated yet.');
Memo1.Lines.Add('Click "Test 1" or "Test 2" first.');
exit;
end;
visitor := TPrettyPrintVisitor.Create;
try
sw := TStopwatch.StartNew;
FLastAst.Accept(visitor);
sw.Stop;
Memo1.Lines.Add(visitor.GetResult);
Memo1.Lines.Add(Format('(AST rendered in %d ms)', [sw.ElapsedMilliseconds]));
finally
// Visitor is an interfaced object and managed automatically.
end;
FLastAst.Accept(visitor);
Memo1.Lines.Add(visitor.GetResult);
end;
procedure TForm1.RecursionButtonClick(Sender: TObject);
var
scope: IExecutionScope;
visitor: IAstVisitor;
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
FGScope.Clear;
sw := TStopwatch.Create;
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Recursive factorial(20) ---');
sw.Start;
sw := TStopwatch.StartNew;
root :=
TAst.Block(
@@ -312,21 +259,17 @@ begin
TAst.Identifier('factorial'),
TAst.LambdaExpr(
[TAst.Identifier('n')],
TAst.Block(
[
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
TAst.Constant(TScalar.FromInt64(1)),
TAst.BinaryExpr(
TAst.Identifier('n'),
boMultiply,
TAst.FunctionCall(
TAst.Identifier('factorial'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
)
)
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
TAst.Constant(TScalar.FromInt64(1)),
TAst.BinaryExpr(
TAst.Identifier('n'),
boMultiply,
TAst.FunctionCall(
TAst.Identifier('factorial'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
)
]
)
)
)
),
@@ -337,43 +280,31 @@ begin
FLastAst := root;
scope := TExecutionScope.Create(nil);
visitor := CreateVisitor(scope);
result := root.Accept(visitor);
sw.Stop;
result := ExecuteAst(root, scope);
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
Memo1.Lines.Add('');
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)');
end;
procedure TForm1.SeriesTestButtonClick(Sender: TObject);
var
jsonDef: string;
recordDef: TScalarRecordDefinition;
series: TScalarRecordSeries;
recordValue: TScalarRecord;
visitor: IAstVisitor;
ast: IExpressionNode;
scope: IExecutionScope;
ast, callAst: IExpressionNode;
resultValue: TAstValue;
series: TScalarRecordSeries;
recordDef: TScalarRecordDefinition;
i: Integer;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Series Test ---');
// --- 1. Arrange (in Delphi) ---
Memo1.Lines.Add('1. Arranging test data in Delphi...');
FGScope.Clear;
RegisterNativeFunctions(FGScope);
jsonDef := TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV));
FGScope.SetValue('ohlcvDef', TAstValue.FromText(jsonDef));
Memo1.Lines.Add(' - Generated and injected JSON definition for TOHLCV.');
recordDef := TRttiAstHelper.JsonToRecordDefinition(jsonDef);
// 1. Arrange: Create a new scope and populate it with Delphi data
scope := TExecutionScope.Create(FGScope); // Inherits native functions
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV)));
series := TScalarRecordSeries.Create(recordDef);
for i := 0 to 4 do
begin
recordValue :=
series.Add(
TScalarRecord.Create(
recordDef,
[
@@ -384,17 +315,12 @@ begin
TScalarValue.FromDouble(102.0 + i),
TScalarValue.FromInt64(10000 * (i + 1))
]
);
series.Add(recordValue);
)
);
end;
scope.Define('ohlcvSeries', TAstValue.FromRecordSeries(series));
FGScope.SetValue('ohlcvSeries', TAstValue.FromRecordSeries(series));
Memo1.Lines.Add(Format(' - Created and injected a series with %d records.', [series.TotalCount]));
Memo1.Lines.Add('');
// --- 2. Act (in Script) ---
Memo1.Lines.Add('2. Executing script...');
// 2. Act: Define and execute the script AST
ast :=
TAst.LambdaExpr(
[],
@@ -404,69 +330,31 @@ begin
TAst.Identifier('closeColumn'),
TAst.MemberAccess(TAst.Identifier('ohlcvSeries'), TAst.Identifier('Close'))
),
TAst.VarDecl(
TAst.Identifier('secondClose'),
TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(TScalar.FromInt64(1)))
)
TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(TScalar.FromInt64(1)))
]
)
);
FLastAst := ast;
callAst := TAst.FunctionCall(ast, []);
resultValue := ExecuteAst(callAst, scope);
visitor := CreateVisitor(FGScope);
resultValue := TAst.FunctionCall(ast, []).Accept(visitor);
Memo1.Lines.Add(' - Script finished.');
Memo1.Lines.Add(Format(' - Script returned value of type: %s', [GetEnumName(TypeInfo(TAstValueKind), Ord(resultValue.Kind))]));
Memo1.Lines.Add('');
// --- 3. Assert (in Delphi) ---
Memo1.Lines.Add('3. Asserting results in Delphi...');
if (resultValue.Kind <> avkScalar) then
begin
Memo1.Lines.Add('TEST FAILED: Script did not return a scalar value.');
exit;
end;
Memo1.Lines.Add(' - Result is a scalar, as expected.');
var resultScalar := resultValue.AsScalar;
if (resultScalar.Kind <> skDouble) then
begin
Memo1.Lines.Add('TEST FAILED: Returned scalar is not a Double.');
exit;
end;
Memo1.Lines.Add(' - Returned scalar is a Double, as expected.');
var closeValue := resultScalar.Value.AsDouble;
// The script asks for index [1], which is the second-to-last element.
// The data was generated for i in 0..4, so the second-to-last is i=3.
var expectedClose := 102.0 + 3;
if (abs(closeValue - expectedClose) > 0.001) then
begin
Memo1.Lines.Add(Format('TEST FAILED: Expected Close price %f, but got %f.', [expectedClose, closeValue]));
exit;
end;
Memo1.Lines.Add(Format(' - Verified Close price: %f.', [closeValue]));
Memo1.Lines.Add('');
Memo1.Lines.Add('--- TEST PASSED ---');
// 3. Assert (logging only)
Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString]));
end;
procedure TForm1.Test1ButtonClick(Sender: TObject);
var
scope: IExecutionScope;
visitor: IAstVisitor;
main, callAst: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
FGScope.Clear;
sw := TStopwatch.Create;
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Simple AST Execution ---');
sw := TStopwatch.StartNew;
sw.Start;
var main :=
main :=
TAst.LambdaExpr(
[],
TAst.Block(
@@ -482,35 +370,25 @@ begin
);
FLastAst := main;
callAst := TAst.FunctionCall(main, []);
scope := TExecutionScope.Create(FGScope);
visitor := CreateVisitor(scope);
result := TAst.FunctionCall(main, []).Accept(visitor);
sw.Stop;
result := ExecuteAst(callAst, scope);
if not result.IsVoid then
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]))
else
Memo1.Lines.Add(Format('<undefined result> (calculated in %d ms)', [sw.ElapsedMilliseconds]));
Memo1.Lines.Add('');
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
end;
procedure TForm1.Test2ButtonClick(Sender: TObject);
var
scope: IExecutionScope;
visitor: IAstVisitor;
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
FGScope.Clear;
sw := TStopwatch.Create;
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Factory Pattern Demo ---');
sw.Start;
sw := TStopwatch.StartNew;
root :=
TAst.Block(
@@ -533,34 +411,26 @@ begin
);
FLastAst := root;
scope := TExecutionScope.Create(FGScope);
visitor := CreateVisitor(scope);
result := root.Accept(visitor);
sw.Stop;
result := ExecuteAst(root, scope);
Memo1.Lines.Add('The entire script has been executed.');
sw.Stop;
Memo1.Lines.Add(Format('Result of the final expression: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
Memo1.Lines.Add('');
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
end;
procedure TForm1.CrerateTriggerExampleButtonClick(Sender: TObject);
var
visitor: IAstVisitor;
closureValue: TAstValue;
blk: IExpressionNode;
begin
// This button now only creates the AST. The persistent scope is managed by FGScope.
FGScope.Clear;
// Create an AST that gets a "tick" in DoTriggerButtonClick.
// This simulates a simple Blueprint-like event system.
// It maintains state via a persistent execution scope.
RegisterNativeFunctions(FGScope); // Re-register natives after clearing
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
var blk :=
blk :=
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(0))),
@@ -574,77 +444,65 @@ begin
]
);
// Evaluate the lambda to create a closure and store it in the scope.
// The closure captures the scope where 'X' is defined.
visitor := CreateVisitor(FGScope);
blk.Accept(visitor);
// Bind and execute the setup block against the persistent global scope
ExecuteAst(blk, FGScope);
// FLastAst is not used for this parameterized example.
FLastAst := blk;
FLastAst := blk; // Store for visualization
Memo1.Lines.Add('Variable "X" initialized to 0 in persistent scope.');
Memo1.Lines.Add('Blueprint function "tickHandler(summand)" created.');
Memo1.Lines.Add('Click "Do Trigger" or "Do Trigger 2" to execute.');
Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.');
Memo1.Lines.Add('Click "Do Trigger" to execute.');
end;
procedure TForm1.DoTriggerButtonClick(Sender: TObject);
var
visitor: IAstVisitor;
currentValue: TAstValue;
callAst: IFunctionCallNode;
currentValue: TAstValue;
depth, index: Integer;
identAst: IIdentifierNode;
begin
// A "tick" executes the stored AST using the persistent scope.
// Create an AST to call the stored handler with argument 1.
// AST for: tickHandler(1)
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]);
// Execute the call AST.
visitor := CreateVisitor(FGScope);
callAst.Accept(visitor);
FLastAst := callAst;
// Get the updated value of 'X' from the scope and display it.
if FGScope.FindValue('X', currentValue) then
// Bind and execute the call against the persistent scope
ExecuteAst(callAst, FGScope);
// To get the value of 'X', we first need to bind an identifier for it
// so we know its location.
identAst := TAst.Identifier('X');
TAst.Bind(identAst, FGScope);
if identAst.Resolve(depth, index) then
begin
currentValue := FGScope.GetValue(depth, index);
Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [currentValue.ToString]));
end
else
begin
// This should not happen if setup was correct.
Memo1.Lines.Add('Error: Variable "X" not found in scope.');
end;
end;
procedure TForm1.DoTrigger2ButtonClick(Sender: TObject);
var
visitor: IAstVisitor;
currentValue: TAstValue;
callAst: IFunctionCallNode;
currentValue: TAstValue;
depth, index: Integer;
identAst: IIdentifierNode;
begin
// A "tick" that adds 2, using the same blueprint function.
// Create an AST to call the stored handler with argument 2.
// AST for: tickHandler(2)
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]);
FLastAst := callAst;
// Execute the call AST.
visitor := CreateVisitor(FGScope);
callAst.Accept(visitor);
// Bind and execute the call against the persistent scope
ExecuteAst(callAst, FGScope);
// Get the updated value of 'X' from the scope and display it.
if FGScope.FindValue('X', currentValue) then
// Inspection requires binding an identifier for 'X'
identAst := TAst.Identifier('X');
TAst.Bind(identAst, FGScope);
if identAst.Resolve(depth, index) then
begin
currentValue := FGScope.GetValue(depth, index);
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [currentValue.ToString]));
end
else
begin
// This should not happen if setup was correct.
Memo1.Lines.Add('Error: Variable "X" not found in scope.');
end;
end;
procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
@@ -663,22 +521,22 @@ end;
procedure TForm1.OHLCButtonClick(Sender: TObject);
const
numRecs = 1000;
lookback = 50;
smaSlowLength = 20;
smaFastLength = 5;
numRecs = 1000000;
lookback = 100;
smaSlowLength = 50;
smaFastLength = 20;
var
recordDef: TScalarRecordDefinition;
series: TScalarRecordSeries;
setupAst: IExpressionNode;
callAst: IExpressionNode;
setupAst, callAst: IExpressionNode;
visitor: IAstVisitor;
i: Integer;
i, depth, index: Integer;
lastClose: Double;
ohlcvRec: TOHLCV;
recordValue: TScalarRecord;
resultValue: TAstValue;
sw: TStopwatch;
currentSeriesIdent: IIdentifierNode;
begin
// 1. Setup
Memo1.Lines.Clear;
@@ -687,14 +545,10 @@ begin
RegisterNativeFunctions(FGScope);
sw := TStopwatch.StartNew;
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV)));
series := TScalarRecordSeries.Create(recordDef);
// 2. Create the setup AST with the optimized O(1) SMA implementation
// 2. Create the setup AST with the strategy logic
setupAst :=
TAst.Block(
[
// This factory is now much simpler. It only manages sum and a counter.
TAst.VarDecl(
TAst.Identifier('CreateSMA'),
TAst.LambdaExpr(
@@ -703,7 +557,6 @@ begin
[
TAst.VarDecl(TAst.Identifier('sum'), TAst.Constant(TScalar.FromDouble(0.0))),
TAst.VarDecl(TAst.Identifier('count'), TAst.Constant(TScalar.FromInt64(0))),
// The returned closure now takes the full series and the new value.
TAst.LambdaExpr(
[TAst.Identifier('series'), TAst.Identifier('val')],
TAst.Block(
@@ -716,7 +569,6 @@ begin
TAst.Identifier('count'),
TAst.BinaryExpr(TAst.Identifier('count'), boAdd, TAst.Constant(TScalar.FromInt64(1)))
),
// If the indicator is "full", subtract the value that just fell out of the window (at index 'len').
TAst.IfExpr(
TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')),
TAst.Assign(
@@ -729,7 +581,6 @@ begin
),
nil
),
// Calculate and return the average. Divisor is capped at 'len'.
TAst.BinaryExpr(
TAst.Identifier('sum'),
boDivide,
@@ -746,7 +597,6 @@ begin
)
)
),
// Instantiation remains the same.
TAst.VarDecl(
TAst.Identifier('smaFast'),
TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaFastLength))])
@@ -755,7 +605,6 @@ begin
TAst.Identifier('smaSlow'),
TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaSlowLength))])
),
// The main strategy now passes the full close series to the indicators.
TAst.VarDecl(
TAst.Identifier('maCrossStrategy'),
TAst.LambdaExpr(
@@ -795,13 +644,30 @@ begin
)
]
);
FLastAst := setupAst;
visitor := CreateVisitor(FGScope);
setupAst.Accept(visitor);
callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')]);
// Bind and execute the setup script once.
ExecuteAst(setupAst, FGScope);
// 3. Simulation Loop
// 3. Prepare for the simulation loop
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV)));
series := TScalarRecordSeries.Create(recordDef);
visitor := CreateVisitor(FGScope);
// Declare the series variable in the scope BEFORE binding the call AST
FGScope.Define('current_series', TAstValue.Void);
// Create the call AST that will be executed in the loop
currentSeriesIdent := TAst.Identifier('current_series');
callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
// Bind the call AST once, before the loop.
TAst.Bind(callAst, FGScope);
// Get the resolved address of 'current_series' for fast updates
if not currentSeriesIdent.Resolve(depth, index) then
raise EInvalidOpException.Create('Could not resolve loop variable ''current_series''.');
// 4. Simulation Loop
Memo1.Lines.Add('Starting simulation...');
Application.ProcessMessages;
@@ -836,11 +702,14 @@ begin
if series.TotalCount >= smaSlowLength then
begin
FGScope.SetValue('current_series', TAstValue.FromRecordSeries(series));
// Update the 'current_series' value in the scope using the FAST index-based assignment
FGScope.AssignValue(depth, index, TAstValue.FromRecordSeries(series));
// Execute the PRE-BOUND call AST
resultValue := callAst.Accept(visitor);
Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
Application.ProcessMessages;
// Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
// Application.ProcessMessages;
end;
end;
Src/AST/Myc.Ast.Evaluator.pas
+56 -57
View File
@@ -35,7 +35,7 @@ type
function VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; virtual;
function VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; virtual;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; virtual;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; virtual;
end;
// TDebugEvaluatorVisitor now overrides all visit methods for full tracing
@@ -68,6 +68,7 @@ type
function VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; override;
end;
// Registers all native core functions in the given scope.
@@ -81,7 +82,7 @@ uses
Myc.Data.Series,
Myc.Ast.Scope,
Myc.Ast.Printer,
Myc.Data.Scalar.JSON; // Added for JsonToRecordDefinition
Myc.Data.Scalar.JSON;
type
// The signature for a native Delphi function callable from the script.
@@ -194,9 +195,10 @@ procedure RegisterNativeFunctions(const AScope: IExecutionScope);
var
closure: IEvaluatorClosure;
begin
// Register CreateRecordSeries
// Use 'Define' to clearly state that we are adding a new variable
// to the global scope before the binder runs.
closure := TNativeClosure.Create(NativeCreateRecordSeries);
AScope.SetValue('CreateRecordSeries', TAstValue.FromClosure(closure));
AScope.Define('CreateRecordSeries', TAstValue.FromClosure(closure));
end;
{ TClosureValue }
@@ -280,19 +282,19 @@ end;
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue;
var
itemValue, lookbackValue: TAstValue;
itemValue, lookbackValue, seriesVar: TAstValue;
lookback: Int64;
varName: string;
seriesVar: TAstValue;
depth, index: Integer;
begin
// The target series is now guaranteed to be an identifier by the AST node definition.
varName := Node.Series.Name;
if not FScope.FindValue(varName, seriesVar) then
raise EArgumentException.CreateFmt('Identifier not found: "%s"', [varName]);
// The target series must have been resolved by the binder.
if not Node.Series.Resolve(depth, index) then
raise EArgumentException
.CreateFmt('Identifier could not be resolved: "%s". This should have been caught by the binder.', [Node.Series.Name]);
seriesVar := FScope.GetValue(depth, index);
itemValue := Node.Value.Accept(Self);
lookback := -1;
lookback := -1; // Default: no lookback limit
if Assigned(Node.Lookback) then
begin
lookbackValue := Node.Lookback.Accept(Self);
@@ -335,22 +337,20 @@ begin
else
raise EArgumentException.Create('"add" operation is only supported for series types.');
end;
Result := TAstValue.Void;
end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
var
varName: string;
value: TAstValue;
depth, index: Integer;
begin
// Evaluate the right-hand side of the assignment.
value := Node.Value.Accept(Self);
varName := Node.Identifier.Name;
// Assign the value to the variable in the scope chain.
FScope.AssignValue(varName, value);
if not Node.Identifier.Resolve(depth, index) then
raise EArgumentException
.CreateFmt('Identifier could not be resolved: "%s". This should have been caught by the binder.', [Node.Identifier.Name]);
// Assignment expressions return the assigned value.
FScope.AssignValue(depth, index, value);
Result := value;
end;
@@ -365,10 +365,8 @@ var
begin
def := Node.Definition.Trim;
// Based on the content, create a scalar or a record series.
if def.StartsWith('[') then
begin
// Assumed to be a record definition array, e.g., '[{"Name": "Close", "Kind": "skDouble"}]'
var recordDef := TRttiAstHelper.JsonToRecordDefinition(def);
if Length(recordDef.Fields) = 0 then
raise EArgumentException.Create('Failed to parse record definition from JSON array.');
@@ -378,7 +376,6 @@ begin
end
else
begin
// Assumed to be a single scalar type name, e.g., 'double'
var scalarKind := StringToScalarKind(def);
var scalarSeries := TScalarSeries.Create(scalarKind, Default(TSeries<TScalarValue>));
Result := TAstValue.FromSeries(scalarSeries);
@@ -387,12 +384,14 @@ end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
var
val: TAstValue;
depth, index: Integer;
begin
if FScope.FindValue(Node.Name, val) then
Result := val
if Node.Resolve(depth, index) then
Result := FScope.GetValue(depth, index)
else
raise EArgumentException.CreateFmt('Identifier not found: "%s"', [Node.Name]);
// This should not happen if the binder ran successfully.
raise EArgumentException
.CreateFmt('Identifier could not be resolved: "%s". This should have been caught by the binder.', [Node.Name]);
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
@@ -404,7 +403,6 @@ begin
baseValue := Node.Base.Accept(Self);
indexValue := Node.Index.Accept(Self);
// Index validation (common for all indexable types)
if (indexValue.Kind <> avkScalar) then
raise EArgumentException.Create('Indexer `[]` requires a scalar integer argument.');
@@ -416,7 +414,6 @@ begin
raise EArgumentException.Create('Indexer `[]` requires an integer type argument.');
end;
// Base type dispatching
case baseValue.Kind of
avkSeries:
begin
@@ -484,14 +481,15 @@ end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
var
varName: string;
value: TAstValue;
begin
varName := Node.Identifier.Name;
if Assigned(Node.Initializer) then
Result := Node.Initializer.Accept(Self)
value := Node.Initializer.Accept(Self)
else
Result := TAstValue.Void;
FScope.SetValue(varName, Result);
value := TAstValue.Void;
FScope.Define(Node.Identifier.Name, value);
Result := value;
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
@@ -518,10 +516,8 @@ begin
closure := calleeValue.AsClosure;
// Distinguish between native and script-defined closures.
if closure is TNativeClosure then
begin
// Native function call
SetLength(argValues, Node.Arguments.Count);
for i := 0 to Node.Arguments.Count - 1 do
begin
@@ -531,23 +527,25 @@ begin
end
else if closure is TClosureValue then
begin
// Script function call (original logic)
if (Node.Arguments.Count <> Length(closure.Parameters)) then
raise EArgumentException
.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), Node.Arguments.Count]);
callScope := TExecutionScope.Create(closure.ClosureScope);
// The order of definitions must exactly match the binder's order.
// Define 'Self' first.
callScope.Define('Self', calleeValue);
// 2. Then, define the parameters.
for i := 0 to Node.Arguments.Count - 1 do
begin
argValues := [Node.Arguments[i].Accept(Self)];
callScope.SetValue(closure.Parameters[i].Name, argValues[0]);
var argValue := Node.Arguments[i].Accept(Self);
callScope.Define(closure.Parameters[i].Name, argValue);
end;
innerVisitor := Self.CreateVisitorForScope(callScope);
callScope.SetValue('Self', calleeValue);
callScope.SetValue('Result', TAstValue.Void);
Result := closure.Body.Accept(innerVisitor);
end
else
@@ -559,7 +557,6 @@ var
leftValue, rightValue: TAstValue;
leftScalar, rightScalar: TScalar;
begin
// Implemented binary operators for Int64 and Double.
leftValue := Node.Left.Accept(Self);
rightValue := Node.Right.Accept(Self);
@@ -571,7 +568,6 @@ begin
if (leftScalar.Kind <> rightScalar.Kind) then
begin
// Automatic type promotion from Int64 to Double.
if (leftScalar.Kind = skInt64) and (rightScalar.Kind = skDouble) then
begin
leftScalar := TScalar.FromDouble(leftScalar.Value.AsInt64);
@@ -582,7 +578,6 @@ begin
end
else
begin
// If types are still different after promotion, they are incompatible.
raise ENotSupportedException.Create(
'Binary operations are only supported for compatible types. ' + leftScalar.ToString + ' ' + rightScalar.ToString);
end;
@@ -637,7 +632,6 @@ var
rightValue: TAstValue;
rightScalar: TScalar;
begin
// Implemented unary operators for Int64, Double, and Boolean.
rightValue := Node.Right.Accept(Self);
case Node.Operator of
@@ -655,7 +649,6 @@ begin
end;
uoNot:
begin
// "not" operates on the truthiness of the value.
Result := TAstValue.FromScalar(TScalar.FromBoolean(not IsTruthy(rightValue)));
end;
else
@@ -672,11 +665,9 @@ begin
Result := Node.ThenBranch.Accept(Self)
else
begin
// If an else branch exists, evaluate it.
if Assigned(Node.ElseBranch) then
Result := Node.ElseBranch.Accept(Self)
else
// Otherwise, an if-statement without an else branch evaluates to void.
Result := TAstValue.Void;
end;
end;
@@ -695,14 +686,13 @@ end;
function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
var
expression: IExpressionNode;
lastValue: TAstValue;
begin
lastValue := TAstValue.Void;
// The result of a block is the result of its last expression.
Result := TAstValue.Void;
for expression in Node.Expressions do
begin
lastValue := expression.Accept(Self);
Result := expression.Accept(Self);
end;
Result := lastValue;
end;
function TEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
@@ -710,20 +700,16 @@ var
seriesValue: TAstValue;
len: Int64;
begin
// 1. Evaluate the identifier to get the series object from the scope.
seriesValue := Node.Series.Accept(Self);
// 2. Get the length based on the actual series type.
case seriesValue.Kind of
avkSeries: len := seriesValue.AsSeries.Value.Items.Count;
avkRecordSeries: len := seriesValue.AsRecordSeries.Value.Count;
avkMemberSeries: len := seriesValue.AsMemberSeries.Value.Count;
else
// It's an error if we try to get the length of something that isn't a series.
raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TAstValueKind), Ord(seriesValue.Kind))]);
end;
// 3. Return the length as a new scalar value.
Result := TAstValue.FromScalar(TScalar.FromInt64(len));
end;
@@ -811,7 +797,8 @@ end;
function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
begin
AppendLine(Format('Assignment %s := {', [Node.Identifier.Name]));
// The name is not easily available anymore for logging.
AppendLine(Format('Assignment to "%s" {', [Node.Identifier.Name]));
Indent;
try
Result := inherited VisitAssignment(Node);
@@ -970,4 +957,16 @@ begin
end;
end;
function TDebugEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
begin
AppendLine('SeriesLength {');
Indent;
try
Result := inherited VisitSeriesLength(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
end.
Src/AST/Myc.Ast.Nodes.pas
+14 -3
View File
@@ -101,9 +101,20 @@ type
function GetParent: IExecutionScope;
{$endregion}
procedure Clear;
function FindValue(const Name: string; out Value: TAstValue): Boolean;
procedure SetValue(const Name: string; const Value: TAstValue);
procedure AssignValue(const Name: string; const Value: TAstValue);
// --- Legacy name-based access (for pre-binder setup, e.g., native functions) ---
function FindValue(const Name: string; out Value: TAstValue): Boolean; deprecated 'Use index-based access after binding.';
procedure SetValue(const Name: string; const Value: TAstValue); deprecated 'Use Define for script variables.';
procedure AssignValue(const Name: string; const Value: TAstValue); overload; deprecated 'Use index-based assignment after binding.';
// --- New index-based access (for use by the evaluator after binding) ---
// Defines a new variable in the current scope.
procedure Define(const Name: string; const Value: TAstValue);
// Gets a value from a scope at a specific depth and slot index.
function GetValue(Depth, Index: Integer): TAstValue;
// Assigns a new value to an existing variable at a specific depth and slot index.
procedure AssignValue(Depth, Index: Integer; const Value: TAstValue); overload;
function Dump: string;
property Parent: IExecutionScope read GetParent;
end;
Src/AST/Myc.Ast.Scope.pas
+105 -20
View File
@@ -12,7 +12,8 @@ type
TExecutionScope = class(TInterfacedObject, IExecutionScope)
private
FParent: IExecutionScope;
FVariables: TDictionary<string, TAstValue>;
FValues: TArray<TAstValue>;
FNameToIndex: TDictionary<string, Integer>;
procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
protected
// IExecutionScope
@@ -20,27 +21,37 @@ type
procedure Clear;
function FindValue(const Name: string; out Value: TAstValue): Boolean;
procedure SetValue(const Name: string; const Value: TAstValue);
procedure AssignValue(const Name: string; const Value: TAstValue);
procedure AssignValue(const Name: string; const Value: TAstValue); overload;
function Dump: string;
// --- New index-based access methods ---
procedure Define(const Name: string; const Value: TAstValue);
function GetValue(Depth, Index: Integer): TAstValue;
procedure AssignValue(Depth, Index: Integer; const Value: TAstValue); overload;
public
constructor Create(AParent: IExecutionScope = nil);
destructor Destroy; override;
property NameToIndex: TDictionary<string, Integer> read FNameToIndex;
end;
implementation
uses
System.Generics.Defaults; // For TComparer
{ TExecutionScope }
constructor TExecutionScope.Create(AParent: IExecutionScope);
begin
inherited Create;
FParent := AParent;
FVariables := TDictionary<string, TAstValue>.Create;
FValues := [];
FNameToIndex := TDictionary<string, Integer>.Create;
end;
destructor TExecutionScope.Destroy;
begin
FVariables.Free;
FNameToIndex.Free;
inherited Destroy;
end;
@@ -50,32 +61,75 @@ begin
end;
procedure TExecutionScope.AssignValue(const Name: string; const Value: TAstValue);
var
index: Integer;
begin
if FVariables.ContainsKey(Name) then
FVariables.AddOrSetValue(Name, Value)
if FNameToIndex.TryGetValue(Name, index) then
FValues[index] := Value
else if Assigned(FParent) then
FParent.AssignValue(Name, Value)
else
raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]);
end;
procedure TExecutionScope.AssignValue(Depth, Index: Integer; const Value: TAstValue);
var
targetScope: IExecutionScope;
i: Integer;
begin
targetScope := Self;
for i := 1 to Depth do
begin
if Assigned(targetScope) then
targetScope := targetScope.Parent
else
// This should not happen if the binder works correctly.
raise EInvalidOpException.Create('Invalid scope depth during assignment.');
end;
// We must cast back to the implementation to modify the private array.
(targetScope as TExecutionScope).FValues[Index] := Value;
end;
procedure TExecutionScope.Clear;
begin
FVariables.Clear;
if Assigned(FParent) then
FParent.Clear;
FValues := [];
FNameToIndex.Clear;
end;
procedure TExecutionScope.Define(const Name: string; const Value: TAstValue);
var
index: Integer;
begin
// A variable can only be defined once per scope.
if FNameToIndex.ContainsKey(Name) then
raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]);
index := Length(FValues);
SetLength(FValues, index + 1);
FValues[index] := Value;
FNameToIndex.Add(Name, index);
end;
procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
var
pair: TPair<string, TAstValue>;
pair: TPair<string, Integer>;
indentStr: string;
sortedPairs: TArray<TPair<string, Integer>>;
begin
indentStr := ''.PadLeft(AIndent);
if (FVariables.Count > 0) then
if (FNameToIndex.Count > 0) then
begin
for pair in FVariables do
ABuilder.AppendLine(indentStr + Format(' %s: %s', [pair.Key, pair.Value.ToString]));
// Copy pairs to an array and sort it by index for consistent output
sortedPairs := FNameToIndex.ToArray;
TArray.Sort<TPair<string, Integer>>(
sortedPairs,
TComparer<TPair<string, Integer>>
.Construct(function(const Left, Right: TPair<string, Integer>): Integer begin Result := Left.Value - Right.Value; end)
);
for pair in sortedPairs do
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s', [pair.Value, pair.Key, FValues[pair.Value].ToString]));
end
else
begin
@@ -85,9 +139,7 @@ begin
if Assigned(FParent) then
begin
ABuilder.AppendLine(indentStr + '[Parent Scope]');
// As FParent is now an interface, we must cast it back to the class to call the private DumpScope.
// This indicates that DumpScope should perhaps be part of the interface or handled differently.
// For now, we use a cast to keep the functionality.
// This cast is necessary for this debug helper to access implementation details.
(FParent as TExecutionScope).DumpScope(ABuilder, AIndent + 2);
end;
end;
@@ -107,17 +159,50 @@ begin
end;
function TExecutionScope.FindValue(const Name: string; out Value: TAstValue): Boolean;
var
index: Integer;
begin
Result := FVariables.TryGetValue(Name, Value);
if not Result and Assigned(FParent) then
if FNameToIndex.TryGetValue(Name, index) then
begin
Result := FParent.FindValue(Name, Value);
Value := FValues[index];
Result := True;
Exit;
end;
if Assigned(FParent) then
Result := FParent.FindValue(Name, Value)
else
Result := False;
end;
function TExecutionScope.GetValue(Depth, Index: Integer): TAstValue;
var
targetScope: IExecutionScope;
i: Integer;
begin
targetScope := Self;
for i := 1 to Depth do
begin
if Assigned(targetScope) then
targetScope := targetScope.Parent
else
// This should not happen if the binder works correctly.
raise EInvalidOpException.Create('Invalid scope depth during value retrieval.');
end;
// We must cast back to the implementation to access the private array.
Result := (targetScope as TExecutionScope).FValues[Index];
end;
procedure TExecutionScope.SetValue(const Name: string; const Value: TAstValue);
var
index: Integer;
begin
FVariables.AddOrSetValue(Name, Value);
// This method is for pre-binder setup (e.g. native functions) or initial definition.
if FNameToIndex.TryGetValue(Name, index) then
FValues[index] := Value
else
Define(Name, Value);
end;
end.
Src/AST/Myc.Ast.pas
+78 -30
View File
@@ -45,7 +45,7 @@ type
// --- Static method to run the binder ---
// Traverses the AST and resolves all identifiers. This must be called before evaluating the AST.
class procedure Bind(const ARootNode: IExpressionNode); static;
class procedure Bind(const ARootNode: IExpressionNode; const AScope: IExecutionScope); static;
end;
// TAstTraverser provides a default AST traversal implementation.
@@ -73,7 +73,8 @@ implementation
uses
System.Classes,
System.Generics.Collections;
System.Generics.Collections,
Myc.Ast.Scope; // Needed for the TExecutionScope cast
type
{ TAstNode }
@@ -296,9 +297,11 @@ type
FParent: TSymbolTable;
FSymbols: TDictionary<string, TSymbol>;
FNextSlotIndex: Integer;
procedure DefinePreResolved(const Name: string; Index: Integer);
public
constructor Create(AParent: TSymbolTable);
destructor Destroy; override;
procedure PopulateFromScope(const AScope: IExecutionScope);
function Define(const Name: string): TSymbol;
function Resolve(const Name: string; out Symbol: TSymbol; out Depth: Integer): Boolean;
end;
@@ -310,12 +313,11 @@ type
procedure EnterScope;
procedure ExitScope;
public
constructor Create;
constructor Create(AInitialScope: IExecutionScope);
destructor Destroy; override;
function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; override;
end;
{ TConstantNode }
@@ -745,6 +747,38 @@ begin
inherited;
end;
procedure TSymbolTable.DefinePreResolved(const Name: string; Index: Integer);
var
symbol: TSymbol;
begin
// Defines a symbol with a specific, pre-determined index.
if not FSymbols.ContainsKey(Name) then
begin
symbol.Name := Name;
symbol.SlotIndex := Index;
FSymbols.Add(Name, symbol);
// Ensure the next automatically assigned index is correct.
if (Index >= FNextSlotIndex) then
FNextSlotIndex := Index + 1;
end;
end;
procedure TSymbolTable.PopulateFromScope(const AScope: IExecutionScope);
var
scopeImpl: TExecutionScope;
pair: TPair<string, Integer>;
begin
// ** THE FIX IS HERE **
// Iterate over the Key-Value pairs of the scope's dictionary to preserve the exact indices.
if not Assigned(AScope) then
Exit;
scopeImpl := (AScope as TExecutionScope);
for pair in scopeImpl.NameToIndex do
DefinePreResolved(pair.Key, pair.Value);
end;
function TSymbolTable.Define(const Name: string): TSymbol;
begin
Result.Name := Name;
@@ -772,16 +806,41 @@ end;
{ TBinder }
constructor TBinder.Create;
// Helper function to recursively build the symbol table hierarchy
function CreateSymbolTableFromScope(AScope: IExecutionScope): TSymbolTable;
begin
inherited;
FCurrentScope := TSymbolTable.Create(nil); // Start with a global scope
if not Assigned(AScope) then
Exit(nil);
// Recursively create the parent symbol table first
Result := TSymbolTable.Create(CreateSymbolTableFromScope(AScope.Parent));
// Then populate the current level
Result.PopulateFromScope(AScope);
end;
constructor TBinder.Create(AInitialScope: IExecutionScope);
begin
inherited Create;
// Correctly and recursively build the symbol table hierarchy from the execution scope.
FCurrentScope := CreateSymbolTableFromScope(AInitialScope);
// If no initial scope was provided, create a single empty root scope.
if not Assigned(FCurrentScope) then
FCurrentScope := TSymbolTable.Create(nil);
end;
destructor TBinder.Destroy;
var
scopeToFree: TSymbolTable;
begin
Assert(not Assigned(FCurrentScope.FParent), 'Scope leak in binder.');
FCurrentScope.Free;
// The previous Assert was incorrect for binders initialized with nested scopes.
// This new implementation robustly cleans up the entire symbol table chain.
while Assigned(FCurrentScope) do
begin
scopeToFree := FCurrentScope;
FCurrentScope := FCurrentScope.FParent;
scopeToFree.Free;
end;
inherited;
end;
@@ -799,17 +858,6 @@ begin
oldScope.Free;
end;
function TBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
begin
EnterScope;
try
// Default traversal of all expressions in the block
inherited VisitBlockExpression(Node);
finally
ExitScope;
end;
end;
function TBinder.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
var
symbol: TSymbol;
@@ -836,6 +884,9 @@ var
begin
EnterScope;
try
// Reserve a slot for 'Self' first.
FCurrentScope.Define('Self');
// 1. Define all parameters in the new scope.
for param in Node.Parameters do
FCurrentScope.Define(param.Name);
@@ -850,24 +901,21 @@ end;
function TBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
begin
// 1. First, visit the initializer expression to resolve its identifiers.
if Assigned(Node.Initializer) then
Node.Initializer.Accept(Self);
// 2. Then, define the new variable in the current scope.
// For recursive functions, we must define the name in the scope FIRST,
// so it can be resolved inside its own initializer (i.e., the lambda body).
FCurrentScope.Define(Node.Identifier.Name);
// 3. Finally, visit the declaration's own identifier to resolve it.
Node.Identifier.Accept(Self);
inherited;
end;
{ TAst }
class procedure TAst.Bind(const ARootNode: IExpressionNode);
class procedure TAst.Bind(const ARootNode: IExpressionNode; const AScope: IExecutionScope);
var
binder: IAstVisitor;
begin
binder := TBinder.Create;
// Create a binder instance, pre-populating its symbol table with the given scope.
binder := TBinder.Create(AScope);
// Traverse the AST to resolve all identifiers.
ARootNode.Accept(binder);
end;