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
Src/AST/Myc.Ast.Debugger.pas
+33 -80
View File
@@ -13,26 +13,6 @@ uses
Myc.Ast.Evaluator;
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)
private
FLog: TStrings;
@@ -44,9 +24,18 @@ type
procedure ShowScope;
protected
// Overridden to provide the debug-specific visitor factory.
function GetVisitorFactory: TVisitorFactory; override;
function CreateVisitorFactory: TVisitorFactory; override;
public
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;
// The logging overrides for other Visit... methods
function VisitConstant(const Node: IConstantNode): TDataValue; override;
@@ -71,44 +60,9 @@ uses
System.TypInfo,
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 }
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
inherited Create(AScope);
Assert(Assigned(ALog));
@@ -118,41 +72,32 @@ begin
ShowScope;
end;
function TDebugEvaluatorVisitor.GetVisitorFactory: TVisitorFactory;
function TDebugEvaluatorVisitor.CreateVisitorFactory: TVisitorFactory;
begin
// Return a closure that creates a new Debug visitor,
// using the context from the currently active session stack.
// Return a closure that creates a new Debug visitor, using the current context
var callingVisitor := Self as IAstVisitor;
Result :=
function(const AScope: IExecutionScope): IAstVisitor
begin
if (not Assigned(TDebugSession.Current)) or (TDebugSession.Current.VisitorStack.Count = 0) then
raise EInvalidOpException.Create('Visitor stack is empty during function invocation.');
var callingVisitor := TDebugSession.Current.VisitorStack.Peek as TDebugEvaluatorVisitor;
Result := TDebugEvaluatorVisitor.Create(AScope, callingVisitor.FLog, callingVisitor.FShowScope, callingVisitor.FIndentLevel);
var visitor := callingVisitor as TDebugEvaluatorVisitor;
Result := TDebugEvaluatorVisitor.Create(AScope, visitor.FLog, visitor.FShowScope, visitor.FIndentLevel);
end;
end;
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
begin
Assert(Assigned(TDebugSession.Current), 'No active debug session.');
TDebugSession.Current.VisitorStack.Push(Self);
AppendLine('FunctionCall{');
Indent;
try
AppendLine('FunctionCall{');
Indent;
try
ShowScope;
Result := inherited VisitFunctionCall(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
ShowScope;
Result := inherited VisitFunctionCall(Node);
finally
TDebugSession.Current.VisitorStack.Pop;
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
// ... The rest of the TDebugEvaluatorVisitor logging methods are unchanged ...
procedure TDebugEvaluatorVisitor.Indent;
begin
inc(FIndentLevel);
@@ -170,12 +115,20 @@ var
begin
pad := '';
for i := 0 to FIndentLevel - 1 do
begin
pad := pad + ':' + ''.PadLeft(3);
end;
FLog.Add(pad + S);
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;
var
scopeDump: TArray<string>;
Src/AST/Myc.Ast.Evaluator.pas
+48 -4
View File
@@ -22,8 +22,9 @@ type
FScope: IExecutionScope;
protected
function IsTruthy(const AValue: TDataValue): Boolean;
// 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.
function CreateLambdaClosure(
@@ -103,7 +104,7 @@ begin
FScope := AScope;
end;
function TEvaluatorVisitor.GetVisitorFactory: TVisitorFactory;
function TEvaluatorVisitor.CreateVisitorFactory: TVisitorFactory;
begin
// The production visitor returns a factory that creates another production visitor.
Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
@@ -137,7 +138,7 @@ var
visitorFactory: TVisitorFactory;
begin
// Get the appropriate factory via virtual dispatch.
visitorFactory := GetVisitorFactory();
visitorFactory := CreateVisitorFactory();
closureValue :=
TDataValue.TFunc(
@@ -184,6 +185,8 @@ var
i: Integer;
sourceAddresses: TArray<TResolvedAddress>;
closureScope: IExecutionScope;
closureValue: TDataValue;
visitorFactory: TVisitorFactory;
begin
sourceAddresses := Node.Upvalues;
SetLength(capturedCells, Length(sourceAddresses));
@@ -195,7 +198,48 @@ begin
else
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;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;