Ast Binding

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
+1 -1
View File
@@ -135,7 +135,7 @@ object Form1: TForm1
object DebugBox: TCheckBox object DebugBox: TCheckBox
Position.X = 24.000000000000000000 Position.X = 24.000000000000000000
Position.Y = 360.000000000000000000 Position.Y = 360.000000000000000000
TabOrder = 17 TabOrder = 16
Text = 'Debug' Text = 'Debug'
end end
end end
+140 -271
View File
@@ -28,7 +28,8 @@ uses
Myc.Ast.Evaluator, Myc.Ast.Evaluator,
Myc.Ast.Printer, Myc.Ast.Printer,
FMX.Layouts, FMX.Layouts,
FMX.Objects; // Added for TExecutionScope FMX.Objects,
Myc.Ast.Scope; // Added for TExecutionScope
type type
// A test record // A test record
@@ -80,6 +81,8 @@ type
FWorkspace: TAuraWorkspace; FWorkspace: TAuraWorkspace;
function CreateVisitor(const AScope: IExecutionScope): IAstVisitor; function CreateVisitor(const AScope: IExecutionScope): IAstVisitor;
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); 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
{ Public declarations } { Public declarations }
end; end;
@@ -90,7 +93,7 @@ var
implementation implementation
uses uses
Myc.Ast.Scope, // Myc.Ast.Scope is now in the interface uses
Myc.Data.Scalar.JSON, Myc.Data.Scalar.JSON,
Myc.Data.Decimal, Myc.Data.Decimal,
System.Diagnostics; // For TStopwatch System.Diagnostics; // For TStopwatch
@@ -115,6 +118,17 @@ begin
Result := TEvaluatorVisitor.Create(AScope); Result := TEvaluatorVisitor.Create(AScope);
end; 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); procedure TForm1.FormCreate(Sender: TObject);
begin begin
FWorkspace := TAuraWorkspace.Create(Panel2); FWorkspace := TAuraWorkspace.Create(Panel2);
@@ -124,7 +138,9 @@ begin
FWorkspace.OnMouseDown := WorkspaceMouseDown; FWorkspace.OnMouseDown := WorkspaceMouseDown;
// Create and prepare the global scope once
FGScope := TExecutionScope.Create(nil); FGScope := TExecutionScope.Create(nil);
RegisterNativeFunctions(FGScope);
end; end;
procedure TForm1.DebugButtonClick(Sender: TObject); procedure TForm1.DebugButtonClick(Sender: TObject);
@@ -137,7 +153,6 @@ begin
if not Assigned(FLastAst) then if not Assigned(FLastAst) then
begin begin
Memo1.Lines.Add('No AST has been generated yet.'); Memo1.Lines.Add('No AST has been generated yet.');
Memo1.Lines.Add('Click "Test 1" or "Test 2" first.');
exit; exit;
end; end;
@@ -146,7 +161,9 @@ begin
Memo1.Lines.Clear; Memo1.Lines.Clear;
Memo1.Lines.Add('--- Debug Evaluator Trace ---'); 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); visitor := TDebugEvaluatorVisitor.Create(scope, Memo1.Lines, ShowScopeBox.IsChecked, 0);
sw := TStopwatch.StartNew; sw := TStopwatch.StartNew;
@@ -156,67 +173,18 @@ begin
Memo1.Lines.Add('-----------------------------'); Memo1.Lines.Add('-----------------------------');
Memo1.Lines.Add(Format('Final script result: %s', [result.ToString])); Memo1.Lines.Add(Format('Final script result: %s', [result.ToString]));
Memo1.Lines.Add(Format('Execution time: %d ms', [sw.ElapsedMilliseconds])); 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; end;
procedure TForm1.FibonacciButtonClick(Sender: TObject); 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 var
scope: IExecutionScope;
visitor: IAstVisitor;
root: IExpressionNode; root: IExpressionNode;
result: TAstValue; result: TAstValue;
sw: TStopwatch; sw: TStopwatch;
result20, result30, result40: Int64; scope: IExecutionScope;
time20, time30, time40: Int64;
begin begin
FGScope.Clear;
Memo1.Lines.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---'); Memo1.Lines.Add('--- Recursive fib with AST---');
Application.ProcessMessages; // Update UI before blocking sw := TStopwatch.StartNew;
sw.Start;
root := root :=
TAst.Block( TAst.Block(
@@ -225,12 +193,9 @@ begin
TAst.Identifier('fib'), TAst.Identifier('fib'),
TAst.LambdaExpr( TAst.LambdaExpr(
[TAst.Identifier('n')], [TAst.Identifier('n')],
// The body is now a single ternary expression that returns a value.
TAst.TernaryExpr( TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))), TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
// The value if true.
TAst.Identifier('n'), TAst.Identifier('n'),
// The value if false.
TAst.BinaryExpr( TAst.BinaryExpr(
TAst.FunctionCall( TAst.FunctionCall(
TAst.Identifier('fib'), TAst.Identifier('fib'),
@@ -250,21 +215,17 @@ begin
); );
FLastAst := root; 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; sw.Stop;
Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); 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; end;
procedure TForm1.PrettyPrintButtonClick(Sender: TObject); procedure TForm1.PrettyPrintButtonClick(Sender: TObject);
var var
visitor: TPrettyPrintVisitor; visitor: TPrettyPrintVisitor;
sw: TStopwatch;
begin begin
Memo1.Lines.Clear; Memo1.Lines.Clear;
Memo1.Lines.Add('--- AST Pretty Print ---'); Memo1.Lines.Add('--- AST Pretty Print ---');
@@ -272,38 +233,24 @@ begin
if not Assigned(FLastAst) then if not Assigned(FLastAst) then
begin begin
Memo1.Lines.Add('No AST has been generated yet.'); Memo1.Lines.Add('No AST has been generated yet.');
Memo1.Lines.Add('Click "Test 1" or "Test 2" first.');
exit; exit;
end; end;
visitor := TPrettyPrintVisitor.Create; visitor := TPrettyPrintVisitor.Create;
try FLastAst.Accept(visitor);
sw := TStopwatch.StartNew; Memo1.Lines.Add(visitor.GetResult);
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;
end; end;
procedure TForm1.RecursionButtonClick(Sender: TObject); procedure TForm1.RecursionButtonClick(Sender: TObject);
var var
scope: IExecutionScope;
visitor: IAstVisitor;
root: IExpressionNode; root: IExpressionNode;
result: TAstValue; result: TAstValue;
sw: TStopwatch; sw: TStopwatch;
scope: IExecutionScope;
begin begin
FGScope.Clear;
sw := TStopwatch.Create;
Memo1.Lines.Clear; Memo1.Lines.Clear;
Memo1.Lines.Add('--- Recursive factorial(20) ---'); Memo1.Lines.Add('--- Recursive factorial(20) ---');
sw := TStopwatch.StartNew;
sw.Start;
root := root :=
TAst.Block( TAst.Block(
@@ -312,21 +259,17 @@ begin
TAst.Identifier('factorial'), TAst.Identifier('factorial'),
TAst.LambdaExpr( TAst.LambdaExpr(
[TAst.Identifier('n')], [TAst.Identifier('n')],
TAst.Block( TAst.TernaryExpr(
[ TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
TAst.TernaryExpr( TAst.Constant(TScalar.FromInt64(1)),
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))), TAst.BinaryExpr(
TAst.Constant(TScalar.FromInt64(1)), TAst.Identifier('n'),
TAst.BinaryExpr( boMultiply,
TAst.Identifier('n'), TAst.FunctionCall(
boMultiply, TAst.Identifier('factorial'),
TAst.FunctionCall( [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
TAst.Identifier('factorial'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
)
)
) )
] )
) )
) )
), ),
@@ -337,43 +280,31 @@ begin
FLastAst := root; FLastAst := root;
scope := TExecutionScope.Create(nil); scope := TExecutionScope.Create(nil);
visitor := CreateVisitor(scope); result := ExecuteAst(root, scope);
result := root.Accept(visitor);
sw.Stop;
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); 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; end;
procedure TForm1.SeriesTestButtonClick(Sender: TObject); procedure TForm1.SeriesTestButtonClick(Sender: TObject);
var var
jsonDef: string; scope: IExecutionScope;
recordDef: TScalarRecordDefinition; ast, callAst: IExpressionNode;
series: TScalarRecordSeries;
recordValue: TScalarRecord;
visitor: IAstVisitor;
ast: IExpressionNode;
resultValue: TAstValue; resultValue: TAstValue;
series: TScalarRecordSeries;
recordDef: TScalarRecordDefinition;
i: Integer; i: Integer;
begin begin
Memo1.Lines.Clear; Memo1.Lines.Clear;
Memo1.Lines.Add('--- Series Test ---'); Memo1.Lines.Add('--- Series Test ---');
// --- 1. Arrange (in Delphi) --- // 1. Arrange: Create a new scope and populate it with Delphi data
Memo1.Lines.Add('1. Arranging test data in Delphi...'); scope := TExecutionScope.Create(FGScope); // Inherits native functions
FGScope.Clear; recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV)));
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);
series := TScalarRecordSeries.Create(recordDef); series := TScalarRecordSeries.Create(recordDef);
for i := 0 to 4 do for i := 0 to 4 do
begin begin
recordValue := series.Add(
TScalarRecord.Create( TScalarRecord.Create(
recordDef, recordDef,
[ [
@@ -384,17 +315,12 @@ begin
TScalarValue.FromDouble(102.0 + i), TScalarValue.FromDouble(102.0 + i),
TScalarValue.FromInt64(10000 * (i + 1)) TScalarValue.FromInt64(10000 * (i + 1))
] ]
); )
series.Add(recordValue); );
end; end;
scope.Define('ohlcvSeries', TAstValue.FromRecordSeries(series));
FGScope.SetValue('ohlcvSeries', TAstValue.FromRecordSeries(series)); // 2. Act: Define and execute the script AST
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...');
ast := ast :=
TAst.LambdaExpr( TAst.LambdaExpr(
[], [],
@@ -404,69 +330,31 @@ begin
TAst.Identifier('closeColumn'), TAst.Identifier('closeColumn'),
TAst.MemberAccess(TAst.Identifier('ohlcvSeries'), TAst.Identifier('Close')) TAst.MemberAccess(TAst.Identifier('ohlcvSeries'), TAst.Identifier('Close'))
), ),
TAst.VarDecl( TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(TScalar.FromInt64(1)))
TAst.Identifier('secondClose'),
TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(TScalar.FromInt64(1)))
)
] ]
) )
); );
FLastAst := ast; FLastAst := ast;
callAst := TAst.FunctionCall(ast, []);
resultValue := ExecuteAst(callAst, scope);
visitor := CreateVisitor(FGScope); // 3. Assert (logging only)
resultValue := TAst.FunctionCall(ast, []).Accept(visitor); Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString]));
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 ---');
end; end;
procedure TForm1.Test1ButtonClick(Sender: TObject); procedure TForm1.Test1ButtonClick(Sender: TObject);
var var
scope: IExecutionScope; main, callAst: IExpressionNode;
visitor: IAstVisitor;
result: TAstValue; result: TAstValue;
sw: TStopwatch; sw: TStopwatch;
scope: IExecutionScope;
begin begin
FGScope.Clear;
sw := TStopwatch.Create;
Memo1.Lines.Clear; Memo1.Lines.Clear;
Memo1.Lines.Add('--- Simple AST Execution ---'); Memo1.Lines.Add('--- Simple AST Execution ---');
sw := TStopwatch.StartNew;
sw.Start; main :=
var main :=
TAst.LambdaExpr( TAst.LambdaExpr(
[], [],
TAst.Block( TAst.Block(
@@ -482,35 +370,25 @@ begin
); );
FLastAst := main; FLastAst := main;
callAst := TAst.FunctionCall(main, []);
scope := TExecutionScope.Create(FGScope); scope := TExecutionScope.Create(FGScope);
visitor := CreateVisitor(scope); result := ExecuteAst(callAst, scope);
result := TAst.FunctionCall(main, []).Accept(visitor);
sw.Stop;
if not result.IsVoid then sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])) 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.)');
end; end;
procedure TForm1.Test2ButtonClick(Sender: TObject); procedure TForm1.Test2ButtonClick(Sender: TObject);
var var
scope: IExecutionScope;
visitor: IAstVisitor;
root: IExpressionNode; root: IExpressionNode;
result: TAstValue; result: TAstValue;
sw: TStopwatch; sw: TStopwatch;
scope: IExecutionScope;
begin begin
FGScope.Clear;
sw := TStopwatch.Create;
Memo1.Lines.Clear; Memo1.Lines.Clear;
Memo1.Lines.Add('--- Factory Pattern Demo ---'); Memo1.Lines.Add('--- Factory Pattern Demo ---');
sw := TStopwatch.StartNew;
sw.Start;
root := root :=
TAst.Block( TAst.Block(
@@ -533,34 +411,26 @@ begin
); );
FLastAst := root; FLastAst := root;
scope := TExecutionScope.Create(FGScope); scope := TExecutionScope.Create(FGScope);
visitor := CreateVisitor(scope); result := ExecuteAst(root, scope);
result := root.Accept(visitor);
sw.Stop;
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(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; end;
procedure TForm1.CrerateTriggerExampleButtonClick(Sender: TObject); procedure TForm1.CrerateTriggerExampleButtonClick(Sender: TObject);
var var
visitor: IAstVisitor; blk: IExpressionNode;
closureValue: TAstValue;
begin begin
// This button now only creates the AST. The persistent scope is managed by FGScope.
FGScope.Clear; FGScope.Clear;
RegisterNativeFunctions(FGScope); // Re-register natives after clearing
// 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.
Memo1.Lines.Clear; Memo1.Lines.Clear;
Memo1.Lines.Add('--- Creating Trigger Blueprint ---'); Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
var blk := blk :=
TAst.Block( TAst.Block(
[ [
TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(0))), 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. // Bind and execute the setup block against the persistent global scope
// The closure captures the scope where 'X' is defined. ExecuteAst(blk, FGScope);
visitor := CreateVisitor(FGScope);
blk.Accept(visitor);
// FLastAst is not used for this parameterized example. FLastAst := blk; // Store for visualization
FLastAst := blk;
Memo1.Lines.Add('Variable "X" initialized to 0 in persistent scope.'); Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.');
Memo1.Lines.Add('Blueprint function "tickHandler(summand)" created.'); Memo1.Lines.Add('Click "Do Trigger" to execute.');
Memo1.Lines.Add('Click "Do Trigger" or "Do Trigger 2" to execute.');
end; end;
procedure TForm1.DoTriggerButtonClick(Sender: TObject); procedure TForm1.DoTriggerButtonClick(Sender: TObject);
var var
visitor: IAstVisitor;
currentValue: TAstValue;
callAst: IFunctionCallNode; callAst: IFunctionCallNode;
currentValue: TAstValue;
depth, index: Integer;
identAst: IIdentifierNode;
begin 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))]); callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]);
// Execute the call AST.
visitor := CreateVisitor(FGScope);
callAst.Accept(visitor);
FLastAst := callAst; FLastAst := callAst;
// Get the updated value of 'X' from the scope and display it. // Bind and execute the call against the persistent scope
if FGScope.FindValue('X', currentValue) then 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 begin
currentValue := FGScope.GetValue(depth, index);
Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [currentValue.ToString])); Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [currentValue.ToString]));
end end
else else
begin
// This should not happen if setup was correct.
Memo1.Lines.Add('Error: Variable "X" not found in scope.'); Memo1.Lines.Add('Error: Variable "X" not found in scope.');
end;
end; end;
procedure TForm1.DoTrigger2ButtonClick(Sender: TObject); procedure TForm1.DoTrigger2ButtonClick(Sender: TObject);
var var
visitor: IAstVisitor;
currentValue: TAstValue;
callAst: IFunctionCallNode; callAst: IFunctionCallNode;
currentValue: TAstValue;
depth, index: Integer;
identAst: IIdentifierNode;
begin 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))]); callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]);
FLastAst := callAst; FLastAst := callAst;
// Execute the call AST. // Bind and execute the call against the persistent scope
visitor := CreateVisitor(FGScope); ExecuteAst(callAst, FGScope);
callAst.Accept(visitor);
// Get the updated value of 'X' from the scope and display it. // Inspection requires binding an identifier for 'X'
if FGScope.FindValue('X', currentValue) then identAst := TAst.Identifier('X');
TAst.Bind(identAst, FGScope);
if identAst.Resolve(depth, index) then
begin begin
currentValue := FGScope.GetValue(depth, index);
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [currentValue.ToString])); Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [currentValue.ToString]));
end end
else else
begin
// This should not happen if setup was correct.
Memo1.Lines.Add('Error: Variable "X" not found in scope.'); Memo1.Lines.Add('Error: Variable "X" not found in scope.');
end;
end; end;
procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
@@ -663,22 +521,22 @@ end;
procedure TForm1.OHLCButtonClick(Sender: TObject); procedure TForm1.OHLCButtonClick(Sender: TObject);
const const
numRecs = 1000; numRecs = 1000000;
lookback = 50; lookback = 100;
smaSlowLength = 20; smaSlowLength = 50;
smaFastLength = 5; smaFastLength = 20;
var var
recordDef: TScalarRecordDefinition; recordDef: TScalarRecordDefinition;
series: TScalarRecordSeries; series: TScalarRecordSeries;
setupAst: IExpressionNode; setupAst, callAst: IExpressionNode;
callAst: IExpressionNode;
visitor: IAstVisitor; visitor: IAstVisitor;
i: Integer; i, depth, index: Integer;
lastClose: Double; lastClose: Double;
ohlcvRec: TOHLCV; ohlcvRec: TOHLCV;
recordValue: TScalarRecord; recordValue: TScalarRecord;
resultValue: TAstValue; resultValue: TAstValue;
sw: TStopwatch; sw: TStopwatch;
currentSeriesIdent: IIdentifierNode;
begin begin
// 1. Setup // 1. Setup
Memo1.Lines.Clear; Memo1.Lines.Clear;
@@ -687,14 +545,10 @@ begin
RegisterNativeFunctions(FGScope); RegisterNativeFunctions(FGScope);
sw := TStopwatch.StartNew; sw := TStopwatch.StartNew;
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV))); // 2. Create the setup AST with the strategy logic
series := TScalarRecordSeries.Create(recordDef);
// 2. Create the setup AST with the optimized O(1) SMA implementation
setupAst := setupAst :=
TAst.Block( TAst.Block(
[ [
// This factory is now much simpler. It only manages sum and a counter.
TAst.VarDecl( TAst.VarDecl(
TAst.Identifier('CreateSMA'), TAst.Identifier('CreateSMA'),
TAst.LambdaExpr( TAst.LambdaExpr(
@@ -703,7 +557,6 @@ begin
[ [
TAst.VarDecl(TAst.Identifier('sum'), TAst.Constant(TScalar.FromDouble(0.0))), TAst.VarDecl(TAst.Identifier('sum'), TAst.Constant(TScalar.FromDouble(0.0))),
TAst.VarDecl(TAst.Identifier('count'), TAst.Constant(TScalar.FromInt64(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.LambdaExpr(
[TAst.Identifier('series'), TAst.Identifier('val')], [TAst.Identifier('series'), TAst.Identifier('val')],
TAst.Block( TAst.Block(
@@ -716,7 +569,6 @@ begin
TAst.Identifier('count'), TAst.Identifier('count'),
TAst.BinaryExpr(TAst.Identifier('count'), boAdd, TAst.Constant(TScalar.FromInt64(1))) 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.IfExpr(
TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')), TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')),
TAst.Assign( TAst.Assign(
@@ -729,7 +581,6 @@ begin
), ),
nil nil
), ),
// Calculate and return the average. Divisor is capped at 'len'.
TAst.BinaryExpr( TAst.BinaryExpr(
TAst.Identifier('sum'), TAst.Identifier('sum'),
boDivide, boDivide,
@@ -746,7 +597,6 @@ begin
) )
) )
), ),
// Instantiation remains the same.
TAst.VarDecl( TAst.VarDecl(
TAst.Identifier('smaFast'), TAst.Identifier('smaFast'),
TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaFastLength))]) TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaFastLength))])
@@ -755,7 +605,6 @@ begin
TAst.Identifier('smaSlow'), TAst.Identifier('smaSlow'),
TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaSlowLength))]) 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.VarDecl(
TAst.Identifier('maCrossStrategy'), TAst.Identifier('maCrossStrategy'),
TAst.LambdaExpr( TAst.LambdaExpr(
@@ -795,13 +644,30 @@ begin
) )
] ]
); );
FLastAst := setupAst; FLastAst := setupAst;
visitor := CreateVisitor(FGScope); // Bind and execute the setup script once.
setupAst.Accept(visitor); ExecuteAst(setupAst, FGScope);
callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')]);
// 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...'); Memo1.Lines.Add('Starting simulation...');
Application.ProcessMessages; Application.ProcessMessages;
@@ -836,11 +702,14 @@ begin
if series.TotalCount >= smaSlowLength then if series.TotalCount >= smaSlowLength then
begin 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); resultValue := callAst.Accept(visitor);
Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString])); // Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
Application.ProcessMessages; // Application.ProcessMessages;
end; end;
end; end;
+56 -57
View File
@@ -35,7 +35,7 @@ type
function VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; virtual; function VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; virtual;
function VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; virtual; function VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; virtual;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; virtual; function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; virtual;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; virtual;
end; end;
// TDebugEvaluatorVisitor now overrides all visit methods for full tracing // TDebugEvaluatorVisitor now overrides all visit methods for full tracing
@@ -68,6 +68,7 @@ type
function VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; override; function VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; override; function VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; override; function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; override;
end; end;
// Registers all native core functions in the given scope. // Registers all native core functions in the given scope.
@@ -81,7 +82,7 @@ uses
Myc.Data.Series, Myc.Data.Series,
Myc.Ast.Scope, Myc.Ast.Scope,
Myc.Ast.Printer, Myc.Ast.Printer,
Myc.Data.Scalar.JSON; // Added for JsonToRecordDefinition Myc.Data.Scalar.JSON;
type type
// The signature for a native Delphi function callable from the script. // The signature for a native Delphi function callable from the script.
@@ -194,9 +195,10 @@ procedure RegisterNativeFunctions(const AScope: IExecutionScope);
var var
closure: IEvaluatorClosure; closure: IEvaluatorClosure;
begin 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); closure := TNativeClosure.Create(NativeCreateRecordSeries);
AScope.SetValue('CreateRecordSeries', TAstValue.FromClosure(closure)); AScope.Define('CreateRecordSeries', TAstValue.FromClosure(closure));
end; end;
{ TClosureValue } { TClosureValue }
@@ -280,19 +282,19 @@ end;
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue;
var var
itemValue, lookbackValue: TAstValue; itemValue, lookbackValue, seriesVar: TAstValue;
lookback: Int64; lookback: Int64;
varName: string; depth, index: Integer;
seriesVar: TAstValue;
begin begin
// The target series is now guaranteed to be an identifier by the AST node definition. // The target series must have been resolved by the binder.
varName := Node.Series.Name; if not Node.Series.Resolve(depth, index) then
if not FScope.FindValue(varName, seriesVar) then raise EArgumentException
raise EArgumentException.CreateFmt('Identifier not found: "%s"', [varName]); .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); itemValue := Node.Value.Accept(Self);
lookback := -1;
lookback := -1; // Default: no lookback limit
if Assigned(Node.Lookback) then if Assigned(Node.Lookback) then
begin begin
lookbackValue := Node.Lookback.Accept(Self); lookbackValue := Node.Lookback.Accept(Self);
@@ -335,22 +337,20 @@ begin
else else
raise EArgumentException.Create('"add" operation is only supported for series types.'); raise EArgumentException.Create('"add" operation is only supported for series types.');
end; end;
Result := TAstValue.Void;
end; end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue; function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
var var
varName: string;
value: TAstValue; value: TAstValue;
depth, index: Integer;
begin begin
// Evaluate the right-hand side of the assignment.
value := Node.Value.Accept(Self); value := Node.Value.Accept(Self);
varName := Node.Identifier.Name;
// Assign the value to the variable in the scope chain. if not Node.Identifier.Resolve(depth, index) then
FScope.AssignValue(varName, value); 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; Result := value;
end; end;
@@ -365,10 +365,8 @@ var
begin begin
def := Node.Definition.Trim; def := Node.Definition.Trim;
// Based on the content, create a scalar or a record series.
if def.StartsWith('[') then if def.StartsWith('[') then
begin begin
// Assumed to be a record definition array, e.g., '[{"Name": "Close", "Kind": "skDouble"}]'
var recordDef := TRttiAstHelper.JsonToRecordDefinition(def); var recordDef := TRttiAstHelper.JsonToRecordDefinition(def);
if Length(recordDef.Fields) = 0 then if Length(recordDef.Fields) = 0 then
raise EArgumentException.Create('Failed to parse record definition from JSON array.'); raise EArgumentException.Create('Failed to parse record definition from JSON array.');
@@ -378,7 +376,6 @@ begin
end end
else else
begin begin
// Assumed to be a single scalar type name, e.g., 'double'
var scalarKind := StringToScalarKind(def); var scalarKind := StringToScalarKind(def);
var scalarSeries := TScalarSeries.Create(scalarKind, Default(TSeries<TScalarValue>)); var scalarSeries := TScalarSeries.Create(scalarKind, Default(TSeries<TScalarValue>));
Result := TAstValue.FromSeries(scalarSeries); Result := TAstValue.FromSeries(scalarSeries);
@@ -387,12 +384,14 @@ end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
var var
val: TAstValue; depth, index: Integer;
begin begin
if FScope.FindValue(Node.Name, val) then if Node.Resolve(depth, index) then
Result := val Result := FScope.GetValue(depth, index)
else 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; end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue; function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
@@ -404,7 +403,6 @@ begin
baseValue := Node.Base.Accept(Self); baseValue := Node.Base.Accept(Self);
indexValue := Node.Index.Accept(Self); indexValue := Node.Index.Accept(Self);
// Index validation (common for all indexable types)
if (indexValue.Kind <> avkScalar) then if (indexValue.Kind <> avkScalar) then
raise EArgumentException.Create('Indexer `[]` requires a scalar integer argument.'); raise EArgumentException.Create('Indexer `[]` requires a scalar integer argument.');
@@ -416,7 +414,6 @@ begin
raise EArgumentException.Create('Indexer `[]` requires an integer type argument.'); raise EArgumentException.Create('Indexer `[]` requires an integer type argument.');
end; end;
// Base type dispatching
case baseValue.Kind of case baseValue.Kind of
avkSeries: avkSeries:
begin begin
@@ -484,14 +481,15 @@ end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
var var
varName: string; value: TAstValue;
begin begin
varName := Node.Identifier.Name;
if Assigned(Node.Initializer) then if Assigned(Node.Initializer) then
Result := Node.Initializer.Accept(Self) value := Node.Initializer.Accept(Self)
else else
Result := TAstValue.Void; value := TAstValue.Void;
FScope.SetValue(varName, Result);
FScope.Define(Node.Identifier.Name, value);
Result := value;
end; end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
@@ -518,10 +516,8 @@ begin
closure := calleeValue.AsClosure; closure := calleeValue.AsClosure;
// Distinguish between native and script-defined closures.
if closure is TNativeClosure then if closure is TNativeClosure then
begin begin
// Native function call
SetLength(argValues, Node.Arguments.Count); SetLength(argValues, Node.Arguments.Count);
for i := 0 to Node.Arguments.Count - 1 do for i := 0 to Node.Arguments.Count - 1 do
begin begin
@@ -531,23 +527,25 @@ begin
end end
else if closure is TClosureValue then else if closure is TClosureValue then
begin begin
// Script function call (original logic)
if (Node.Arguments.Count <> Length(closure.Parameters)) then if (Node.Arguments.Count <> Length(closure.Parameters)) then
raise EArgumentException raise EArgumentException
.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), Node.Arguments.Count]); .CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), Node.Arguments.Count]);
callScope := TExecutionScope.Create(closure.ClosureScope); 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 for i := 0 to Node.Arguments.Count - 1 do
begin begin
argValues := [Node.Arguments[i].Accept(Self)]; var argValue := Node.Arguments[i].Accept(Self);
callScope.SetValue(closure.Parameters[i].Name, argValues[0]); callScope.Define(closure.Parameters[i].Name, argValue);
end; end;
innerVisitor := Self.CreateVisitorForScope(callScope); innerVisitor := Self.CreateVisitorForScope(callScope);
callScope.SetValue('Self', calleeValue);
callScope.SetValue('Result', TAstValue.Void);
Result := closure.Body.Accept(innerVisitor); Result := closure.Body.Accept(innerVisitor);
end end
else else
@@ -559,7 +557,6 @@ var
leftValue, rightValue: TAstValue; leftValue, rightValue: TAstValue;
leftScalar, rightScalar: TScalar; leftScalar, rightScalar: TScalar;
begin begin
// Implemented binary operators for Int64 and Double.
leftValue := Node.Left.Accept(Self); leftValue := Node.Left.Accept(Self);
rightValue := Node.Right.Accept(Self); rightValue := Node.Right.Accept(Self);
@@ -571,7 +568,6 @@ begin
if (leftScalar.Kind <> rightScalar.Kind) then if (leftScalar.Kind <> rightScalar.Kind) then
begin begin
// Automatic type promotion from Int64 to Double.
if (leftScalar.Kind = skInt64) and (rightScalar.Kind = skDouble) then if (leftScalar.Kind = skInt64) and (rightScalar.Kind = skDouble) then
begin begin
leftScalar := TScalar.FromDouble(leftScalar.Value.AsInt64); leftScalar := TScalar.FromDouble(leftScalar.Value.AsInt64);
@@ -582,7 +578,6 @@ begin
end end
else else
begin begin
// If types are still different after promotion, they are incompatible.
raise ENotSupportedException.Create( raise ENotSupportedException.Create(
'Binary operations are only supported for compatible types. ' + leftScalar.ToString + ' ' + rightScalar.ToString); 'Binary operations are only supported for compatible types. ' + leftScalar.ToString + ' ' + rightScalar.ToString);
end; end;
@@ -637,7 +632,6 @@ var
rightValue: TAstValue; rightValue: TAstValue;
rightScalar: TScalar; rightScalar: TScalar;
begin begin
// Implemented unary operators for Int64, Double, and Boolean.
rightValue := Node.Right.Accept(Self); rightValue := Node.Right.Accept(Self);
case Node.Operator of case Node.Operator of
@@ -655,7 +649,6 @@ begin
end; end;
uoNot: uoNot:
begin begin
// "not" operates on the truthiness of the value.
Result := TAstValue.FromScalar(TScalar.FromBoolean(not IsTruthy(rightValue))); Result := TAstValue.FromScalar(TScalar.FromBoolean(not IsTruthy(rightValue)));
end; end;
else else
@@ -672,11 +665,9 @@ begin
Result := Node.ThenBranch.Accept(Self) Result := Node.ThenBranch.Accept(Self)
else else
begin begin
// If an else branch exists, evaluate it.
if Assigned(Node.ElseBranch) then if Assigned(Node.ElseBranch) then
Result := Node.ElseBranch.Accept(Self) Result := Node.ElseBranch.Accept(Self)
else else
// Otherwise, an if-statement without an else branch evaluates to void.
Result := TAstValue.Void; Result := TAstValue.Void;
end; end;
end; end;
@@ -695,14 +686,13 @@ end;
function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
var var
expression: IExpressionNode; expression: IExpressionNode;
lastValue: TAstValue;
begin 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 for expression in Node.Expressions do
begin begin
lastValue := expression.Accept(Self); Result := expression.Accept(Self);
end; end;
Result := lastValue;
end; end;
function TEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; function TEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
@@ -710,20 +700,16 @@ var
seriesValue: TAstValue; seriesValue: TAstValue;
len: Int64; len: Int64;
begin begin
// 1. Evaluate the identifier to get the series object from the scope.
seriesValue := Node.Series.Accept(Self); seriesValue := Node.Series.Accept(Self);
// 2. Get the length based on the actual series type.
case seriesValue.Kind of case seriesValue.Kind of
avkSeries: len := seriesValue.AsSeries.Value.Items.Count; avkSeries: len := seriesValue.AsSeries.Value.Items.Count;
avkRecordSeries: len := seriesValue.AsRecordSeries.Value.Count; avkRecordSeries: len := seriesValue.AsRecordSeries.Value.Count;
avkMemberSeries: len := seriesValue.AsMemberSeries.Value.Count; avkMemberSeries: len := seriesValue.AsMemberSeries.Value.Count;
else 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))]); raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TAstValueKind), Ord(seriesValue.Kind))]);
end; end;
// 3. Return the length as a new scalar value.
Result := TAstValue.FromScalar(TScalar.FromInt64(len)); Result := TAstValue.FromScalar(TScalar.FromInt64(len));
end; end;
@@ -811,7 +797,8 @@ end;
function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue; function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
begin 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; Indent;
try try
Result := inherited VisitAssignment(Node); Result := inherited VisitAssignment(Node);
@@ -970,4 +957,16 @@ begin
end; end;
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. end.
+14 -3
View File
@@ -101,9 +101,20 @@ type
function GetParent: IExecutionScope; function GetParent: IExecutionScope;
{$endregion} {$endregion}
procedure Clear; procedure Clear;
function FindValue(const Name: string; out Value: TAstValue): Boolean;
procedure SetValue(const Name: string; const Value: TAstValue); // --- Legacy name-based access (for pre-binder setup, e.g., native functions) ---
procedure AssignValue(const Name: string; const Value: TAstValue); 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; function Dump: string;
property Parent: IExecutionScope read GetParent; property Parent: IExecutionScope read GetParent;
end; end;
+105 -20
View File
@@ -12,7 +12,8 @@ type
TExecutionScope = class(TInterfacedObject, IExecutionScope) TExecutionScope = class(TInterfacedObject, IExecutionScope)
private private
FParent: IExecutionScope; FParent: IExecutionScope;
FVariables: TDictionary<string, TAstValue>; FValues: TArray<TAstValue>;
FNameToIndex: TDictionary<string, Integer>;
procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
protected protected
// IExecutionScope // IExecutionScope
@@ -20,27 +21,37 @@ type
procedure Clear; procedure Clear;
function FindValue(const Name: string; out Value: TAstValue): Boolean; function FindValue(const Name: string; out Value: TAstValue): Boolean;
procedure SetValue(const Name: string; const Value: TAstValue); 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; 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 public
constructor Create(AParent: IExecutionScope = nil); constructor Create(AParent: IExecutionScope = nil);
destructor Destroy; override; destructor Destroy; override;
property NameToIndex: TDictionary<string, Integer> read FNameToIndex;
end; end;
implementation implementation
uses
System.Generics.Defaults; // For TComparer
{ TExecutionScope } { TExecutionScope }
constructor TExecutionScope.Create(AParent: IExecutionScope); constructor TExecutionScope.Create(AParent: IExecutionScope);
begin begin
inherited Create; inherited Create;
FParent := AParent; FParent := AParent;
FVariables := TDictionary<string, TAstValue>.Create; FValues := [];
FNameToIndex := TDictionary<string, Integer>.Create;
end; end;
destructor TExecutionScope.Destroy; destructor TExecutionScope.Destroy;
begin begin
FVariables.Free; FNameToIndex.Free;
inherited Destroy; inherited Destroy;
end; end;
@@ -50,32 +61,75 @@ begin
end; end;
procedure TExecutionScope.AssignValue(const Name: string; const Value: TAstValue); procedure TExecutionScope.AssignValue(const Name: string; const Value: TAstValue);
var
index: Integer;
begin begin
if FVariables.ContainsKey(Name) then if FNameToIndex.TryGetValue(Name, index) then
FVariables.AddOrSetValue(Name, Value) FValues[index] := Value
else if Assigned(FParent) then else if Assigned(FParent) then
FParent.AssignValue(Name, Value) FParent.AssignValue(Name, Value)
else else
raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]); raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]);
end; 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; procedure TExecutionScope.Clear;
begin begin
FVariables.Clear; FValues := [];
if Assigned(FParent) then FNameToIndex.Clear;
FParent.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; end;
procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
var var
pair: TPair<string, TAstValue>; pair: TPair<string, Integer>;
indentStr: string; indentStr: string;
sortedPairs: TArray<TPair<string, Integer>>;
begin begin
indentStr := ''.PadLeft(AIndent); indentStr := ''.PadLeft(AIndent);
if (FVariables.Count > 0) then if (FNameToIndex.Count > 0) then
begin begin
for pair in FVariables do // Copy pairs to an array and sort it by index for consistent output
ABuilder.AppendLine(indentStr + Format(' %s: %s', [pair.Key, pair.Value.ToString])); 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 end
else else
begin begin
@@ -85,9 +139,7 @@ begin
if Assigned(FParent) then if Assigned(FParent) then
begin begin
ABuilder.AppendLine(indentStr + '[Parent Scope]'); 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 cast is necessary for this debug helper to access implementation details.
// This indicates that DumpScope should perhaps be part of the interface or handled differently.
// For now, we use a cast to keep the functionality.
(FParent as TExecutionScope).DumpScope(ABuilder, AIndent + 2); (FParent as TExecutionScope).DumpScope(ABuilder, AIndent + 2);
end; end;
end; end;
@@ -107,17 +159,50 @@ begin
end; end;
function TExecutionScope.FindValue(const Name: string; out Value: TAstValue): Boolean; function TExecutionScope.FindValue(const Name: string; out Value: TAstValue): Boolean;
var
index: Integer;
begin begin
Result := FVariables.TryGetValue(Name, Value); if FNameToIndex.TryGetValue(Name, index) then
if not Result and Assigned(FParent) then
begin begin
Result := FParent.FindValue(Name, Value); Value := FValues[index];
Result := True;
Exit;
end; 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; end;
procedure TExecutionScope.SetValue(const Name: string; const Value: TAstValue); procedure TExecutionScope.SetValue(const Name: string; const Value: TAstValue);
var
index: Integer;
begin 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;
end. end.
+78 -30
View File
@@ -45,7 +45,7 @@ type
// --- Static method to run the binder --- // --- Static method to run the binder ---
// Traverses the AST and resolves all identifiers. This must be called before evaluating the AST. // 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; end;
// TAstTraverser provides a default AST traversal implementation. // TAstTraverser provides a default AST traversal implementation.
@@ -73,7 +73,8 @@ implementation
uses uses
System.Classes, System.Classes,
System.Generics.Collections; System.Generics.Collections,
Myc.Ast.Scope; // Needed for the TExecutionScope cast
type type
{ TAstNode } { TAstNode }
@@ -296,9 +297,11 @@ type
FParent: TSymbolTable; FParent: TSymbolTable;
FSymbols: TDictionary<string, TSymbol>; FSymbols: TDictionary<string, TSymbol>;
FNextSlotIndex: Integer; FNextSlotIndex: Integer;
procedure DefinePreResolved(const Name: string; Index: Integer);
public public
constructor Create(AParent: TSymbolTable); constructor Create(AParent: TSymbolTable);
destructor Destroy; override; destructor Destroy; override;
procedure PopulateFromScope(const AScope: IExecutionScope);
function Define(const Name: string): TSymbol; function Define(const Name: string): TSymbol;
function Resolve(const Name: string; out Symbol: TSymbol; out Depth: Integer): Boolean; function Resolve(const Name: string; out Symbol: TSymbol; out Depth: Integer): Boolean;
end; end;
@@ -310,12 +313,11 @@ type
procedure EnterScope; procedure EnterScope;
procedure ExitScope; procedure ExitScope;
public public
constructor Create; constructor Create(AInitialScope: IExecutionScope);
destructor Destroy; override; destructor Destroy; override;
function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override; function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; override;
end; end;
{ TConstantNode } { TConstantNode }
@@ -745,6 +747,38 @@ begin
inherited; inherited;
end; 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; function TSymbolTable.Define(const Name: string): TSymbol;
begin begin
Result.Name := Name; Result.Name := Name;
@@ -772,16 +806,41 @@ end;
{ TBinder } { TBinder }
constructor TBinder.Create; // Helper function to recursively build the symbol table hierarchy
function CreateSymbolTableFromScope(AScope: IExecutionScope): TSymbolTable;
begin begin
inherited; if not Assigned(AScope) then
FCurrentScope := TSymbolTable.Create(nil); // Start with a global scope 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; end;
destructor TBinder.Destroy; destructor TBinder.Destroy;
var
scopeToFree: TSymbolTable;
begin begin
Assert(not Assigned(FCurrentScope.FParent), 'Scope leak in binder.'); // The previous Assert was incorrect for binders initialized with nested scopes.
FCurrentScope.Free; // 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; inherited;
end; end;
@@ -799,17 +858,6 @@ begin
oldScope.Free; oldScope.Free;
end; 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; function TBinder.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
var var
symbol: TSymbol; symbol: TSymbol;
@@ -836,6 +884,9 @@ var
begin begin
EnterScope; EnterScope;
try try
// Reserve a slot for 'Self' first.
FCurrentScope.Define('Self');
// 1. Define all parameters in the new scope. // 1. Define all parameters in the new scope.
for param in Node.Parameters do for param in Node.Parameters do
FCurrentScope.Define(param.Name); FCurrentScope.Define(param.Name);
@@ -850,24 +901,21 @@ end;
function TBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; function TBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
begin begin
// 1. First, visit the initializer expression to resolve its identifiers. // For recursive functions, we must define the name in the scope FIRST,
if Assigned(Node.Initializer) then // so it can be resolved inside its own initializer (i.e., the lambda body).
Node.Initializer.Accept(Self);
// 2. Then, define the new variable in the current scope.
FCurrentScope.Define(Node.Identifier.Name); FCurrentScope.Define(Node.Identifier.Name);
inherited;
// 3. Finally, visit the declaration's own identifier to resolve it.
Node.Identifier.Accept(Self);
end; end;
{ TAst } { TAst }
class procedure TAst.Bind(const ARootNode: IExpressionNode); class procedure TAst.Bind(const ARootNode: IExpressionNode; const AScope: IExecutionScope);
var var
binder: IAstVisitor; binder: IAstVisitor;
begin 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); ARootNode.Accept(binder);
end; end;