From faa447fd91710a26654137dd51312c35b13bc31d Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Thu, 4 Sep 2025 17:33:10 +0200 Subject: [PATCH] Binding --- ASTPlayground/MainForm.fmx | 30 ++- ASTPlayground/MainForm.pas | 306 ++++++++++++------------------ Src/AST/Myc.Ast.Evaluator.pas | 85 ++++----- Src/AST/Myc.Ast.Nodes.pas | 54 ++++-- Src/AST/Myc.Ast.Scope.pas | 61 +++--- Src/AST/Myc.Ast.pas | 247 ++++++++++++++++-------- Src/Data/Myc.Data.Scalar.JSON.pas | 6 +- 7 files changed, 411 insertions(+), 378 deletions(-) diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index b939a9b..ccb8b3f 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -39,21 +39,13 @@ object Form1: TForm1 TextSettings.Trimming = None OnClick = PrettyPrintButtonClick end - object DebugButton: TButton - Position.X = 24.000000000000000000 - Position.Y = 411.000000000000000000 - TabOrder = 4 - Text = 'Debug' - TextSettings.Trimming = None - OnClick = DebugButtonClick - end object RecursionButton: TButton Position.X = 24.000000000000000000 Position.Y = 92.000000000000000000 Size.Width = 80.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False - TabOrder = 5 + TabOrder = 4 Text = 'Recursion' TextSettings.Trimming = None OnClick = RecursionButtonClick @@ -61,13 +53,13 @@ object Form1: TForm1 object ShowScopeBox: TCheckBox Position.X = 24.000000000000000000 Position.Y = 441.000000000000000000 - TabOrder = 6 + TabOrder = 5 Text = 'Scope' end object FibonacciButton: TButton Position.X = 24.000000000000000000 Position.Y = 122.000000000000000000 - TabOrder = 8 + TabOrder = 7 Text = 'Fibonacci' TextSettings.Trimming = None OnClick = FibonacciButtonClick @@ -75,15 +67,15 @@ object Form1: TForm1 object CrerateTriggerExampleButton: TButton Position.X = 24.000000000000000000 Position.Y = 168.000000000000000000 - TabOrder = 9 + TabOrder = 8 Text = 'TriggerTest' TextSettings.Trimming = None - OnClick = CrerateTriggerExampleButtonClick + OnClick = CreateTriggerExampleButtonClick end object DoTriggerButton: TButton Position.X = 24.000000000000000000 Position.Y = 198.000000000000000000 - TabOrder = 10 + TabOrder = 9 Text = 'Trigger!' TextSettings.Trimming = None OnClick = DoTriggerButtonClick @@ -101,7 +93,7 @@ object Form1: TForm1 Size.Width = 80.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False - TabOrder = 11 + TabOrder = 10 Text = 'Clear' TextSettings.Trimming = None OnClick = ClearButtonClick @@ -109,7 +101,7 @@ object Form1: TForm1 object FlowOnlyBox: TCheckBox Position.X = 24.000000000000000000 Position.Y = 8.000000000000000000 - TabOrder = 12 + TabOrder = 11 Text = 'Flow only' OnChange = ClearButtonClick end @@ -119,7 +111,7 @@ object Form1: TForm1 Size.Width = 80.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False - TabOrder = 14 + TabOrder = 13 Text = 'Series' TextSettings.Trimming = None OnClick = SeriesTestButtonClick @@ -127,7 +119,7 @@ object Form1: TForm1 object OHLCButton: TButton Position.X = 24.000000000000000000 Position.Y = 304.000000000000000000 - TabOrder = 15 + TabOrder = 14 Text = 'OHLC' TextSettings.Trimming = None OnClick = OHLCButtonClick @@ -135,7 +127,7 @@ object Form1: TForm1 object DebugBox: TCheckBox Position.X = 24.000000000000000000 Position.Y = 360.000000000000000000 - TabOrder = 16 + TabOrder = 15 Text = 'Debug' end end diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 7280fbb..b15c235 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -48,7 +48,6 @@ type Test1Button: TButton; Test2Button: TButton; PrettyPrintButton: TButton; - DebugButton: TButton; RecursionButton: TButton; ShowScopeBox: TCheckBox; FibonacciButton: TButton; @@ -63,8 +62,7 @@ type DebugBox: TCheckBox; procedure ClearButtonClick(Sender: TObject); procedure FormCreate(Sender: TObject); - procedure CrerateTriggerExampleButtonClick(Sender: TObject); - procedure DebugButtonClick(Sender: TObject); + procedure CreateTriggerExampleButtonClick(Sender: TObject); procedure DoTrigger2ButtonClick(Sender: TObject); procedure DoTriggerButtonClick(Sender: TObject); procedure FibonacciButtonClick(Sender: TObject); @@ -82,7 +80,7 @@ type 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; + function ExecuteAst(const ANode: IExpressionNode; const AParentScope: IExecutionScope): TAstValue; public { Public declarations } end; @@ -104,6 +102,10 @@ procedure TForm1.ClearButtonClick(Sender: TObject); begin FWorkspace.DeleteChildren; FWorkspace.Repaint; + + // Create and prepare the global scope once + FGScope := TExecutionScope.Create(nil); + RegisterNativeFunctions(FGScope); end; function TForm1.CreateVisitor(const AScope: IExecutionScope): IAstVisitor; @@ -118,14 +120,19 @@ begin Result := TEvaluatorVisitor.Create(AScope); end; -function TForm1.ExecuteAst(const ANode: IExpressionNode; const AScope: IExecutionScope): TAstValue; +function TForm1.ExecuteAst(const ANode: IExpressionNode; const AParentScope: IExecutionScope): TAstValue; +var + scriptDescriptor: IScopeDescriptor; + scriptScope: IExecutionScope; begin - // STEP 1: BIND - // The binder uses the provided scope to know about native functions etc. - TAst.Bind(ANode, AScope); + // STEP 1: BIND and get the descriptor for the script's local variables. + scriptDescriptor := TAst.Bind(ANode, AParentScope); - // STEP 2: EVALUATE - var visitor := CreateVisitor(AScope); + // STEP 2: CREATE the correctly-sized execution scope for the script. + scriptScope := scriptDescriptor.Instantiate(AParentScope); + + // STEP 3: EVALUATE using the new, correctly-sized scope. + var visitor := CreateVisitor(scriptScope); Result := ANode.Accept(visitor); end; @@ -138,41 +145,7 @@ begin FWorkspace.OnMouseDown := WorkspaceMouseDown; - // Create and prepare the global scope once - FGScope := TExecutionScope.Create(nil); - RegisterNativeFunctions(FGScope); -end; - -procedure TForm1.DebugButtonClick(Sender: TObject); -var - scope: IExecutionScope; - visitor: IAstVisitor; - result: TAstValue; - sw: TStopwatch; -begin - if not Assigned(FLastAst) then - begin - Memo1.Lines.Add('No AST has been generated yet.'); - exit; - end; - - scope := TExecutionScope.Create(FGScope); - - Memo1.Lines.Clear; - Memo1.Lines.Add('--- Debug Evaluator Trace ---'); - - // 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; - result := FLastAst.Accept(visitor); - sw.Stop; - - Memo1.Lines.Add('-----------------------------'); - Memo1.Lines.Add(Format('Final script result: %s', [result.ToString])); - Memo1.Lines.Add(Format('Execution time: %d ms', [sw.ElapsedMilliseconds])); + ClearButtonClick(Self); end; procedure TForm1.FibonacciButtonClick(Sender: TObject); @@ -180,7 +153,6 @@ var root: IExpressionNode; result: TAstValue; sw: TStopwatch; - scope: IExecutionScope; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Recursive fib with AST---'); @@ -215,9 +187,8 @@ begin ); FLastAst := root; - scope := TExecutionScope.Create(nil); // No global scope needed for this pure function - - result := ExecuteAst(root, scope); + // Execute with nil as parent scope + result := ExecuteAst(root, nil); sw.Stop; Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); @@ -246,7 +217,6 @@ var root: IExpressionNode; result: TAstValue; sw: TStopwatch; - scope: IExecutionScope; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Recursive factorial(20) ---'); @@ -278,9 +248,8 @@ begin ); FLastAst := root; - scope := TExecutionScope.Create(nil); - - result := ExecuteAst(root, scope); + // Execute with nil as parent scope + result := ExecuteAst(root, nil); sw.Stop; Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); @@ -300,7 +269,7 @@ begin // 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))); + recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson); series := TScalarRecordSeries.Create(recordDef); for i := 0 to 4 do begin @@ -348,7 +317,6 @@ var main, callAst: IExpressionNode; result: TAstValue; sw: TStopwatch; - scope: IExecutionScope; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Simple AST Execution ---'); @@ -371,9 +339,8 @@ begin FLastAst := main; callAst := TAst.FunctionCall(main, []); - scope := TExecutionScope.Create(FGScope); - - result := ExecuteAst(callAst, scope); + // Execute with FGScope as parent + result := ExecuteAst(callAst, FGScope); sw.Stop; Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); @@ -384,7 +351,6 @@ var root: IExpressionNode; result: TAstValue; sw: TStopwatch; - scope: IExecutionScope; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Factory Pattern Demo ---'); @@ -411,100 +377,13 @@ begin ); FLastAst := root; - scope := TExecutionScope.Create(FGScope); - - result := ExecuteAst(root, scope); + // Execute with FGScope as parent + result := ExecuteAst(root, FGScope); sw.Stop; Memo1.Lines.Add(Format('Result of the final expression: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); end; -procedure TForm1.CrerateTriggerExampleButtonClick(Sender: TObject); -var - blk: IExpressionNode; -begin - // This button now only creates the AST. The persistent scope is managed by FGScope. - FGScope.Clear; - RegisterNativeFunctions(FGScope); // Re-register natives after clearing - - Memo1.Lines.Clear; - Memo1.Lines.Add('--- Creating Trigger Blueprint ---'); - - blk := - TAst.Block( - [ - TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(0))), - TAst.VarDecl( - TAst.Identifier('tickHandler'), - TAst.LambdaExpr( - [TAst.Identifier('summand')], - TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand'))) - ) - ) - ] - ); - - // Bind and execute the setup block against the persistent global scope - ExecuteAst(blk, FGScope); - - FLastAst := blk; // Store for visualization - - 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 - callAst: IFunctionCallNode; - currentValue: TAstValue; - depth, index: Integer; - identAst: IIdentifierNode; -begin - callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]); - FLastAst := callAst; - - // 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 - Memo1.Lines.Add('Error: Variable "X" not found in scope.'); -end; - -procedure TForm1.DoTrigger2ButtonClick(Sender: TObject); -var - callAst: IFunctionCallNode; - currentValue: TAstValue; - depth, index: Integer; - identAst: IIdentifierNode; -begin - callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]); - FLastAst := callAst; - - // Bind and execute the call against the persistent scope - ExecuteAst(callAst, FGScope); - - // 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 - Memo1.Lines.Add('Error: Variable "X" not found in scope.'); -end; - procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin if Button <> TMouseButton.mbMiddle then @@ -525,28 +404,15 @@ const lookback = 100; smaSlowLength = 50; smaFastLength = 20; -var - recordDef: TScalarRecordDefinition; - series: TScalarRecordSeries; - setupAst, callAst: IExpressionNode; - visitor: IAstVisitor; - i, depth, index: Integer; - lastClose: Double; - ohlcvRec: TOHLCV; - recordValue: TScalarRecord; - resultValue: TAstValue; - sw: TStopwatch; - currentSeriesIdent: IIdentifierNode; begin // 1. Setup Memo1.Lines.Clear; Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs])); - FGScope.Clear; - RegisterNativeFunctions(FGScope); - sw := TStopwatch.StartNew; + + var sw := TStopwatch.StartNew; // 2. Create the setup AST with the strategy logic - setupAst := + var setupAst := TAst.Block( [ TAst.VarDecl( @@ -645,37 +511,35 @@ begin ] ); FLastAst := setupAst; - // Bind and execute the setup script once. - ExecuteAst(setupAst, FGScope); - // 3. Prepare for the simulation loop - recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV))); - series := TScalarRecordSeries.Create(recordDef); - visitor := CreateVisitor(FGScope); + var scope := TAst.Bind(setupAst, FGScope).Instantiate(FGScope); + setupAst.Accept(CreateVisitor(scope)); // Declare the series variable in the scope BEFORE binding the call AST - FGScope.Define('current_series', TAstValue.Void); + scope.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]); + var currentSeriesIdent := TAst.Identifier('current_series'); + var 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''.'); + scope := TAst.Bind(callAst, scope).Instantiate(scope); + var visitor := CreateVisitor(scope); // 4. Simulation Loop Memo1.Lines.Add('Starting simulation...'); Application.ProcessMessages; - lastClose := 1000.0; + var lastClose := 1000.0; Randomize; + var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson); + var series := TAstValue.FromRecordSeries(TScalarRecordSeries.Create(recDef)); + var seriesAddress := currentSeriesIdent.Resolve; + var nw := Now; - for i := 1 to numRecs do + var ohlcvRec: TOHLCV; + for var i := 1 to numRecs do begin ohlcvRec.Timestamp := nw + (i / (24 * 60)); ohlcvRec.Open := lastClose + (Random * 0.05); @@ -685,9 +549,9 @@ begin ohlcvRec.Volume := RandomRange(1000, 50000); lastClose := ohlcvRec.Close; - recordValue := + var recordValue := TScalarRecord.Create( - recordDef, + recDef, [ TScalarValue.FromDateTime(ohlcvRec.Timestamp), TScalarValue.FromDouble(ohlcvRec.Open), @@ -698,18 +562,21 @@ begin ] ); - series.Add(recordValue, lookback); + series.AsRecordSeries.Value.Add(recordValue, lookback); - if series.TotalCount >= smaSlowLength then + if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then begin // Update the 'current_series' value in the scope using the FAST index-based assignment - FGScope.AssignValue(depth, index, TAstValue.FromRecordSeries(series)); + scope.AssignValue(seriesAddress, series); // Execute the PRE-BOUND call AST - resultValue := callAst.Accept(visitor); + var resultValue := callAst.Accept(visitor); - // Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString])); - // Application.ProcessMessages; + if i < smaSlowLength + 50 then + begin + Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString])); + Application.ProcessMessages; + end; end; end; @@ -718,4 +585,67 @@ begin Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds])); end; +var + TriggerScope: IExecutionScope; + +procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject); +var + blk: IExpressionNode; +begin + // This is a setup script, so its goal is to create and populate FGScope. + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Creating Trigger Blueprint ---'); + + // Define the AST for the setup script. + blk := + TAst.Block( + [ + TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(0))), + TAst.VarDecl( + TAst.Identifier('tickHandler'), + TAst.LambdaExpr( + [TAst.Identifier('summand')], + TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand'))) + ) + ) + ] + ); + + TriggerScope := TAst.Bind(blk, FGScope).Instantiate(FGScope); + + blk.Accept(CreateVisitor(TriggerScope)); + + FLastAst := blk; // Store for visualization + + 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 + callAst: IFunctionCallNode; +begin + callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]); + FLastAst := callAst; + + // Bind and execute the call against the persistent scope + var X := ExecuteAst(callAst, TriggerScope); + + Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [X.ToString])); +end; + +procedure TForm1.DoTrigger2ButtonClick(Sender: TObject); +var + callAst: IFunctionCallNode; + currentValue: TAstValue; +begin + callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]); + FLastAst := callAst; + + // Bind and execute the call against the persistent scope + var X := ExecuteAst(callAst, TriggerScope); + + Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString])); +end; + end. diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index a515455..0805f62 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -8,6 +8,7 @@ uses System.Generics.Collections, Myc.Data.Scalar, Myc.Ast.Nodes, + Myc.Ast.Scope, Myc.Ast; type @@ -80,7 +81,6 @@ uses System.TypInfo, Myc.Data.Decimal, Myc.Data.Series, - Myc.Ast.Scope, Myc.Ast.Printer, Myc.Data.Scalar.JSON; @@ -92,13 +92,16 @@ type TClosureValue = class(TInterfacedObject, IEvaluatorClosure) private FBody: IExpressionNode; - FParameters: TArray; FClosureScope: IExecutionScope; + FLambdaNode: ILambdaExpressionNode; function GetBody: IExpressionNode; function GetParameters: TArray; function GetClosureScope: IExecutionScope; + function GetLambdaNode: ILambdaExpressionNode; public - constructor Create(ABody: IExpressionNode; const AParameters: TArray; const AClosureScope: IExecutionScope); + constructor Create(const ALambdaNode: ILambdaExpressionNode; const AClosureScope: IExecutionScope); + property ClosureScope: IExecutionScope read GetClosureScope; + property LambdaNode: ILambdaExpressionNode read GetLambdaNode; end; // Concrete implementation of IEvaluatorClosure for native Delphi functions. @@ -203,11 +206,11 @@ end; { TClosureValue } -constructor TClosureValue.Create(ABody: IExpressionNode; const AParameters: TArray; const AClosureScope: IExecutionScope); +constructor TClosureValue.Create(const ALambdaNode: ILambdaExpressionNode; const AClosureScope: IExecutionScope); begin inherited Create; - FBody := ABody; - FParameters := AParameters; + FLambdaNode := ALambdaNode; + FBody := ALambdaNode.Body; FClosureScope := AClosureScope; end; @@ -221,9 +224,14 @@ begin Result := FClosureScope; end; +function TClosureValue.GetLambdaNode: ILambdaExpressionNode; +begin + Result := FLambdaNode; +end; + function TClosureValue.GetParameters: TArray; begin - Result := FParameters; + Result := FLambdaNode.Parameters; end; { TNativeClosure } @@ -284,14 +292,9 @@ function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): T var itemValue, lookbackValue, seriesVar: TAstValue; lookback: Int64; - depth, index: Integer; begin // 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); + seriesVar := FScope.GetValue(Node.Series.Resolve); itemValue := Node.Value.Accept(Self); lookback := -1; @@ -340,18 +343,9 @@ begin end; function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue; -var - value: TAstValue; - depth, index: Integer; begin - value := Node.Value.Accept(Self); - - 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]); - - FScope.AssignValue(depth, index, value); - Result := value; + Result := Node.Value.Accept(Self); + FScope.AssignValue(Node.Identifier.Resolve, Result); end; function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue; @@ -383,15 +377,8 @@ begin end; function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; -var - depth, index: Integer; begin - if Node.Resolve(depth, index) then - Result := FScope.GetValue(depth, index) - else - // 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]); + Result := FScope.GetValue(Node.Resolve) end; function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue; @@ -488,16 +475,14 @@ begin else value := TAstValue.Void; - FScope.Define(Node.Identifier.Name, value); + FScope.AssignValue(Node.Identifier.Resolve, value); + Result := value; end; function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; -var - closureImpl: IEvaluatorClosure; begin - closureImpl := TClosureValue.Create(Node.Body, Node.Parameters, FScope); - Result := TAstValue.FromClosure(closureImpl); + Result := TAstValue.FromClosure(TClosureValue.Create(Node, FScope)); end; function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; @@ -505,9 +490,9 @@ var calleeValue: TAstValue; closure: IEvaluatorClosure; i: Integer; - argValues: TArray; callScope: IExecutionScope; innerVisitor: IAstVisitor; + descriptor: IScopeDescriptor; begin calleeValue := Node.Callee.Accept(Self); @@ -518,11 +503,10 @@ begin if closure is TNativeClosure then begin + var argValues: TArray; SetLength(argValues, Node.Arguments.Count); for i := 0 to Node.Arguments.Count - 1 do - begin argValues[i] := Node.Arguments[i].Accept(Self); - end; Result := (closure as TNativeClosure).Method(argValues); end else if closure is TClosureValue then @@ -531,20 +515,17 @@ begin raise EArgumentException .CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), Node.Arguments.Count]); - callScope := TExecutionScope.Create(closure.ClosureScope); + descriptor := (closure as TClosureValue).LambdaNode.ScopeDescriptor; + if not Assigned(descriptor) then + raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?'); - // The order of definitions must exactly match the binder's order. + callScope := descriptor.Instantiate(closure.ClosureScope); + callScope.SetValueByIndex(0, calleeValue); - // Define 'Self' first. - callScope.Define('Self', calleeValue); - - // 2. Then, define the parameters. for i := 0 to Node.Arguments.Count - 1 do - begin - var argValue := Node.Arguments[i].Accept(Self); - callScope.Define(closure.Parameters[i].Name, argValue); - end; + callScope.SetValueByIndex(closure.Parameters[i].Resolve.SlotIndex, Node.Arguments[i].Accept(Self)); + // 3. Führe den Körper der Funktion im neuen Scope aus. innerVisitor := Self.CreateVisitorForScope(callScope); Result := closure.Body.Accept(innerVisitor); end @@ -914,6 +895,7 @@ begin AppendMultiline((pp as TPrettyPrintVisitor).GetResult); + ShowScope; Result := inherited VisitLambdaExpression(Node); finally Unindent; @@ -926,6 +908,7 @@ begin AppendLine('FunctionCall{'); Indent; try + ShowScope; Result := inherited VisitFunctionCall(Node); finally Unindent; @@ -938,8 +921,8 @@ begin AppendLine('Block{'); Indent; try - ShowScope; Result := inherited VisitBlockExpression(Node); + ShowScope; finally Unindent; end; diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 979f700..d240d15 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -25,7 +25,6 @@ type TAstValueKind = (avkUndefined, avkScalar, avkClosure, avkText, avkSeries, avkRecordSeries, avkRecord, avkMemberSeries); // --- Forward Declarations to break cycles --- - IExecutionScope = interface; IAstVisitor = interface; IAstNode = interface; IExpressionNode = interface; @@ -46,18 +45,25 @@ type IAddSeriesItemNode = interface; ISeriesLengthNode = interface; IEvaluatorClosure = interface; + IExecutionScope = interface; + IScopeDescriptor = interface; // --- Concrete Type Definitions --- - IEvaluatorClosure = interface(IInterface) + TResolvedAddress = record + ScopeDepth: Integer; + SlotIndex: Integer; + end; + + IEvaluatorClosure = interface {$region 'private'} function GetBody: IExpressionNode; - function GetParameters: TArray; function GetClosureScope: IExecutionScope; + function GetParameters: TArray; {$endregion} property Body: IExpressionNode read GetBody; - property Parameters: TArray read GetParameters; property ClosureScope: IExecutionScope read GetClosureScope; + property Parameters: TArray read GetParameters; end; TAstValue = record @@ -96,29 +102,40 @@ type property Kind: TAstValueKind read GetKind; end; - IExecutionScope = interface(IInterface) + IExecutionScope = interface {$region 'private'} function GetParent: IExecutionScope; {$endregion} procedure Clear; - // --- 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.'; + // --- Legacy name-based access --- + 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); overload; - // --- New index-based access (for use by the evaluator after binding) --- - // Defines a new variable in the current scope. + // --- New index-based access --- 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 GetValue(const Address: TResolvedAddress): TAstValue; + procedure AssignValue(const Address: TResolvedAddress; const Value: TAstValue); overload; + procedure SetValueByIndex(Index: Integer; const Value: TAstValue); function Dump: string; property Parent: IExecutionScope read GetParent; end; + IScopeDescriptor = interface + {$region 'private'} + function GetParent: IScopeDescriptor; + function GetSlotCount: Integer; + function GetSymbols: TDictionary; + {$endregion} + function Instantiate(const AParent: IExecutionScope): IExecutionScope; + procedure PopulateFromScope(const AScope: IExecutionScope); + property Parent: IScopeDescriptor read GetParent; + property SlotCount: Integer read GetSlotCount; + property Symbols: TDictionary read GetSymbols; + end; + IAstVisitor = interface function VisitConstant(const Node: IConstantNode): TAstValue; function VisitIdentifier(const Node: IIdentifierNode): TAstValue; @@ -154,9 +171,12 @@ type IIdentifierNode = interface(IExpressionNode) {$region 'private'} + function GetIsResolved: Boolean; function GetName: string; {$endregion} - function Resolve(out ScopeDepth: Integer; out SlotIndex: Integer): Boolean; + //TODO fasse ScopeDepth und SlotIndex in einem record zusammen + function Resolve: TResolvedAddress; + property IsResolved: Boolean read GetIsResolved; property Name: string read GetName; end; @@ -208,9 +228,11 @@ type {$region 'private'} function GetParameters: TArray; function GetBody: IExpressionNode; + function GetScopeDescriptor: IScopeDescriptor; {$endregion} property Parameters: TArray read GetParameters; property Body: IExpressionNode read GetBody; + property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor; end; IFunctionCallNode = interface(IExpressionNode) diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index 868c1ff..302e6ab 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -23,21 +23,23 @@ type procedure SetValue(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; + function GetValue(const Address: TResolvedAddress): TAstValue; + procedure AssignValue(const Address: TResolvedAddress; const Value: TAstValue); overload; + procedure SetValueByIndex(Index: Integer; const Value: TAstValue); // <-- NEU public constructor Create(AParent: IExecutionScope = nil); + constructor CreateFromDescriptor(const AParent: IExecutionScope; const ADescriptor: IScopeDescriptor); destructor Destroy; override; property NameToIndex: TDictionary read FNameToIndex; + property Parent: IExecutionScope read FParent; + property Values: TArray read FValues; end; implementation uses - System.Generics.Defaults; // For TComparer + System.Generics.Defaults; { TExecutionScope } @@ -49,6 +51,14 @@ begin FNameToIndex := TDictionary.Create; end; +constructor TExecutionScope.CreateFromDescriptor(const AParent: IExecutionScope; const ADescriptor: IScopeDescriptor); +begin + inherited Create; + FParent := AParent; + FNameToIndex := TDictionary.Create(ADescriptor.Symbols); + SetLength(FValues, ADescriptor.SlotCount); +end; + destructor TExecutionScope.Destroy; begin FNameToIndex.Free; @@ -72,23 +82,23 @@ begin raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]); end; -procedure TExecutionScope.AssignValue(Depth, Index: Integer; const Value: TAstValue); +procedure TExecutionScope.AssignValue(const Address: TResolvedAddress; const Value: TAstValue); var targetScope: IExecutionScope; i: Integer; begin targetScope := Self; - for i := 1 to Depth do + for i := 1 to Address.ScopeDepth 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; + if Address.SlotIndex >= Length((targetScope as TExecutionScope).FValues) then + raise EInvalidOpException.Create('Invalid scope index during assignment.'); + (targetScope as TExecutionScope).FValues[Address.SlotIndex] := Value; end; procedure TExecutionScope.Clear; @@ -101,7 +111,6 @@ 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]); @@ -120,7 +129,6 @@ begin indentStr := ''.PadLeft(AIndent); if (FNameToIndex.Count > 0) then begin - // Copy pairs to an array and sort it by index for consistent output sortedPairs := FNameToIndex.ToArray; TArray.Sort>( sortedPairs, @@ -139,7 +147,6 @@ begin if Assigned(FParent) then begin ABuilder.AppendLine(indentStr + '[Parent Scope]'); - // This cast is necessary for this debug helper to access implementation details. (FParent as TExecutionScope).DumpScope(ABuilder, AIndent + 2); end; end; @@ -175,34 +182,40 @@ begin Result := False; end; -function TExecutionScope.GetValue(Depth, Index: Integer): TAstValue; +function TExecutionScope.GetValue(const Address: TResolvedAddress): TAstValue; var - targetScope: IExecutionScope; + targetScope: TExecutionScope; i: Integer; begin targetScope := Self; - for i := 1 to Depth do + + for i := 0 to Address.ScopeDepth - 1 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.'); + targetScope := targetScope.Parent as TExecutionScope; + Assert(Assigned(targetScope), '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]; + Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.Values)), 'Invalid scope index during value retrieval.'); + Result := targetScope.Values[Address.SlotIndex]; end; procedure TExecutionScope.SetValue(const Name: string; const Value: TAstValue); var index: Integer; begin - // 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; +procedure TExecutionScope.SetValueByIndex(Index: Integer; const Value: TAstValue); +begin + // This is a direct write to a slot in the current scope's value array. + // It's used for setting up a function call frame. + if (Index < 0) or (Index >= Length(FValues)) then + raise EArgumentException.CreateFmt('Index %d is out of bounds for scope with %d slots.', [Index, Length(FValues)]); + FValues[Index] := Value; +end; + end. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 1c04deb..aa6b517 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -3,9 +3,12 @@ unit Myc.Ast; interface uses + System.Classes, System.SysUtils, + System.Generics.Collections, Myc.Data.Scalar, - Myc.Ast.Nodes; + Myc.Ast.Nodes, + Myc.Ast.Scope; type // Record acting as a namespace for the factory functions. @@ -44,8 +47,10 @@ type class function SeriesLength(const ASeries: IIdentifierNode): ISeriesLengthNode; static; // --- 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; const AScope: IExecutionScope); static; + // Traverses the AST and resolves all identifiers. Returns a scope descriptor for the script's top-level variables. + class function CreateScopeDescriptor(const Parent: IScopeDescriptor): IScopeDescriptor; static; + class function CreateBinding(const Scope: IExecutionScope): IScopeDescriptor; static; + class function Bind(const RootNode: IExpressionNode; const ParentScope: IExecutionScope): IScopeDescriptor; static; end; // TAstTraverser provides a default AST traversal implementation. @@ -71,12 +76,23 @@ type implementation -uses - System.Classes, - System.Generics.Collections, - Myc.Ast.Scope; // Needed for the TExecutionScope cast - type + TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor) + private + FParent: IScopeDescriptor; + FSymbols: TDictionary; + function GetParent: IScopeDescriptor; + function GetSlotCount: Integer; + function GetSymbols: TDictionary; + public + constructor Create(AParent: IScopeDescriptor); + destructor Destroy; override; + function Define(const Name: string): Integer; + function FindSymbol(const Name: string; out Index: Integer; out Depth: Integer): Boolean; + function Instantiate(const AParent: IExecutionScope): IExecutionScope; + procedure PopulateFromScope(const AScope: IExecutionScope); + end; + { TAstNode } // Common base class for AST nodes to reduce boilerplate. TAstNode = class(TInterfacedObject, IExpressionNode) @@ -100,15 +116,15 @@ type private FName: string; // --- Annotation fields added for the binder --- - FIsResolved: Boolean; - FScopeDepth: Integer; - FSlotIndex: Integer; + FResolvedAddress: TResolvedAddress; function GetName: string; + function GetIsResolved: Boolean; inline; public constructor Create(AName: string); function Accept(const Visitor: IAstVisitor): TAstValue; override; - function Resolve(out ScopeDepth: Integer; out SlotIndex: Integer): Boolean; + function Resolve: TResolvedAddress; + property IsResolved: Boolean read GetIsResolved; property Name: string read FName; end; @@ -172,11 +188,14 @@ type private FParameters: TArray; FBody: IExpressionNode; + FScopeDescriptor: IScopeDescriptor; // Backing field for the new property function GetParameters: TArray; function GetBody: IExpressionNode; + function GetScopeDescriptor: IScopeDescriptor; public constructor Create(const AParameters: TArray; const ABody: IExpressionNode); function Accept(const Visitor: IAstVisitor): TAstValue; override; + property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor; end; { TFunctionCallNode } @@ -306,20 +325,86 @@ type function Resolve(const Name: string; out Symbol: TSymbol; out Depth: Integer): Boolean; end; - // TBinder inherits from the base traverser and overrides methods with specific binding logic. TBinder = class(TAstTraverser) private - FCurrentScope: TSymbolTable; + FCurrentDescriptor: IScopeDescriptor; procedure EnterScope; procedure ExitScope; public - constructor Create(AInitialScope: IExecutionScope); - destructor Destroy; override; + constructor Create(const AInitialScope: IExecutionScope); function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override; + property CurrentDescriptor: IScopeDescriptor read FCurrentDescriptor; end; +{ TScopeDescriptor } + +constructor TScopeDescriptor.Create(AParent: IScopeDescriptor); +begin + inherited Create; + FParent := AParent; + FSymbols := TDictionary.Create; +end; + +destructor TScopeDescriptor.Destroy; +begin + FSymbols.Free; + inherited; +end; + +function TScopeDescriptor.Define(const Name: string): Integer; +begin + Result := FSymbols.Count; + FSymbols.Add(Name, Result); +end; + +function TScopeDescriptor.FindSymbol(const Name: string; out Index: Integer; out Depth: Integer): Boolean; +var + currentDescriptor: IScopeDescriptor; +begin + Depth := 0; + currentDescriptor := Self; + while Assigned(currentDescriptor) do + begin + if (currentDescriptor as TScopeDescriptor).FSymbols.TryGetValue(Name, Index) then + Exit(True); + inc(Depth); + currentDescriptor := currentDescriptor.Parent; + end; + Result := False; +end; + +function TScopeDescriptor.GetParent: IScopeDescriptor; +begin + Result := FParent; +end; + +function TScopeDescriptor.GetSlotCount: Integer; +begin + Result := FSymbols.Count; +end; + +function TScopeDescriptor.GetSymbols: TDictionary; +begin + Result := FSymbols; +end; + +function TScopeDescriptor.Instantiate(const AParent: IExecutionScope): IExecutionScope; +begin + Result := TExecutionScope.CreateFromDescriptor(AParent, Self); +end; + +procedure TScopeDescriptor.PopulateFromScope(const AScope: IExecutionScope); +begin + if not Assigned(AScope) then + Exit; + + for var pair in (AScope as TExecutionScope).NameToIndex do + if not FSymbols.ContainsKey(pair.Key) then + FSymbols.Add(pair.Key, pair.Value); +end; + { TConstantNode } constructor TConstantNode.Create(AValue: TScalar); @@ -344,9 +429,8 @@ constructor TIdentifierNode.Create(AName: string); begin inherited Create; FName := AName; - FIsResolved := False; - FScopeDepth := -1; - FSlotIndex := -1; + FResolvedAddress.ScopeDepth := -1; + FResolvedAddress.SlotIndex := -1; end; function TIdentifierNode.Accept(const Visitor: IAstVisitor): TAstValue; @@ -354,19 +438,22 @@ begin Result := Visitor.VisitIdentifier(Self); end; +function TIdentifierNode.GetIsResolved: Boolean; +begin + Result := FResolvedAddress.ScopeDepth >= 0; +end; + function TIdentifierNode.GetName: string; begin Result := FName; end; -function TIdentifierNode.Resolve(out ScopeDepth: Integer; out SlotIndex: Integer): Boolean; +function TIdentifierNode.Resolve: TResolvedAddress; begin - Result := FIsResolved; - if Result then - begin - ScopeDepth := FScopeDepth; - SlotIndex := FSlotIndex; - end; + if not IsResolved then + raise EInvalidOpException.Create('Identifier not bound'); + + Result := FResolvedAddress; end; { TBinaryExpressionNode } @@ -490,6 +577,7 @@ begin inherited Create; FBody := ABody; FParameters := AParameters; + FScopeDescriptor := nil; end; function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; @@ -507,6 +595,11 @@ begin Result := FParameters; end; +function TLambdaExpressionNode.GetScopeDescriptor: IScopeDescriptor; +begin + Result := FScopeDescriptor; +end; + { TFunctionCallNode } constructor TFunctionCallNode.Create(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode); @@ -769,7 +862,6 @@ 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; @@ -818,61 +910,37 @@ begin Result.PopulateFromScope(AScope); end; -constructor TBinder.Create(AInitialScope: IExecutionScope); +{ TBinder } + +constructor TBinder.Create(const 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 - // 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; + FCurrentDescriptor := TAst.CreateBinding(AInitialScope); end; procedure TBinder.EnterScope; begin - FCurrentScope := TSymbolTable.Create(FCurrentScope); + FCurrentDescriptor := TScopeDescriptor.Create(FCurrentDescriptor); end; procedure TBinder.ExitScope; -var - oldScope: TSymbolTable; begin - oldScope := FCurrentScope; - FCurrentScope := FCurrentScope.FParent; - oldScope.Free; + FCurrentDescriptor := FCurrentDescriptor.Parent; end; function TBinder.VisitIdentifier(const Node: IIdentifierNode): TAstValue; var - symbol: TSymbol; - depth: Integer; + index, depth: Integer; identNode: TIdentifierNode; begin identNode := Node as TIdentifierNode; - if identNode.FIsResolved then + if identNode.IsResolved then Exit; - if FCurrentScope.Resolve(identNode.Name, symbol, depth) then + if (FCurrentDescriptor as TScopeDescriptor).FindSymbol(identNode.Name, index, depth) then begin - identNode.FIsResolved := True; - identNode.FScopeDepth := depth; - identNode.FSlotIndex := symbol.SlotIndex; + identNode.FResolvedAddress.ScopeDepth := depth; + identNode.FResolvedAddress.SlotIndex := index; end else raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]); @@ -884,16 +952,15 @@ var begin EnterScope; try - // Reserve a slot for 'Self' first. - FCurrentScope.Define('Self'); + (FCurrentDescriptor as TScopeDescriptor).Define('Self'); - // 1. Define all parameters in the new scope. for param in Node.Parameters do - FCurrentScope.Define(param.Name); + (FCurrentDescriptor as TScopeDescriptor).Define(param.Name); - // 2. Now visit the parameter identifiers to resolve them to their new definitions, - // and visit the body to resolve its identifiers. inherited VisitLambdaExpression(Node); + + // Annotate the lambda node with the completed scope descriptor. + (Node as TLambdaExpressionNode).FScopeDescriptor := FCurrentDescriptor; finally ExitScope; end; @@ -901,22 +968,32 @@ end; function TBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; begin - // 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); + (FCurrentDescriptor as TScopeDescriptor).Define(Node.Identifier.Name); inherited; end; { TAst } -class procedure TAst.Bind(const ARootNode: IExpressionNode; const AScope: IExecutionScope); +class function TAst.Bind(const RootNode: IExpressionNode; const ParentScope: IExecutionScope): IScopeDescriptor; var - binder: IAstVisitor; + binder: TBinder; + visitor: IAstVisitor; begin - // 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); + // Create a binder, initialized with the parent scope (for globals etc.) + binder := TBinder.Create(ParentScope); + visitor := binder; + + // Create a new scope descriptor for the script's local variables. + binder.EnterScope; + try + // Traverse the AST. This annotates all nodes AND populates the new descriptor. + RootNode.Accept(visitor); + // Return the completed descriptor for the script's scope. + Result := binder.FCurrentDescriptor; + finally + // Restore the binder's internal state. + binder.ExitScope; + end; end; class function TAst.AddSeriesItem( @@ -958,6 +1035,22 @@ begin Result := TBinaryExpressionNode.Create(ALeft, AOperator, ARight); end; +class function TAst.CreateBinding(const Scope: IExecutionScope): IScopeDescriptor; +begin + if Assigned(Scope) then + begin + Result := CreateScopeDescriptor(CreateBinding(Scope.Parent)); + Result.PopulateFromScope(Scope); + end + else + Result := TScopeDescriptor.Create(nil); +end; + +class function TAst.CreateScopeDescriptor(const Parent: IScopeDescriptor): IScopeDescriptor; +begin + Result := TScopeDescriptor.Create(Parent); +end; + class function TAst.FunctionCall(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode): IFunctionCallNode; begin Result := TFunctionCallNode.Create(ACallee, AArguments); diff --git a/Src/Data/Myc.Data.Scalar.JSON.pas b/Src/Data/Myc.Data.Scalar.JSON.pas index d58acca..cae0daf 100644 --- a/Src/Data/Myc.Data.Scalar.JSON.pas +++ b/Src/Data/Myc.Data.Scalar.JSON.pas @@ -15,7 +15,7 @@ type class function TypeToScalarKind(AType: TRttiType): TScalarKind; static; public // Creates a JSON definition string from a record type info. - class function RecordDefinitionToJson(ATypeInfo: PTypeInfo): string; static; + class function RecordDefinitionToJson: string; static; // Creates a record definition from a JSON string. class function JsonToRecordDefinition(const AJson: string): TScalarRecordDefinition; static; end; @@ -67,7 +67,7 @@ begin end; end; -class function TRttiAstHelper.RecordDefinitionToJson(ATypeInfo: PTypeInfo): string; +class function TRttiAstHelper.RecordDefinitionToJson: string; var ctx: TRttiContext; rttiType: TRttiType; @@ -77,7 +77,7 @@ var fieldObj: TJSONObject; begin ctx := TRttiContext.Create; - rttiType := ctx.GetType(ATypeInfo); + rttiType := ctx.GetType(TypeInfo(T)); if not (rttiType is TRttiRecordType) then raise EArgumentException.Create('PTypeInfo provided is not a record type.');