Michael Schimmel
703 lines
25 KiB
ObjectPascal
703 lines
25 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,
|
|
Myc.Ast.Persistence,
|
|
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;
|
|
FromJSONButton: TButton;
|
|
ToJSONButton: TButton;
|
|
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);
|
|
procedure FromJSONButtonClick(Sender: TObject);
|
|
procedure ToJSONButtonClick(Sender: TObject);
|
|
private
|
|
// Stores the last AST generated by Test1 or Test2 button clicks.
|
|
FLastAst: IAstNode;
|
|
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: IAstNode; 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: IAstNode; const AParentScope: IExecutionScope): TAstValue;
|
|
var
|
|
scriptScope: IExecutionScope;
|
|
begin
|
|
scriptScope := TAst.Bind(ANode, AParentScope);
|
|
|
|
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: IAstNode;
|
|
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('Self'),
|
|
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))]
|
|
),
|
|
boAdd,
|
|
TAst.FunctionCall(
|
|
TAst.Identifier('Self'),
|
|
[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: IAstNode;
|
|
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('Self'),
|
|
[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: IAstNode;
|
|
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: IAstNode;
|
|
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: IAstNode;
|
|
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 = 1000;
|
|
lookback = 50;
|
|
smaSlowLength = 20;
|
|
smaFastLength = 10;
|
|
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);
|
|
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);
|
|
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.Address;
|
|
|
|
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].Value := series;
|
|
|
|
// Execute the PRE-BOUND call AST
|
|
var resultValue := callAst.Accept(visitor);
|
|
|
|
if i mod 50 = 0 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: IAstNode;
|
|
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);
|
|
|
|
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;
|
|
|
|
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;
|
|
|
|
var X := ExecuteAst(callAst, TriggerScope);
|
|
|
|
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString]));
|
|
end;
|
|
|
|
procedure TForm1.FromJSONButtonClick(Sender: TObject);
|
|
begin
|
|
// Reads an AST JSON string from the memo and deserializes it into FLastAst.
|
|
if Memo1.Lines.Text.IsEmpty then
|
|
begin
|
|
Memo1.Lines.Text := 'Memo is empty. Paste an AST JSON structure here first.';
|
|
exit;
|
|
end;
|
|
|
|
try
|
|
Memo1.Lines.Insert(0, '--- Deserializing AST from JSON ---');
|
|
FLastAst := TAstProjectPersistence.JsonStringToAstNode(Memo1.Lines.Text);
|
|
if Assigned(FLastAst) then
|
|
begin
|
|
Memo1.Lines.Add('--- Deserialization successful. ---');
|
|
Memo1.Lines.Add('Middle-click on the right panel to visualize the new AST.');
|
|
end
|
|
else
|
|
begin
|
|
Memo1.Lines.Add('--- Deserialization failed. Invalid JSON or data structure. ---');
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
Memo1.Lines.Add('--- ERROR during deserialization ---');
|
|
Memo1.Lines.Add(E.ClassName + ': ' + E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.ToJSONButtonClick(Sender: TObject);
|
|
begin
|
|
// Serializes the current FLastAst to a JSON string and displays it in the memo.
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- Serializing AST to JSON ---');
|
|
|
|
if not Assigned(FLastAst) then
|
|
begin
|
|
Memo1.Lines.Add('No AST available to serialize. Generate one first.');
|
|
exit;
|
|
end;
|
|
|
|
try
|
|
Memo1.Lines.Text := TAstProjectPersistence.AstNodeToJsonString(FLastAst);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- ERROR during serialization ---');
|
|
Memo1.Lines.Add(E.ClassName + ': ' + E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|