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

unit Myc.Ast.Dumper;

interface

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

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;

    // Inherits from the new non-generic TAstVisitor base class
    TAstDumper = class(TAstVisitor, IAstDumper)
    private
        FOutput: TStrings;
        FIndent: Integer;
        procedure Indent;
        procedure Unindent;
        // Updated Log methods to include the node for type dumping
        procedure Log(const Text: string; const Node: IAstNode = nil); overload;
        procedure LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode = nil); overload;
        function FormatAddress(const Addr: TResolvedAddress): string;

    protected
        // Override abstract procedures from TAstVisitor
        procedure VisitConstant(const Node: IConstantNode); override;
        procedure VisitIdentifier(const Node: IIdentifierNode); override;
        procedure VisitKeyword(const Node: IKeywordNode); override;
        procedure VisitIfExpression(const Node: IIfExpressionNode); override;
        procedure VisitTernaryExpression(const Node: ITernaryExpressionNode); override;
        procedure VisitLambdaExpression(const Node: ILambdaExpressionNode); override;
        procedure VisitFunctionCall(const Node: IFunctionCallNode); override;
        procedure VisitMacroExpansionNode(const Node: IMacroExpansionNode); override;
        procedure VisitRecurNode(const Node: IRecurNode); override;
        procedure VisitBlockExpression(const Node: IBlockExpressionNode); override;
        procedure VisitVariableDeclaration(const Node: IVariableDeclarationNode); override;
        procedure VisitAssignment(const Node: IAssignmentNode); override;
        procedure VisitMacroDefinition(const Node: IMacroDefinitionNode); override;
        procedure VisitQuasiquote(const Node: IQuasiquoteNode); override;
        procedure VisitUnquote(const Node: IUnquoteNode); override;
        procedure VisitUnquoteSplicing(const Node: IUnquoteSplicingNode); override;
        procedure VisitIndexer(const Node: IIndexerNode); override;
        procedure VisitMemberAccess(const Node: IMemberAccessNode); override;
        procedure VisitRecordLiteral(const Node: IRecordLiteralNode); override;
        procedure VisitCreateSeries(const Node: ICreateSeriesNode); override;
        procedure VisitAddSeriesItem(const Node: IAddSeriesItemNode); override;
        procedure VisitSeriesLength(const Node: ISeriesLengthNode); override;
        procedure VisitNop(const Node: INopNode); 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.Types; // Added for IStaticType.ToString

{ 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; const Node: IAstNode = nil);
var
    typeStr: string;
    typedNode: IAstTypedNode;
    staticType: IStaticType;
begin
    typeStr := '';
    // Check if the node is typed
    if Assigned(Node) and Node.IsTyped then
    begin
        typedNode := Node.AsTypedNode;

        staticType := typedNode.StaticType;
        if Assigned(staticType) then
            // Append the static type information
            typeStr := Format(' <Type: %s>', [staticType.ToString])
        else
            typeStr := ' <Type: nil>';
    end;
    FOutput.Add(StringOfChar(' ', FIndent) + Text + typeStr);
end;

procedure TAstDumper.LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode = nil);
begin
    // Pass the node to the base Log method
    Log(Format(Fmt, Args), Node);
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;

procedure TAstDumper.VisitConstant(const Node: IConstantNode);
begin
    LogFmt('Constant: %s', [Node.Value.ToString], Node);
end;

procedure TAstDumper.VisitIdentifier(const Node: IIdentifierNode);
var
    adr: TResolvedAddress;
begin
    adr := Node.Address;

    if adr.Kind <> akUnresolved then
        LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(adr)], Node)
    else
        LogFmt('Identifier: %s (unbound)', [Node.Name], Node);
end;

procedure TAstDumper.VisitKeyword(const Node: IKeywordNode);
begin
    LogFmt('Keyword: :%s', [Node.Value.Name], Node);
end;

procedure TAstDumper.VisitIfExpression(const Node: IIfExpressionNode);
begin
    Log('IfExpression', Node);
    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;
end;

procedure TAstDumper.VisitTernaryExpression(const Node: ITernaryExpressionNode);
begin
    Log('TernaryExpression', Node);
    Indent;
    Log('Condition:');
    Node.Condition.Accept(Self);
    Log('Then:');
    Node.ThenBranch.Accept(Self);
    Log('Else:');
    Node.ElseBranch.Accept(Self);
    Unindent;
end;

procedure TAstDumper.VisitLambdaExpression(const Node: ILambdaExpressionNode);
var
    upvalueAddr: TResolvedAddress;
    pair: TPair<string, Integer>;
begin
    if Assigned(Node.ScopeDescriptor) then
    begin
        LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString(TUseBoolStrs.True)], Node);
        Indent;

        Log('Parameters:');
        Indent;
        for var param in Node.Parameters do
            param.Accept(Self);
        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:');
        Node.Body.Accept(Self);

        Unindent;
    end
    else
    begin
        Log('LambdaExpression (unbound)', Node);
        Indent;
        Log('Parameters:');
        Indent;
        for var param in Node.Parameters do
            param.Accept(Self);
        Unindent;
        Log('Body:');
        Node.Body.Accept(Self);
        Unindent;
    end;
end;

procedure TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode);
var
    arg: IAstNode;
    staticStatus: string;
    sigStr: string; // Added
    argTypes: TArray<string>;
    i: Integer;
begin
    sigStr := ''; // Default to empty
    if Assigned(Node.StaticTarget) then
    begin
        staticStatus := 'Assigned';

        // Reconstruct the signature from the available data
        SetLength(argTypes, Length(Node.Arguments));
        for i := 0 to High(Node.Arguments) do
        begin
            if Node.Arguments[i].IsTyped then
                argTypes[i] := Node.Arguments[i].AsTypedNode.StaticType.ToString
            else
                argTypes[i] := 'Untyped';
        end;

        // Node.StaticType holds the return type set by the Specializer
        sigStr := Format(' <ResolvedSig: Method(%s): %s>', [string.Join(', ', argTypes), Node.StaticType.ToString]);
    end
    else
    begin
        staticStatus := 'nil';
    end;

    LogFmt(
        'FunctionCall (IsTailCall: %s, StaticTarget: %s%s)',
        [
            Node.IsTailCall.ToString(TUseBoolStrs.True),
            staticStatus,
            sigStr // Added the signature string
        ],
        Node
    ); // Pass Node to LogFmt to append the <Type: ...>

    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;
end;

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

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

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

    Unindent;
end;

procedure TAstDumper.VisitRecurNode(const Node: IRecurNode);
var
    arg: IAstNode;
begin
    // 'recur' must be a tail call, which is enforced by the binder.
    Log('Recur', Node);
    Indent;
    LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
    Indent;
    for arg in Node.Arguments do
        arg.Accept(Self);
    Unindent;
    Unindent;
end;

procedure TAstDumper.VisitBlockExpression(const Node: IBlockExpressionNode);
var
    expr: IAstNode;
begin
    Log('BlockExpression', Node);
    Indent;
    for expr in Node.Expressions do
        expr.Accept(Self);
    Unindent;
end;

procedure TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode);
begin
    LogFmt('VariableDeclaration (IsBoxed: %s)', [Node.IsBoxed.ToString(TUseBoolStrs.True)], Node);

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

procedure TAstDumper.VisitAssignment(const Node: IAssignmentNode);
begin
    Log('Assignment', Node);
    Indent;
    Node.Identifier.Accept(Self);
    Log('Value:');
    Node.Value.Accept(Self);
    Unindent;
end;

procedure TAstDumper.VisitMacroDefinition(const Node: IMacroDefinitionNode);
begin
    Log('MacroDefinition', Node); // Macros are not IAstTypedNode
    Indent;

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

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

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

    Unindent;
end;

procedure TAstDumper.VisitQuasiquote(const Node: IQuasiquoteNode);
begin
    Log('Quasiquote', Node); // Not IAstTypedNode
    Indent;
    Node.Expression.Accept(Self);
    Unindent;
end;

procedure TAstDumper.VisitUnquote(const Node: IUnquoteNode);
begin
    Log('Unquote', Node); // Not IAstTypedNode
    Indent;
    Node.Expression.Accept(Self);
    Unindent;
end;

procedure TAstDumper.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode);
begin
    Log('UnquoteSplicing', Node); // Not IAstTypedNode
    Indent;
    Node.Expression.Accept(Self);
    Unindent;
end;

procedure TAstDumper.VisitIndexer(const Node: IIndexerNode);
begin
    Log('Indexer', Node);
    Indent;
    Log('Base:');
    Node.Base.Accept(Self);
    Log('Index:');
    Node.Index.Accept(Self);
    Unindent;
end;

procedure TAstDumper.VisitMemberAccess(const Node: IMemberAccessNode);
begin
    Log('MemberAccess', Node);
    Indent;
    Log('Base:');
    Node.Base.Accept(Self);
    Log('Member:');
    Node.Member.Accept(Self);
    Unindent;
end;

procedure TAstDumper.VisitRecordLiteral(const Node: IRecordLiteralNode);
var
    field: TRecordFieldLiteral;
begin
    LogFmt('RecordLiteral (%d fields)', [Length(Node.Fields)], Node);
    Indent;
    for field in Node.Fields do
    begin
        LogFmt('Field :%s', [field.Key.Value.Name]);
        Indent;
        field.Value.Accept(Self);
        Unindent;
    end;
    Unindent;
end;

procedure TAstDumper.VisitCreateSeries(const Node: ICreateSeriesNode);
begin
    LogFmt('CreateSeries: %s', [Node.Definition], Node);
end;

procedure TAstDumper.VisitAddSeriesItem(const Node: IAddSeriesItemNode);
begin
    Log('AddSeriesItem', Node);
    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;
end;

procedure TAstDumper.VisitNop(const Node: INopNode);
begin
    Log('Nop', Node);
end;

procedure TAstDumper.VisitSeriesLength(const Node: ISeriesLengthNode);
begin
    Log('SeriesLength', Node);
    Indent;
    Log('Series:');
    Node.Series.Accept(Self);
    Unindent;
end;

end.