Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Tail call optimization

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-19 11:53:16 +02:00
parent 9be22dea3a
commit abbce15362
11 changed files with 169 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.dproj
+1 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">ASTPlayground</ProjectName>
<TargetedPlatforms>2</TargetedPlatforms>
ASTPlayground/MainForm.fmx
+15 -7
View File
@@ -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
ASTPlayground/MainForm.pas
+61 -8
View File
@@ -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;
ASTPlayground/Myc.Fmx.AstEditor.Text.pas
+6
View File
@@ -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;
ASTPlayground/Myc.Fmx.AstEditor.pas
+6
View File
@@ -101,6 +101,7 @@ type
property Connections: TList<TPinConnection> 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
Src/AST/Myc.Ast.Debugger.pas
-17
View File
@@ -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<string>;
Src/AST/Myc.Ast.Evaluator.pas
+59 -19
View File
@@ -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<TDataValue>;
constructor Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>);
end;
constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>);
begin
Callee := ACallee;
Args := AArgs;
end;
// --- Native Functions Implementation ---
function NativeCreateRecordSeries(const Args: TArray<TDataValue>): 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<TThunk>;
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<TDataValue>;
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<TDataValue>;
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>(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;
Src/AST/Myc.Ast.JSON.pas
+6
View File
@@ -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);
Src/AST/Myc.Ast.Nodes.pas
+2
View File
@@ -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;
Src/AST/Myc.Ast.Printer.pas
+6
View File
@@ -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]));
Src/AST/Myc.Ast.Traverser.pas
+7
View File
@@ -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);