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.Data.Scalar, Myc.Data.Value, Myc.Ast.Nodes, Myc.Ast, Myc.Ast.Evaluator, Myc.Ast.Printer, Myc.Ast.Dumper, Myc.Data.Decimal, Myc.Ast.Binding, Myc.Ast.RTL, Myc.Ast.Script, FMX.Layouts, FMX.Objects, Myc.Ast.Debugger, Myc.Fmx.AstEditor, Myc.Fmx.AstEditor.Node, Myc.Fmx.AstEditor.Workspace; 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; ExternalFuncButton: TButton; InnerLambdaButton: TButton; DumpButton: TButton; FailingUpvalueButton: TButton; TailCallButten: TButton; Splitter1: TSplitter; Splitter2: TSplitter; ScriptMemo: TMemo; procedure InnerLambdaButtonClick(Sender: TObject); procedure ClearButtonClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure CreateTriggerExampleButtonClick(Sender: TObject); procedure DoTrigger2ButtonClick(Sender: TObject); procedure DoTriggerButtonClick(Sender: TObject); procedure DumpButtonClick(Sender: TObject); 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); procedure SeriesTestButtonClick(Sender: TObject); 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 // Stores the last AST generated by Test1 or Test2 button clicks. 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; var Form1: TForm1; implementation uses Myc.Data.Scalar.JSON, System.Diagnostics, // For TStopwatch Myc.Ast.Json; // For TAstJson serialization {$R *.fmx} procedure TForm1.InnerLambdaButtonClick(Sender: TObject); var // Only the root node is needed as a local variable. mainBlock: IAstNode; // Execution and result variables resultValue: TDataValue; begin // Build the entire AST inline to ensure no node instances are shared. mainBlock := TAst.Block( [ // var outer = lambda() { ... }; TAst.VarDecl( TAst.Identifier('outer'), TAst.LambdaExpr( [], TAst.Block( [ // var x = 10; TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(10)), // var inner = lambda() { ... }; TAst.VarDecl( TAst.Identifier('inner'), TAst.LambdaExpr( [], TAst.Block( [ // var innermost = lambda() { ... }; TAst.VarDecl( TAst.Identifier('innermost'), TAst.LambdaExpr( [], // x = x + 5; TAst.Assign( TAst.Identifier('x'), TAst.BinaryExpr(TAst.Identifier('x'), TScalar.TBinaryOp.Add, TAst.Constant(5)) ) ) ), // innermost(); TAst.FunctionCall(TAst.Identifier('innermost'), []) ] ) ) ), // inner(); TAst.FunctionCall(TAst.Identifier('inner'), []), // return x; TAst.Identifier('x') ] ) ) ), // var finalResult = outer(); TAst.VarDecl(TAst.Identifier('finalResult'), TAst.FunctionCall(TAst.Identifier('outer'), [])) ] ); FLastAst := mainBlock; resultValue := ExecuteAst(mainBlock, FGScope); Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15, but is ' + resultValue.AsScalar.ToString); UpdateScript; end; procedure TForm1.ClearButtonClick(Sender: TObject); begin FWorkspace.DeleteChildren; FWorkspace.Repaint; // Create and prepare the global scope once FGScope := TAst.CreateScope(nil); RegisterNativeFunctions(FGScope); end; function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue; begin // This helper function handles simple, one-off script executions. // It binds the AST and then decides whether to run a debug session or a standard evaluation. var scriptScope := TAstBinder.Bind(ANode, AParentScope).CreateScope(AParentScope); var visitor := CreateVisitor(scriptScope); Result := visitor.Execute(ANode); end; procedure TForm1.FormCreate(Sender: TObject); begin FWorkspace := TAuraWorkspace.Create(Panel2); FWorkspace.Parent := Panel2; FWorkspace.Align := TAlignLayout.Client; FWorkspace.ClipChildren := true; FWorkspace.OnMouseDown := WorkspaceMouseDown; Tast.RegisterLibrary( procedure(const Scope: IExecutionScope) begin var smaAst := TAst.LambdaExpr( [TAst.Identifier('len')], TAst.Block( [ 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'), TScalar.TBinaryOp.Add, TAst.Identifier('val')) ), TAst.Assign( TAst.Identifier('count'), TAst.BinaryExpr(TAst.Identifier('count'), TScalar.TBinaryOp.Add, TAst.Constant(1)) ), TAst.Assign( TAst.Identifier('sum'), TAst.TernaryExpr( TAst.BinaryExpr( TAst.Identifier('count'), TScalar.TBinaryOp.Greater, TAst.Identifier('len') ), TAst.BinaryExpr( TAst.Identifier('sum'), TScalar.TBinaryOp.Subtract, TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len')) ), TAst.Identifier('sum') ) ), TAst.BinaryExpr( TAst.Identifier('sum'), TScalar.TBinaryOp.Divide, TAst.TernaryExpr( TAst.BinaryExpr(TAst.Identifier('count'), TScalar.TBinaryOp.Less, TAst.Identifier('len')), TAst.Identifier('count'), TAst.Identifier('len') ) ) ] ) ) ] ) ); Scope.Define('CreateSMA', CreateVisitor(TAstBinder.Bind(smaAst, FGScope).CreateScope(FGScope)).Execute(smaAst)); end ); // Setup global scope ClearButtonClick(Self); end; procedure TForm1.FibonacciButtonClick(Sender: TObject); var root: IAstNode; result: TDataValue; sw: TStopwatch; begin // 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( [ // 1. var fib; (Declare the name so it can be captured by the lambda) TAst.VarDecl(TAst.Identifier('fib')), // 2. fib = lambda(n) { ... fib(n-1) + fib(n-2) ... }; TAst.Assign( TAst.Identifier('fib'), TAst.LambdaExpr( [TAst.Identifier('n')], TAst.TernaryExpr( 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'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))] ), TScalar.TBinaryOp.Add, // Second naive recursive call TAst.FunctionCall( TAst.Identifier('fib'), [TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(2))] ) ) ) ) ) ] ); // Create a new scope and define the 'fib' function within it. var fibScope := TAstBinder.Bind(fibAst, FGScope).CreateScope(FGScope); var visitor := CreateVisitor(fibScope); visitor.Execute(fibAst); Memo1.Lines.Clear; Memo1.Lines.Add('--- Naive recursive fib with AST---'); sw := TStopwatch.StartNew; // The script to execute is just the call to the function. root := TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]); FLastAst := root; // Execute within the scope where 'fib' is defined. result := ExecuteAst(root, fibScope); sw.Stop; Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); Memo1.Lines.Add(''); Memo1.Lines.Add('--- Memoized naive fib with AST (using global fib)---'); sw := TStopwatch.StartNew; root := TAst.Block( [ // 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(25)]) ] ); FLastAst := root; result := ExecuteAst(root, fibScope); 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); 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; visitor.Execute(FLastAst); Memo1.Lines.Add(visitor.GetResult); end; procedure TForm1.RecursionButtonClick(Sender: TObject); var root: IAstNode; result: TDataValue; sw: TStopwatch; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Tail-Recursive factorial(20) ---'); sw := TStopwatch.StartNew; // Rewritten to be tail-recursive to use 'recur' root := TAst.Block( [ // Define the tail-recursive helper function TAst.VarDecl( TAst.Identifier('fact_iter'), TAst.LambdaExpr( [TAst.Identifier('n'), TAst.Identifier('acc')], TAst.TernaryExpr( 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'), TScalar.TBinaryOp.Subtract, TAst.Constant(1)), TAst.BinaryExpr(TAst.Identifier('acc'), TScalar.TBinaryOp.Multiply, TAst.Identifier('n')) ] ) ) ) ), // Define the public-facing factorial function TAst.VarDecl( TAst.Identifier('factorial'), TAst.LambdaExpr( [TAst.Identifier('n')], TAst.FunctionCall(TAst.Identifier('fact_iter'), [TAst.Identifier('n'), TAst.Constant(1)]) ) ), // Call the main function TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(20)]) ] ); FLastAst := root; // Execute with FGScope as parent. result := ExecuteAst(root, FGScope); sw.Stop; Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); UpdateScript; end; procedure TForm1.SeriesTestButtonClick(Sender: TObject); var ast, callAst: IAstNode; resultValue: TDataValue; series: TScalarRecordSeries; recordDef: TScalarRecordDefinition; i: Integer; scope: IExecutionScope; values: TArray; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Series Test ---'); scope := TAst.CreateScope(FGScope); recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson); series := TScalarRecordSeries.Create(recordDef); SetLength(values, 6); for i := 0 to 4 do begin // 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)); 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(1)) ] ) ); FLastAst := ast; callAst := TAst.FunctionCall(ast, []); resultValue := ExecuteAst(callAst, scope); Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString])); UpdateScript; end; procedure TForm1.Test1ButtonClick(Sender: TObject); var main, callAst: IAstNode; result: TDataValue; 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(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')) ] ) ); FLastAst := main; callAst := TAst.FunctionCall(main, []); result := ExecuteAst(callAst, FGScope); sw.Stop; Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); UpdateScript; end; procedure TForm1.Test2ButtonClick(Sender: TObject); var root: IAstNode; result: TDataValue; 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(100)), TAst.BinaryExpr(TAst.Identifier('baseValue'), TScalar.TBinaryOp.Add, TAst.Identifier('offset')) ] ) ) ), TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(20)]), TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(55)]) ] ); FLastAst := root; result := ExecuteAst(root, FGScope); 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); begin if Button <> TMouseButton.mbMiddle then exit; ShowVizualization(X, Y); end; procedure TForm1.OHLCButtonClick(Sender: TObject); const numRecs = 1000; lookback = 50; smaSlowLength = 20; smaFastLength = 10; var scope: IExecutionScope; values: TArray; recordValue: TScalarRecord; begin Memo1.Lines.Clear; Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs])); var sw := TStopwatch.StartNew; var setupAst := TAst.Block( [ 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( [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(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'), TScalar.TBinaryOp.Greater, TAst.Identifier('valSmaSlow') ), TAst.Constant(1), TAst.Constant(-1) ) ] ) ) ) ] ); FLastAst := setupAst; // 1. Bind and execute the setup script. scope := TAstBinder.Bind(setupAst, FGScope).CreateScope(FGScope); // This is a temporary visitor just for the setup execution. var setupVisitor := CreateVisitor(scope); setupVisitor.Execute(setupAst); // 2. Prepare for the simulation loop by modifying the now-populated scope. scope.Define('current_series', TDataValue.Void); var currentSeriesIdent := TAst.Identifier('current_series'); var callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]); // 3. Re-bind the scope with the new AST. This creates the FINAL scope for the loop. scope := TAstBinder.Bind(callAst, scope).CreateScope(scope); var seriesAddress := currentSeriesIdent.Address; var visitor := CreateVisitor(scope); // 5. Simulation Loop Memo1.Lines.Add('Starting simulation...'); Application.ProcessMessages; var lastClose := 1000.0; Randomize; var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson); var series := TDataValue.FromRecordSeries(TScalarRecordSeries.Create(recDef)); 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; 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 begin scope[seriesAddress] := series; var resultValue := visitor.Execute(callAst); 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])); 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; 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 blk: IAstNode; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Creating Trigger Blueprint ---'); blk := TAst.Block( [ 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'), TScalar.TBinaryOp.Add, TAst.Identifier('summand')) ) ) ) ] ); FTriggerScope := TAstBinder.Bind(blk, FGScope).CreateScope(FGScope); // This case is simple enough to just inline the logic from ExecuteAst 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; begin if DebugBox.IsChecked then Result := TDebugEvaluatorVisitor.Create(Scope, Memo1.Lines, ShowScopeBox.IsChecked) else Result := TEvaluatorVisitor.Create(Scope); end; procedure TForm1.DoTriggerButtonClick(Sender: TObject); var callAst: IFunctionCallNode; begin callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(1)]); FLastAst := callAst; 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(2)]); FLastAst := callAst; 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); begin // Call the dumper for the last AST. Memo1.Lines.Clear; Memo1.Lines.Add('--- AST Dump ---'); if not Assigned(FLastAst) then begin Memo1.Lines.Add('No AST has been generated yet. Click a test button first.'); exit; end; TAstDumper.Dump(FLastAst, Memo1.Lines); end; procedure TForm1.ExternalFuncButtonClick(Sender: TObject); var scope: IExecutionScope; callAst: IAstNode; resultValue: TDataValue; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Calling external Delphi function from AST ---'); scope := TAst.CreateScope(FGScope); scope.Define( 'delphiAdd', function(const ArgNodes: TArray): TDataValue var val1, val2: Int64; begin if Length(ArgNodes) <> 2 then raise Exception.Create('delphiAdd requires exactly 2 arguments.'); val1 := ArgNodes[0].AsScalar.Value.AsInt64; val2 := ArgNodes[1].AsScalar.Value.AsInt64; Result := TScalar.FromInt64(val1 + val2); end ); 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, 123): %s', [resultValue.ToString])); UpdateScript; end; procedure TForm1.FailingUpvalueButtonClick(Sender: TObject); var mainBlock: IAstNode; resultValue: TDataValue; begin mainBlock := TAst.Block( [ // 1. Define the shared variable. 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( TAst.Identifier('modifier'), TAst.LambdaExpr( [], // Outer modifier shell TAst.LambdaExpr( [], // Inner closure that is returned TAst.Assign( TAst.Identifier('a'), TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Add, TAst.Constant(5)) ) ) ) ), // 3. Define a simple closure that READS 'a'. TAst.VarDecl(TAst.Identifier('reader'), TAst.LambdaExpr([], TAst.Identifier('a'))), // --- Execute the test --- // 4. Get the inner modifier closure. TAst.VarDecl(TAst.Identifier('innermost_closure'), TAst.FunctionCall(TAst.Identifier('modifier'), [])), // 5. Call the inner closure to modify 'a'. TAst.FunctionCall(TAst.Identifier('innermost_closure'), []), // 6. Call the reader to get the final value. TAst.FunctionCall(TAst.Identifier('reader'), []) ] ); FLastAst := mainBlock; Memo1.Lines.Clear; Memo1.Lines.Add('--- Executing Corrected Upvalue Test ---'); resultValue := ExecuteAst(mainBlock, FGScope); // With a correct binder and evaluator, the result must be 15. var res := resultValue.AsScalar.Value.AsInt64; if res = 15 then begin Memo1.Lines.Add('SUCCESS: The result is 15.'); end else begin Memo1.Lines.Add(Format('FAILURE: Expected 15, but got %s.', [resultValue.ToString])); end; 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); var jsonString: string; begin Memo1.Lines.BeginUpdate; try jsonString := Memo1.Lines.Text; Memo1.Lines.Clear; if jsonString.IsEmpty then begin Memo1.Lines.Add('Memo is empty. Please paste an AST JSON string.'); exit; end; try FLastAst := TAstJson.Deserialize(jsonString); Memo1.Lines.Add('AST deserialized successfully from JSON.'); Memo1.Lines.Add('You can now visualize it (Middle Mouse Click) or pretty-print it.'); except on E: Exception do begin FLastAst := nil; Memo1.Lines.Add('Error deserializing AST from JSON:'); Memo1.Lines.Add(E.Message); Memo1.Lines.Add('--- Original JSON ---'); Memo1.Lines.Text := Memo1.Lines.Text + sLineBreak + jsonString; end; end; finally Memo1.Lines.EndUpdate; end; UpdateScript; end; procedure TForm1.ScriptMemoChange(Sender: TObject); begin if FScriptUpdate then exit; try FLastAst := TAstScript.Parse(ScriptMemo.Lines.Text) except on E: Exception do Memo1.Lines.Add(E.Message); end; end; procedure TForm1.ToJSONButtonClick(Sender: TObject); var jsonString: string; begin Memo1.Lines.Clear; if not Assigned(FLastAst) then begin Memo1.Lines.Add('No AST available to serialize. Please generate one first.'); exit; end; try jsonString := TAstJson.Serialize(FLastAst); Memo1.Lines.Text := jsonString; except on E: Exception do begin Memo1.Lines.Add('Error serializing AST to JSON:'); Memo1.Lines.Add(E.Message); end; 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.