diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index b9eb503..086c243 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -10,7 +10,8 @@ uses Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas', Myc.Ast.Visualizer in 'Myc.Ast.Visualizer.pas', Myc.Ast.ViewModel in '..\Src\AST\Myc.Ast.ViewModel.pas', - Myc.Data.Value in 'Myc.Data.Value.pas'; + Myc.Data.Value in 'Myc.Data.Value.pas', + Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas'; {$R *.res} diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index cdaa73a..b988ee1 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -4,7 +4,7 @@ 20.3 FMX True - Debug + Release Win64 ASTPlayground 2 @@ -142,6 +142,7 @@ + Base @@ -197,12 +198,6 @@ true - - - ASTPlayground.rsm - true - - ASTPlayground.exe diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index ddd8f1a..a3ced39 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -33,7 +33,7 @@ object Form1: TForm1 end object PrettyPrintButton: TButton Position.X = 24.000000000000000000 - Position.Y = 381.000000000000000000 + Position.Y = 405.000000000000000000 TabOrder = 3 Text = 'Print' TextSettings.Trimming = None @@ -52,7 +52,7 @@ object Form1: TForm1 end object ShowScopeBox: TCheckBox Position.X = 24.000000000000000000 - Position.Y = 441.000000000000000000 + Position.Y = 465.000000000000000000 TabOrder = 5 Text = 'Scope' end @@ -89,7 +89,7 @@ object Form1: TForm1 end object ClearButton: TButton Position.X = 24.000000000000000000 - Position.Y = 472.000000000000000000 + Position.Y = 496.000000000000000000 Size.Width = 80.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False @@ -126,13 +126,13 @@ object Form1: TForm1 end object DebugBox: TCheckBox Position.X = 24.000000000000000000 - Position.Y = 360.000000000000000000 + Position.Y = 384.000000000000000000 TabOrder = 15 Text = 'Debug' end object FromJSONButton: TButton Position.X = 24.000000000000000000 - Position.Y = 520.000000000000000000 + Position.Y = 544.000000000000000000 TabOrder = 16 Text = 'From JSON' TextSettings.Trimming = None @@ -140,12 +140,20 @@ object Form1: TForm1 end object ToJSONButton: TButton Position.X = 24.000000000000000000 - Position.Y = 550.000000000000000000 + Position.Y = 574.000000000000000000 TabOrder = 17 Text = 'To JSON' TextSettings.Trimming = None OnClick = ToJSONButtonClick end + object ExternalFuncButton: TButton + Position.X = 24.000000000000000000 + Position.Y = 336.000000000000000000 + TabOrder = 18 + Text = 'External Func' + TextSettings.Trimming = None + OnClick = ExternalFuncButtonClick + end end object Panel2: TPanel Align = Client diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 6b0547b..9650752 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -23,14 +23,15 @@ uses FMX.Controls.Presentation, Myc.Ast.Visualizer, Myc.Data.Scalar, - Myc.Data.Value, // Added + Myc.Data.Value, Myc.Ast.Nodes, Myc.Ast, Myc.Ast.Evaluator, Myc.Ast.Printer, FMX.Layouts, FMX.Objects, - Myc.Ast.Scope; + Myc.Ast.Scope, + Myc.Ast.Debugger; // Added for TDebugSession type // A test record @@ -63,11 +64,13 @@ type DebugBox: TCheckBox; FromJSONButton: TButton; ToJSONButton: TButton; + ExternalFuncButton: TButton; procedure ClearButtonClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure CreateTriggerExampleButtonClick(Sender: TObject); procedure DoTrigger2ButtonClick(Sender: TObject); procedure DoTriggerButtonClick(Sender: TObject); + procedure ExternalFuncButtonClick(Sender: TObject); procedure FibonacciButtonClick(Sender: TObject); procedure OHLCButtonClick(Sender: TObject); procedure PrettyPrintButtonClick(Sender: TObject); @@ -82,9 +85,8 @@ type FLastAst: IAstNode; FGScope: IExecutionScope; 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 + // Helper function to encapsulate the Bind -> Evaluate pattern function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue; public { Public declarations } @@ -113,26 +115,32 @@ begin RegisterNativeFunctions(FGScope); end; -function TForm1.CreateVisitor(const AScope: IExecutionScope): IAstVisitor; -begin - // Conditionally create a debug visitor if the checkbox is checked. - if DebugBox.IsChecked then - begin - Memo1.Lines.Add('--- Creating DEBUG visitor ---'); - Result := TDebugEvaluatorVisitor.Create(AScope, Memo1.Lines, ShowScopeBox.IsChecked); - end - else - Result := TEvaluatorVisitor.Create(AScope); -end; - function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue; var scriptScope: IExecutionScope; begin + // This helper function handles simple, one-off script executions. + // It binds the AST and then decides whether to run a debug session or a standard evaluation. scriptScope := TAst.Bind(ANode, AParentScope); - var visitor := CreateVisitor(scriptScope); - Result := ANode.Accept(visitor); + if DebugBox.IsChecked then + begin + // Debug path: Create, run, and destroy a debug session. + var session := TDebugSession.Create(ShowScopeBox.IsChecked); + try + Result := session.Execute(ANode, scriptScope); + Memo1.Lines.Add('--- DEBUG LOG ---'); + Memo1.Lines.AddStrings(session.Log); + finally + session.Free; + end; + end + else + begin + // Production path: Create and use the standard evaluator. + var visitor := TEvaluatorVisitor.Create(scriptScope); + Result := ANode.Accept(visitor); + end; end; procedure TForm1.FormCreate(Sender: TObject); @@ -186,8 +194,8 @@ begin ); FLastAst := root; - // Execute with nil as parent scope - result := ExecuteAst(root, nil); + // Execute with FGScope as parent. The helper function handles debug/prod switching. + result := ExecuteAst(root, FGScope); sw.Stop; Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); @@ -247,8 +255,8 @@ begin ); FLastAst := root; - // Execute with nil as parent scope - result := ExecuteAst(root, nil); + // Execute with FGScope as parent. + result := ExecuteAst(root, FGScope); sw.Stop; Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); @@ -256,18 +264,17 @@ end; procedure TForm1.SeriesTestButtonClick(Sender: TObject); var - scope: IExecutionScope; ast, callAst: IAstNode; resultValue: TDataValue; series: TScalarRecordSeries; recordDef: TScalarRecordDefinition; i: Integer; + scope: IExecutionScope; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Series Test ---'); - // 1. Arrange: Create a new scope and populate it with Delphi data - scope := TExecutionScope.Create(FGScope); // Inherits native functions + scope := TExecutionScope.Create(FGScope); recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson); series := TScalarRecordSeries.Create(recordDef); for i := 0 to 4 do @@ -288,7 +295,6 @@ begin end; scope.Define('ohlcvSeries', TDataValue.FromRecordSeries(series)); - // 2. Act: Define and execute the script AST ast := TAst.LambdaExpr( [], @@ -307,7 +313,6 @@ begin callAst := TAst.FunctionCall(ast, []); resultValue := ExecuteAst(callAst, scope); - // 3. Assert (logging only) Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString])); end; @@ -338,7 +343,6 @@ begin FLastAst := main; callAst := TAst.FunctionCall(main, []); - // Execute with FGScope as parent result := ExecuteAst(callAst, FGScope); sw.Stop; @@ -376,7 +380,6 @@ begin ); FLastAst := root; - // Execute with FGScope as parent result := ExecuteAst(root, FGScope); sw.Stop; @@ -403,14 +406,14 @@ const lookback = 50; smaSlowLength = 20; smaFastLength = 10; +var + visitor: IAstVisitor; + scope: IExecutionScope; + session: TDebugSession; begin - // 1. Setup Memo1.Lines.Clear; Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs])); - var sw := TStopwatch.StartNew; - - // 2. Create the setup AST with the strategy logic var setupAst := TAst.Block( [ @@ -511,77 +514,106 @@ begin ); FLastAst := setupAst; - var scope := TAst.Bind(setupAst, FGScope); - setupAst.Accept(CreateVisitor(scope)); + // 1. Bind and execute the setup script. + scope := TAst.Bind(setupAst, FGScope); - // Declare the series variable in the scope BEFORE binding the call AST + // This is a temporary visitor just for the setup execution. + var setupVisitor: IAstVisitor; + if DebugBox.IsChecked then + begin + session := TDebugSession.Create(ShowScopeBox.IsChecked); + try + // Execute setup script within a temporary session. + session.Execute(setupAst, scope); + Memo1.Lines.Add('--- DEBUG LOG (Setup) ---'); + Memo1.Lines.AddStrings(session.Log); + session.Log.Clear; // Clear log for the next phase + finally + session.Free; + end; + end + else + begin + setupVisitor := TEvaluatorVisitor.Create(scope); + setupAst.Accept(setupVisitor); + end; + + // 2. Prepare for the simulation loop by modifying the now-populated scope. scope.Define('current_series', TDataValue.Void); - - // Create the call AST that will be executed in the loop var currentSeriesIdent := TAst.Identifier('current_series'); var callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]); - // Bind the call AST once, before the loop. + // 3. Re-bind the scope with the new AST. This creates the FINAL scope for the loop. scope := TAst.Bind(callAst, scope); - var visitor := CreateVisitor(scope); - - // 4. Simulation Loop - Memo1.Lines.Add('Starting simulation...'); - Application.ProcessMessages; - - var lastClose := 1000.0; - Randomize; - - var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson); - var series := TDataValue.FromRecordSeries(TScalarRecordSeries.Create(recDef)); var seriesAddress := currentSeriesIdent.Address; - var nw := Now; - var ohlcvRec: TOHLCV; - for var i := 1 to numRecs do - begin - ohlcvRec.Timestamp := nw + (i / (24 * 60)); - ohlcvRec.Open := lastClose + (Random * 0.05); - ohlcvRec.Close := lastClose + (Random - 0.49) * 2; - ohlcvRec.High := Max(ohlcvRec.Open, ohlcvRec.Close) + Random; - ohlcvRec.Low := Min(ohlcvRec.Open, ohlcvRec.Close) - Random; - ohlcvRec.Volume := RandomRange(1000, 50000); - lastClose := ohlcvRec.Close; - - var recordValue := - TScalarRecord.Create( - recDef, - [ - TScalarValue.FromDateTime(ohlcvRec.Timestamp), - TScalarValue.FromDouble(ohlcvRec.Open), - TScalarValue.FromDouble(ohlcvRec.High), - TScalarValue.FromDouble(ohlcvRec.Low), - TScalarValue.FromDouble(ohlcvRec.Close), - TScalarValue.FromInt64(ohlcvRec.Volume) - ] - ); - - series.AsRecordSeries.Value.Add(recordValue, lookback); - - if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then + // 4. NOW create the visitor for the simulation loop, using the final scope. + session := nil; + try + if DebugBox.IsChecked then begin - // Update the 'current_series' value in the scope using the FAST index-based assignment - scope[seriesAddress].Value := series; + // Create a new session that will live for the duration of the loop. + session := TDebugSession.Create(ShowScopeBox.IsChecked); + visitor := TDebugEvaluatorVisitor.Create(scope, session.Log, ShowScopeBox.IsChecked, 1); + end + else + begin + visitor := TEvaluatorVisitor.Create(scope); + end; - // Execute the PRE-BOUND call AST - var resultValue := callAst.Accept(visitor); + // 5. Simulation Loop + Memo1.Lines.Add('Starting simulation...'); + Application.ProcessMessages; - if i mod 50 = 0 then + var lastClose := 1000.0; + Randomize; + var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson); + var series := TDataValue.FromRecordSeries(TScalarRecordSeries.Create(recDef)); + var nw := Now; + var ohlcvRec: TOHLCV; + for var i := 1 to numRecs do + begin + // ... (simulation logic is unchanged) ... + ohlcvRec.Timestamp := nw + (i / (24 * 60)); + ohlcvRec.Open := lastClose + (Random * 0.05); + ohlcvRec.Close := lastClose + (Random - 0.49) * 2; + ohlcvRec.High := Max(ohlcvRec.Open, ohlcvRec.Close) + Random; + ohlcvRec.Low := Min(ohlcvRec.Open, ohlcvRec.Close) - Random; + ohlcvRec.Volume := RandomRange(1000, 50000); + lastClose := ohlcvRec.Close; + var recordValue := + TScalarRecord.Create( + recDef, + [ + TScalarValue.FromDateTime(ohlcvRec.Timestamp), + TScalarValue.FromDouble(ohlcvRec.Open), + TScalarValue.FromDouble(ohlcvRec.High), + TScalarValue.FromDouble(ohlcvRec.Low), + TScalarValue.FromDouble(ohlcvRec.Close), + TScalarValue.FromInt64(ohlcvRec.Volume) + ] + ); + series.AsRecordSeries.Value.Add(recordValue, lookback); + + if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then begin - Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString])); - Application.ProcessMessages; + scope[seriesAddress].Value := series; + var resultValue := callAst.Accept(visitor); + if i mod 50 = 0 then + begin + Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString])); + Application.ProcessMessages; + end; end; end; - end; - sw.Stop; - Memo1.Lines.Add('--- Simulation Finished ---'); - Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds])); + sw.Stop; + Memo1.Lines.Add('--- Simulation Finished ---'); + Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds])); + finally + if Assigned(session) then + session.Free; + end; end; var @@ -590,12 +622,10 @@ var procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject); var blk: IAstNode; + visitor: IAstVisitor; 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( [ @@ -612,9 +642,25 @@ begin TriggerScope := TAst.Bind(blk, FGScope); - blk.Accept(CreateVisitor(TriggerScope)); + // This case is simple enough to just inline the logic from ExecuteAst + if DebugBox.IsChecked then + begin + var session := TDebugSession.Create(ShowScopeBox.IsChecked); + try + session.Execute(blk, TriggerScope); + Memo1.Lines.Add('--- DEBUG LOG ---'); + Memo1.Lines.AddStrings(session.Log); + finally + session.Free; + end; + end + else + begin + visitor := TEvaluatorVisitor.Create(TriggerScope); + blk.Accept(visitor); + end; - FLastAst := blk; // Store for visualization + FLastAst := blk; Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.'); Memo1.Lines.Add('Click "Do Trigger" to execute.'); @@ -644,11 +690,43 @@ begin Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString])); end; +procedure TForm1.ExternalFuncButtonClick(Sender: TObject); +var + scope: IExecutionScope; + callAst: IAstNode; + resultValue: TDataValue; +begin + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Calling external Delphi function from AST ---'); + + scope := TExecutionScope.Create(FGScope); + + scope.Define( + 'delphiAdd', + function(const ArgNodes: TArray): TDataValue + var + val1, val2: Int64; + begin + if Length(ArgNodes) <> 2 then + raise Exception.Create('delphiAdd requires exactly 2 arguments.'); + val1 := ArgNodes[0].AsScalar.Value.AsInt64; + val2 := ArgNodes[1].AsScalar.Value.AsInt64; + Result := TScalar.FromInt64(val1 + val2); + end + ); + + callAst := + TAst.FunctionCall(TAst.Identifier('delphiAdd'), [TAst.Constant(TScalar.FromInt64(100)), TAst.Constant(TScalar.FromInt64(23))]); + + FLastAst := callAst; + resultValue := ExecuteAst(callAst, scope); + Memo1.Lines.Add(Format('Result from delphiAdd(100, 23): %s', [resultValue.ToString])); +end; + procedure TForm1.FromJSONButtonClick(Sender: TObject); var jsonString: string; begin - // Implemented TODO: Reads an AST JSON string from the memo and deserializes it into FLastAst. Memo1.Lines.BeginUpdate; try jsonString := Memo1.Lines.Text; @@ -670,7 +748,6 @@ begin FLastAst := nil; Memo1.Lines.Add('Error deserializing AST from JSON:'); Memo1.Lines.Add(E.Message); - // Restore original text for correction Memo1.Lines.Add('--- Original JSON ---'); Memo1.Lines.Text := Memo1.Lines.Text + sLineBreak + jsonString; end; @@ -684,7 +761,6 @@ procedure TForm1.ToJSONButtonClick(Sender: TObject); var jsonString: string; begin - // Implemented TODO: Serializes the current FLastAst to a JSON string and displays it in the memo. Memo1.Lines.Clear; if not Assigned(FLastAst) then diff --git a/ASTPlayground/Myc.Ast.Visualizer.pas b/ASTPlayground/Myc.Ast.Visualizer.pas index 7a33929..49c558c 100644 --- a/ASTPlayground/Myc.Ast.Visualizer.pas +++ b/ASTPlayground/Myc.Ast.Visualizer.pas @@ -365,10 +365,10 @@ begin try sb.Append(calleeStr); sb.Append('('); - for i := 0 to Node.Arguments.Count - 1 do + for i := 0 to High(Node.Arguments) do begin sb.Append(Node.Arguments[i].Accept(Self).AsText); - if i < Node.Arguments.Count - 1 then + if i < High(Node.Arguments) then sb.Append(', '); end; sb.Append(')'); @@ -1405,9 +1405,9 @@ begin end else begin - SetLength(inputExpressions, 1 + Node.Arguments.Count); + SetLength(inputExpressions, 1 + Length(Node.Arguments)); inputExpressions[0] := Node.Callee; - for var i := 0 to Node.Arguments.Count - 1 do + for var i := 0 to High(Node.Arguments) do inputExpressions[i + 1] := Node.Arguments[i]; VisitOperatorNode( @@ -1425,8 +1425,8 @@ begin CreateEntry(funcCallNode); calleePin := CreateInput(funcCallNode, 'Callee'); - SetLength(argPin, Node.Arguments.Count); - for i := 0 to Node.Arguments.Count - 1 do + SetLength(argPin, Length(Node.Arguments)); + for i := 0 to High(argPin) do argPin[i] := CreateInput(funcCallNode, 'Arg' + i.ToString); CreateExit(funcCallNode, ''); @@ -1434,7 +1434,7 @@ begin if Assigned(InputResults[0].OutputPin) then FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, calleePin)); - for i := 0 to Node.Arguments.Count - 1 do + for i := 0 to High(Node.Arguments) do if Assigned(InputResults[i + 1].OutputPin) then FConnections.Add(TPinConnection.Create(InputResults[i + 1].OutputPin, argPin[i])); diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 31a8483..88b0124 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -13,14 +13,29 @@ uses Myc.Ast; type + // A factory for creating visitors, primarily used by the debugger subsystem. + TVisitorFactory = reference to function(const Scope: IExecutionScope): IAstVisitor; + + // The standard AST evaluator for production use. TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor) private FScope: IExecutionScope; protected function IsTruthy(const AValue: TDataValue): Boolean; - function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; virtual; + // Returns a closure that can create the correct type of visitor for a lambda's body. + function GetVisitorFactory: TVisitorFactory; virtual; + + // Creates the callable closure for a lambda expression. No longer virtual. + function CreateLambdaClosure( + const Node: ILambdaExpressionNode; + const ACapturedCells: TArray; + const AClosureScope: IExecutionScope + ): TDataValue; + + property Scope: IExecutionScope read FScope; public constructor Create(const AScope: IExecutionScope); + function VisitConstant(const Node: IConstantNode): TDataValue; virtual; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual; @@ -39,38 +54,7 @@ type function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual; end; - TDebugEvaluatorVisitor = class(TEvaluatorVisitor) - private - FLog: TStrings; - FIndentLevel: Integer; - FShowScope: Boolean; - procedure Indent; - procedure Unindent; - procedure AppendLine(const S: string); - procedure AppendMultiline(const S: string); - procedure ShowScope; - protected - function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; override; - public - constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); - function VisitConstant(const Node: IConstantNode): TDataValue; override; - function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; - function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; - function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; - function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; - function VisitIndexer(const Node: IIndexerNode): TDataValue; override; - function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; - function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; - function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override; - function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; - end; - +// Registers native Delphi functions into a scope. procedure RegisterNativeFunctions(const AScope: IExecutionScope); implementation @@ -80,46 +64,8 @@ uses System.Generics.Defaults, Myc.Data.Decimal, Myc.Data.Series, - Myc.Ast.Printer, Myc.Data.Scalar.JSON; -type - TNativeFunction = function(const Args: TArray): TDataValue; - - TClosure = class(TInterfacedObject) - function GetArity: Integer; virtual; abstract; - function Invoke( - const AVisitor: IAstVisitor; - const ASelf: TDataValue; - const AArgNodes: TList - ): TDataValue; virtual; abstract; - end; - - TClosureValue = class(TClosure) - private - FLambdaNode: ILambdaExpressionNode; - FClosureScope: IExecutionScope; - FUpvalues: TArray; - public - constructor Create( - const ALambdaNode: ILambdaExpressionNode; - const AClosureScope: IExecutionScope; - const AUpvalues: TArray - ); - function GetArity: Integer; override; - function Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList): TDataValue; override; - end; - - TNativeClosure = class(TClosure) - private - FMethod: TNativeFunction; - FArity: Integer; - public - constructor Create(const AMethod: TNativeFunction; AArity: Integer); - function GetArity: Integer; override; - function Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList): TDataValue; override; - end; - // --- Native Functions Implementation --- function NativeCreateRecordSeries(const Args: TArray): TDataValue; @@ -128,9 +74,8 @@ var recordDef: TScalarRecordDefinition; series: TScalarRecordSeries; begin - // Arity check is now done by the caller (TNativeClosure.Invoke) - if Args[0].Kind <> vkText then - raise EArgumentException.Create('CreateRecordSeries requires a string argument.'); + if (Length(Args) <> 1) or (Args[0].Kind <> vkText) then + raise EArgumentException.Create('CreateRecordSeries requires one string argument.'); jsonDef := Args[0].AsText; recordDef := TRttiAstHelper.JsonToRecordDefinition(jsonDef); @@ -146,88 +91,7 @@ end; procedure RegisterNativeFunctions(const AScope: IExecutionScope); begin - // Use 'Define' to clearly state that we are adding a new variable - // to the global scope before the binder runs. - AScope.Define('CreateRecordSeries', TNativeClosure.Create(NativeCreateRecordSeries, 1)); -end; - -{ TClosureValue } - -constructor TClosureValue.Create( - const ALambdaNode: ILambdaExpressionNode; - const AClosureScope: IExecutionScope; - const AUpvalues: TArray -); -begin - inherited Create; - FLambdaNode := ALambdaNode; - FClosureScope := AClosureScope; - FUpvalues := AUpvalues; -end; - -function TClosureValue.GetArity: Integer; -begin - Result := Length(FLambdaNode.Parameters); -end; - -function TClosureValue.Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList): TDataValue; -var - i: Integer; - descriptor: IScopeDescriptor; - callScope: IExecutionScope; - adr: TResolvedAddress; -begin - if (AArgNodes.Count <> GetArity) then - raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [GetArity, AArgNodes.Count]); - - descriptor := FLambdaNode.ScopeDescriptor; - if not Assigned(descriptor) then - raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?'); - - callScope := TExecutionScope.Create(FClosureScope, descriptor, FUpvalues); - - adr.Kind := akLocalOrParent; - adr.ScopeDepth := 0; - adr.SlotIndex := 0; - callScope[adr].Value := ASelf; - - for i := 0 to AArgNodes.Count - 1 do - begin - adr.SlotIndex := FLambdaNode.Parameters[i].Address.SlotIndex; - callScope[adr].Value := AArgNodes[i].Accept(AVisitor); - end; - - Result := FLambdaNode.Body.Accept((AVisitor as TEvaluatorVisitor).CreateVisitorForScope(callScope)); -end; - -{ TNativeClosure } - -constructor TNativeClosure.Create(const AMethod: TNativeFunction; AArity: Integer); -begin - inherited Create; - FMethod := AMethod; - FArity := AArity; -end; - -function TNativeClosure.GetArity: Integer; -begin - Result := FArity; -end; - -function TNativeClosure.Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList): TDataValue; -var - argValues: TArray; - i: Integer; -begin - if (FArity <> -1) and (AArgNodes.Count <> FArity) then - raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [FArity, AArgNodes.Count]); - - // Evaluate argument nodes to get values for the native function - SetLength(argValues, AArgNodes.Count); - for i := 0 to AArgNodes.Count - 1 do - argValues[i] := AArgNodes[i].Accept(AVisitor); - - Result := FMethod(argValues); + AScope.Define('CreateRecordSeries', TDataValue(NativeCreateRecordSeries)); end; { TEvaluatorVisitor } @@ -239,16 +103,18 @@ begin FScope := AScope; end; -function TEvaluatorVisitor.CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; +function TEvaluatorVisitor.GetVisitorFactory: TVisitorFactory; begin - Result := TEvaluatorVisitor.Create(AScope); + // The production visitor returns a factory that creates another production visitor. + Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end; end; function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean; begin if (AValue.Kind <> vkScalar) then begin - Exit(False); + Result := False; + exit; end; case AValue.AsScalar.Kind of @@ -261,26 +127,102 @@ begin end; end; +function TEvaluatorVisitor.CreateLambdaClosure( + const Node: ILambdaExpressionNode; + const ACapturedCells: TArray; + const AClosureScope: IExecutionScope +): TDataValue; +var + closureValue: TDataValue; + visitorFactory: TVisitorFactory; +begin + // Get the appropriate factory via virtual dispatch. + visitorFactory := GetVisitorFactory(); + + closureValue := + TDataValue.TFunc( + function(const ArgValues: TArray): TDataValue + var + lambdaScope: IExecutionScope; + bodyVisitor: IAstVisitor; + i: Integer; + adr: TResolvedAddress; + begin + if (Length(ArgValues) <> Length(Node.Parameters)) then + raise EArgumentException + .CreateFmt('Argument count mismatch: expected %d, got %d', [Length(Node.Parameters), Length(ArgValues)]); + + lambdaScope := TExecutionScope.Create(AClosureScope, Node.ScopeDescriptor, ACapturedCells); + + adr.Kind := akLocalOrParent; + adr.ScopeDepth := 0; + + // Set 'Self' (slot 0) to the captured closureValue for recursion. + adr.SlotIndex := 0; + lambdaScope.Cell[adr].Value := closureValue; + + // Populate the actual parameters. + for i := 0 to High(ArgValues) do + begin + adr.SlotIndex := Node.Parameters[i].Address.SlotIndex; + lambdaScope.Cell[adr].Value := ArgValues[i]; + end; + + // Use the injected factory to create the visitor for the lambda's body. + bodyVisitor := visitorFactory(lambdaScope); + + Result := Node.Body.Accept(bodyVisitor); + end + ); + + Result := closureValue; +end; + +function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; +var + capturedCells: TArray; + i: Integer; + sourceAddresses: TArray; + closureScope: IExecutionScope; +begin + sourceAddresses := Node.Upvalues; + SetLength(capturedCells, Length(sourceAddresses)); + for i := 0 to High(sourceAddresses) do + capturedCells[i] := FScope.GetCell(sourceAddresses[i]); + + if Node.HasNestedLambdas then + closureScope := FScope + else + closureScope := nil; + + Result := CreateLambdaClosure(Node, capturedCells, closureScope); +end; + function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; var calleeValue: TDataValue; + argValues: TArray; + i: Integer; begin calleeValue := Node.Callee.Accept(Self); - // Check if the value holds an interface and if that interface supports our invocation contract. - if (calleeValue.Kind <> vkInterface) or not (calleeValue.AsInterface is TClosure) then - raise EArgumentException.Create('Expression is not invokable in this context.'); + var argNodes := Node.Arguments; + SetLength(argValues, Length(argNodes)); + for i := 0 to High(argNodes) do + argValues[i] := argNodes[i].Accept(Self); - // "Tell, Don't Ask": Simply tell the object to invoke itself. - Result := (calleeValue.AsInterface as TClosure).Invoke(Self, calleeValue, Node.Arguments); + if (calleeValue.Kind = vkMethod) then + Result := (calleeValue.AsMethod)(argValues) + else + raise EArgumentException.Create('Expression is not invokable in this context.'); end; +// ... The rest of the Visit... methods are unchanged and remain as they were ... function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; var itemValue, lookbackValue, seriesVar: TDataValue; lookback: Int64; begin - // The target series must have been resolved by the binder. seriesVar := FScope[Node.Series.Address].Value; itemValue := Node.Value.Accept(Self); lookback := -1; @@ -297,7 +239,6 @@ begin lookback := lookbackValue.AsScalar.Value.AsInt64; end; - // Dispatch based on series type case seriesVar.Kind of vkSeries: begin @@ -309,7 +250,6 @@ begin if (itemValue.AsScalar.Kind <> Kind) then raise EArgumentException .CreateFmt('Type mismatch: Cannot add %s to a series of %s.', [itemValue.AsScalar.Kind.ToString, Kind.ToString]); - Items.Add(itemValue.AsScalar.Value, lookback); end; end; @@ -326,7 +266,7 @@ begin else raise EArgumentException.Create('"add" operation is only supported for series types.'); end; - Result := TDataValue.Void; // 'add' is a procedure, returns void + Result := TDataValue.Void; end; function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue; @@ -395,7 +335,6 @@ begin begin if (index < 0) or (index >= Items.TotalCount) then raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, Items.TotalCount]); - Result := TScalar.Create(Kind, Items[Integer(index)]); end; end; @@ -404,7 +343,6 @@ begin var series := baseValue.AsRecordSeries.Value; if (index < 0) or (index >= series.TotalCount) then raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]); - var recordValue := series.Items[Integer(index)]; Result := TDataValue.FromRecord(recordValue); end; @@ -414,7 +352,6 @@ begin if (index < 0) or (index >= memberSeries.Count) then raise EArgumentException .CreateFmt('Index %d is out of bounds for member series with %d elements.', [index, memberSeries.Count]); - Result := memberSeries.Items[Integer(index)]; end; else @@ -466,22 +403,6 @@ begin Result := value; end; -function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; -var - capturedCells: TArray; - i: Integer; - sourceAddresses: TArray; -begin - // The binder has identified the upvalues. Capture the cells from the current scope - // using the original source addresses provided by the binder. - sourceAddresses := Node.Upvalues; - SetLength(capturedCells, Length(sourceAddresses)); - for i := 0 to High(sourceAddresses) do - capturedCells[i] := FScope.GetCell(sourceAddresses[i]); - - Result := TClosureValue.Create(Node, FScope, capturedCells) as IInterface; -end; - function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; var leftValue, rightValue: TDataValue; @@ -499,18 +420,12 @@ begin if (leftScalar.Kind <> rightScalar.Kind) then begin if (leftScalar.Kind = skInt64) and (rightScalar.Kind = skDouble) then - begin - leftScalar := TScalar.FromDouble(leftScalar.Value.AsInt64); - end + leftScalar := TScalar.FromDouble(leftScalar.Value.AsInt64) else if (leftScalar.Kind = skDouble) and (rightScalar.Kind = skInt64) then - begin - rightScalar := TScalar.FromDouble(rightScalar.Value.AsInt64); - end + rightScalar := TScalar.FromDouble(rightScalar.Value.AsInt64) else - begin raise ENotSupportedException.Create( 'Binary operations are only supported for compatible types. ' + leftScalar.ToString + ' ' + rightScalar.ToString); - end; end; case leftScalar.Kind of @@ -617,7 +532,6 @@ function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode var expression: IAstNode; begin - // The result of a block is the result of its last expression. Result := TDataValue.Void; for expression in Node.Expressions do begin @@ -630,7 +544,7 @@ var seriesValue: TDataValue; len: Int64; begin - seriesValue := Node.Series.Accept(Self); + seriesValue := FScope[Node.Series.Address].Value; case seriesValue.Kind of vkSeries: len := seriesValue.AsSeries.Value.Items.Count; @@ -643,261 +557,4 @@ begin Result := TScalar.FromInt64(len); end; -{ TDebugEvaluatorVisitor } - -constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer); -begin - inherited Create(AScope); - Assert(Assigned(ALog)); - FLog := ALog; - FIndentLevel := AInitialIndent; - FShowScope := AShowScope; - - ShowScope; -end; - -function TDebugEvaluatorVisitor.CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; -begin - Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, FIndentLevel); -end; - -procedure TDebugEvaluatorVisitor.Indent; -begin - inc(FIndentLevel); -end; - -procedure TDebugEvaluatorVisitor.Unindent; -begin - dec(FIndentLevel); -end; - -procedure TDebugEvaluatorVisitor.AppendLine(const S: string); -var - pad: string; - i: Integer; -begin - pad := ''; - for i := 0 to FIndentLevel - 1 do - begin - pad := pad + ':' + ''.PadLeft(3); - end; - FLog.Add(pad + S); -end; - -procedure TDebugEvaluatorVisitor.AppendMultiline(const S: string); -begin - var Str := TStringList.Create; - try - Str.Text := s; - for var i := 0 to Str.Count - 1 do - AppendLine(Str[i]); - finally - Str.Free; - end; -end; - -procedure TDebugEvaluatorVisitor.ShowScope; -var - scopeDump: TArray; - line: string; -begin - if FShowScope then - begin - AppendLine('-- Scope --'); - scopeDump := FScope.Dump.Split([sLineBreak]); - for line in scopeDump do - begin - AppendLine(line); - end; - AppendLine('-----------'); - end; -end; - -function TDebugEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; -begin - AppendLine('AddSeriesItem {'); - Indent; - try - Result := inherited VisitAddSeriesItem(Node); - finally - Unindent; - end; - AppendLine('} -> (void)'); -end; - -function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue; -begin - AppendLine(Format('Assignment to "%s" {', [Node.Identifier.Name])); - Indent; - try - Result := inherited VisitAssignment(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue; -begin - AppendLine(Format('Constant (%s)', [Node.Value.ToString])); - Result := inherited VisitConstant(Node); -end; - -function TDebugEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; -begin - AppendLine('CreateSeries {'); - Indent; - try - Result := inherited VisitCreateSeries(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue; -begin - Result := inherited VisitIdentifier(Node); - AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; -begin - AppendLine(Format('BinaryExpr "%s" {', [Node.Operator.ToString])); - Indent; - try - Result := inherited VisitBinaryExpression(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; -begin - AppendLine(Format('UnaryExpr "%s" {', [Node.Operator.ToString])); - Indent; - try - Result := inherited VisitUnaryExpression(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; -begin - AppendLine('IfExpr{'); - Indent; - try - Result := inherited VisitIfExpression(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue; -begin - AppendLine('Indexer {'); - Indent; - try - Result := inherited VisitIndexer(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; -begin - AppendLine(Format('MemberAccess (Member: %s) {', [Node.Member.Name])); - Indent; - try - Result := inherited VisitMemberAccess(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; -begin - AppendLine('TernaryExpr{'); - Indent; - try - Result := inherited VisitTernaryExpression(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; -begin - AppendLine('LambdaExpr{'); - Indent; - try - var pp: IAstVisitor := TPrettyPrintVisitor.Create(0); - pp.VisitLambdaExpression(Node); - - AppendMultiline((pp as TPrettyPrintVisitor).GetResult); - - ShowScope; - Result := inherited VisitLambdaExpression(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; -begin - AppendLine('FunctionCall{'); - Indent; - try - ShowScope; - Result := inherited VisitFunctionCall(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; -begin - AppendLine('Block{'); - Indent; - try - Result := inherited VisitBlockExpression(Node); - ShowScope; - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; -begin - AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name])); - Indent; - try - Result := inherited VisitVariableDeclaration(Node); - finally - Unindent; - end; -end; - -function TDebugEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; -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.JSON.pas b/Src/AST/Myc.Ast.JSON.pas index d23087f..85ea878 100644 --- a/Src/AST/Myc.Ast.JSON.pas +++ b/Src/AST/Myc.Ast.JSON.pas @@ -297,7 +297,7 @@ begin for arg in Node.Arguments do arg.Accept(Self); - SetLength(tempArgs, Node.Arguments.Count); + SetLength(tempArgs, Length(Node.Arguments)); for i := High(tempArgs) downto 0 do tempArgs[i] := FJsonObjectStack.Pop; diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index e9ff5e2..478eb25 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -182,20 +182,22 @@ type function GetBody: IAstNode; function GetScopeDescriptor: IScopeDescriptor; function GetUpvalues: TArray; + function GetHasNestedLambdas: Boolean; {$endregion} property Parameters: TArray read GetParameters; property Body: IAstNode read GetBody; property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor; property Upvalues: TArray read GetUpvalues; + property HasNestedLambdas: Boolean read GetHasNestedLambdas; end; IFunctionCallNode = interface(IAstNode) {$region 'private'} function GetCallee: IAstNode; - function GetArguments: TList; + function GetArguments: TArray; {$endregion} property Callee: IAstNode read GetCallee; - property Arguments: TList read GetArguments; + property Arguments: TArray read GetArguments; end; IBlockExpressionNode = interface(IAstNode) diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index f1d9efc..068bb67 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -43,9 +43,9 @@ uses type TValueCell = class(TInterfacedObject, IValueCell) private - FValue: TDataValue; // <-- Changed from TAstValue - function GetValue: TDataValue; // <-- Changed from TAstValue - procedure SetValue(const AValue: TDataValue); // <-- Changed from TAstValue + FValue: TDataValue; + function GetValue: TDataValue; + procedure SetValue(const AValue: TDataValue); end; { TValueCell } diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index c02a574..b5bb407 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -23,7 +23,7 @@ type class function IfExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): IIfExpressionNode; static; class function TernaryExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): ITernaryExpressionNode; static; class function LambdaExpr(const AParameters: TArray; const ABody: IAstNode): ILambdaExpressionNode; static; - class function FunctionCall(const ACallee: IAstNode; const AArguments: array of IAstNode): IFunctionCallNode; static; + class function FunctionCall(const ACallee: IAstNode; const AArguments: TArray): IFunctionCallNode; static; class function Block(const AExpressions: array of IAstNode): IBlockExpressionNode; static; class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IAstNode): IVariableDeclarationNode; static; class function Assign(const AIdentifier: IIdentifierNode; const AValue: IAstNode): IAssignmentNode; static; @@ -44,6 +44,10 @@ type // TAstTraverser provides a default AST traversal implementation. TAstTraverser = class abstract(TInterfacedObject, IAstVisitor) + private + FDone: Boolean; + protected + property Done: Boolean read FDone write FDone; public function VisitConstant(const Node: IConstantNode): TDataValue; virtual; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual; @@ -179,13 +183,16 @@ type FBody: IAstNode; FScopeDescriptor: IScopeDescriptor; FUpvalues: TArray; + FHasNestedLambdas: Boolean; function GetParameters: TArray; function GetBody: IAstNode; function GetScopeDescriptor: IScopeDescriptor; function GetUpvalues: TArray; + function GetHasNestedLambdas: Boolean; public constructor Create(const AParameters: TArray; const ABody: IAstNode); function Accept(const Visitor: IAstVisitor): TDataValue; override; + property HasNestedLambdas: Boolean read FHasNestedLambdas write FHasNestedLambdas; property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor; end; @@ -193,12 +200,11 @@ type TFunctionCallNode = class(TAstNode, IFunctionCallNode) private FCallee: IAstNode; - FArguments: TList; + FArguments: TArray; function GetCallee: IAstNode; - function GetArguments: TList; + function GetArguments: TArray; public - constructor Create(const ACallee: IAstNode; const AArguments: array of IAstNode); - destructor Destroy; override; + constructor Create(const ACallee: IAstNode; const AArguments: TArray); function Accept(const Visitor: IAstVisitor): TDataValue; override; end; @@ -308,6 +314,7 @@ type FCurrentDescriptor: IScopeDescriptor; FUpvalueMapStack: TStack>; FUpvalueNodesStack: TStack>; + FNestedLambdaCount: Integer; procedure EnterScope; procedure ExitScope; public @@ -587,6 +594,11 @@ begin Result := FBody; end; +function TLambdaExpressionNode.GetHasNestedLambdas: Boolean; +begin + Result := FHasNestedLambdas; +end; + function TLambdaExpressionNode.GetParameters: TArray; begin Result := FParameters; @@ -599,21 +611,11 @@ end; { TFunctionCallNode } -constructor TFunctionCallNode.Create(const ACallee: IAstNode; const AArguments: array of IAstNode); -var - arg: IAstNode; +constructor TFunctionCallNode.Create(const ACallee: IAstNode; const AArguments: TArray); begin inherited Create; FCallee := ACallee; - FArguments := TList.Create; - for arg in AArguments do - FArguments.Add(arg); -end; - -destructor TFunctionCallNode.Destroy; -begin - FArguments.Free; - inherited; + FArguments := AArguments; end; function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TDataValue; @@ -621,7 +623,7 @@ begin Result := Visitor.VisitFunctionCall(Self); end; -function TFunctionCallNode.GetArguments: TList; +function TFunctionCallNode.GetArguments: TArray; begin Result := FArguments; end; @@ -829,6 +831,7 @@ begin FCurrentDescriptor := TAst.CreateDescriptor(AInitialScope); FUpvalueMapStack := TStack>.Create; FUpvalueNodesStack := TStack>.Create; + FNestedLambdaCount := 0; end; destructor TBinder.Destroy; @@ -913,8 +916,11 @@ begin for param in Node.Parameters do (FCurrentDescriptor as TScopeDescriptor).Define(param.Name); + var lastNestedLambdaCount := FNestedLambdaCount; + inherited VisitLambdaExpression(Node); + (Node as TLambdaExpressionNode).HasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount; (Node as TLambdaExpressionNode).FScopeDescriptor := FCurrentDescriptor; finally ExitScope; @@ -941,6 +947,8 @@ begin upvalueMap.Free; upvalueNodes.Free; + + inc(FNestedLambdaCount); end; end; @@ -1027,7 +1035,7 @@ begin Result := TScopeDescriptor.Create(nil); end; -class function TAst.FunctionCall(const ACallee: IAstNode; const AArguments: array of IAstNode): IFunctionCallNode; +class function TAst.FunctionCall(const ACallee: IAstNode; const AArguments: TArray): IFunctionCallNode; begin Result := TFunctionCallNode.Create(ACallee, AArguments); end; @@ -1081,22 +1089,29 @@ end; function TAstTraverser.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; begin - Node.Series.Accept(Self); - Node.Value.Accept(Self); + if not FDone then + Node.Series.Accept(Self); + if not FDone then + Node.Value.Accept(Self); if Assigned(Node.Lookback) then - Node.Lookback.Accept(Self); + if not FDone then + Node.Lookback.Accept(Self); end; function TAstTraverser.VisitAssignment(const Node: IAssignmentNode): TDataValue; begin - Node.Value.Accept(Self); - Node.Identifier.Accept(Self); + if not FDone then + Node.Value.Accept(Self); + if not FDone then + Node.Identifier.Accept(Self); end; function TAstTraverser.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; begin - Node.Left.Accept(Self); - Node.Right.Accept(Self); + if not FDone then + Node.Left.Accept(Self); + if not FDone then + Node.Right.Accept(Self); end; function TAstTraverser.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; @@ -1104,7 +1119,11 @@ var expr: IAstNode; begin for expr in Node.Expressions do + begin + if FDone then + break; expr.Accept(Self); + end; end; function TAstTraverser.VisitConstant(const Node: IConstantNode): TDataValue; @@ -1119,9 +1138,14 @@ function TAstTraverser.VisitFunctionCall(const Node: IFunctionCallNode): TDataVa var arg: IAstNode; begin - Node.Callee.Accept(Self); + if not FDone then + Node.Callee.Accept(Self); for arg in Node.Arguments do + begin + if FDone then + break; arg.Accept(Self); + end; end; function TAstTraverser.VisitIdentifier(const Node: IIdentifierNode): TDataValue; @@ -1130,16 +1154,21 @@ end; function TAstTraverser.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; begin - Node.Condition.Accept(Self); - Node.ThenBranch.Accept(Self); + if not FDone then + Node.Condition.Accept(Self); + if not FDone then + Node.ThenBranch.Accept(Self); if Assigned(Node.ElseBranch) then - Node.ElseBranch.Accept(Self); + if not FDone then + Node.ElseBranch.Accept(Self); end; function TAstTraverser.VisitIndexer(const Node: IIndexerNode): TDataValue; begin - Node.Base.Accept(Self); - Node.Index.Accept(Self); + if not FDone then + Node.Base.Accept(Self); + if not FDone then + Node.Index.Accept(Self); end; function TAstTraverser.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; @@ -1147,38 +1176,51 @@ var param: IIdentifierNode; begin for param in Node.Parameters do + begin + if FDone then + break; param.Accept(Self); - Node.Body.Accept(Self); + end; + if not FDone then + Node.Body.Accept(Self); end; function TAstTraverser.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; begin // Do not visit the member identifier, as it's not a variable in the current scope. - Node.Base.Accept(Self); + if not FDone then + Node.Base.Accept(Self); end; function TAstTraverser.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; begin - Node.Series.Accept(Self); + if not FDone then + Node.Series.Accept(Self); end; function TAstTraverser.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; begin - Node.Condition.Accept(Self); - Node.ThenBranch.Accept(Self); - Node.ElseBranch.Accept(Self); + if not FDone then + Node.Condition.Accept(Self); + if not FDone then + Node.ThenBranch.Accept(Self); + if not FDone then + Node.ElseBranch.Accept(Self); end; function TAstTraverser.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; begin - Node.Right.Accept(Self); + if not FDone then + Node.Right.Accept(Self); end; function TAstTraverser.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; begin if Assigned(Node.Initializer) then - Node.Initializer.Accept(Self); - Node.Identifier.Accept(Self); + if not FDone then + Node.Initializer.Accept(Self); + if not FDone then + Node.Identifier.Accept(Self); end; end. diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas index c9a4c05..9194d72 100644 --- a/Src/Data/Myc.Data.Value.pas +++ b/Src/Data/Myc.Data.Value.pas @@ -8,7 +8,7 @@ uses Myc.Data.Series; type - TDataValueKind = (vkVoid, vkScalar, vkInterface, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries, vkGeneric); + TDataValueKind = (vkVoid, vkScalar, vkInterface, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries, vkGeneric, vkMethod); TDataValue = record public @@ -17,6 +17,9 @@ type Value: T; constructor Create(const AValue: T); end; + + TFunc = reference to function(const ArgNodes: TArray): TDataValue; + private var FKind: TDataValueKind; @@ -30,7 +33,7 @@ type class operator Implicit(const AValue: TScalar): TDataValue; overload; inline; class operator Implicit(const AValue: String): TDataValue; overload; inline; - class operator Implicit(const AValue: IInterface): TDataValue; overload; inline; + class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline; class function From(const [ref] AValue: T): TDataValue; static; inline; function AsVal: TVal; inline; @@ -39,9 +42,11 @@ type class function FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TDataValue; static; inline; class function FromRecord(const [ref] AValue: TScalarRecord): TDataValue; static; inline; class function FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TDataValue; static; inline; + class function FromInterface(const [ref] AValue: IInterface): TDataValue; static; inline; function AsScalar: TScalar; inline; function AsInterface: IInterface; inline; + function AsMethod: TFunc; inline; function AsText: String; inline; function AsRecordSeries: TVal; inline; function AsRecord: TVal; inline; @@ -90,6 +95,13 @@ begin Result := TVal(FInterface); end; +function TDataValue.AsMethod: TFunc; +begin + if (FKind <> vkMethod) then + raise EInvalidCast.Create('Cannot read value as a method.'); + Result := TFunc(FInterface); +end; + function TDataValue.AsVal: TVal; begin if (FKind <> vkGeneric) then @@ -138,39 +150,34 @@ begin Result.FInterface := TVal.Create(AValue); end; +class function TDataValue.FromInterface(const [ref] AValue: IInterface): TDataValue; +begin + Result.FKind := vkInterface; + Result.FInterface := AValue; +end; + class function TDataValue.FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TDataValue; begin Result.FKind := vkMemberSeries; Result.FInterface := TVal.Create(AValue); - Result.FScalar := Default(TScalar); end; class function TDataValue.FromRecord(const [ref] AValue: TScalarRecord): TDataValue; begin Result.FKind := vkRecord; Result.FInterface := TVal.Create(AValue); - Result.FScalar := Default(TScalar); end; class function TDataValue.FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TDataValue; begin Result.FKind := vkRecordSeries; Result.FInterface := TVal.Create(AValue); - Result.FScalar := Default(TScalar); end; class function TDataValue.FromSeries(const [ref] AValue: TScalarSeries): TDataValue; begin Result.FKind := vkSeries; Result.FInterface := TVal.Create(AValue); - Result.FScalar := Default(TScalar); -end; - -class operator TDataValue.Implicit(const AValue: IInterface): TDataValue; -begin - Result.FKind := vkInterface; - Result.FInterface := AValue; - Result.FScalar := Default(TScalar); end; class operator TDataValue.Implicit(const AValue: TScalar): TDataValue; @@ -184,7 +191,6 @@ class operator TDataValue.Implicit(const AValue: String): TDataValue; begin Result.FKind := vkText; Result.FInterface := TVal.Create(AValue); - Result.FScalar := Default(TScalar); end; function TDataValue.GetIsVoid: Boolean; @@ -214,6 +220,8 @@ begin vkRecord: Result := ''; vkMemberSeries: Result := ''; vkVoid: Result := ''; + vkMethod: Result := ''; + vkGeneric: Result := ''; else Result := '[Unknown DataValue]'; end; @@ -224,4 +232,10 @@ begin Result := Default(TDataValue); end; +class operator TDataValue.Implicit(const AValue: TDataValue.TFunc): TDataValue; +begin + Result.FKind := vkMethod; + TFunc(Result.FInterface) := AValue; +end; + end.