unit MainForm; interface uses System.SysUtils, System.Types, System.TypInfo, System.UITypes, System.Classes, System.Variants, System.Generics.Collections, System.Math, System.JSON, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Memo.Types, FMX.StdCtrls, FMX.ScrollBox, FMX.Memo, FMX.Controls.Presentation, FMX.Layouts, FMX.Objects, FMX.DialogService, FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, FMX.ListView, FMX.ListBox, // Myc Units Myc.Data.Scalar, Myc.Data.Value, Myc.Ast.Nodes, Myc.Ast.Scope, Myc.Ast, Myc.Ast.Visitor, Myc.Data.Decimal, Myc.Ast.Script, Myc.Ast.Types, Myc.Ast.Environment, Myc.Ast.RTL, Myc.Ast.Compiler.Macros, // Editor Units Myc.Fmx.AstEditor, Demo.Finance, FMX.Menus; 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; RecursionButton: TButton; ShowScopeBox: TCheckBox; FibonacciButton: TButton; CrerateTriggerExampleButton: TButton; DoTriggerButton: TButton; DoTrigger2Button: TButton; Panel2: TPanel; ClearButton: TButton; 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; LoadUserLibButton: TButton; SaveUserLibButton: TButton; RTLListView: TListView; CompilerStageBox: TComboBox; SaveTestBtn: TButton; procedure InnerLambdaButtonClick(Sender: TObject); procedure ClearButtonClick(Sender: TObject); procedure CompilerStageBoxChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure CreateTriggerExampleButtonClick(Sender: TObject); procedure DebugBoxChange(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 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); procedure SaveUserLibButtonClick(Sender: TObject); procedure LoadUserLibButtonClick(Sender: TObject); procedure RTLListViewChange(Sender: TObject); private FCurrUnboundAst: IAstNode; FCurrCompiled: ILambdaExpressionNode; FCurrExec: TCompiledFunction; FEnvironment: TAstEnvironment; FAstEditor: TAstEditor; // Die Komponente (Facade) FScriptUpdate: Boolean; FTriggerTest: TAstEnvironment; procedure AstEditorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); // Helper function to encapsulate the Compile -> Evaluate pattern function ExecuteAst(const ANode: IAstNode): TDataValue; procedure UpdateScript; procedure ShowVizualization; procedure PrintScript(const Node: IAstNode); public { Public declarations } end; const UserLibName = 'T:\Myc\ASTPlayground\UserLib.json'; var Form1: TForm1; implementation uses Myc.Data.Scalar.JSON, Myc.Trade.Broker, System.Diagnostics, // For TStopwatch System.TimeSpan, Myc.Ast.Json, // For TAstJson serialization System.IOUtils, // For TFile Myc.Ast.Dumper; // Needed for DumpButtonClick {$R *.fmx} procedure TForm1.FormCreate(Sender: TObject); begin // 1. Initialize Environment FEnvironment := TAstEnvironment.Construct(TAst.CreateScope(nil)); // 2. Initialize AST Editor Component // This replaces the manual Workspace + Controller setup. // The Editor encapsulates logic for Navigation, Zoom, Drag&Drop, Undo/Redo. FAstEditor := TAstEditor.Create(Self); FAstEditor.Parent := Panel2; FAstEditor.Align := TAlignLayout.Client; // Wire up events exposed by the component FAstEditor.OnMouseDown := AstEditorMouseDown; // Initialize the logic backend of the editor FAstEditor.Init(FEnvironment); // 3. Register the SMA factory into the environment var RegFunc := procedure(const Scope: IExecutionScope) var smaAst: IAstNode; begin 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.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('sum'), TAst.Identifier('val')]) ), TAst.Assign( TAst.Identifier('count'), TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('count'), TAst.Constant(1)]) ), TAst.Assign( TAst.Identifier('sum'), TAst.TernaryExpr( TAst.FunctionCall(TAst.Identifier('>'), [TAst.Identifier('count'), TAst.Identifier('len')]), TAst.FunctionCall( TAst.Identifier('-'), [ TAst.Identifier('sum'), TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len')) ] ), TAst.Identifier('sum') ) ), TAst.FunctionCall( TAst.Identifier('/'), [ TAst.Identifier('sum'), TAst.TernaryExpr( TAst.FunctionCall( TAst.Identifier('<'), [TAst.Identifier('count'), TAst.Identifier('len')] ), TAst.Identifier('count'), TAst.Identifier('len') ) ] ) ] ) ) ] ) ); var smaFactory := FEnvironment.Run(smaAst); Scope.Define('CreateSMA', smaFactory); Scope.Define( 'print', function(const Args: TArray): TDataValue var str: TStringBuilder; begin str := TStringBuilder.Create; try for var i := 0 to High(Args) do begin if Args[i].Kind = vkText then str.Append(Args[i].AsText) else str.Append(Args[i].ToString); end; Memo1.Lines.Add(str.ToString); finally str.Free; end; end ); Scope.Define( 'timestamp', function(const Args: TArray): TDataValue begin Result := TStopwatch.GetTimeStamp div TTimeSpan.TicksPerMillisecond; end ); end; RegFunc(FEnvironment.RootScope); FEnvironment.MacroRegistry.Define( TAstScript .Parse( ''' (defmacro stopwatch [body] `(do (def start-time (timestamp)) (def result ~body) (print "(calculated in " (- (timestamp) start-time) " ms)" ) result )) ''') .AsMacroDefinition ); CompilerStageBox.BringToFront; ClearButtonClick(Self); end; procedure TForm1.ShowVizualization; begin if FCurrUnboundAst = nil then exit; // Use the Editor Component to build, validate and show the UI FAstEditor.SetRoot(FCurrUnboundAst); end; // Simplified ExecuteAst using TEnvironment and handling errors gracefully function TForm1.ExecuteAst(const ANode: IAstNode): TDataValue; begin FCurrUnboundAst := ANode; FCurrExec := Default(TCompiledFunction); if DebugBox.IsChecked then FEnvironment.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked) else FEnvironment.SetStandardMode; try // Use Compile directly. Errors will be raised as ECompilationFailed. // We catch them to print to log, but allow flow to continue so UI can be updated. FCurrCompiled := FEnvironment.Compile(ANode); FCurrExec := FEnvironment.Link(FCurrCompiled); if Assigned(FCurrExec.Func) then begin Memo1.Lines.Add( Format('Compiled. Signature: %s, IsPure=%s', [FCurrExec.StaticType.ToString, BoolToStr(FCurrExec.IsPure, true)]) ); end; Result := FCurrExec.Func([]); except on E: ECompilationFailed do begin Memo1.Lines.BeginUpdate; try Memo1.Lines.Clear; Memo1.Lines.Add(E.Message); Memo1.Lines.Add(''); for var err in E.Errors do Memo1.Lines.Add(err.ToString); finally Memo1.Lines.EndUpdate; end; // Return void so caller doesn't crash, but UI will show red nodes via ShowVizualization Result := TDataValue.Void; end; on E: Exception do begin FCurrExec.Func := nil; Memo1.Lines.Add('--- RUNTIME ERROR ---'); Memo1.Lines.Add(E.ClassName + ': ' + E.Message); Result := TDataValue.Void; end; end; end; procedure TForm1.InnerLambdaButtonClick(Sender: TObject); begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Nested Lambda & Upvalue Mutation Test ---'); var mainBlock := TAst.Block( [ TAst.VarDecl( TAst.Identifier('outer'), TAst.LambdaExpr( [], TAst.Block( [ TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(10)), TAst.VarDecl( TAst.Identifier('inner'), TAst.LambdaExpr( [], TAst.Block( [ TAst.VarDecl( TAst.Identifier('innermost'), TAst.LambdaExpr( [], TAst.Assign( TAst.Identifier('x'), TAst.FunctionCall( TAst.Identifier('+'), [TAst.Identifier('x'), TAst.Constant(5)] ) ) ) ), TAst.FunctionCall(TAst.Identifier('innermost'), []) ] ) ) ), TAst.FunctionCall(TAst.Identifier('inner'), []), TAst.Identifier('x') ] ) ) ), TAst.VarDecl(TAst.Identifier('finalResult'), TAst.FunctionCall(TAst.Identifier('outer'), [])) ] ); var resultValue := ExecuteAst(mainBlock); if (resultValue.Kind = vkScalar) and (resultValue.AsScalar.Kind = TScalar.TKind.Ordinal) then begin var resInt := resultValue.AsScalar.Value.AsInt64; Memo1.Lines.Add(Format('Actual Result: %d', [resInt])); if resInt = 15 then Memo1.Lines.Add('SUCCESS: Deeply nested closure modified captured variable correctly.') else Memo1.Lines.Add(Format('FAILURE: Upvalue logic broken. Expected 15, got %d.', [resInt])); end else Memo1.Lines.Add('FAILURE: Result is not an integer scalar.'); UpdateScript; end; procedure TForm1.ClearButtonClick(Sender: TObject); begin // Clear content of component FAstEditor.SetRoot(nil); end; procedure TForm1.CompilerStageBoxChange(Sender: TObject); begin ShowVizualization; 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.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('X'), TAst.Identifier('summand')]) ) ) ) ] ); FTriggerTest := FEnvironment.CreateEnvironment; FTriggerTest.Define('X', TAst.Constant(0)); FTriggerTest.Define( 'tickHandler', TAst.LambdaExpr( [TAst.Identifier('summand')], TAst.Assign(TAst.Identifier('X'), TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('X'), TAst.Identifier('summand')])) ) ); Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.'); Memo1.Lines.Add('Click "Do Trigger" to execute.'); UpdateScript; end; procedure TForm1.DebugBoxChange(Sender: TObject); begin if DebugBox.IsChecked then FEnvironment.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked) else FEnvironment.SetStandardMode; end; procedure TForm1.DoTriggerButtonClick(Sender: TObject); var callAst: IAstNode; begin callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(1)]); var X := FTriggerTest.Run(callAst); Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [X.ToString])); UpdateScript; end; procedure TForm1.DoTrigger2ButtonClick(Sender: TObject); var callAst: IAstNode; begin callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(2)]); var X := FTriggerTest.Run(callAst); Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString])); UpdateScript; end; procedure TForm1.ExternalFuncButtonClick(Sender: TObject); var callAst: IAstNode; resultValue: TDataValue; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Calling external Delphi function from AST ---'); FEnvironment.RootScope.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)]); resultValue := ExecuteAst(callAst); Memo1.Lines.Add(Format('Result from delphiAdd(100, 123): %s', [resultValue.ToString])); UpdateScript; end; procedure TForm1.FailingUpvalueButtonClick(Sender: TObject); var resultValue: TDataValue; begin FCurrUnboundAst := TAst.Block( [ TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)), TAst.VarDecl( TAst.Identifier('modifier'), TAst.LambdaExpr( [], // Outer modifier shell TAst.LambdaExpr( [], // Inner closure that is returned TAst.Assign( TAst.Identifier('a'), TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('a'), TAst.Constant(5)]) ) ) ) ), TAst.VarDecl(TAst.Identifier('reader'), TAst.LambdaExpr([], TAst.Identifier('a'))), TAst.VarDecl(TAst.Identifier('innermost_closure'), TAst.FunctionCall(TAst.Identifier('modifier'), [])), TAst.FunctionCall(TAst.Identifier('innermost_closure'), []), TAst.FunctionCall(TAst.Identifier('reader'), []) ] ); UpdateScript; Memo1.Lines.Clear; Memo1.Lines.Add('--- Executing Corrected Upvalue Test ---'); resultValue := ExecuteAst(FCurrUnboundAst); if resultValue.Kind <> vkVoid then begin var res := resultValue.AsScalar.Value.AsInt64; if res = 15 then Memo1.Lines.Add('SUCCESS: The result is 15.') else Memo1.Lines.Add(Format('FAILURE: Expected 15, but got %s.', [resultValue.ToString])); Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15.'); end; Memo1.Lines.Add('Please check the new dump.'); UpdateScript; end; procedure TForm1.FibonacciButtonClick(Sender: TObject); var result: TDataValue; sw: TStopwatch; begin Memo1.Lines.Clear; FCurrUnboundAst := TAstScript.Parse( ''' (do (def fib) (assign fib (fn [n] (? (< n 2) n (+ (fib (- n 1)) (fib (- n 2))) ) )) ) ''' ); var TestEnv := FEnvironment.CreateEnvironment; TestEnv.Define('fib', FCurrUnboundAst); Memo1.Lines.Add('--- Naive recursive fib with AST---'); FCurrCompiled := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)])); var fibExec := TestEnv.Link(FCurrCompiled).Func; sw := TStopwatch.StartNew; result := fibExec([]); sw.Stop; Memo1.Lines.Add(Format('Result: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); Memo1.Lines.Add(''); Memo1.Lines.Add('--- Memoized naive fib with AST (using global fib)---'); var memoizeTest := TestEnv.CreateEnvironment; memoizeTest.Define('fib', TAstScript.Parse('(Memoize fib)')); var memoizeExec := memoizeTest.Link(memoizeTest.Compile(TAstScript.Parse('(fib 25)'))).Func; sw := TStopwatch.StartNew; result := memoizeExec([]); sw.Stop; Memo1.Lines.Add(Format('Result 1st call: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); sw := TStopwatch.StartNew; result := memoizeExec([]); sw.Stop; Memo1.Lines.Add(Format('Result 2nd call: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); UpdateScript; end; procedure TForm1.FlowOnlyBoxChange(Sender: TObject); begin UpdateScript; end; procedure TForm1.PrintScript(const Node: IAstNode); begin try FScriptUpdate := true; try if Assigned(Node) then ScriptMemo.Lines.Text := TAstScript.Print(Node) else ScriptMemo.Lines.Clear; finally FScriptUpdate := false; end; except on E: Exception do ScriptMemo.Lines.Add(E.Message); end; end; procedure TForm1.RTLListViewChange(Sender: TObject); var itemName: string; jsonString: string; jsonLib, jsonObj: TJSONObject; converter: IJsonAstConverter; AItem: TListViewItem; begin if RTLListView.ItemIndex < 0 then exit; AItem := RTLListView.Items[RTLListView.ItemIndex]; itemName := AItem.Text; Memo1.Lines.Clear; Memo1.Lines.Add(Format('Loading "%s" from library...', [itemName])); if not TFile.Exists(UserLibName) then begin Memo1.Lines.Add(Format('Library file "%s" not found.', [UserLibName])); exit; end; jsonLib := nil; try try jsonString := TFile.ReadAllText(UserLibName); jsonLib := TJSONObject.ParseJSONValue(jsonString) as TJSONObject; if not Assigned(jsonLib) then raise Exception.Create('Invalid JSON library format.'); var jsonValue := jsonLib.GetValue(itemName); if not Assigned(jsonValue) or not (jsonValue is TJSONObject) then raise Exception.Create(Format('Definition for "%s" not found in library.', [itemName])); jsonObj := jsonValue as TJSONObject; converter := TJsonAstConverter.Create; FCurrUnboundAst := converter.Deserialize(jsonObj); // <-- Store unbound AST // Update the UI UpdateScript; // This will print to ScriptMemo and show visualization Memo1.Lines.Add(Format('"%s" loaded into script editor and workspace.', [itemName])); except on E: Exception do begin Memo1.Lines.Add('Error: ' + E.Message); end; end; finally if Assigned(jsonLib) then jsonLib.Free; end; end; procedure TForm1.ScriptMemoChange(Sender: TObject); begin if FScriptUpdate then exit; Memo1.Lines.Clear; try FCurrUnboundAst := TAstScript.Parse(ScriptMemo.Lines.Text); try // We invoke ExecuteAst here to trigger the validation/compilation logic // and show the result in the log. var result := ExecuteAst(FCurrUnboundAst); Memo1.Lines.Add(Format('Script executed. Final result: %s', [result.ToString])); finally // Trigger visualization update via Component ShowVizualization; end; except on E: Exception do Memo1.Lines.Add(E.Message); end; end; procedure TForm1.FromJSONButtonClick(Sender: TObject); var jsonString: string; jsonObj: TJSONObject; converter: IJsonAstConverter; 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 converter := TJsonAstConverter.Create; jsonObj := TJSONObject.ParseJSONValue(jsonString) as TJSONObject; if not Assigned(jsonObj) then raise Exception.Create('Invalid JSON format.'); try FCurrUnboundAst := converter.Deserialize(jsonObj); // Run the full pipeline via environment FCurrCompiled := FEnvironment.Compile(FCurrUnboundAst); FCurrExec := FEnvironment.Link(FCurrCompiled); Memo1.Lines.Add('AST deserialized and bound successfully from JSON.'); Memo1.Lines.Add('You can now visualize it (Middle Mouse Click) or pretty-print it.'); finally jsonObj.Free; end; except on E: Exception do begin 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.OHLCButtonClick(Sender: TObject); const numRecs = 1000; lookback = 50; smaSlowLength = 20; smaFastLength = 10; var values: TArray; recordValue: TScalarRecord; setupAst: IAstNode; begin Memo1.Lines.Clear; Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs])); var sw := TStopwatch.StartNew; setupAst := TAstScript.Parse( ''' (do (def smaFast (CreateSMA 10)) (def smaSlow (CreateSMA 20)) (fn [ohlcv] (do (def closeSeries (:Close ohlcv)) (def currentClose (get closeSeries 0)) (def valSmaFast (smaFast closeSeries currentClose)) (def valSmaSlow (smaSlow closeSeries currentClose)) (? (> valSmaFast valSmaSlow) 1 -1) ) ) ) ''' ); FCurrUnboundAst := setupAst; UpdateScript; Application.ProcessMessages; var env := FEnvironment.CreateEnvironment; env.Define('maCrossStrategy', setupAst); var seriesAddress := env.RootScope.Define('current_series', TDataValue.Void); var callExec := env.Link(env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')]))).Func; // Simulation Loop Memo1.Lines.Clear; 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 env.RootScope[seriesAddress] := series; var resultValue := callExec([]); 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.UpdateScript; begin PrintScript(FCurrUnboundAst); // Clear and redraw via Component FAstEditor.SetRoot(FCurrUnboundAst); end; procedure TForm1.AstEditorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin // Nur zur Demo: Wir könnten hier klicken, um etwas im Memo zu loggen if Button = TMouseButton.mbMiddle then ShowVizualization; end; procedure TForm1.SaveUserLibButtonClick(Sender: TObject); var rootNode: IAstNode; definitions: TDictionary; jsonLib: TJSONObject; converter: IJsonAstConverter; jsonString: string; updatedCount: Integer; addedList: TList; begin try rootNode := TAstScript.Parse(ScriptMemo.Lines.Text); if not Assigned(rootNode) then raise Exception.Create('Script is empty or invalid.'); definitions := TDictionary.Create; try if rootNode.Kind = akBlockExpression then begin for var expr in rootNode.AsBlockExpression.Expressions do begin if (expr.Kind = akVariableDeclaration) then begin var decl := expr.AsVariableDeclaration; definitions.Add(decl.Target.AsIdentifier.Name, decl.Initializer); end else if expr.Kind = akMacroDefinition then begin var macroDef := expr.AsMacroDefinition; definitions.Add(macroDef.Name.Name, macroDef); end; end; end else if rootNode.Kind = akVariableDeclaration then begin var decl := rootNode.AsVariableDeclaration; definitions.Add(decl.Target.AsIdentifier.Name, decl.Initializer); end else if rootNode.Kind = akMacroDefinition then begin var macroDef := rootNode.AsMacroDefinition; definitions.Add(macroDef.Name.Name, macroDef); end; if definitions.Count = 0 then begin Memo1.Lines.Add('No top-level "(def ...)" or "(defmacro ...)" definitions found in the script to save.'); exit; end; jsonLib := nil; if TFile.Exists(UserLibName) then begin jsonString := TFile.ReadAllText(UserLibName); if not jsonString.IsEmpty then jsonLib := TJSONObject.ParseJSONValue(jsonString) as TJSONObject; end; if not Assigned(jsonLib) then jsonLib := TJSONObject.Create; addedList := TList.Create; try converter := TJsonAstConverter.Create; updatedCount := 0; for var pair in definitions do begin if jsonLib.Values[pair.Key] <> nil then begin Inc(updatedCount); jsonLib.RemovePair(pair.Key); end else addedList.Add(pair.Key); jsonLib.AddPair(pair.Key, converter.Serialize(pair.Value)); end; TFile.WriteAllText(UserLibName, jsonLib.Format(4)); Memo1.Lines.Add(Format('--- Library "%s" updated ---', [ExtractFileName(UserLibName)])); if updatedCount > 0 then Memo1.Lines.Add(Format('%d existing definitions updated.', [updatedCount])); if addedList.Count > 0 then begin Memo1.Lines.Add(Format('%d new definitions added:', [addedList.Count])); RTLListView.Items.BeginUpdate; try for var n in addedList do begin Memo1.Lines.Add(n); RTLListView.Items.Add.Text := n; end; finally RTLListView.Items.EndUpdate; end; end; finally jsonLib.Free; addedList.Free; end; finally definitions.Free; end; except on E: Exception do Memo1.Lines.Add('Error saving library: ' + E.Message); end; end; procedure TForm1.LoadUserLibButtonClick(Sender: TObject); var jsonString: string; jsonObj: TJSONObject; pair: TJSONPair; funcAst: IAstNode; funcValue: TDataValue; converter: IJsonAstConverter; addr: TResolvedAddress; begin if not TFile.Exists(UserLibName) then begin Memo1.Lines.Add(Format('Library file "%s" not found.', [UserLibName])); exit; end; try converter := TJsonAstConverter.Create; jsonString := TFile.ReadAllText(UserLibName); jsonObj := TJSONObject.ParseJSONValue(jsonString) as TJSONObject; if not Assigned(jsonObj) then raise Exception.Create('Invalid JSON format for library file.'); try Memo1.Lines.Add(Format('--- Loading User Library from %s ---', [ExtractFileName(UserLibName)])); RTLListView.Items.BeginUpdate; try for pair in jsonObj do begin if not (pair.JsonValue is TJSONObject) then continue; funcAst := converter.Deserialize(pair.JsonValue as TJSONObject); addr := FEnvironment.RootScope.Resolve(pair.JsonString.Value); if addr.Kind = akUnresolved then begin if funcAst.Kind = akMacroDefinition then begin FEnvironment.MacroRegistry.Define(funcAst.AsMacroDefinition); Memo1.Lines.Add(Format('Defined macro "%s"', [pair.JsonString.Value])); end else begin funcValue := ExecuteAst(funcAst); FEnvironment.RootScope.Define(pair.JsonString.Value, funcValue); Memo1.Lines.Add(Format('Defined function "%s"', [pair.JsonString.Value])); end; end else Memo1.Lines.Add(Format('Symbol "%s" already defined', [pair.JsonString.Value])); RTLListView.Items.Add.Text := pair.JsonString.Value; end; finally RTLListView.Items.EndUpdate; end; finally jsonObj.Free; end; except on E: Exception do Memo1.Lines.Add('Error loading library: ' + E.Message); end; end; procedure TForm1.RecursionButtonClick(Sender: TObject); begin TailCallButtenClick(Sender); end; procedure TForm1.SeriesTestButtonClick(Sender: TObject); var ast: IAstNode; resultValue: TDataValue; series: IWriteableScalarRecordSeries; recordDef: IScalarRecordDefinition; i: Integer; values: TArray; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Series Test ---'); recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson); series := TScalarRecordSeries.Create(recordDef); SetLength(values, 6); for i := 0 to 4 do begin 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; var testEnv := FEnvironment.CreateEnvironment; testEnv.RootScope.Define('ohlcvSeries', TDataValue.FromRecordSeries(series)); ast := TAst.LambdaExpr( [], TAst.Block( [ TAst.VarDecl( TAst.Identifier('closeColumn'), TAst.FunctionCall(TAst.Keyword('Close'), [TAst.Identifier('ohlcvSeries')]) ), TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(1)) ] ) ); var callAst := TAst.FunctionCall(ast, []); resultValue := testEnv.Run(callAst); Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString])); UpdateScript; end; procedure TForm1.TailCallButtenClick(Sender: TObject); const 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( [ TAst.VarDecl( TAst.Identifier('countDown'), TAst.LambdaExpr( [TAst.Identifier('n')], TAst.IfExpr( TAst.FunctionCall(TAst.Identifier('>'), [TAst.Identifier('n'), TAst.Constant(0)]), TAst.Recur([TAst.FunctionCall(TAst.Identifier('-'), [TAst.Identifier('n'), TAst.Constant(1)])]), TAst.Constant(0) ) ) ), TAst.FunctionCall(TAst.Identifier('countDown'), [TAst.Constant(RecursionDepth)]) ] ); result := ExecuteAst(root); 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.Test1ButtonClick(Sender: TObject); begin FCurrUnboundAst := TAstScript.Parse('(do (print txt))'); FCurrCompiled := FEnvironment.Compile(FCurrUnboundAst, [TAst.Identifier('txt')]); var fn := FEnvironment.Link(FCurrCompiled).Func; fn(['Hello World']); FEnvironment.RootScope.Define('fn', fn); 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.FunctionCall(TAst.Identifier('fn'), [TAst.Constant('xyz')]), TAst.VarDecl( TAst.Identifier('createStrategyInstance'), TAst.LambdaExpr( [TAst.Identifier('offset')], TAst.Block( [ TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(100)), TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('baseValue'), TAst.Identifier('offset')]) ] ) ) ), TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(20)]), TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(55)]) ] ); result := ExecuteAst(root); sw.Stop; Memo1.Lines.Add(Format('Result of the final expression: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); UpdateScript; end; procedure TForm1.ToJSONButtonClick(Sender: TObject); var jsonObj: TJSONObject; converter: IJsonAstConverter; begin Memo1.Lines.Clear; if not Assigned(FCurrExec.Func) then begin Memo1.Lines.Add('No *compiled* AST has been generated yet. Click a test button first.'); exit; end; try converter := TJsonAstConverter.Create; jsonObj := converter.Serialize(FCurrUnboundAst); try Memo1.Lines.Text := jsonObj.Format(4); finally jsonObj.Free; end; except on E: Exception do begin Memo1.Lines.Add('Error serializing AST to JSON:'); Memo1.Lines.Add(E.Message); end; end; end; procedure TForm1.DumpButtonClick(Sender: TObject); begin Memo1.Lines.Clear; Memo1.Lines.Add('--- AST Dump ---'); if FCurrCompiled = nil then begin Memo1.Lines.Add('No compiled AST available.'); exit; end; // Dump the raw unbound AST first TAstDumper.Dump(FCurrCompiled, Memo1.Lines); end; initialization TAst.RegisterLibrary(RegisterBroker); end.