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.Visitor,
    Myc.Data.Value,
    Myc.Data.Scalar;

type
    // Dumps a bound AST into a human-readable format for debugging purposes.
    // It inherits from the abstract TAstVisitor to implement the IAstVisitor interface.
    IAstDumper = interface(IAstVisitor)
        procedure Execute(const RootNode: IAstNode);
    end;

    TAstDumper = class(TAstVisitor)
    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 VisitConstant(const Node: IConstantNode): TDataValue; override;
        function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
        function VisitKeyword(const Node: IKeywordNode): 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 VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
        function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
        function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
        function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
        function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
        function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
        function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override;
        function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
        function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
        function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
        function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
        function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
        function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
        function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
        function VisitSeriesLength(const Node: ISeriesLengthNode): 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);

        procedure Execute(const RootNode: IAstNode);
    end;

implementation

uses
    Myc.Data.Keyword,
    Myc.Ast.Binding; // For TBound...Node classes

{ TAstDumper }

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

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

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

procedure TAstDumper.Execute(const RootNode: IAstNode);
begin
    if Assigned(RootNode) then
        RootNode.Accept(Self);
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
    if Node is TBoundIdentifierNode then
        LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress((Node as TBoundIdentifierNode).Address)])
    else
        LogFmt('Identifier: %s (unbound)', [Node.Name]);
    Result := TDataValue.Void;
end;

function TAstDumper.VisitKeyword(const Node: IKeywordNode): TDataValue;
begin
    LogFmt('Keyword: :%s', [Node.Value.Name]);
    Result := TDataValue.Void;
end;

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

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

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

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

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

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

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

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

        Log('Body:');
        boundNode.Body.Accept(Self);

        Unindent;
    end
    else
    begin
        Log('LambdaExpression (unbound)');
        Indent;
        Log('Parameters:');
        Indent;
        for param in Node.Parameters do
            param.Accept(Self);
        Unindent;
        Log('Body:');
        Node.Body.Accept(Self);
        Unindent;
    end;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
    arg: IAstNode;
begin
    if Node is TBoundFunctionCallNode then
        LogFmt('FunctionCall (IsTailCall: %s)', [(Node as TBoundFunctionCallNode).IsTailCall.ToString(TUseBoolStrs.True)])
    else
        Log('FunctionCall (unbound)');

    Indent;
    Log('Callee:');
    Node.Callee.Accept(Self);
    LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
    Indent;
    for arg in Node.Arguments do
        arg.Accept(Self);
    Unindent;
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
var
    arg: IAstNode;
begin
    Log('MacroExpansion');
    Indent;

    Log('Original Call:');
    Indent;
    Log('Callee:');
    Node.Callee.Accept(Self);
    LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
    Indent;
    for arg in Node.Arguments do
        arg.Accept(Self);
    Unindent;
    Unindent;

    Log('Expanded Body:');
    Indent;
    Node.ExpandedBody.Accept(Self);
    Unindent;

    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
    arg: IAstNode;
begin
    // 'recur' must be a tail call, which is enforced by the binder.
    Log('Recur');
    Indent;
    LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
    Indent;
    for arg in Node.Arguments do
        arg.Accept(Self);
    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
        expr.Accept(Self);
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
    if Node is TBoundVariableDeclarationNode then
        LogFmt('VariableDeclaration (IsBoxed: %s)', [(Node as TBoundVariableDeclarationNode).IsBoxed.ToString(TUseBoolStrs.True)])
    else
        Log('VariableDeclaration (unbound)');

    Indent;
    Node.Identifier.Accept(Self);
    if Assigned(Node.Initializer) then
    begin
        Log('Initializer:');
        Node.Initializer.Accept(Self);
    end;
    Unindent;
    Result := TDataValue.Void;
end;

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

function TAstDumper.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
var
    param: IIdentifierNode;
begin
    Log('MacroDefinition');
    Indent;

    Log('Name:');
    Indent;
    Node.Name.Accept(Self);
    Unindent;

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

    Log('Body:');
    Indent;
    Node.Body.Accept(Self);
    Unindent;

    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
begin
    Log('Quasiquote');
    Indent;
    Node.Expression.Accept(Self);
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitUnquote(const Node: IUnquoteNode): TDataValue;
begin
    Log('Unquote');
    Indent;
    Node.Expression.Accept(Self);
    Unindent;
    Result := TDataValue.Void;
end;

function TAstDumper.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
begin
    Log('UnquoteSplicing');
    Indent;
    Node.Expression.Accept(Self);
    Unindent;
    Result := TDataValue.Void;
end;

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

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

function TAstDumper.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
var
    field: TRecordFieldLiteral;
begin
    LogFmt('RecordLiteral (%d fields)', [Length(Node.Fields)]);
    Indent;
    for field in Node.Fields do
    begin
        LogFmt('Field :%s', [field.Key.Value.Name]);
        Indent;
        field.Value.Accept(Self);
        Unindent;
    end;
    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:');
    Node.Series.Accept(Self);
    Log('Value:');
    Node.Value.Accept(Self);
    if Assigned(Node.Lookback) then
    begin
        Log('Lookback:');
        Node.Lookback.Accept(Self);
    end;
    Unindent;
    Result := TDataValue.Void;
end;

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

end.