AST Debugger
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,352 @@
|
||||
unit Myc.Ast.Debugger;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.Generics.Collections,
|
||||
Myc.Data.Value,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast,
|
||||
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;
|
||||
FIndentLevel: Integer;
|
||||
FShowScope: Boolean;
|
||||
procedure Indent;
|
||||
procedure Unindent;
|
||||
procedure AppendLine(const S: string);
|
||||
procedure ShowScope;
|
||||
protected
|
||||
// Overridden to provide the debug-specific visitor factory.
|
||||
function GetVisitorFactory: TVisitorFactory; override;
|
||||
public
|
||||
constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
// The logging overrides for other Visit... methods
|
||||
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
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);
|
||||
begin
|
||||
inherited Create(AScope);
|
||||
Assert(Assigned(ALog));
|
||||
FLog := ALog;
|
||||
FIndentLevel := AInitialIndent;
|
||||
FShowScope := AShowScope;
|
||||
ShowScope;
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.GetVisitorFactory: TVisitorFactory;
|
||||
begin
|
||||
// Return a closure that creates a new Debug visitor,
|
||||
// using the context from the currently active session stack.
|
||||
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);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
begin
|
||||
Assert(Assigned(TDebugSession.Current), 'No active debug session.');
|
||||
TDebugSession.Current.VisitorStack.Push(Self);
|
||||
try
|
||||
AppendLine('FunctionCall{');
|
||||
Indent;
|
||||
try
|
||||
ShowScope;
|
||||
Result := inherited VisitFunctionCall(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
finally
|
||||
TDebugSession.Current.VisitorStack.Pop;
|
||||
end;
|
||||
end;
|
||||
|
||||
// ... The rest of the TDebugEvaluatorVisitor logging methods are unchanged ...
|
||||
procedure TDebugEvaluatorVisitor.Indent;
|
||||
begin
|
||||
inc(FIndentLevel);
|
||||
end;
|
||||
|
||||
procedure TDebugEvaluatorVisitor.Unindent;
|
||||
begin
|
||||
dec(FIndentLevel);
|
||||
end;
|
||||
|
||||
procedure TDebugEvaluatorVisitor.AppendLine(const S: string);
|
||||
var
|
||||
pad: string;
|
||||
i: Integer;
|
||||
begin
|
||||
pad := '';
|
||||
for i := 0 to FIndentLevel - 1 do
|
||||
begin
|
||||
pad := pad + ':' + ''.PadLeft(3);
|
||||
end;
|
||||
FLog.Add(pad + S);
|
||||
end;
|
||||
|
||||
procedure TDebugEvaluatorVisitor.ShowScope;
|
||||
var
|
||||
scopeDump: TArray<string>;
|
||||
line: string;
|
||||
begin
|
||||
if FShowScope then
|
||||
begin
|
||||
AppendLine('-- Scope --');
|
||||
scopeDump := Scope.Dump.Split([sLineBreak]);
|
||||
for line in scopeDump do
|
||||
begin
|
||||
AppendLine(line);
|
||||
end;
|
||||
AppendLine('-----------');
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||
begin
|
||||
AppendLine('AddSeriesItem {');
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitAddSeriesItem(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine('} -> (void)');
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||
begin
|
||||
AppendLine(Format('Assignment to "%s" {', [Node.Identifier.Name]));
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitAssignment(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||
begin
|
||||
AppendLine(Format('Constant (%s)', [Node.Value.ToString]));
|
||||
Result := inherited VisitConstant(Node);
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||
begin
|
||||
AppendLine('CreateSeries {');
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitCreateSeries(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
begin
|
||||
Result := inherited VisitIdentifier(Node);
|
||||
AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.ToString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||
begin
|
||||
AppendLine(Format('BinaryExpr "%s" {', [Node.Operator.ToString]));
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitBinaryExpression(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
begin
|
||||
AppendLine(Format('UnaryExpr "%s" {', [Node.Operator.ToString]));
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitUnaryExpression(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
begin
|
||||
AppendLine('IfExpr{');
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitIfExpression(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||
begin
|
||||
AppendLine('Indexer {');
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitIndexer(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||
begin
|
||||
AppendLine(Format('MemberAccess (Member: %s) {', [Node.Member.Name]));
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitMemberAccess(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||
begin
|
||||
AppendLine('TernaryExpr{');
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitTernaryExpression(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
begin
|
||||
AppendLine('Block{');
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitBlockExpression(Node);
|
||||
ShowScope;
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
begin
|
||||
AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name]));
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitVariableDeclaration(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||
begin
|
||||
AppendLine('SeriesLength {');
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitSeriesLength(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.ToString]));
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user