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

Global data value refactoring + 1st scripting version

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-20 18:30:32 +02:00
parent 09bd25b318
commit 00f5861148
17 changed files with 1430 additions and 2742 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.pas
+199 -141
View File
@@ -31,6 +31,7 @@ uses
Myc.Data.Decimal,
Myc.Ast.Binding,
Myc.Ast.RTL,
Myc.Ast.Script,
FMX.Layouts,
FMX.Objects,
Myc.Ast.Debugger,
@@ -74,6 +75,9 @@ type
DumpButton: TButton;
FailingUpvalueButton: TButton;
TailCallButten: TButton;
Splitter1: TSplitter;
Splitter2: TSplitter;
ScriptMemo: TMemo;
procedure InnerLambdaButtonClick(Sender: TObject);
procedure ClearButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
@@ -84,6 +88,7 @@ type
procedure ExternalFuncButtonClick(Sender: TObject);
procedure FailingUpvalueButtonClick(Sender: TObject);
procedure FibonacciButtonClick(Sender: TObject);
procedure FlowOnlyBoxChange(Sender: TObject);
procedure OHLCButtonClick(Sender: TObject);
procedure PrettyPrintButtonClick(Sender: TObject);
procedure RecursionButtonClick(Sender: TObject);
@@ -91,6 +96,7 @@ type
procedure Test1ButtonClick(Sender: TObject);
procedure Test2ButtonClick(Sender: TObject);
procedure FromJSONButtonClick(Sender: TObject);
procedure ScriptMemoChange(Sender: TObject);
procedure TailCallButtenClick(Sender: TObject);
procedure ToJSONButtonClick(Sender: TObject);
private
@@ -98,10 +104,14 @@ type
FLastAst: IAstNode;
FGScope: IExecutionScope;
FWorkspace: TAuraWorkspace;
FTriggerScope: IExecutionScope;
FScriptUpdate: Boolean;
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
function CreateVisitor(Scope: IExecutionScope): IAstVisitor;
// Helper function to encapsulate the Bind -> Evaluate pattern
function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
procedure UpdateScript;
procedure ShowVizualization(X, Y: Single);
public
{ Public declarations }
end;
@@ -138,7 +148,7 @@ begin
TAst.Block(
[
// var x = 10;
TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(TScalar.FromInteger(10))),
TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(10)),
// var inner = lambda() { ... };
TAst.VarDecl(
TAst.Identifier('inner'),
@@ -154,11 +164,7 @@ begin
// x = x + 5;
TAst.Assign(
TAst.Identifier('x'),
TAst.BinaryExpr(
TAst.Identifier('x'),
boAdd,
TAst.Constant(TScalar.FromInteger(5))
)
TAst.BinaryExpr(TAst.Identifier('x'), TScalar.TBinaryOp.Add, TAst.Constant(5))
)
)
),
@@ -185,7 +191,8 @@ begin
resultValue := ExecuteAst(mainBlock, FGScope);
Assert(TScalar.FromInteger(15) = resultValue.AsScalar, 'The final result should be 15, but is ' + resultValue.AsScalar.ToString);
Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15, but is ' + resultValue.AsScalar.ToString);
UpdateScript;
end;
procedure TForm1.ClearButtonClick(Sender: TObject);
@@ -224,27 +231,31 @@ begin
[TAst.Identifier('len')],
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('sum'), TAst.Constant(TScalar.FromDouble(0.0))),
TAst.VarDecl(TAst.Identifier('count'), TAst.Constant(TScalar.FromInt64(0))),
TAst.VarDecl(TAst.Identifier('sum'), TAst.Constant(0.0)),
TAst.VarDecl(TAst.Identifier('count'), TAst.Constant(0)),
TAst.LambdaExpr(
[TAst.Identifier('series'), TAst.Identifier('val')],
TAst.Block(
[
TAst.Assign(
TAst.Identifier('sum'),
TAst.BinaryExpr(TAst.Identifier('sum'), boAdd, TAst.Identifier('val'))
TAst.BinaryExpr(TAst.Identifier('sum'), TScalar.TBinaryOp.Add, TAst.Identifier('val'))
),
TAst.Assign(
TAst.Identifier('count'),
TAst.BinaryExpr(TAst.Identifier('count'), boAdd, TAst.Constant(TScalar.FromInt64(1)))
TAst.BinaryExpr(TAst.Identifier('count'), TScalar.TBinaryOp.Add, TAst.Constant(1))
),
TAst.Assign(
TAst.Identifier('sum'),
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')),
TAst.BinaryExpr(
TAst.Identifier('count'),
TScalar.TBinaryOp.Greater,
TAst.Identifier('len')
),
TAst.BinaryExpr(
TAst.Identifier('sum'),
boSubtract,
TScalar.TBinaryOp.Subtract,
TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len'))
),
TAst.Identifier('sum')
@@ -252,9 +263,9 @@ begin
),
TAst.BinaryExpr(
TAst.Identifier('sum'),
boDivide,
TScalar.TBinaryOp.Divide,
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('count'), boLess, TAst.Identifier('len')),
TAst.BinaryExpr(TAst.Identifier('count'), TScalar.TBinaryOp.Less, TAst.Identifier('len')),
TAst.Identifier('count'),
TAst.Identifier('len')
)
@@ -280,7 +291,7 @@ var
result: TDataValue;
sw: TStopwatch;
begin
// This script defines a naive, slow recursive 'fib' function.
// This script defines a naive, slow recursive 'fib' function (on purpose!).
// The lambda captures its own name ('fib') from the parent scope to perform recursion.
var fibAst :=
TAst.Block(
@@ -293,19 +304,19 @@ begin
TAst.LambdaExpr(
[TAst.Identifier('n')],
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Less, TAst.Constant(2)),
TAst.Identifier('n'),
TAst.BinaryExpr(
// Naive recursive call using the variable name 'fib'
TAst.FunctionCall(
TAst.Identifier('fib'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
[TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))]
),
boAdd,
TScalar.TBinaryOp.Add,
// Second naive recursive call
TAst.FunctionCall(
TAst.Identifier('fib'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(2)))]
[TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(2))]
)
)
)
@@ -324,9 +335,10 @@ begin
sw := TStopwatch.StartNew;
// The script to execute is just the call to the function.
root := TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TScalar.FromInt64(25))]);
root := TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]);
FLastAst := root;
// Execute within the scope where 'fib' is defined.
result := ExecuteAst(root, fibScope);
@@ -343,7 +355,7 @@ begin
// Create a memoized version by calling the RTL function on 'fib'
TAst.Assign(TAst.Identifier('fib'), TAst.FunctionCall(TAst.Identifier('Memoize'), [TAst.Identifier('fib')])),
// Call the new, memoized function
TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TScalar.FromInt64(25))])
TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)])
]
);
@@ -352,6 +364,7 @@ begin
sw.Stop;
Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
UpdateScript;
end;
procedure TForm1.PrettyPrintButtonClick(Sender: TObject);
@@ -392,12 +405,12 @@ begin
TAst.LambdaExpr(
[TAst.Identifier('n'), TAst.Identifier('acc')],
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLessOrEqual, TAst.Constant(TScalar.FromInt64(1))),
TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.LessOrEqual, TAst.Constant(1)),
TAst.Identifier('acc'), // Base case: return the accumulator
TAst.Recur( // Tail-recursive step
[
TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1))),
TAst.BinaryExpr(TAst.Identifier('acc'), boMultiply, TAst.Identifier('n'))
TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1)),
TAst.BinaryExpr(TAst.Identifier('acc'), TScalar.TBinaryOp.Multiply, TAst.Identifier('n'))
]
)
)
@@ -408,11 +421,11 @@ begin
TAst.Identifier('factorial'),
TAst.LambdaExpr(
[TAst.Identifier('n')],
TAst.FunctionCall(TAst.Identifier('fact_iter'), [TAst.Identifier('n'), TAst.Constant(TScalar.FromInt64(1))])
TAst.FunctionCall(TAst.Identifier('fact_iter'), [TAst.Identifier('n'), TAst.Constant(1)])
)
),
// Call the main function
TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(TScalar.FromInt64(20))])
TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(20)])
]
);
@@ -422,6 +435,7 @@ begin
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
UpdateScript;
end;
procedure TForm1.SeriesTestButtonClick(Sender: TObject);
@@ -432,6 +446,7 @@ var
recordDef: TScalarRecordDefinition;
i: Integer;
scope: IExecutionScope;
values: TArray<TScalar.TValue>;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Series Test ---');
@@ -439,21 +454,19 @@ begin
scope := TAst.CreateScope(FGScope);
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
series := TScalarRecordSeries.Create(recordDef);
SetLength(values, 6);
for i := 0 to 4 do
begin
series.Add(
TScalarRecord.Create(
recordDef,
[
TScalarValue.FromDateTime(Now + i),
TScalarValue.FromDouble(100.0 + i),
TScalarValue.FromDouble(105.0 + i),
TScalarValue.FromDouble(98.0 + i),
TScalarValue.FromDouble(102.0 + i),
TScalarValue.FromInt64(10000 * (i + 1))
]
)
);
// TScalar can no longer hold TDateTime, convert to Int64 for the test.
values[0].AsInt64 := Round((Now + i) * 24 * 60 * 60 * 1000);
values[1].AsDouble := 100.0 + i;
values[2].AsDouble := 105.0 + i;
values[3].AsDouble := 98.0 + i;
values[4].AsDouble := 102.0 + i;
values[5].AsInt64 := 10000 * (i + 1);
series.Add(TScalarRecord.Create(recordDef, values));
end;
scope.Define('ohlcvSeries', TDataValue.FromRecordSeries(series));
@@ -466,7 +479,7 @@ begin
TAst.Identifier('closeColumn'),
TAst.MemberAccess(TAst.Identifier('ohlcvSeries'), TAst.Identifier('Close'))
),
TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(TScalar.FromInt64(1)))
TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(1))
]
)
);
@@ -476,6 +489,7 @@ begin
resultValue := ExecuteAst(callAst, scope);
Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString]));
UpdateScript;
end;
procedure TForm1.Test1ButtonClick(Sender: TObject);
@@ -493,12 +507,9 @@ begin
[],
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TScalar.FromInt64(10))),
TAst.VarDecl(
TAst.Identifier('b'),
TAst.BinaryExpr(TAst.Identifier('a'), boMultiply, TAst.Constant(TScalar.FromInt64(2)))
),
TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Identifier('b'))
TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)),
TAst.VarDecl(TAst.Identifier('b'), TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Multiply, TAst.Constant(2))),
TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Add, TAst.Identifier('b'))
]
)
);
@@ -509,6 +520,7 @@ begin
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
UpdateScript;
end;
procedure TForm1.Test2ButtonClick(Sender: TObject);
@@ -530,14 +542,14 @@ begin
[TAst.Identifier('offset')],
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(TScalar.FromInt64(100))),
TAst.BinaryExpr(TAst.Identifier('baseValue'), boAdd, TAst.Identifier('offset'))
TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(100)),
TAst.BinaryExpr(TAst.Identifier('baseValue'), TScalar.TBinaryOp.Add, TAst.Identifier('offset'))
]
)
)
),
TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TScalar.FromInt64(20))]),
TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TScalar.FromInt64(55))])
TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(20)]),
TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(55)])
]
);
@@ -546,6 +558,7 @@ begin
sw.Stop;
Memo1.Lines.Add(Format('Result of the final expression: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
UpdateScript;
end;
procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
@@ -553,15 +566,7 @@ begin
if Button <> TMouseButton.mbMiddle then
exit;
if FLastAst <> nil then
begin
var visu := TVisualizationMode.vmDetailed;
if FlowOnlyBox.IsChecked then
visu := TVisualizationMode.vmControlFlow;
var descr := TAstBinder.Bind(FLastAst, FGScope);
FWorkspace.BuildTree(FLastAst, descr.CreateScope(FGScope), TPointF.Create(X, Y), visu);
end;
ShowVizualization(X, Y);
end;
procedure TForm1.OHLCButtonClick(Sender: TObject);
@@ -572,6 +577,8 @@ const
smaFastLength = 10;
var
scope: IExecutionScope;
values: TArray<TScalar.TValue>;
recordValue: TScalarRecord;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs]));
@@ -579,14 +586,8 @@ begin
var setupAst :=
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('smaFast'),
TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaFastLength))])
),
TAst.VarDecl(
TAst.Identifier('smaSlow'),
TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(TScalar.FromInt64(smaSlowLength))])
),
TAst.VarDecl(TAst.Identifier('smaFast'), TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(smaFastLength)])),
TAst.VarDecl(TAst.Identifier('smaSlow'), TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(smaSlowLength)])),
TAst.VarDecl(
TAst.Identifier('maCrossStrategy'),
TAst.LambdaExpr(
@@ -599,7 +600,7 @@ begin
),
TAst.VarDecl(
TAst.Identifier('currentClose'),
TAst.Indexer(TAst.Identifier('closeSeries'), TAst.Constant(TScalar.FromInt64(0)))
TAst.Indexer(TAst.Identifier('closeSeries'), TAst.Constant(0))
),
TAst.VarDecl(
TAst.Identifier('valSmaFast'),
@@ -616,9 +617,13 @@ begin
)
),
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('valSmaFast'), boGreater, TAst.Identifier('valSmaSlow')),
TAst.Constant(TScalar.FromInt64(1)),
TAst.Constant(TScalar.FromInt64(-1))
TAst.BinaryExpr(
TAst.Identifier('valSmaFast'),
TScalar.TBinaryOp.Greater,
TAst.Identifier('valSmaSlow')
),
TAst.Constant(1),
TAst.Constant(-1)
)
]
)
@@ -658,7 +663,6 @@ begin
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;
@@ -666,18 +670,16 @@ begin
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)
]
);
SetLength(values, 6);
values[0].AsDouble := ohlcvRec.Timestamp;
values[1].AsDouble := ohlcvRec.Open;
values[2].AsDouble := ohlcvRec.High;
values[3].AsDouble := ohlcvRec.Low;
values[4].AsDouble := ohlcvRec.Close;
values[5].AsInt64 := ohlcvRec.Volume;
recordValue := TScalarRecord.Create(recDef, values);
series.AsRecordSeries.Add(recordValue, lookback);
if series.AsRecordSeries.TotalCount >= smaSlowLength then
@@ -695,10 +697,54 @@ begin
sw.Stop;
Memo1.Lines.Add('--- Simulation Finished ---');
Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds]));
UpdateScript;
end;
procedure TForm1.TailCallButtenClick(Sender: TObject);
const
// A large number to prove TCO prevents stack overflow
RecursionDepth = 1000000;
var
TriggerScope: IExecutionScope;
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 recur(n-1) else 0
TAst.IfExpr(
TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Greater, TAst.Constant(0)),
// This is the tail call position, now using recur.
TAst.Recur([TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))]),
// Base case of the recursion returns 0
TAst.Constant(0)
)
)
),
// Initial call to start the recursion
TAst.FunctionCall(TAst.Identifier('countDown'), [TAst.Constant(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]));
UpdateScript;
end;
procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject);
var
@@ -709,27 +755,31 @@ begin
blk :=
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(0))),
TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(0)),
TAst.VarDecl(
TAst.Identifier('tickHandler'),
TAst.LambdaExpr(
[TAst.Identifier('summand')],
TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand')))
TAst.Assign(
TAst.Identifier('X'),
TAst.BinaryExpr(TAst.Identifier('X'), TScalar.TBinaryOp.Add, TAst.Identifier('summand'))
)
)
)
]
);
TriggerScope := TAstBinder.Bind(blk, FGScope).CreateScope(FGScope);
FTriggerScope := TAstBinder.Bind(blk, FGScope).CreateScope(FGScope);
// This case is simple enough to just inline the logic from ExecuteAst
var visitor := CreateVisitor(TriggerScope);
var visitor := CreateVisitor(FTriggerScope);
visitor.Execute(blk);
FLastAst := blk;
Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.');
Memo1.Lines.Add('Click "Do Trigger" to execute.');
UpdateScript;
end;
function TForm1.CreateVisitor(Scope: IExecutionScope): IAstVisitor;
@@ -744,24 +794,26 @@ procedure TForm1.DoTriggerButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]);
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(1)]);
FLastAst := callAst;
var X := ExecuteAst(callAst, TriggerScope);
var X := ExecuteAst(callAst, FTriggerScope);
Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [X.ToString]));
UpdateScript;
end;
procedure TForm1.DoTrigger2ButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]);
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(2)]);
FLastAst := callAst;
var X := ExecuteAst(callAst, TriggerScope);
var X := ExecuteAst(callAst, FTriggerScope);
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString]));
UpdateScript;
end;
procedure TForm1.DumpButtonClick(Sender: TObject);
@@ -804,12 +856,12 @@ begin
end
);
callAst :=
TAst.FunctionCall(TAst.Identifier('delphiAdd'), [TAst.Constant(TScalar.FromInt64(100)), TAst.Constant(TScalar.FromInt64(23))]);
callAst := TAst.FunctionCall(TAst.Identifier('delphiAdd'), [TAst.Constant(100), TAst.Constant(123)]);
FLastAst := callAst;
resultValue := ExecuteAst(callAst, scope);
Memo1.Lines.Add(Format('Result from delphiAdd(100, 23): %s', [resultValue.ToString]));
Memo1.Lines.Add(Format('Result from delphiAdd(100, 123): %s', [resultValue.ToString]));
UpdateScript;
end;
procedure TForm1.FailingUpvalueButtonClick(Sender: TObject);
@@ -821,7 +873,7 @@ begin
TAst.Block(
[
// 1. Define the shared variable.
TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TScalar.FromInt64(10))),
TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)),
// 2. Define a function that returns a closure that MODIFIES 'a'.
// This creates the multi-level capture scenario.
TAst.VarDecl(
@@ -832,7 +884,7 @@ begin
[], // Inner closure that is returned
TAst.Assign(
TAst.Identifier('a'),
TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Constant(TScalar.FromInt64(5)))
TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Add, TAst.Constant(5))
)
)
)
@@ -866,8 +918,14 @@ begin
Memo1.Lines.Add(Format('FAILURE: Expected 15, but got %s.', [resultValue.ToString]));
end;
Assert(TScalar.FromInteger(15) = resultValue.AsScalar, 'The final result should be 15.');
Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15.');
Memo1.Lines.Add('Please check the new dump.');
UpdateScript;
end;
procedure TForm1.FlowOnlyBoxChange(Sender: TObject);
begin
UpdateScript;
end;
procedure TForm1.FromJSONButtonClick(Sender: TObject);
@@ -902,51 +960,20 @@ begin
finally
Memo1.Lines.EndUpdate;
end;
UpdateScript;
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;
procedure TForm1.ScriptMemoChange(Sender: TObject);
begin
Memo1.Lines.Clear;
Memo1.Lines.Add(Format('--- Testing TCO with recursion depth of %d ---', [RecursionDepth]));
Application.ProcessMessages;
sw := TStopwatch.StartNew;
if FScriptUpdate then
exit;
root :=
TAst.Block(
[
// var countDown = lambda(n) { ... };
TAst.VarDecl(
TAst.Identifier('countDown'),
TAst.LambdaExpr(
[TAst.Identifier('n')],
// if (n > 0) then recur(n-1) else 'done'
TAst.IfExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boGreater, TAst.Constant(TScalar.FromInt64(0))),
// This is the tail call position, now using recur.
TAst.Recur([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]));
try
FLastAst := TAstScript.Parse(ScriptMemo.Lines.Text)
except
on E: Exception do
Memo1.Lines.Add(E.Message);
end;
end;
procedure TForm1.ToJSONButtonClick(Sender: TObject);
@@ -973,4 +1000,35 @@ begin
end;
end;
procedure TForm1.UpdateScript;
begin
try
FScriptUpdate := true;
try
ScriptMemo.Lines.Text := TAstScript.Print(FLastAst);
finally
FScriptUpdate := false;
end;
except
on E: Exception do
ScriptMemo.Lines.Add(E.Message);
end;
FWorkspace.DeleteChildren;
ShowVizualization(14, 14);
end;
procedure TForm1.ShowVizualization(X, Y: Single);
begin
if FLastAst <> nil then
begin
var visu := TVisualizationMode.vmDetailed;
if FlowOnlyBox.IsChecked then
visu := TVisualizationMode.vmControlFlow;
var descr := TAstBinder.Bind(FLastAst, FGScope);
FWorkspace.BuildTree(FLastAst, descr.CreateScope(FGScope), TPointF.Create(X, Y), visu);
end;
end;
end.