MycLib/Src/AST/Myc.Ast.Dumper.pas

unit Myc.Ast.Dumper;

interface

uses
    System.SysUtils,
    System.Classes,
    System.Generics.Collections,
    Myc.Ast.Nodes,
    Myc.Ast.Traverser,
    Myc.Data.Value,
    Myc.Data.Scalar;

type
    // Dumps a bound AST into a human-readable format for debugging purposes.
    TAstDumper = class(TAstTraverser)
    private
        FOutput: TStrings;
        FIndent: Integer;
        procedure Indent;
        procedure Unindent;
        procedure Log(const Text: string); overload;
        procedure LogFmt(const Fmt: string; const Args: array of const); overload;
        function FormatAddress(const Addr: TResolvedAddress): string;
    protected
        function Accept(const Node: IAstNode): TDataValue; override;
    public
        // Creates a new instance of the AST dumper.
        constructor Create(const AOutput: TStrings);

        // Traverses the given root node and writes the structural information into the output.
        class procedure Dump(const RootNode: IAstNode; const Output: TStrings);

        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 VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
        function VisitFunctionCall(const Node: IFunctionCallNode): 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

{ TAstDumper }

class procedure TAstDumper.Dump(const RootNode: IAstNode; const Output: TStrings);
var
    dumper: TAstDumper;
begin
    if not Assigned(Output) then
        exit;

    Output.Clear;
    dumper := TAstDumper.Create(Output);
    try
        dumper.Accept(RootNode);
    finally
        dumper.Free;
    end;
end;

constructor TAstDumper.Create(const AOutput: TStrings);
begin
    inherited Create;
    FOutput := AOutput;
    FIndent := 0;
end;

function TAstDumper.Accept(const Node: IAstNode): TDataValue;
begin
    Result := TDataValue.Void;
    if Assigned(Node) then
        Result := inherited Accept(Node);
end;

procedure TAstDumper.Indent;
begin
    inc(FIndent, 2);
end;

procedure TAstDumper.Unindent;
begin
    dec(FIndent, 2);
end;

procedure TAstDumper.Log(const Text: string);
begin
    FOutput.Add(StringOfChar(' ', FIndent) + Text);
end;

procedure TAstDumper.LogFmt(const Fmt: string; const Args: array of const);
begin
    Log(Format(Fmt, Args));
end;

function TAstDumper.FormatAddress(const Addr: TResolvedAddress): string;
begin
    case Addr.Kind of
        akUnresolved: Result := '!! UNRESOLVED !!';
        akLocalOrParent: Result := Format('LocalOrParent (Depth: %d, Slot: %d)', [Addr.ScopeDepth, Addr.SlotIndex]);
        akUpvalue: Result := Format('Upvalue (Index: %d)', [Addr.SlotIndex]);
    else
        Result := 'Unknown Address Kind';
    end;
end;

function TAstDumper.VisitConstant(const Node: IConstantNode): TDataValue;
begin
    LogFmt('Constant: %s', [Node.Value.ToString]);
    Result := TDataValue.Void;
end;

function TAstDumper.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
    LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(Node.Address)]);
    Result := TDataValue.Void;
end;

function TAstDumper.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
    LogFmt('BinaryExpression: %s', [Node.Operator.ToString]);
    Indent;
    Accept(Node.Left);
    Accept(Node.Right);
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
    LogFmt('UnaryExpression: %s', [Node.Operator.ToString]);
    Indent;
    Accept(Node.Right);
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
    Log('IfExpression');
    Indent;
    Log('Condition:');
    Accept(Node.Condition);
    Log('Then:');
    Accept(Node.ThenBranch);
    if Assigned(Node.ElseBranch) then
    begin
        Log('Else:');
        Accept(Node.ElseBranch);
    end;
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
    Log('TernaryExpression');
    Indent;
    Log('Condition:');
    Accept(Node.Condition);
    Log('Then:');
    Accept(Node.ThenBranch);
    Log('Else:');
    Accept(Node.ElseBranch);
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
    param: IIdentifierNode;
    upvalueAddr: TResolvedAddress;
    pair: TPair<string, Integer>;
begin
    LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString]);
    Indent;

    Log('Parameters:');
    Indent;
    for param in Node.Parameters do
        Accept(param);
    Unindent;

    LogFmt('Upvalues (%d):', [Length(Node.Upvalues)]);
    Indent;
    for upvalueAddr in Node.Upvalues do
        Log(FormatAddress(upvalueAddr));
    Unindent;

    Log('Scope Descriptor:');
    Indent;
    if Assigned(Node.ScopeDescriptor) then
        for pair in Node.ScopeDescriptor.Symbols do
            LogFmt('"%s" -> Slot %d', [pair.Key, pair.Value])
    else
        Log('(none)');
    Unindent;

    Log('Body:');
    Accept(Node.Body);

    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
    arg: IAstNode;
begin
    LogFmt('FunctionCall (IsTailCall: %s)', [Node.IsTailCall.ToString]);
    Indent;
    Log('Callee:');
    Accept(Node.Callee);
    LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
    Indent;
    for arg in Node.Arguments do
        Accept(arg);
    Unindent;
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
    expr: IAstNode;
begin
    Log('BlockExpression');
    Indent;
    for expr in Node.Expressions do
        Accept(expr);
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
    Log('VariableDeclaration');
    Indent;
    Accept(Node.Identifier);
    if Assigned(Node.Initializer) then
    begin
        Log('Initializer:');
        Accept(Node.Initializer);
    end;
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
    Log('Assignment');
    Indent;
    Accept(Node.Identifier);
    Log('Value:');
    Accept(Node.Value);
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
    Log('Indexer');
    Indent;
    Log('Base:');
    Accept(Node.Base);
    Log('Index:');
    Accept(Node.Index);
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
    Log('MemberAccess');
    Indent;
    Log('Base:');
    Accept(Node.Base);
    Log('Member:');
    Accept(Node.Member);
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
    LogFmt('CreateSeries: %s', [Node.Definition]);
    Result := TDataValue.Void;
end;

function TAstDumper.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
    Log('AddSeriesItem');
    Indent;
    Log('Series:');
    Accept(Node.Series);
    Log('Value:');
    Accept(Node.Value);
    if Assigned(Node.Lookback) then
    begin
        Log('Lookback:');
        Accept(Node.Lookback);
    end;
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
    Log('SeriesLength');
    Indent;
    Log('Series:');
    Accept(Node.Series);
    Unindent;
    Result := TDataValue.Void;
end;

end.