Files
MycLib/ASTPlayground/MainForm.pas
T
Michael Schimmel bb74d408da Binding
2025-09-04 19:50:05 +02:00

652 lines
24 KiB
ObjectPascal

unit MainForm;
interface
uses
System.SysUtils,
System.Types,
System.TypInfo,
System.UITypes,
System.Classes,
System.Variants,
System.Generics.Collections,
System.Math,
FMX.Types,
FMX.Controls,
FMX.Forms,
FMX.Graphics,
FMX.Dialogs,
FMX.Memo.Types,
FMX.StdCtrls,
FMX.ScrollBox,
FMX.Memo,
FMX.Controls.Presentation,
Myc.Ast.Visualizer,
Myc.Data.Scalar,
Myc.Ast.Nodes,
Myc.Ast,
Myc.Ast.Evaluator,
Myc.Ast.Printer,
FMX.Layouts,
FMX.Objects,
Myc.Ast.Scope; // Added for TExecutionScope
type
// A test record
TOHLCV = record
Timestamp: TDateTime;
Open: Double;
High: Double;
Low: Double;
Close: Double;
Volume: Int64;
end;
TForm1 = class(TForm)
Panel1: TPanel;
Memo1: TMemo;
Test1Button: TButton;
Test2Button: TButton;
PrettyPrintButton: TButton;
RecursionButton: TButton;
ShowScopeBox: TCheckBox;
FibonacciButton: TButton;
CrerateTriggerExampleButton: TButton;
DoTriggerButton: TButton;
DoTrigger2Button: TButton;
Panel2: TPanel;
ClearButton: TButton;
FlowOnlyBox: TCheckBox;
SeriesTestButton: TButton;
OHLCButton: TButton;
DebugBox: TCheckBox;
procedure ClearButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CreateTriggerExampleButtonClick(Sender: TObject);
procedure DoTrigger2ButtonClick(Sender: TObject);
procedure DoTriggerButtonClick(Sender: TObject);
procedure FibonacciButtonClick(Sender: TObject);
procedure OHLCButtonClick(Sender: TObject);
procedure PrettyPrintButtonClick(Sender: TObject);
procedure RecursionButtonClick(Sender: TObject);
procedure SeriesTestButtonClick(Sender: TObject);
procedure Test1ButtonClick(Sender: TObject);
procedure Test2ButtonClick(Sender: TObject);
private
// Stores the last AST generated by Test1 or Test2 button clicks.
FLastAst: IExpressionNode;
FGScope: IExecutionScope;
FWorkspace: TAuraWorkspace;
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 AParentScope: IExecutionScope): TAstValue;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
// Myc.Ast.Scope is now in the interface uses
Myc.Data.Scalar.JSON,
Myc.Data.Decimal,
System.Diagnostics; // For TStopwatch
{$R *.fmx}
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;
begin
// Conditionally create a debug visitor if the checkbox is checked.
if DebugBox.IsChecked then
begin
Memo1.Lines.Add('--- Creating DEBUG visitor ---');
Result := TDebugEvaluatorVisitor.Create(AScope, Memo1.Lines, ShowScopeBox.IsChecked);
end
else
Result := TEvaluatorVisitor.Create(AScope);
end;
function TForm1.ExecuteAst(const ANode: IExpressionNode; const AParentScope: IExecutionScope): TAstValue;
var
scriptDescriptor: IScopeDescriptor;
scriptScope: IExecutionScope;
begin
// STEP 1: BIND and get the descriptor for the script's local variables.
scriptDescriptor := TAst.Bind(ANode, AParentScope);
// 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;
procedure TForm1.FormCreate(Sender: TObject);
begin
FWorkspace := TAuraWorkspace.Create(Panel2);
FWorkspace.Parent := Panel2;
FWorkspace.Align := TAlignLayout.Client;
FWorkspace.ClipChildren := true;
FWorkspace.OnMouseDown := WorkspaceMouseDown;
ClearButtonClick(Self);
end;
procedure TForm1.FibonacciButtonClick(Sender: TObject);
var
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Recursive fib with AST---');
sw := TStopwatch.StartNew;
root :=
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('fib'),
TAst.LambdaExpr(
[TAst.Identifier('n')],
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
TAst.Identifier('n'),
TAst.BinaryExpr(
TAst.FunctionCall(
TAst.Identifier('fib'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
),
boAdd,
TAst.FunctionCall(
TAst.Identifier('fib'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(2)))]
)
)
)
)
),
TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TScalar.FromInt64(30))])
]
);
FLastAst := root;
// 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]));
end;
procedure TForm1.PrettyPrintButtonClick(Sender: TObject);
var
visitor: TPrettyPrintVisitor;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- AST Pretty Print ---');
if not Assigned(FLastAst) then
begin
Memo1.Lines.Add('No AST has been generated yet.');
exit;
end;
visitor := TPrettyPrintVisitor.Create;
FLastAst.Accept(visitor);
Memo1.Lines.Add(visitor.GetResult);
end;
procedure TForm1.RecursionButtonClick(Sender: TObject);
var
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Recursive factorial(20) ---');
sw := TStopwatch.StartNew;
root :=
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('factorial'),
TAst.LambdaExpr(
[TAst.Identifier('n')],
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
TAst.Constant(TScalar.FromInt64(1)),
TAst.BinaryExpr(
TAst.Identifier('n'),
boMultiply,
TAst.FunctionCall(
TAst.Identifier('factorial'),
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
)
)
)
)
),
TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(TScalar.FromInt64(20))])
]
);
FLastAst := root;
// 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]));
end;
procedure TForm1.SeriesTestButtonClick(Sender: TObject);
var
scope: IExecutionScope;
ast, callAst: IExpressionNode;
resultValue: TAstValue;
series: TScalarRecordSeries;
recordDef: TScalarRecordDefinition;
i: Integer;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Series Test ---');
// 1. Arrange: Create a new scope and populate it with Delphi data
scope := TExecutionScope.Create(FGScope); // Inherits native functions
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
series := TScalarRecordSeries.Create(recordDef);
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))
]
)
);
end;
scope.Define('ohlcvSeries', TAstValue.FromRecordSeries(series));
// 2. Act: Define and execute the script AST
ast :=
TAst.LambdaExpr(
[],
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('closeColumn'),
TAst.MemberAccess(TAst.Identifier('ohlcvSeries'), TAst.Identifier('Close'))
),
TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(TScalar.FromInt64(1)))
]
)
);
FLastAst := ast;
callAst := TAst.FunctionCall(ast, []);
resultValue := ExecuteAst(callAst, scope);
// 3. Assert (logging only)
Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString]));
end;
procedure TForm1.Test1ButtonClick(Sender: TObject);
var
main, callAst: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Simple AST Execution ---');
sw := TStopwatch.StartNew;
main :=
TAst.LambdaExpr(
[],
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'))
]
)
);
FLastAst := main;
callAst := TAst.FunctionCall(main, []);
// 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]));
end;
procedure TForm1.Test2ButtonClick(Sender: TObject);
var
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Factory Pattern Demo ---');
sw := TStopwatch.StartNew;
root :=
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('createStrategyInstance'),
TAst.LambdaExpr(
[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.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TScalar.FromInt64(20))]),
TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TScalar.FromInt64(55))])
]
);
FLastAst := root;
// 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.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if Button <> TMouseButton.mbMiddle then
exit;
if FLastAst <> nil then
begin
var visu := TVisualizationMode.vmDetailed;
if FlowOnlyBox.IsChecked then
visu := TVisualizationMode.vmControlFlow;
FWorkspace.BuildTree(FLastAst, TPointF.Create(X, Y), visu);
end;
end;
procedure TForm1.OHLCButtonClick(Sender: TObject);
const
numRecs = 1000000;
lookback = 100;
smaSlowLength = 50;
smaFastLength = 20;
begin
// 1. Setup
Memo1.Lines.Clear;
Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs]));
var sw := TStopwatch.StartNew;
// 2. Create the setup AST with the strategy logic
var setupAst :=
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('CreateSMA'),
TAst.LambdaExpr(
[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.LambdaExpr(
[TAst.Identifier('series'), TAst.Identifier('val')],
TAst.Block(
[
TAst.Assign(
TAst.Identifier('sum'),
TAst.BinaryExpr(TAst.Identifier('sum'), boAdd, TAst.Identifier('val'))
),
TAst.Assign(
TAst.Identifier('count'),
TAst.BinaryExpr(TAst.Identifier('count'), boAdd, TAst.Constant(TScalar.FromInt64(1)))
),
TAst.IfExpr(
TAst.BinaryExpr(TAst.Identifier('count'), boGreater, TAst.Identifier('len')),
TAst.Assign(
TAst.Identifier('sum'),
TAst.BinaryExpr(
TAst.Identifier('sum'),
boSubtract,
TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len'))
)
),
nil
),
TAst.BinaryExpr(
TAst.Identifier('sum'),
boDivide,
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('count'), boLess, TAst.Identifier('len')),
TAst.Identifier('count'),
TAst.Identifier('len')
)
)
]
)
)
]
)
)
),
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('maCrossStrategy'),
TAst.LambdaExpr(
[TAst.Identifier('ohlcv')],
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('closeSeries'),
TAst.MemberAccess(TAst.Identifier('ohlcv'), TAst.Identifier('Close'))
),
TAst.VarDecl(
TAst.Identifier('currentClose'),
TAst.Indexer(TAst.Identifier('closeSeries'), TAst.Constant(TScalar.FromInt64(0)))
),
TAst.VarDecl(
TAst.Identifier('valSmaFast'),
TAst.FunctionCall(
TAst.Identifier('smaFast'),
[TAst.Identifier('closeSeries'), TAst.Identifier('currentClose')]
)
),
TAst.VarDecl(
TAst.Identifier('valSmaSlow'),
TAst.FunctionCall(
TAst.Identifier('smaSlow'),
[TAst.Identifier('closeSeries'), TAst.Identifier('currentClose')]
)
),
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('valSmaFast'), boGreater, TAst.Identifier('valSmaSlow')),
TAst.Constant(TScalar.FromInt64(1)),
TAst.Constant(TScalar.FromInt64(-1))
)
]
)
)
)
]
);
FLastAst := setupAst;
var scope := TAst.Bind(setupAst, FGScope).Instantiate(FGScope);
setupAst.Accept(CreateVisitor(scope));
// Declare the series variable in the scope BEFORE binding the call AST
scope.Define('current_series', TAstValue.Void);
// Create the call AST that will be executed in the loop
var currentSeriesIdent := TAst.Identifier('current_series');
var callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
// Bind the call AST once, before the loop.
scope := TAst.Bind(callAst, scope).Instantiate(scope);
var visitor := CreateVisitor(scope);
// 4. Simulation Loop
Memo1.Lines.Add('Starting simulation...');
Application.ProcessMessages;
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;
var ohlcvRec: TOHLCV;
for var i := 1 to numRecs do
begin
ohlcvRec.Timestamp := nw + (i / (24 * 60));
ohlcvRec.Open := lastClose + (Random * 0.05);
ohlcvRec.Close := lastClose + (Random - 0.49) * 2;
ohlcvRec.High := Max(ohlcvRec.Open, ohlcvRec.Close) + Random;
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)
]
);
series.AsRecordSeries.Value.Add(recordValue, lookback);
if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then
begin
// Update the 'current_series' value in the scope using the FAST index-based assignment
scope[seriesAddress] := series;
// Execute the PRE-BOUND call AST
var resultValue := callAst.Accept(visitor);
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;
sw.Stop;
Memo1.Lines.Add('--- Simulation Finished ---');
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.