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