Michael Schimmel
1325 lines
46 KiB
ObjectPascal
1325 lines
46 KiB
ObjectPascal
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,
|
|
Myc.Data.Scalar,
|
|
Myc.Data.Value,
|
|
Myc.Ast.Nodes,
|
|
Myc.Ast.Scope,
|
|
Myc.Ast,
|
|
Myc.Ast.Visitor,
|
|
Myc.Data.Decimal,
|
|
Myc.Ast.Script,
|
|
FMX.Layouts,
|
|
FMX.Objects,
|
|
Myc.Fmx.AstEditor.Node,
|
|
Myc.Fmx.AstEditor.Workspace,
|
|
FMX.DialogService,
|
|
FMX.ListView.Types,
|
|
FMX.ListView.Appearances,
|
|
FMX.ListView.Adapters.Base,
|
|
FMX.ListView,
|
|
Myc.Ast.Environment; // Added Environment
|
|
|
|
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;
|
|
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;
|
|
procedure InnerLambdaButtonClick(Sender: TObject);
|
|
procedure ClearButtonClick(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 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);
|
|
procedure SaveUserLibButtonClick(Sender: TObject);
|
|
procedure LoadUserLibButtonClick(Sender: TObject);
|
|
procedure RTLListViewChange(Sender: TObject);
|
|
private
|
|
FCurrUnboundAst: IAstNode;
|
|
FCurrExec: IExecutable; // Replaced FCurrAst and FCurrDesc
|
|
FEnvironment: TAstEnvironment;
|
|
FWorkspace: TAuraWorkspace;
|
|
FScriptUpdate: Boolean;
|
|
FTriggerTest: TAstEnvironment;
|
|
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
|
|
|
function CreateEnvironment: TAstEnvironment;
|
|
// Helper function to encapsulate the Compile -> Evaluate pattern
|
|
function ExecuteAst(const ANode: IAstNode): TDataValue;
|
|
procedure UpdateScript;
|
|
procedure ShowVizualization(X, Y: Single);
|
|
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,
|
|
System.Diagnostics, // For TStopwatch
|
|
System.TimeSpan,
|
|
Myc.Ast.Json, // For TAstJson serialization
|
|
Myc.Ast.Types, // Needed for TTypeRules
|
|
System.IOUtils, // For TFile
|
|
Myc.Ast.Dumper, // Needed for DumpButtonClick
|
|
Myc.Ast.RTL,
|
|
Myc.Ast.Compiler.Macros; // Needed for MacroRegistry access
|
|
|
|
{$R *.fmx}
|
|
|
|
procedure TForm1.InnerLambdaButtonClick(Sender: TObject);
|
|
var
|
|
mainBlock: IAstNode;
|
|
resultValue: TDataValue;
|
|
begin
|
|
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.BinaryExpr(TAst.Identifier('x'), TScalar.TBinaryOp.Add, 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'), []))
|
|
]
|
|
);
|
|
|
|
resultValue := ExecuteAst(mainBlock);
|
|
|
|
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;
|
|
end;
|
|
|
|
function TForm1.CreateEnvironment: TAstEnvironment;
|
|
begin
|
|
if DebugBox.IsChecked then
|
|
Result.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked)
|
|
else
|
|
Result.SetStandardMode;
|
|
end;
|
|
|
|
// Simplified ExecuteAst using TEnvironment
|
|
function TForm1.ExecuteAst(const ANode: IAstNode): TDataValue;
|
|
begin
|
|
FCurrUnboundAst := ANode;
|
|
FCurrExec := nil; // Clear previous
|
|
|
|
// 1. Set strategy based on UI
|
|
if DebugBox.IsChecked then
|
|
FEnvironment.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked)
|
|
else
|
|
FEnvironment.SetStandardMode;
|
|
|
|
try
|
|
// 2. Compile (Pipeline is inside Environment)
|
|
// We store the executable artifact in the form
|
|
FCurrExec := FEnvironment.Compile(ANode);
|
|
|
|
// 3. Execute
|
|
Result := FEnvironment.Execute(FCurrExec);
|
|
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
Memo1.Lines.Add('--- ERROR ---');
|
|
Memo1.Lines.Add(E.ClassName + ': ' + E.Message);
|
|
Result := TDataValue.Void;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
FEnvironment := CreateEnvironment;
|
|
|
|
FWorkspace := TAuraWorkspace.Create(Panel2);
|
|
FWorkspace.Parent := Panel2;
|
|
FWorkspace.Align := TAlignLayout.Client;
|
|
FWorkspace.ClipChildren := true;
|
|
FWorkspace.OnMouseDown := WorkspaceMouseDown;
|
|
|
|
RegisterRtlFunctions(FEnvironment.RootScope);
|
|
|
|
// Register the SMA factory into the environment
|
|
var RegFunc :=
|
|
procedure(const Scope: IExecutionScope)
|
|
var
|
|
smaAst: IAstNode;
|
|
smaExec: IExecutable;
|
|
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.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')
|
|
)
|
|
)
|
|
]
|
|
)
|
|
)
|
|
]
|
|
)
|
|
);
|
|
|
|
// Compile the SMA factory using the environment itself
|
|
// Note: We pass FEnvironment.RootScope as the parent scope
|
|
smaExec := FEnvironment.Compile(smaAst);
|
|
|
|
// Execute the compiled AST to define the 'CreateSMA' function in the target scope
|
|
// We must use the *target* scope (Scope) as the parent for execution.
|
|
var smaFactory := FEnvironment.Execute(smaExec);
|
|
|
|
Scope.Define('CreateSMA', smaFactory); // Define the factory
|
|
|
|
Scope.Define(
|
|
'print',
|
|
function(const Args: TArray<TDataValue>): 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>): TDataValue
|
|
begin
|
|
Result := TStopwatch.GetTimeStamp div TTimeSpan.TicksPerMillisecond;
|
|
end
|
|
);
|
|
end;
|
|
|
|
RegFunc(FEnvironment.RootScope);
|
|
|
|
// Register the 'stopwatch' macro into the global registry
|
|
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
|
|
);
|
|
|
|
ClearButtonClick(Self);
|
|
end;
|
|
|
|
procedure TForm1.LoadUserLibButtonClick(Sender: TObject);
|
|
var
|
|
jsonString: string;
|
|
jsonObj: TJSONObject;
|
|
pair: TJSONPair;
|
|
funcAst: IAstNode;
|
|
funcValue: TDataValue;
|
|
converter: IJsonAstConverter;
|
|
begin
|
|
// Load definitions from JSON and populate the global scope.
|
|
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)]));
|
|
var scopeDescr := FEnvironment.RootScope.CreateDescriptor;
|
|
// Populate the list view with loaded functions and macros.
|
|
RTLListView.Items.BeginUpdate;
|
|
try
|
|
for pair in jsonObj do
|
|
begin
|
|
if not (pair.JsonValue is TJSONObject) then
|
|
continue;
|
|
|
|
// First, deserialize the AST node from JSON.
|
|
funcAst := converter.Deserialize(pair.JsonValue as TJSONObject);
|
|
|
|
var sym := scopeDescr.FindSymbol(pair.JsonString.Value);
|
|
if sym.Address.Kind = akUnresolved then
|
|
begin
|
|
// Distinguish between loading a macro and loading a function.
|
|
if funcAst.Kind = akMacroDefinition then
|
|
begin
|
|
// Macros are stored in the *global compile-time registry*.
|
|
FEnvironment.MacroRegistry.Define(funcAst.AsMacroDefinition);
|
|
Memo1.Lines.Add(Format('Defined macro "%s"', [pair.JsonString.Value]));
|
|
end
|
|
else
|
|
begin
|
|
// Functions (lambdas) must be executed to create a callable closure.
|
|
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]));
|
|
// Add the new function/macro to the RTL list view.
|
|
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.SaveUserLibButtonClick(Sender: TObject);
|
|
var
|
|
rootNode: IAstNode;
|
|
definitions: TDictionary<string, IAstNode>;
|
|
jsonLib: TJSONObject;
|
|
converter: IJsonAstConverter;
|
|
jsonString: string;
|
|
updatedCount: Integer;
|
|
addedList: TList<String>;
|
|
begin
|
|
// Extract definitions from the current script and merge them into the JSON library.
|
|
try
|
|
rootNode := TAstScript.Parse(ScriptMemo.Lines.Text);
|
|
if not Assigned(rootNode) then
|
|
raise Exception.Create('Script is empty or invalid.');
|
|
|
|
definitions := TDictionary<string, IAstNode>.Create;
|
|
try
|
|
// Check if the root is a block and extract top-level definitions
|
|
if rootNode.Kind = akBlockExpression then
|
|
begin
|
|
for var expr in rootNode.AsBlockExpression.Expressions do
|
|
begin
|
|
// Use interface 'is' check
|
|
if (expr.Kind = akVariableDeclaration) then
|
|
begin
|
|
var decl := expr.AsVariableDeclaration;
|
|
definitions.Add(decl.Identifier.Name, decl.Initializer);
|
|
end
|
|
// Handle macro definitions inside the block
|
|
else if expr.Kind = akMacroDefinition then
|
|
begin
|
|
var macroDef := expr.AsMacroDefinition;
|
|
// Store the entire macro definition node for serialization.
|
|
definitions.Add(macroDef.Name.Name, macroDef);
|
|
end;
|
|
end;
|
|
end
|
|
// Use interface 'is' check
|
|
else if rootNode.Kind = akVariableDeclaration then // Handle single definition
|
|
begin
|
|
var decl := rootNode.AsVariableDeclaration;
|
|
definitions.Add(decl.Identifier.Name, decl.Initializer);
|
|
end
|
|
// Handle a single macro definition
|
|
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;
|
|
|
|
// Load existing library file or create a new JSON object if it doesn't exist
|
|
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<String>.Create;
|
|
try
|
|
// Serialize and merge the definitions from the script into the JSON object
|
|
converter := TJsonAstConverter.Create;
|
|
updatedCount := 0;
|
|
|
|
for var pair in definitions do
|
|
begin
|
|
// Track if we are adding or updating a function/macro
|
|
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));
|
|
|
|
// Provide more detailed feedback to the user
|
|
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]));
|
|
// Add the new item to the RTL list view.
|
|
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.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 EJSONParseException.Create('Invalid JSON format.');
|
|
|
|
try
|
|
var unboundAst := converter.Deserialize(jsonObj);
|
|
|
|
// Set strategy based on UI
|
|
if DebugBox.IsChecked then
|
|
FEnvironment.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked)
|
|
else
|
|
FEnvironment.SetStandardMode;
|
|
|
|
// Run the full pipeline
|
|
FCurrExec := FEnvironment.Compile(unboundAst);
|
|
|
|
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
|
|
FCurrExec := 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.ToJSONButtonClick(Sender: TObject);
|
|
var
|
|
jsonObj: TJSONObject;
|
|
converter: IJsonAstConverter;
|
|
begin
|
|
Memo1.Lines.Clear;
|
|
|
|
if not Assigned(FCurrExec) then
|
|
begin
|
|
Memo1.Lines.Add('No AST available to serialize. Please generate one first.');
|
|
exit;
|
|
end;
|
|
|
|
try
|
|
converter := TJsonAstConverter.Create;
|
|
jsonObj := converter.Serialize(FCurrExec.CompiledAst);
|
|
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 not Assigned(FCurrExec) then // Check FCurrExec
|
|
begin
|
|
Memo1.Lines.Add('No *compiled* AST has been generated yet. Click a test button first.');
|
|
exit;
|
|
end;
|
|
|
|
// Dump the compiled AST from the executable
|
|
TAstDumper.Dump(FCurrExec.CompiledAst, Memo1.Lines);
|
|
end;
|
|
|
|
procedure TForm1.FibonacciButtonClick(Sender: TObject);
|
|
var
|
|
result: TDataValue;
|
|
sw: TStopwatch;
|
|
fibDataValue: TDataValue;
|
|
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---');
|
|
|
|
var fibExec := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]));
|
|
|
|
sw := TStopwatch.StartNew;
|
|
result := TestEnv.Execute(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.Compile(TAstScript.Parse('(fib 25)'));
|
|
|
|
sw := TStopwatch.StartNew;
|
|
result := memoizeTest.Execute(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 := memoizeTest.Execute(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.PrettyPrintButtonClick(Sender: TObject);
|
|
begin
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- AST Pretty Print ---');
|
|
|
|
// We print the *compiled* AST
|
|
if not Assigned(FCurrExec) then
|
|
begin
|
|
Memo1.Lines.Add('No AST has been generated yet.');
|
|
exit;
|
|
end;
|
|
|
|
Memo1.Lines.Add(TAstScript.Print(FCurrExec.CompiledAst));
|
|
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;
|
|
|
|
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)])
|
|
]
|
|
);
|
|
|
|
// Execute with RootScope as parent.
|
|
result := ExecuteAst(root);
|
|
|
|
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: IScalarRecordDefinition;
|
|
i: Integer;
|
|
values: TArray<TScalar.TValue>;
|
|
begin
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- Series Test ---');
|
|
|
|
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
|
|
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))
|
|
]
|
|
)
|
|
);
|
|
|
|
callAst := TAst.FunctionCall(ast, []);
|
|
|
|
resultValue := testEnv.CompileAndExecute(callAst);
|
|
|
|
Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString]));
|
|
UpdateScript;
|
|
end;
|
|
|
|
procedure TForm1.Test1ButtonClick(Sender: TObject);
|
|
begin
|
|
FCurrUnboundAst :=
|
|
TAst.Block(
|
|
[
|
|
TAst.LambdaExpr(
|
|
[],
|
|
TAst.Block(
|
|
[
|
|
TAst.VarDecl(TAst.Identifier('a'), TAst.Nop),
|
|
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'))
|
|
]
|
|
)
|
|
)
|
|
]
|
|
);
|
|
|
|
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)])
|
|
]
|
|
);
|
|
|
|
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.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
|
|
values: TArray<TScalar.TValue>;
|
|
recordValue: TScalarRecord;
|
|
setupAst: IAstNode;
|
|
callExec: IExecutable;
|
|
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);
|
|
|
|
callExec := env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')]));
|
|
|
|
// Simulation Loop
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('Starting simulation...');
|
|
Application.ProcessMessages;
|
|
|
|
var lastClose := 1000.0;
|
|
Randomize;
|
|
var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
|
|
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 := env.Execute(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.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.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Greater, TAst.Constant(0)),
|
|
TAst.Recur([TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, 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.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'))
|
|
)
|
|
)
|
|
)
|
|
]
|
|
);
|
|
|
|
FTriggerTest := FEnvironment.CreateEnvironment;
|
|
|
|
FTriggerTest.Define('X', TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(0)));
|
|
FTriggerTest.Define(
|
|
'tickHandler',
|
|
TAst.LambdaExpr(
|
|
[TAst.Identifier('summand')],
|
|
TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), TScalar.TBinaryOp.Add, 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.CompileAndExecute(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.CompileAndExecute(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>): 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
|
|
mainBlock: IAstNode;
|
|
resultValue: TDataValue;
|
|
begin
|
|
mainBlock :=
|
|
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.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Add, 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'), [])
|
|
]
|
|
);
|
|
|
|
Memo1.Lines.Clear;
|
|
Memo1.Lines.Add('--- Executing Corrected Upvalue Test ---');
|
|
|
|
resultValue := ExecuteAst(mainBlock);
|
|
|
|
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.');
|
|
Memo1.Lines.Add('Please check the new dump.');
|
|
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
|
|
try
|
|
// Execute the entire script block when it changes
|
|
var result := ExecuteAst(TAstScript.Parse(ScriptMemo.Lines.Text));
|
|
Memo1.Lines.Add(Format('Script executed. Final result: %s', [result.ToString]));
|
|
finally
|
|
ShowVizualization(14, 14);
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
Memo1.Lines.Add(E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.UpdateScript;
|
|
begin
|
|
PrintScript(FCurrUnboundAst);
|
|
|
|
FWorkspace.DeleteChildren;
|
|
ShowVizualization(14, 14);
|
|
end;
|
|
|
|
procedure TForm1.ShowVizualization(X, Y: Single);
|
|
begin
|
|
FWorkspace.DeleteChildren;
|
|
|
|
FWorkspace.Build(FCurrUnboundAst, TPointF.Create(X, Y));
|
|
//
|
|
// if FCurrExec <> nil then
|
|
// begin
|
|
// FWorkspace.Build(FCurrExec.CompiledAst, TPointF.Create(X, Y));
|
|
// end
|
|
// else if FCurrUnboundAst <> nil then
|
|
// begin
|
|
// FWorkspace.Build(FCurrUnboundAst, TPointF.Create(X, Y));
|
|
// end;
|
|
end;
|
|
|
|
end.
|