diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index a04de77..b939a9b 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -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 diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index e8d39fe..7280fbb 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -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(' (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; diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 60b88ef..a515455 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -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)); 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. diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 6948633..979f700 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -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; diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index 71423bb..868c1ff 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -12,7 +12,8 @@ type TExecutionScope = class(TInterfacedObject, IExecutionScope) private FParent: IExecutionScope; - FVariables: TDictionary; + FValues: TArray; + FNameToIndex: TDictionary; 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 read FNameToIndex; end; implementation +uses + System.Generics.Defaults; // For TComparer + { TExecutionScope } constructor TExecutionScope.Create(AParent: IExecutionScope); begin inherited Create; FParent := AParent; - FVariables := TDictionary.Create; + FValues := []; + FNameToIndex := TDictionary.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; + pair: TPair; indentStr: string; + sortedPairs: TArray>; 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>( + sortedPairs, + TComparer> + .Construct(function(const Left, Right: TPair): 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. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 9bdedac..1c04deb 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -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; 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; +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;