Michael Schimmel
725 lines
25 KiB
ObjectPascal
725 lines
25 KiB
ObjectPascal
unit MainForm;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Types,
|
|
System.TypInfo,
|
|
System.UITypes,
|
|
System.Classes,
|
|
System.Variants,
|
|
System.Generics.Collections,
|
|
FMX.Types,
|
|
FMX.Controls,
|
|
FMX.Forms,
|
|
FMX.Graphics,
|
|
FMX.Dialogs,
|
|
FMX.Memo.Types,
|
|
FMX.StdCtrls,
|
|
FMX.ScrollBox,
|
|
FMX.Memo,
|
|
FMX.Controls.Presentation,
|
|
DraggablePanel,
|
|
Myc.Ast.Visualizer,
|
|
Myc.Data.Scalar,
|
|
Myc.Ast.Nodes,
|
|
Myc.Ast,
|
|
Myc.Ast.Evaluator,
|
|
Myc.Ast.Printer,
|
|
FMX.Layouts,
|
|
FMX.Objects; // Added for TExecutionScope
|
|
|
|
type
|
|
TForm1 = class(TForm)
|
|
Panel1: TPanel;
|
|
Memo1: TMemo;
|
|
Test1Button: TButton;
|
|
Test2Button: TButton;
|
|
PrettyPrintButton: TButton;
|
|
DebugButton: TButton;
|
|
RecursionButton: TButton;
|
|
ShowScopeBox: TCheckBox;
|
|
FibonacciButton: TButton;
|
|
CrerateTriggerExampleButton: TButton;
|
|
DoTriggerButton: TButton;
|
|
DoTrigger2Button: TButton;
|
|
Panel2: TPanel;
|
|
ClearButton: TButton;
|
|
FlowOnlyBox: TCheckBox;
|
|
SeriesTestButton: TButton;
|
|
procedure ClearButtonClick(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure CrerateTriggerExampleButtonClick(Sender: TObject);
|
|
procedure DebugButtonClick(Sender: TObject);
|
|
procedure DoTrigger2ButtonClick(Sender: TObject);
|
|
procedure DoTriggerButtonClick(Sender: TObject);
|
|
procedure FibonacciButtonClick(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: IAstNode;
|
|
FGScope: IExecutionScope;
|
|
FWorkspace: TAuraWorkspace;
|
|
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Myc.Ast.Scope,
|
|
Myc.Data.Scalar.JSON,
|
|
Myc.Data.Decimal,
|
|
System.Diagnostics; // For TStopwatch
|
|
|
|
{$R *.fmx}
|
|
|
|
procedure TForm1.ClearButtonClick(Sender: TObject);
|
|
begin
|
|
FWorkspace.DeleteChildren;
|
|
FWorkspace.Repaint;
|
|
end;
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
FWorkspace := TAuraWorkspace.Create(Panel2);
|
|
FWorkspace.Parent := Panel2;
|
|
FWorkspace.Align := TAlignLayout.Client;
|
|
FWorkspace.ClipChildren := true;
|
|
|
|
FWorkspace.OnMouseDown := WorkspaceMouseDown;
|
|
|
|
FGScope := TExecutionScope.Create(nil);
|
|
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.');
|
|
Memo1.Lines.Add('Click "Test 1" or "Test 2" first.');
|
|
exit;
|
|
end;
|
|
|
|
scope := TExecutionScope.Create(FGScope);
|
|
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- Debug Evaluator Trace ---');
|
|
|
|
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]));
|
|
Memo1.Lines.Add('');
|
|
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
|
|
end;
|
|
|
|
procedure TForm1.FibonacciButtonClick(Sender: TObject);
|
|
|
|
function NativeFib(n: Integer): Int64;
|
|
begin
|
|
// The identical, naive recursive algorithm in native Delphi code.
|
|
if (n < 2) then
|
|
Result := n
|
|
else
|
|
Result := NativeFib(n - 1) + NativeFib(n - 2);
|
|
end;
|
|
|
|
var
|
|
scope: IExecutionScope;
|
|
visitor: IAstVisitor;
|
|
root: IExpressionNode;
|
|
result: TAstValue;
|
|
sw: TStopwatch;
|
|
result20, result30, result40: Int64;
|
|
time20, time30, time40: Int64;
|
|
begin
|
|
FGScope.Clear;
|
|
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- Native Delphi Fibonacci Performance ---');
|
|
Memo1.Lines.Add('Calculating fib(30) and fib(40)...');
|
|
Application.ProcessMessages; // Update UI before blocking
|
|
|
|
// --- Calculate fib(30) ---
|
|
sw := TStopwatch.StartNew;
|
|
result20 := NativeFib(20);
|
|
sw.Stop;
|
|
time20 := sw.ElapsedMilliseconds;
|
|
|
|
// --- Calculate fib(30) ---
|
|
sw := TStopwatch.StartNew;
|
|
result30 := NativeFib(30);
|
|
sw.Stop;
|
|
time30 := sw.ElapsedMilliseconds;
|
|
|
|
// --- Calculate fib(40) ---
|
|
sw.Reset;
|
|
sw.Start;
|
|
result40 := NativeFib(40);
|
|
sw.Stop;
|
|
time40 := sw.ElapsedMilliseconds;
|
|
sw.Reset;
|
|
|
|
Memo1.Lines.Add('');
|
|
Memo1.Lines.Add(Format('fib(20) = %d (calculated in %d ms)', [result20, time20]));
|
|
Memo1.Lines.Add(Format('fib(30) = %d (calculated in %d ms)', [result30, time30]));
|
|
Memo1.Lines.Add(Format('fib(40) = %d (calculated in %d ms)', [result40, time40]));
|
|
Memo1.Lines.Add('');
|
|
Memo1.Lines.Add('');
|
|
Memo1.Lines.Add('--- Recursive fib with AST---');
|
|
Application.ProcessMessages; // Update UI before blocking
|
|
|
|
sw.Start;
|
|
{
|
|
root :=
|
|
TAst.Block(
|
|
[
|
|
TAst.VarDecl(
|
|
TAst.Identifier('fib'),
|
|
TAst.LambdaExpr(
|
|
[TAst.Identifier('n')],
|
|
TAst.IfExpr(
|
|
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
|
|
TAst.Assign(TAst.Identifier('Result'), TAst.Identifier('n')),
|
|
TAst.Assign(
|
|
TAst.Identifier('Result'),
|
|
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))])
|
|
]
|
|
);
|
|
}
|
|
root :=
|
|
TAst.Block(
|
|
[
|
|
TAst.VarDecl(
|
|
TAst.Identifier('fib'),
|
|
TAst.LambdaExpr(
|
|
[TAst.Identifier('n')],
|
|
// The body is now a single ternary expression that returns a value.
|
|
TAst.TernaryExpr(
|
|
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
|
|
// The value if true.
|
|
TAst.Identifier('n'),
|
|
// The value if false.
|
|
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;
|
|
scope := TExecutionScope.Create(nil);
|
|
|
|
visitor := TEvaluatorVisitor.Create(scope);
|
|
result := root.Accept(visitor);
|
|
sw.Stop;
|
|
|
|
Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
|
|
Memo1.Lines.Add('');
|
|
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)');
|
|
end;
|
|
|
|
procedure TForm1.PrettyPrintButtonClick(Sender: TObject);
|
|
var
|
|
visitor: TPrettyPrintVisitor;
|
|
sw: TStopwatch;
|
|
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.');
|
|
Memo1.Lines.Add('Click "Test 1" or "Test 2" first.');
|
|
exit;
|
|
end;
|
|
|
|
visitor := TPrettyPrintVisitor.Create;
|
|
try
|
|
sw := TStopwatch.StartNew;
|
|
FLastAst.Accept(visitor);
|
|
sw.Stop;
|
|
|
|
Memo1.Lines.Add(visitor.GetResult);
|
|
Memo1.Lines.Add(Format('(AST rendered in %d ms)', [sw.ElapsedMilliseconds]));
|
|
finally
|
|
// Visitor is an interfaced object and managed automatically.
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.RecursionButtonClick(Sender: TObject);
|
|
var
|
|
scope: IExecutionScope;
|
|
visitor: IAstVisitor;
|
|
root: IExpressionNode;
|
|
result: TAstValue;
|
|
sw: TStopwatch;
|
|
begin
|
|
FGScope.Clear;
|
|
|
|
sw := TStopwatch.Create;
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- Recursive factorial(20) ---');
|
|
|
|
sw.Start;
|
|
{
|
|
root :=
|
|
TAst.Block(
|
|
[
|
|
TAst.VarDecl(
|
|
TAst.Identifier('factorial'),
|
|
TAst.LambdaExpr(
|
|
[TAst.Identifier('n')],
|
|
TAst.Block(
|
|
[
|
|
TAst.IfExpr(
|
|
TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))),
|
|
TAst.Assign(TAst.Identifier('Result'), TAst.Constant(TScalar.FromInt64(1))),
|
|
TAst.Assign(
|
|
TAst.Identifier('Result'),
|
|
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))])
|
|
]
|
|
);
|
|
}
|
|
root :=
|
|
TAst.Block(
|
|
[
|
|
TAst.VarDecl(
|
|
TAst.Identifier('factorial'),
|
|
TAst.LambdaExpr(
|
|
[TAst.Identifier('n')],
|
|
TAst.Block(
|
|
[
|
|
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;
|
|
scope := TExecutionScope.Create(nil);
|
|
|
|
visitor := TEvaluatorVisitor.Create(scope);
|
|
result := root.Accept(visitor);
|
|
sw.Stop;
|
|
|
|
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
|
|
Memo1.Lines.Add('');
|
|
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)');
|
|
end;
|
|
|
|
procedure TForm1.SeriesTestButtonClick(Sender: TObject);
|
|
type
|
|
// A test record to generate a definition from.
|
|
TOHLCV = record
|
|
Timestamp: TDateTime;
|
|
Open: Double;
|
|
High: Double;
|
|
Low: Double;
|
|
Close: Double;
|
|
Volume: Int64;
|
|
end;
|
|
var
|
|
jsonDef: string;
|
|
recordDef: TScalarRecordDefinition;
|
|
series: TScalarRecordSeries;
|
|
recordValue: TScalarRecord;
|
|
visitor: IAstVisitor;
|
|
ast: IExpressionNode;
|
|
resultValue: TAstValue;
|
|
i: Integer;
|
|
begin
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- Series Test ---');
|
|
|
|
// --- 1. Arrange (in Delphi) ---
|
|
Memo1.Lines.Add('1. Arranging test data in Delphi...');
|
|
FGScope.Clear;
|
|
RegisterNativeFunctions(FGScope);
|
|
|
|
jsonDef := TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV));
|
|
FGScope.SetValue('ohlcvDef', TAstValue.FromText(jsonDef));
|
|
Memo1.Lines.Add(' - Generated and injected JSON definition for TOHLCV.');
|
|
|
|
recordDef := TRttiAstHelper.JsonToRecordDefinition(jsonDef);
|
|
series := TScalarRecordSeries.Create(recordDef);
|
|
for i := 0 to 4 do
|
|
begin
|
|
recordValue :=
|
|
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))
|
|
]
|
|
);
|
|
series.Add(recordValue);
|
|
end;
|
|
|
|
FGScope.SetValue('ohlcvSeries', TAstValue.FromRecordSeries(series));
|
|
Memo1.Lines.Add(Format(' - Created and injected a series with %d records.', [series.TotalCount]));
|
|
Memo1.Lines.Add('');
|
|
|
|
// --- 2. Act (in Script) ---
|
|
Memo1.Lines.Add('2. Executing script...');
|
|
|
|
// This script now tests member access and indexing the resulting member series.
|
|
// let closeColumn = ohlcvSeries.Close;
|
|
// let secondClose = closeColumn[1];
|
|
// secondClose
|
|
ast :=
|
|
TAst.LambdaExpr(
|
|
[],
|
|
TAst.Block(
|
|
[
|
|
TAst.VarDecl(
|
|
TAst.Identifier('closeColumn'),
|
|
TAst.MemberAccess(TAst.Identifier('ohlcvSeries'), TAst.Identifier('Close'))
|
|
),
|
|
TAst.VarDecl(
|
|
TAst.Identifier('secondClose'),
|
|
TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(TScalar.FromInt64(1)))
|
|
),
|
|
TAst.AssignResult(TAst.Identifier('secondClose'))
|
|
]
|
|
)
|
|
);
|
|
FLastAst := ast;
|
|
|
|
visitor := TEvaluatorVisitor.Create(FGScope);
|
|
resultValue := TAst.FunctionCall(ast, []).Accept(visitor);
|
|
|
|
Memo1.Lines.Add(' - Script finished.');
|
|
Memo1.Lines.Add(Format(' - Script returned value of type: %s', [GetEnumName(TypeInfo(TAstValueKind), Ord(resultValue.Kind))]));
|
|
Memo1.Lines.Add('');
|
|
|
|
// --- 3. Assert (in Delphi) ---
|
|
Memo1.Lines.Add('3. Asserting results in Delphi...');
|
|
|
|
if (resultValue.Kind <> avkScalar) then
|
|
begin
|
|
Memo1.Lines.Add('TEST FAILED: Script did not return a scalar value.');
|
|
exit;
|
|
end;
|
|
Memo1.Lines.Add(' - Result is a scalar, as expected.');
|
|
|
|
var resultScalar := resultValue.AsScalar;
|
|
if (resultScalar.Kind <> skDouble) then
|
|
begin
|
|
Memo1.Lines.Add('TEST FAILED: Returned scalar is not a Double.');
|
|
exit;
|
|
end;
|
|
Memo1.Lines.Add(' - Returned scalar is a Double, as expected.');
|
|
|
|
var closeValue := resultScalar.Value.AsDouble;
|
|
// The script asks for index [1], which is the second-to-last element.
|
|
// The data was generated for i in 0..4, so the second-to-last is i=3.
|
|
var expectedClose := 102.0 + 3;
|
|
if (abs(closeValue - expectedClose) > 0.001) then
|
|
begin
|
|
Memo1.Lines.Add(Format('TEST FAILED: Expected Close price %f, but got %f.', [expectedClose, closeValue]));
|
|
exit;
|
|
end;
|
|
Memo1.Lines.Add(Format(' - Verified Close price: %f.', [closeValue]));
|
|
Memo1.Lines.Add('');
|
|
Memo1.Lines.Add('--- TEST PASSED ---');
|
|
end;
|
|
|
|
procedure TForm1.Test1ButtonClick(Sender: TObject);
|
|
var
|
|
scope: IExecutionScope;
|
|
visitor: IAstVisitor;
|
|
result: TAstValue;
|
|
sw: TStopwatch;
|
|
begin
|
|
FGScope.Clear;
|
|
|
|
sw := TStopwatch.Create;
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- Simple AST Execution ---');
|
|
|
|
sw.Start;
|
|
var 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.AssignResult(TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Identifier('b')))
|
|
]
|
|
)
|
|
);
|
|
|
|
FLastAst := main;
|
|
scope := TExecutionScope.Create(FGScope);
|
|
|
|
visitor := TEvaluatorVisitor.Create(scope);
|
|
result := TAst.FunctionCall(main, []).Accept(visitor);
|
|
sw.Stop;
|
|
|
|
if not result.IsVoid then
|
|
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]))
|
|
else
|
|
Memo1.Lines.Add(Format('<undefined result> (calculated in %d ms)', [sw.ElapsedMilliseconds]));
|
|
Memo1.Lines.Add('');
|
|
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
|
|
end;
|
|
|
|
procedure TForm1.Test2ButtonClick(Sender: TObject);
|
|
var
|
|
scope: IExecutionScope;
|
|
visitor: IAstVisitor;
|
|
root: IExpressionNode;
|
|
result: TAstValue;
|
|
sw: TStopwatch;
|
|
begin
|
|
FGScope.Clear;
|
|
|
|
sw := TStopwatch.Create;
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- Factory Pattern Demo ---');
|
|
|
|
sw.Start;
|
|
|
|
root :=
|
|
TAst.Block(
|
|
[
|
|
TAst.VarDecl(
|
|
TAst.Identifier('createStrategyInstance'),
|
|
TAst.LambdaExpr(
|
|
[TAst.Identifier('offset')],
|
|
Tast.VarDecl(
|
|
TAst.Identifier('Result'),
|
|
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;
|
|
|
|
scope := TExecutionScope.Create(FGScope);
|
|
|
|
visitor := TEvaluatorVisitor.Create(scope);
|
|
result := root.Accept(visitor);
|
|
sw.Stop;
|
|
|
|
Memo1.Lines.Add('The entire script has been executed.');
|
|
Memo1.Lines.Add(Format('Result of the final expression: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
|
|
Memo1.Lines.Add('');
|
|
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
|
|
end;
|
|
|
|
procedure TForm1.CrerateTriggerExampleButtonClick(Sender: TObject);
|
|
var
|
|
visitor: IAstVisitor;
|
|
closureValue: TAstValue;
|
|
begin
|
|
FGScope.Clear;
|
|
|
|
// Create an AST that gets a "tick" in DoTriggerButtonClick.
|
|
// This simulates a simple Blueprint-like event system.
|
|
// It maintains state via a persistent execution scope.
|
|
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
|
|
|
|
var 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')))
|
|
)
|
|
)
|
|
]
|
|
);
|
|
|
|
// lambdaAst :=
|
|
// TAst.LambdaExpr(
|
|
// [TAst.Identifier('summand')],
|
|
// TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand')))
|
|
// );
|
|
|
|
// Evaluate the lambda to create a closure and store it in the scope.
|
|
// The closure captures the scope where 'X' is defined.
|
|
visitor := TEvaluatorVisitor.Create(FGScope);
|
|
blk.Accept(visitor);
|
|
|
|
// FLastAst is not used for this parameterized example.
|
|
FLastAst := blk;
|
|
|
|
Memo1.Lines.Add('Variable "X" initialized to 0 in persistent scope.');
|
|
Memo1.Lines.Add('Blueprint function "tickHandler(summand)" created.');
|
|
Memo1.Lines.Add('Click "Do Trigger" or "Do Trigger 2" to execute.');
|
|
end;
|
|
|
|
procedure TForm1.DoTriggerButtonClick(Sender: TObject);
|
|
var
|
|
visitor: IAstVisitor;
|
|
currentValue: TAstValue;
|
|
callAst: IFunctionCallNode;
|
|
begin
|
|
// A "tick" executes the stored AST using the persistent scope.
|
|
|
|
// Create an AST to call the stored handler with argument 1.
|
|
// AST for: tickHandler(1)
|
|
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]);
|
|
|
|
// Execute the call AST.
|
|
visitor := TEvaluatorVisitor.Create(FGScope);
|
|
callAst.Accept(visitor);
|
|
|
|
FLastAst := callAst;
|
|
|
|
// Get the updated value of 'X' from the scope and display it.
|
|
if FGScope.FindValue('X', currentValue) then
|
|
begin
|
|
Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [currentValue.ToString]));
|
|
end
|
|
else
|
|
begin
|
|
// This should not happen if setup was correct.
|
|
Memo1.Lines.Add('Error: Variable "X" not found in scope.');
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.DoTrigger2ButtonClick(Sender: TObject);
|
|
var
|
|
visitor: IAstVisitor;
|
|
currentValue: TAstValue;
|
|
callAst: IFunctionCallNode;
|
|
begin
|
|
// A "tick" that adds 2, using the same blueprint function.
|
|
|
|
// Create an AST to call the stored handler with argument 2.
|
|
// AST for: tickHandler(2)
|
|
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]);
|
|
|
|
FLastAst := callAst;
|
|
|
|
// Execute the call AST.
|
|
visitor := TEvaluatorVisitor.Create(FGScope);
|
|
callAst.Accept(visitor);
|
|
|
|
// Get the updated value of 'X' from the scope and display it.
|
|
if FGScope.FindValue('X', currentValue) then
|
|
begin
|
|
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [currentValue.ToString]));
|
|
end
|
|
else
|
|
begin
|
|
// This should not happen if setup was correct.
|
|
Memo1.Lines.Add('Error: Variable "X" not found in scope.');
|
|
end;
|
|
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;
|
|
|
|
end.
|