Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

AST Debugger

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-13 20:40:18 +02:00
parent 0f9eb36ab8
commit d731048b41
4 changed files with 143 additions and 206 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.dproj
+1 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion> <ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType> <FrameworkType>FMX</FrameworkType>
<Base>True</Base> <Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config> <Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform> <Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">ASTPlayground</ProjectName> <ProjectName Condition="'$(ProjectName)'==''">ASTPlayground</ProjectName>
<TargetedPlatforms>2</TargetedPlatforms> <TargetedPlatforms>2</TargetedPlatforms>
ASTPlayground/MainForm.pas
+61 -121
View File
@@ -31,7 +31,7 @@ uses
FMX.Layouts, FMX.Layouts,
FMX.Objects, FMX.Objects,
Myc.Ast.Scope, Myc.Ast.Scope,
Myc.Ast.Debugger; // Added for TDebugSession Myc.Ast.Debugger;
type type
// A test record // A test record
@@ -86,6 +86,7 @@ type
FGScope: IExecutionScope; FGScope: IExecutionScope;
FWorkspace: TAuraWorkspace; FWorkspace: TAuraWorkspace;
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
function CreateVisitor(Scope: IExecutionScope): IAstVisitor;
// Helper function to encapsulate the Bind -> Evaluate pattern // Helper function to encapsulate the Bind -> Evaluate pattern
function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue; function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
public public
@@ -116,31 +117,12 @@ begin
end; end;
function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue; function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
var
scriptScope: IExecutionScope;
begin begin
// This helper function handles simple, one-off script executions. // 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. // It binds the AST and then decides whether to run a debug session or a standard evaluation.
scriptScope := TAst.Bind(ANode, AParentScope); var scriptScope := TAst.Bind(ANode, AParentScope);
var visitor := CreateVisitor(scriptScope);
if DebugBox.IsChecked then Result := ANode.Accept(visitor);
begin
// Debug path: Create, run, and destroy a debug session.
var session := TDebugSession.Create(ShowScopeBox.IsChecked);
try
Result := session.Execute(ANode, scriptScope);
Memo1.Lines.Add('--- DEBUG LOG ---');
Memo1.Lines.AddStrings(session.Log);
finally
session.Free;
end;
end
else
begin
// Production path: Create and use the standard evaluator.
var visitor := TEvaluatorVisitor.Create(scriptScope);
Result := ANode.Accept(visitor);
end;
end; end;
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
@@ -407,9 +389,7 @@ const
smaSlowLength = 20; smaSlowLength = 20;
smaFastLength = 10; smaFastLength = 10;
var var
visitor: IAstVisitor;
scope: IExecutionScope; scope: IExecutionScope;
session: TDebugSession;
begin begin
Memo1.Lines.Clear; Memo1.Lines.Clear;
Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs])); Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs]));
@@ -518,25 +498,8 @@ begin
scope := TAst.Bind(setupAst, FGScope); scope := TAst.Bind(setupAst, FGScope);
// This is a temporary visitor just for the setup execution. // This is a temporary visitor just for the setup execution.
var setupVisitor: IAstVisitor; var setupVisitor := CreateVisitor(scope);
if DebugBox.IsChecked then setupAst.Accept(setupVisitor);
begin
session := TDebugSession.Create(ShowScopeBox.IsChecked);
try
// Execute setup script within a temporary session.
session.Execute(setupAst, scope);
Memo1.Lines.Add('--- DEBUG LOG (Setup) ---');
Memo1.Lines.AddStrings(session.Log);
session.Log.Clear; // Clear log for the next phase
finally
session.Free;
end;
end
else
begin
setupVisitor := TEvaluatorVisitor.Create(scope);
setupAst.Accept(setupVisitor);
end;
// 2. Prepare for the simulation loop by modifying the now-populated scope. // 2. Prepare for the simulation loop by modifying the now-populated scope.
scope.Define('current_series', TDataValue.Void); scope.Define('current_series', TDataValue.Void);
@@ -547,73 +510,57 @@ begin
scope := TAst.Bind(callAst, scope); scope := TAst.Bind(callAst, scope);
var seriesAddress := currentSeriesIdent.Address; var seriesAddress := currentSeriesIdent.Address;
// 4. NOW create the visitor for the simulation loop, using the final scope. var visitor := CreateVisitor(scope);
session := nil;
try
if DebugBox.IsChecked then
begin
// Create a new session that will live for the duration of the loop.
session := TDebugSession.Create(ShowScopeBox.IsChecked);
visitor := TDebugEvaluatorVisitor.Create(scope, session.Log, ShowScopeBox.IsChecked, 1);
end
else
begin
visitor := TEvaluatorVisitor.Create(scope);
end;
// 5. Simulation Loop // 5. Simulation Loop
Memo1.Lines.Add('Starting simulation...'); Memo1.Lines.Add('Starting simulation...');
Application.ProcessMessages; Application.ProcessMessages;
var lastClose := 1000.0; var lastClose := 1000.0;
Randomize; Randomize;
var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>); var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
var series := TDataValue.FromRecordSeries(TScalarRecordSeries.Create(recDef)); var series := TDataValue.FromRecordSeries(TScalarRecordSeries.Create(recDef));
var nw := Now; var nw := Now;
var ohlcvRec: TOHLCV; var ohlcvRec: TOHLCV;
for var i := 1 to numRecs do for var i := 1 to numRecs do
begin
// ... (simulation logic is unchanged) ...
ohlcvRec.Timestamp := nw + (i / (24 * 60));
ohlcvRec.Open := lastClose + (Random * 0.05);
ohlcvRec.Close := lastClose + (Random - 0.49) * 2;
ohlcvRec.High := Max(ohlcvRec.Open, ohlcvRec.Close) + Random;
ohlcvRec.Low := Min(ohlcvRec.Open, ohlcvRec.Close) - Random;
ohlcvRec.Volume := RandomRange(1000, 50000);
lastClose := ohlcvRec.Close;
var recordValue :=
TScalarRecord.Create(
recDef,
[
TScalarValue.FromDateTime(ohlcvRec.Timestamp),
TScalarValue.FromDouble(ohlcvRec.Open),
TScalarValue.FromDouble(ohlcvRec.High),
TScalarValue.FromDouble(ohlcvRec.Low),
TScalarValue.FromDouble(ohlcvRec.Close),
TScalarValue.FromInt64(ohlcvRec.Volume)
]
);
series.AsRecordSeries.Value.Add(recordValue, lookback);
if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then
begin begin
// ... (simulation logic is unchanged) ... scope[seriesAddress].Value := series;
ohlcvRec.Timestamp := nw + (i / (24 * 60)); var resultValue := callAst.Accept(visitor);
ohlcvRec.Open := lastClose + (Random * 0.05); if i mod 50 = 0 then
ohlcvRec.Close := lastClose + (Random - 0.49) * 2;
ohlcvRec.High := Max(ohlcvRec.Open, ohlcvRec.Close) + Random;
ohlcvRec.Low := Min(ohlcvRec.Open, ohlcvRec.Close) - Random;
ohlcvRec.Volume := RandomRange(1000, 50000);
lastClose := ohlcvRec.Close;
var recordValue :=
TScalarRecord.Create(
recDef,
[
TScalarValue.FromDateTime(ohlcvRec.Timestamp),
TScalarValue.FromDouble(ohlcvRec.Open),
TScalarValue.FromDouble(ohlcvRec.High),
TScalarValue.FromDouble(ohlcvRec.Low),
TScalarValue.FromDouble(ohlcvRec.Close),
TScalarValue.FromInt64(ohlcvRec.Volume)
]
);
series.AsRecordSeries.Value.Add(recordValue, lookback);
if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then
begin begin
scope[seriesAddress].Value := series; Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
var resultValue := callAst.Accept(visitor); Application.ProcessMessages;
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;
end; end;
sw.Stop;
Memo1.Lines.Add('--- Simulation Finished ---');
Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds]));
finally
if Assigned(session) then
session.Free;
end; end;
sw.Stop;
Memo1.Lines.Add('--- Simulation Finished ---');
Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds]));
end; end;
var var
@@ -622,7 +569,6 @@ var
procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject); procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject);
var var
blk: IAstNode; blk: IAstNode;
visitor: IAstVisitor;
begin begin
Memo1.Lines.Clear; Memo1.Lines.Clear;
Memo1.Lines.Add('--- Creating Trigger Blueprint ---'); Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
@@ -643,22 +589,8 @@ begin
TriggerScope := TAst.Bind(blk, FGScope); TriggerScope := TAst.Bind(blk, FGScope);
// This case is simple enough to just inline the logic from ExecuteAst // This case is simple enough to just inline the logic from ExecuteAst
if DebugBox.IsChecked then var visitor := CreateVisitor(TriggerScope);
begin blk.Accept(visitor);
var session := TDebugSession.Create(ShowScopeBox.IsChecked);
try
session.Execute(blk, TriggerScope);
Memo1.Lines.Add('--- DEBUG LOG ---');
Memo1.Lines.AddStrings(session.Log);
finally
session.Free;
end;
end
else
begin
visitor := TEvaluatorVisitor.Create(TriggerScope);
blk.Accept(visitor);
end;
FLastAst := blk; FLastAst := blk;
@@ -666,6 +598,14 @@ begin
Memo1.Lines.Add('Click "Do Trigger" to execute.'); Memo1.Lines.Add('Click "Do Trigger" to execute.');
end; end;
function TForm1.CreateVisitor(Scope: IExecutionScope): IAstVisitor;
begin
if DebugBox.IsChecked then
Result := TDebugEvaluatorVisitor.CreateVisitor(Scope, Memo1.Lines, ShowScopeBox.IsChecked)
else
Result := TEvaluatorVisitor.Create(Scope);
end;
procedure TForm1.DoTriggerButtonClick(Sender: TObject); procedure TForm1.DoTriggerButtonClick(Sender: TObject);
var var
callAst: IFunctionCallNode; callAst: IFunctionCallNode;
Src/AST/Myc.Ast.Debugger.pas
+33 -80
View File
@@ -13,26 +13,6 @@ uses
Myc.Ast.Evaluator; Myc.Ast.Evaluator;
type type
TDebugSession = class
private
class var
FCurrent: TDebugSession;
private
FLog: TStrings;
FShowScope: Boolean;
FVisitorStack: TStack<IAstVisitor>;
function GetLog: TStrings;
public
constructor Create(AShowScope: Boolean);
destructor Destroy; override;
class property Current: TDebugSession read FCurrent;
function Execute(const ANode: IAstNode; const AScriptScope: IExecutionScope): TDataValue;
property Log: TStrings read GetLog;
property VisitorStack: TStack<IAstVisitor> read FVisitorStack;
end;
TDebugEvaluatorVisitor = class(TEvaluatorVisitor) TDebugEvaluatorVisitor = class(TEvaluatorVisitor)
private private
FLog: TStrings; FLog: TStrings;
@@ -44,9 +24,18 @@ type
procedure ShowScope; procedure ShowScope;
protected protected
// Overridden to provide the debug-specific visitor factory. // Overridden to provide the debug-specific visitor factory.
function GetVisitorFactory: TVisitorFactory; override; function CreateVisitorFactory: TVisitorFactory; override;
public public
constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
class function CreateVisitor(
const AScope: IExecutionScope;
ALog: TStrings;
AShowScope: Boolean;
AInitialIndent: Integer = 0
): IAstVisitor;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
// The logging overrides for other Visit... methods // The logging overrides for other Visit... methods
function VisitConstant(const Node: IConstantNode): TDataValue; override; function VisitConstant(const Node: IConstantNode): TDataValue; override;
@@ -71,44 +60,9 @@ uses
System.TypInfo, System.TypInfo,
Myc.Ast.Printer; Myc.Ast.Printer;
{ TDebugSession }
constructor TDebugSession.Create(AShowScope: Boolean);
begin
inherited Create;
if Assigned(FCurrent) then
raise EInvalidOpException.Create('Another debug session is already active.');
FLog := TStringList.Create;
FShowScope := AShowScope;
FVisitorStack := TStack<IAstVisitor>.Create;
FCurrent := Self;
end;
destructor TDebugSession.Destroy;
begin
FLog.Free;
FVisitorStack.Free;
FCurrent := nil;
inherited Destroy;
end;
function TDebugSession.Execute(const ANode: IAstNode; const AScriptScope: IExecutionScope): TDataValue;
var
initialVisitor: IAstVisitor;
begin
initialVisitor := TDebugEvaluatorVisitor.Create(AScriptScope, FLog, FShowScope, 0);
Result := ANode.Accept(initialVisitor);
end;
function TDebugSession.GetLog: TStrings;
begin
Result := FLog;
end;
{ TDebugEvaluatorVisitor } { TDebugEvaluatorVisitor }
constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer); constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
begin begin
inherited Create(AScope); inherited Create(AScope);
Assert(Assigned(ALog)); Assert(Assigned(ALog));
@@ -118,41 +72,32 @@ begin
ShowScope; ShowScope;
end; end;
function TDebugEvaluatorVisitor.GetVisitorFactory: TVisitorFactory; function TDebugEvaluatorVisitor.CreateVisitorFactory: TVisitorFactory;
begin begin
// Return a closure that creates a new Debug visitor, // Return a closure that creates a new Debug visitor, using the current context
// using the context from the currently active session stack.
var callingVisitor := Self as IAstVisitor;
Result := Result :=
function(const AScope: IExecutionScope): IAstVisitor function(const AScope: IExecutionScope): IAstVisitor
begin begin
if (not Assigned(TDebugSession.Current)) or (TDebugSession.Current.VisitorStack.Count = 0) then var visitor := callingVisitor as TDebugEvaluatorVisitor;
raise EInvalidOpException.Create('Visitor stack is empty during function invocation.'); Result := TDebugEvaluatorVisitor.Create(AScope, visitor.FLog, visitor.FShowScope, visitor.FIndentLevel);
var callingVisitor := TDebugSession.Current.VisitorStack.Peek as TDebugEvaluatorVisitor;
Result := TDebugEvaluatorVisitor.Create(AScope, callingVisitor.FLog, callingVisitor.FShowScope, callingVisitor.FIndentLevel);
end; end;
end; end;
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
begin begin
Assert(Assigned(TDebugSession.Current), 'No active debug session.'); AppendLine('FunctionCall{');
TDebugSession.Current.VisitorStack.Push(Self); Indent;
try try
AppendLine('FunctionCall{'); ShowScope;
Indent; Result := inherited VisitFunctionCall(Node);
try
ShowScope;
Result := inherited VisitFunctionCall(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
finally finally
TDebugSession.Current.VisitorStack.Pop; Unindent;
end; end;
AppendLine(Format('} -> %s', [Result.ToString]));
end; end;
// ... The rest of the TDebugEvaluatorVisitor logging methods are unchanged ...
procedure TDebugEvaluatorVisitor.Indent; procedure TDebugEvaluatorVisitor.Indent;
begin begin
inc(FIndentLevel); inc(FIndentLevel);
@@ -170,12 +115,20 @@ var
begin begin
pad := ''; pad := '';
for i := 0 to FIndentLevel - 1 do for i := 0 to FIndentLevel - 1 do
begin
pad := pad + ':' + ''.PadLeft(3); pad := pad + ':' + ''.PadLeft(3);
end;
FLog.Add(pad + S); FLog.Add(pad + S);
end; end;
class function TDebugEvaluatorVisitor.CreateVisitor(
const AScope: IExecutionScope;
ALog: TStrings;
AShowScope: Boolean;
AInitialIndent: Integer = 0
): IAstVisitor;
begin
Result := TDebugEvaluatorVisitor.Create(AScope, ALog, AShowScope, AInitialIndent);
end;
procedure TDebugEvaluatorVisitor.ShowScope; procedure TDebugEvaluatorVisitor.ShowScope;
var var
scopeDump: TArray<string>; scopeDump: TArray<string>;
Src/AST/Myc.Ast.Evaluator.pas
+48 -4
View File
@@ -22,8 +22,9 @@ type
FScope: IExecutionScope; FScope: IExecutionScope;
protected protected
function IsTruthy(const AValue: TDataValue): Boolean; function IsTruthy(const AValue: TDataValue): Boolean;
// Returns a closure that can create the correct type of visitor for a lambda's body. // Returns a closure that can create the correct type of visitor for a lambda's body.
function GetVisitorFactory: TVisitorFactory; virtual; function CreateVisitorFactory: TVisitorFactory; virtual;
// Creates the callable closure for a lambda expression. No longer virtual. // Creates the callable closure for a lambda expression. No longer virtual.
function CreateLambdaClosure( function CreateLambdaClosure(
@@ -103,7 +104,7 @@ begin
FScope := AScope; FScope := AScope;
end; end;
function TEvaluatorVisitor.GetVisitorFactory: TVisitorFactory; function TEvaluatorVisitor.CreateVisitorFactory: TVisitorFactory;
begin begin
// The production visitor returns a factory that creates another production visitor. // The production visitor returns a factory that creates another production visitor.
Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end; Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
@@ -137,7 +138,7 @@ var
visitorFactory: TVisitorFactory; visitorFactory: TVisitorFactory;
begin begin
// Get the appropriate factory via virtual dispatch. // Get the appropriate factory via virtual dispatch.
visitorFactory := GetVisitorFactory(); visitorFactory := CreateVisitorFactory();
closureValue := closureValue :=
TDataValue.TFunc( TDataValue.TFunc(
@@ -184,6 +185,8 @@ var
i: Integer; i: Integer;
sourceAddresses: TArray<TResolvedAddress>; sourceAddresses: TArray<TResolvedAddress>;
closureScope: IExecutionScope; closureScope: IExecutionScope;
closureValue: TDataValue;
visitorFactory: TVisitorFactory;
begin begin
sourceAddresses := Node.Upvalues; sourceAddresses := Node.Upvalues;
SetLength(capturedCells, Length(sourceAddresses)); SetLength(capturedCells, Length(sourceAddresses));
@@ -195,7 +198,48 @@ begin
else else
closureScope := nil; closureScope := nil;
Result := CreateLambdaClosure(Node, capturedCells, closureScope); // Get the appropriate factory via virtual dispatch.
visitorFactory := CreateVisitorFactory();
var scopeDescriptor := Node.ScopeDescriptor;
var params := Node.Parameters;
closureValue :=
TDataValue.TFunc(
function(const ArgValues: TArray<TDataValue>): TDataValue
var
lambdaScope: IExecutionScope;
bodyVisitor: IAstVisitor;
i: Integer;
adr: TResolvedAddress;
begin
if (Length(ArgValues) <> Length(params)) then
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(params), Length(ArgValues)]);
lambdaScope := TExecutionScope.Create(closureScope, scopeDescriptor, capturedCells);
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
// Set 'Self' (slot 0) to the captured closureValue for recursion.
adr.SlotIndex := 0;
lambdaScope.Cell[adr].Value := closureValue;
// Populate the actual parameters.
for i := 0 to High(ArgValues) do
begin
adr.SlotIndex := params[i].Address.SlotIndex;
lambdaScope.Cell[adr].Value := ArgValues[i];
end;
// Use the injected factory to create the visitor for the lambda's body.
bodyVisitor := visitorFactory(lambdaScope);
Result := Node.Body.Accept(bodyVisitor);
end
);
Result := closureValue;
end; end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;