diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index 40c6112..434774a 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -4,7 +4,7 @@ 20.3 FMX True - Debug + Release Win64 ASTPlayground 2 diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index 0b78642..90e36cc 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 = 463.000000000000000000 + Position.Y = 479.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 = 436.000000000000000000 + Position.Y = 452.000000000000000000 TabOrder = 5 Text = 'Scope' end @@ -89,7 +89,7 @@ object Form1: TForm1 end object ClearButton: TButton Position.X = 24.000000000000000000 - Position.Y = 538.000000000000000000 + Position.Y = 554.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 = 423.000000000000000000 + Position.Y = 439.000000000000000000 TabOrder = 15 Text = 'Debug' end object FromJSONButton: TButton Position.X = 24.000000000000000000 - Position.Y = 586.000000000000000000 + Position.Y = 602.000000000000000000 TabOrder = 16 Text = 'From JSON' TextSettings.Trimming = None @@ -140,7 +140,7 @@ object Form1: TForm1 end object ToJSONButton: TButton Position.X = 24.000000000000000000 - Position.Y = 616.000000000000000000 + Position.Y = 632.000000000000000000 TabOrder = 17 Text = 'To JSON' TextSettings.Trimming = None @@ -164,7 +164,7 @@ object Form1: TForm1 end object DumpButton: TButton Position.X = 24.000000000000000000 - Position.Y = 493.000000000000000000 + Position.Y = 509.000000000000000000 TabOrder = 20 Text = 'Dump' TextSettings.Trimming = None @@ -178,6 +178,14 @@ object Form1: TForm1 TextSettings.Trimming = None OnClick = FailingUpvalueButtonClick end + object TailCallButten: TButton + Position.X = 24.000000000000000000 + Position.Y = 406.000000000000000000 + TabOrder = 23 + Text = 'Tail calls' + TextSettings.Trimming = None + OnClick = TailCallButtenClick + end end object Panel2: TPanel Align = Client diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 2d6bd21..5e10417 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -70,6 +70,7 @@ type InnerLambdaButton: TButton; DumpButton: TButton; FailingUpvalueButton: TButton; + TailCallButten: TButton; procedure InnerLambdaButtonClick(Sender: TObject); procedure ClearButtonClick(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -87,6 +88,7 @@ type procedure Test1ButtonClick(Sender: TObject); procedure Test2ButtonClick(Sender: TObject); procedure FromJSONButtonClick(Sender: TObject); + procedure TailCallButtenClick(Sender: TObject); procedure ToJSONButtonClick(Sender: TObject); private // Stores the last AST generated by Test1 or Test2 button clicks. @@ -182,7 +184,10 @@ begin resultValue := ExecuteAst(mainBlock, FGScope); - Assert(TScalar.FromInteger(15) = resultValue.AsScalar, 'The final result should be 15.'); + //TODO Dieses Assert löst aus: + // "The final result should be 15, but is 10 (T:\Myc\ASTPlayground\MainForm.pas, line 186)" + + Assert(TScalar.FromInteger(15) = resultValue.AsScalar, 'The final result should be 15, but is ' + resultValue.AsScalar.ToString); end; procedure TForm1.ClearButtonClick(Sender: TObject); @@ -201,7 +206,7 @@ begin // It binds the AST and then decides whether to run a debug session or a standard evaluation. var scriptScope := TAstBinder.Bind(ANode, AParentScope).CreateScope(AParentScope); var visitor := CreateVisitor(scriptScope); - Result := ANode.Accept(visitor); + Result := visitor.Execute(ANode); end; procedure TForm1.FormCreate(Sender: TObject); @@ -263,7 +268,7 @@ begin ) ); - Scope.Define('CreateSMA', smaAst.Accept(TEvaluatorVisitor.Create(TAstBinder.Bind(smaAst, FGScope).CreateScope(FGScope)))); + Scope.Define('CreateSMA', CreateVisitor(TAstBinder.Bind(smaAst, FGScope).CreateScope(FGScope)).Execute(smaAst)); end ); @@ -331,7 +336,7 @@ begin end; visitor := TPrettyPrintVisitor.Create; - FLastAst.Accept(visitor); + visitor.Execute(FLastAst); Memo1.Lines.Add(visitor.GetResult); end; @@ -635,7 +640,7 @@ begin // This is a temporary visitor just for the setup execution. var setupVisitor := CreateVisitor(scope); - setupAst.Accept(setupVisitor); + setupVisitor.Execute(setupAst); // 2. Prepare for the simulation loop by modifying the now-populated scope. scope.Define('current_series', TDataValue.Void); @@ -685,7 +690,7 @@ begin if series.AsRecordSeries.TotalCount >= smaSlowLength then begin scope[seriesAddress] := series; - var resultValue := callAst.Accept(visitor); + var resultValue := visitor.Execute(callAst); if i mod 50 = 0 then begin Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString])); @@ -726,7 +731,7 @@ begin // This case is simple enough to just inline the logic from ExecuteAst var visitor := CreateVisitor(TriggerScope); - blk.Accept(visitor); + visitor.Execute(blk); FLastAst := blk; @@ -737,7 +742,7 @@ end; function TForm1.CreateVisitor(Scope: IExecutionScope): IAstVisitor; begin if DebugBox.IsChecked then - Result := TDebugEvaluatorVisitor.CreateVisitor(Scope, Memo1.Lines, ShowScopeBox.IsChecked) + Result := TDebugEvaluatorVisitor.Create(Scope, Memo1.Lines, ShowScopeBox.IsChecked) else Result := TEvaluatorVisitor.Create(Scope); end; @@ -906,6 +911,54 @@ begin end; end; +procedure TForm1.TailCallButtenClick(Sender: TObject); +const + // A large number to prove TCO prevents stack overflow + RecursionDepth = 1000000; +var + root: IAstNode; + result: TDataValue; + sw: TStopwatch; +begin + Memo1.Lines.Clear; + Memo1.Lines.Add(Format('--- Testing TCO with recursion depth of %d ---', [RecursionDepth])); + Application.ProcessMessages; + sw := TStopwatch.StartNew; + + root := + TAst.Block( + [ + // var countDown = lambda(n) { ... }; + TAst.VarDecl( + TAst.Identifier('countDown'), + TAst.LambdaExpr( + [TAst.Identifier('n')], + // if (n > 0) then Self(n-1) else 'done' + TAst.IfExpr( + TAst.BinaryExpr(TAst.Identifier('n'), boGreater, TAst.Constant(TScalar.FromInt64(0))), + // This is the tail call position. + TAst.FunctionCall( + TAst.Identifier('Self'), + [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))] + ), + // Base case of the recursion + TAst.Constant(TScalar.FromString('done')) + ) + ) + ), + // Initial call to start the recursion + TAst.FunctionCall(TAst.Identifier('countDown'), [TAst.Constant(TScalar.FromInt64(RecursionDepth))]) + ] + ); + + FLastAst := root; + result := ExecuteAst(root, FGScope); + sw.Stop; + + Memo1.Lines.Add(Format('Result: %s', [result.ToString])); + Memo1.Lines.Add(Format('Execution finished in %d ms without stack overflow.', [sw.ElapsedMilliseconds])); +end; + procedure TForm1.ToJSONButtonClick(Sender: TObject); var jsonString: string; diff --git a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas index 2be0a5d..2037df3 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas @@ -13,6 +13,7 @@ type TAstToTextVisitor = class(TInterfacedObject, IAstVisitor) public { IAstVisitor } + function Execute(const RootNode: IAstNode): TDataValue; function VisitConstant(const Node: IConstantNode): TDataValue; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; @@ -33,6 +34,11 @@ type implementation +function TAstToTextVisitor.Execute(const RootNode: IAstNode): TDataValue; +begin + Result := RootNode.Accept(Self); +end; + { TAstToTextVisitor } function TAstToTextVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; diff --git a/ASTPlayground/Myc.Fmx.AstEditor.pas b/ASTPlayground/Myc.Fmx.AstEditor.pas index 9ab2aaa..73b643e 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.pas @@ -101,6 +101,7 @@ type property Connections: TList read FConnections; { IAstVisitor } + function Execute(const RootNode: IAstNode): TDataValue; function VisitConstant(const Node: IConstantNode): TDataValue; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; @@ -337,6 +338,11 @@ begin Result.TagString := Tag; end; +function TAstToAuraNodeVisitor.Execute(const RootNode: IAstNode): TDataValue; +begin + Result := RootNode.Accept(Self); +end; + function TAstToAuraNodeVisitor.TryGetDescr(const Node: IAstNode; out Text: String): Boolean; begin if FMode <> vmControlFlow then diff --git a/Src/AST/Myc.Ast.Debugger.pas b/Src/AST/Myc.Ast.Debugger.pas index 7d9fc53..e48667b 100644 --- a/Src/AST/Myc.Ast.Debugger.pas +++ b/Src/AST/Myc.Ast.Debugger.pas @@ -31,13 +31,6 @@ type public constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); - class function CreateVisitor( - const AScope: IExecutionScope; - ALog: TStrings; - AShowScope: Boolean; - AInitialIndent: Integer = 0 - ): IAstVisitor; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; // The logging overrides for other Visit... methods function VisitConstant(const Node: IConstantNode): TDataValue; override; @@ -121,16 +114,6 @@ begin FLog.Add(pad + S); end; -class function TDebugEvaluatorVisitor.CreateVisitor( - const AScope: IExecutionScope; - ALog: TStrings; - AShowScope: Boolean; - AInitialIndent: Integer = 0 -): IAstVisitor; -begin - Result := TDebugEvaluatorVisitor.Create(AScope, ALog, AShowScope, AInitialIndent); -end; - procedure TDebugEvaluatorVisitor.ShowScope; var scopeDump: TArray; diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 3354b65..9843db0 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -25,10 +25,15 @@ type // Returns a closure that can create the correct type of visitor for a lambda's body. function CreateVisitorFactory: TVisitorFactory; virtual; + procedure HandleTCO(var ResultValue: TDataValue); + property Scope: IExecutionScope read FScope; public constructor Create(const AScope: IExecutionScope); + // Executes an AST with proper TCO handling. This is the main entry point. + function Execute(const RootNode: IAstNode): TDataValue; + function VisitConstant(const Node: IConstantNode): TDataValue; virtual; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual; @@ -59,6 +64,20 @@ uses Myc.Data.Series, Myc.Data.Scalar.JSON; +// Helper type for TCO via trampolining. +type + TThunk = record + Callee: TDataValue; + Args: TArray; + constructor Create(const ACallee: TDataValue; const AArgs: TArray); + end; + +constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray); +begin + Callee := ACallee; + Args := AArgs; +end; + // --- Native Functions Implementation --- function NativeCreateRecordSeries(const Args: TArray): TDataValue; @@ -96,12 +115,33 @@ begin FScope := AScope; end; +function TEvaluatorVisitor.Execute(const RootNode: IAstNode): TDataValue; +begin + if not Assigned(RootNode) then + exit(TDataValue.Void); + + Result := RootNode.Accept(Self); + HandleTCO(Result); +end; + function TEvaluatorVisitor.CreateVisitorFactory: TVisitorFactory; begin // The production visitor returns a factory that creates another production visitor. Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end; end; +procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue); +begin + // This is the central trampoline loop for Tail Call Optimization. + // It runs as long as the evaluation returns a thunk. + while ResultValue.Kind = vkGeneric do + begin + var thunk := ResultValue.AsGeneric; + var callee := thunk.Callee.AsMethod(); + ResultValue := callee(thunk.Args); + end; +end; + function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean; begin if (AValue.Kind <> vkScalar) then @@ -188,31 +228,31 @@ end; function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; var calleeValue: TDataValue; - [weak] - callee: TDataValue.TFunc; + argValues: TArray; begin calleeValue := Node.Callee.Accept(Self); - - case calleeValue.Kind of - vkMethod: callee := calleeValue.AsMethod(); - else + if calleeValue.Kind <> vkMethod then raise EArgumentException.Create('Expression is not invokable in this context.'); - end; var argNodes := Node.Arguments; - case Length(argNodes) of - 0: Result := callee([]); - 1: Result := callee([argNodes[0].Accept(Self)]); - 2: Result := callee([argNodes[0].Accept(Self), argNodes[1].Accept(Self)]); - 3: Result := callee([argNodes[0].Accept(Self), argNodes[1].Accept(Self), argNodes[2].Accept(Self)]); - 4: Result := callee([argNodes[0].Accept(Self), argNodes[1].Accept(Self), argNodes[2].Accept(Self), argNodes[3].Accept(Self)]); - else - var argValues: TArray; - SetLength(argValues, Length(argNodes)); - for var i := 0 to High(argNodes) do - argValues[i] := argNodes[i].Accept(Self); + SetLength(argValues, Length(argNodes)); + for var i := 0 to High(argNodes) do + argValues[i] := argNodes[i].Accept(Self); - Result := callee(argValues); + if Node.IsTailCall then + begin + // This is a tail call. Return a thunk to be processed + // by an outer trampoline loop (either in Execute or a parent non-tail-call). + Result := TDataValue.FromGeneric(TThunk.Create(calleeValue, argValues)); + end + else + begin + // This is a non-tail call. It must execute the call and act as + // the trampoline for any subsequent tail calls it may trigger. + + Result := (calleeValue.AsMethod)(argValues); + + HandleTCO(Result); end; end; diff --git a/Src/AST/Myc.Ast.JSON.pas b/Src/AST/Myc.Ast.JSON.pas index 85ea878..d83127e 100644 --- a/Src/AST/Myc.Ast.JSON.pas +++ b/Src/AST/Myc.Ast.JSON.pas @@ -70,6 +70,7 @@ type public constructor Create; destructor Destroy; override; + function Execute(const RootNode: IAstNode): TDataValue; function Serialize(const ANode: IAstNode): string; function Deserialize(const AJson: string): IAstNode; end; @@ -127,6 +128,11 @@ begin end; end; +function TJsonAstConverter.Execute(const RootNode: IAstNode): TDataValue; +begin + Result := RootNode.Accept(Self); +end; + { TJsonAstConverter - IAstVisitor for Serialization } procedure TJsonAstConverter.ScalarToJson(const AScalar: TScalar; const AParent: TJSONObject; const AName: string); diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index a29bdee..e2e3a75 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -85,6 +85,8 @@ type end; IAstVisitor = interface + function Execute(const RootNode: IAstNode): TDataValue; + function VisitConstant(const Node: IConstantNode): TDataValue; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; diff --git a/Src/AST/Myc.Ast.Printer.pas b/Src/AST/Myc.Ast.Printer.pas index a0ccf70..ca3e61f 100644 --- a/Src/AST/Myc.Ast.Printer.pas +++ b/Src/AST/Myc.Ast.Printer.pas @@ -23,6 +23,7 @@ type destructor Destroy; override; function GetResult: string; // IAstVisitor + function Execute(const RootNode: IAstNode): TDataValue; function VisitConstant(const Node: IConstantNode): TDataValue; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; @@ -84,6 +85,11 @@ begin FBuilder.AppendLine(S); end; +function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue; +begin + Result := RootNode.Accept(Self); +end; + function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TDataValue; begin AppendLine(Format('Constant (%s)', [Node.Value.ToString])); diff --git a/Src/AST/Myc.Ast.Traverser.pas b/Src/AST/Myc.Ast.Traverser.pas index a958998..bf37e90 100644 --- a/Src/AST/Myc.Ast.Traverser.pas +++ b/Src/AST/Myc.Ast.Traverser.pas @@ -17,6 +17,8 @@ type function Accept(const Node: IAstNode): TDataValue; virtual; property Done: Boolean read FDone write FDone; public + function Execute(const RootNode: IAstNode): TDataValue; + function VisitConstant(const Node: IConstantNode): TDataValue; virtual; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual; @@ -62,6 +64,11 @@ begin Result := Node.Accept(Self); end; +function TAstTraverser.Execute(const RootNode: IAstNode): TDataValue; +begin + Result := RootNode.Accept(Self); +end; + function TAstTraverser.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; begin Accept(Node.Series);