This commit is contained in:
Michael Schimmel
2025-09-04 17:33:10 +02:00
parent 9c90a92b04
commit faa447fd91
7 changed files with 411 additions and 378 deletions
+118 -188
View File
@@ -48,7 +48,6 @@ type
Test1Button: TButton;
Test2Button: TButton;
PrettyPrintButton: TButton;
DebugButton: TButton;
RecursionButton: TButton;
ShowScopeBox: TCheckBox;
FibonacciButton: TButton;
@@ -63,8 +62,7 @@ type
DebugBox: TCheckBox;
procedure ClearButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CrerateTriggerExampleButtonClick(Sender: TObject);
procedure DebugButtonClick(Sender: TObject);
procedure CreateTriggerExampleButtonClick(Sender: TObject);
procedure DoTrigger2ButtonClick(Sender: TObject);
procedure DoTriggerButtonClick(Sender: TObject);
procedure FibonacciButtonClick(Sender: TObject);
@@ -82,7 +80,7 @@ type
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
function ExecuteAst(const ANode: IExpressionNode; const AScope: IExecutionScope): TAstValue;
function ExecuteAst(const ANode: IExpressionNode; const AParentScope: IExecutionScope): TAstValue;
public
{ Public declarations }
end;
@@ -104,6 +102,10 @@ procedure TForm1.ClearButtonClick(Sender: TObject);
begin
FWorkspace.DeleteChildren;
FWorkspace.Repaint;
// Create and prepare the global scope once
FGScope := TExecutionScope.Create(nil);
RegisterNativeFunctions(FGScope);
end;
function TForm1.CreateVisitor(const AScope: IExecutionScope): IAstVisitor;
@@ -118,14 +120,19 @@ begin
Result := TEvaluatorVisitor.Create(AScope);
end;
function TForm1.ExecuteAst(const ANode: IExpressionNode; const AScope: IExecutionScope): TAstValue;
function TForm1.ExecuteAst(const ANode: IExpressionNode; const AParentScope: IExecutionScope): TAstValue;
var
scriptDescriptor: IScopeDescriptor;
scriptScope: IExecutionScope;
begin
// STEP 1: BIND
// The binder uses the provided scope to know about native functions etc.
TAst.Bind(ANode, AScope);
// STEP 1: BIND and get the descriptor for the script's local variables.
scriptDescriptor := TAst.Bind(ANode, AParentScope);
// STEP 2: EVALUATE
var visitor := CreateVisitor(AScope);
// STEP 2: CREATE the correctly-sized execution scope for the script.
scriptScope := scriptDescriptor.Instantiate(AParentScope);
// STEP 3: EVALUATE using the new, correctly-sized scope.
var visitor := CreateVisitor(scriptScope);
Result := ANode.Accept(visitor);
end;
@@ -138,41 +145,7 @@ begin
FWorkspace.OnMouseDown := WorkspaceMouseDown;
// Create and prepare the global scope once
FGScope := TExecutionScope.Create(nil);
RegisterNativeFunctions(FGScope);
end;
procedure TForm1.DebugButtonClick(Sender: TObject);
var
scope: IExecutionScope;
visitor: IAstVisitor;
result: TAstValue;
sw: TStopwatch;
begin
if not Assigned(FLastAst) then
begin
Memo1.Lines.Add('No AST has been generated yet.');
exit;
end;
scope := TExecutionScope.Create(FGScope);
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Debug Evaluator Trace ---');
// Manually bind and evaluate to use the debug visitor
TAst.Bind(FLastAst, scope);
visitor := TDebugEvaluatorVisitor.Create(scope, Memo1.Lines, ShowScopeBox.IsChecked, 0);
sw := TStopwatch.StartNew;
result := FLastAst.Accept(visitor);
sw.Stop;
Memo1.Lines.Add('-----------------------------');
Memo1.Lines.Add(Format('Final script result: %s', [result.ToString]));
Memo1.Lines.Add(Format('Execution time: %d ms', [sw.ElapsedMilliseconds]));
ClearButtonClick(Self);
end;
procedure TForm1.FibonacciButtonClick(Sender: TObject);
@@ -180,7 +153,6 @@ var
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Recursive fib with AST---');
@@ -215,9 +187,8 @@ begin
);
FLastAst := root;
scope := TExecutionScope.Create(nil); // No global scope needed for this pure function
result := ExecuteAst(root, scope);
// Execute with nil as parent scope
result := ExecuteAst(root, nil);
sw.Stop;
Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -246,7 +217,6 @@ var
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Recursive factorial(20) ---');
@@ -278,9 +248,8 @@ begin
);
FLastAst := root;
scope := TExecutionScope.Create(nil);
result := ExecuteAst(root, scope);
// Execute with nil as parent scope
result := ExecuteAst(root, nil);
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -300,7 +269,7 @@ begin
// 1. Arrange: Create a new scope and populate it with Delphi data
scope := TExecutionScope.Create(FGScope); // Inherits native functions
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV)));
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
series := TScalarRecordSeries.Create(recordDef);
for i := 0 to 4 do
begin
@@ -348,7 +317,6 @@ var
main, callAst: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Simple AST Execution ---');
@@ -371,9 +339,8 @@ begin
FLastAst := main;
callAst := TAst.FunctionCall(main, []);
scope := TExecutionScope.Create(FGScope);
result := ExecuteAst(callAst, scope);
// Execute with FGScope as parent
result := ExecuteAst(callAst, FGScope);
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -384,7 +351,6 @@ var
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Factory Pattern Demo ---');
@@ -411,100 +377,13 @@ begin
);
FLastAst := root;
scope := TExecutionScope.Create(FGScope);
result := ExecuteAst(root, scope);
// Execute with FGScope as parent
result := ExecuteAst(root, FGScope);
sw.Stop;
Memo1.Lines.Add(Format('Result of the final expression: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
end;
procedure TForm1.CrerateTriggerExampleButtonClick(Sender: TObject);
var
blk: IExpressionNode;
begin
// This button now only creates the AST. The persistent scope is managed by FGScope.
FGScope.Clear;
RegisterNativeFunctions(FGScope); // Re-register natives after clearing
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
blk :=
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(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')))
)
)
]
);
// Bind and execute the setup block against the persistent global scope
ExecuteAst(blk, FGScope);
FLastAst := blk; // Store for visualization
Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.');
Memo1.Lines.Add('Click "Do Trigger" to execute.');
end;
procedure TForm1.DoTriggerButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
currentValue: TAstValue;
depth, index: Integer;
identAst: IIdentifierNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]);
FLastAst := callAst;
// Bind and execute the call against the persistent scope
ExecuteAst(callAst, FGScope);
// To get the value of 'X', we first need to bind an identifier for it
// so we know its location.
identAst := TAst.Identifier('X');
TAst.Bind(identAst, FGScope);
if identAst.Resolve(depth, index) then
begin
currentValue := FGScope.GetValue(depth, index);
Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [currentValue.ToString]));
end
else
Memo1.Lines.Add('Error: Variable "X" not found in scope.');
end;
procedure TForm1.DoTrigger2ButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
currentValue: TAstValue;
depth, index: Integer;
identAst: IIdentifierNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]);
FLastAst := callAst;
// Bind and execute the call against the persistent scope
ExecuteAst(callAst, FGScope);
// Inspection requires binding an identifier for 'X'
identAst := TAst.Identifier('X');
TAst.Bind(identAst, FGScope);
if identAst.Resolve(depth, index) then
begin
currentValue := FGScope.GetValue(depth, index);
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [currentValue.ToString]));
end
else
Memo1.Lines.Add('Error: Variable "X" not found in scope.');
end;
procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if Button <> TMouseButton.mbMiddle then
@@ -525,28 +404,15 @@ const
lookback = 100;
smaSlowLength = 50;
smaFastLength = 20;
var
recordDef: TScalarRecordDefinition;
series: TScalarRecordSeries;
setupAst, callAst: IExpressionNode;
visitor: IAstVisitor;
i, depth, index: Integer;
lastClose: Double;
ohlcvRec: TOHLCV;
recordValue: TScalarRecord;
resultValue: TAstValue;
sw: TStopwatch;
currentSeriesIdent: IIdentifierNode;
begin
// 1. Setup
Memo1.Lines.Clear;
Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs]));
FGScope.Clear;
RegisterNativeFunctions(FGScope);
sw := TStopwatch.StartNew;
var sw := TStopwatch.StartNew;
// 2. Create the setup AST with the strategy logic
setupAst :=
var setupAst :=
TAst.Block(
[
TAst.VarDecl(
@@ -645,37 +511,35 @@ begin
]
);
FLastAst := setupAst;
// Bind and execute the setup script once.
ExecuteAst(setupAst, FGScope);
// 3. Prepare for the simulation loop
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV)));
series := TScalarRecordSeries.Create(recordDef);
visitor := CreateVisitor(FGScope);
var scope := TAst.Bind(setupAst, FGScope).Instantiate(FGScope);
setupAst.Accept(CreateVisitor(scope));
// Declare the series variable in the scope BEFORE binding the call AST
FGScope.Define('current_series', TAstValue.Void);
scope.Define('current_series', TAstValue.Void);
// Create the call AST that will be executed in the loop
currentSeriesIdent := TAst.Identifier('current_series');
callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
var currentSeriesIdent := TAst.Identifier('current_series');
var callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
// Bind the call AST once, before the loop.
TAst.Bind(callAst, FGScope);
// Get the resolved address of 'current_series' for fast updates
if not currentSeriesIdent.Resolve(depth, index) then
raise EInvalidOpException.Create('Could not resolve loop variable ''current_series''.');
scope := TAst.Bind(callAst, scope).Instantiate(scope);
var visitor := CreateVisitor(scope);
// 4. Simulation Loop
Memo1.Lines.Add('Starting simulation...');
Application.ProcessMessages;
lastClose := 1000.0;
var lastClose := 1000.0;
Randomize;
var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
var series := TAstValue.FromRecordSeries(TScalarRecordSeries.Create(recDef));
var seriesAddress := currentSeriesIdent.Resolve;
var nw := Now;
for i := 1 to numRecs do
var ohlcvRec: TOHLCV;
for var i := 1 to numRecs do
begin
ohlcvRec.Timestamp := nw + (i / (24 * 60));
ohlcvRec.Open := lastClose + (Random * 0.05);
@@ -685,9 +549,9 @@ begin
ohlcvRec.Volume := RandomRange(1000, 50000);
lastClose := ohlcvRec.Close;
recordValue :=
var recordValue :=
TScalarRecord.Create(
recordDef,
recDef,
[
TScalarValue.FromDateTime(ohlcvRec.Timestamp),
TScalarValue.FromDouble(ohlcvRec.Open),
@@ -698,18 +562,21 @@ begin
]
);
series.Add(recordValue, lookback);
series.AsRecordSeries.Value.Add(recordValue, lookback);
if series.TotalCount >= smaSlowLength then
if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then
begin
// Update the 'current_series' value in the scope using the FAST index-based assignment
FGScope.AssignValue(depth, index, TAstValue.FromRecordSeries(series));
scope.AssignValue(seriesAddress, series);
// Execute the PRE-BOUND call AST
resultValue := callAst.Accept(visitor);
var resultValue := callAst.Accept(visitor);
// Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
// Application.ProcessMessages;
if i < smaSlowLength + 50 then
begin
Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
Application.ProcessMessages;
end;
end;
end;
@@ -718,4 +585,67 @@ begin
Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds]));
end;
var
TriggerScope: IExecutionScope;
procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject);
var
blk: IExpressionNode;
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(
[
TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(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')))
)
)
]
);
TriggerScope := TAst.Bind(blk, FGScope).Instantiate(FGScope);
blk.Accept(CreateVisitor(TriggerScope));
FLastAst := blk; // Store for visualization
Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.');
Memo1.Lines.Add('Click "Do Trigger" to execute.');
end;
procedure TForm1.DoTriggerButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]);
FLastAst := callAst;
// Bind and execute the call against the persistent scope
var X := ExecuteAst(callAst, TriggerScope);
Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [X.ToString]));
end;
procedure TForm1.DoTrigger2ButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
currentValue: TAstValue;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]);
FLastAst := callAst;
// Bind and execute the call against the persistent scope
var X := ExecuteAst(callAst, TriggerScope);
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString]));
end;
end.