unit Myc.Ast.Script;

interface

uses
    System.SysUtils,
    Myc.Ast.Nodes,
    Myc.Ast.Visitor;

var
    // This BNF should always be kept up to date and valid. It is used to comunicate with LLMs.
    // (Nop isn't part of the language syntax.)

    BNF: String =
        '''
        (* ---------------------------------------------------------------------- *)
        (* ---- Main Productions (Start Symbols)                             ---- *)
        (* ---------------------------------------------------------------------- *)

        (* A program is a single expression, which can be followed by comments *)
        program         ::= expression

        (* An expression is either an atom, a list, a record, or a macro character *)
        expression      ::= atom | list | record_literal | reader_macro

        (* ---------------------------------------------------------------------- *)
        (* ---- Atoms (Basic Values)                                         ---- *)
        (* ---------------------------------------------------------------------- *)

        atom            ::= number | string | identifier | keyword

        (* ---------------------------------------------------------------------- *)
        (* ---- Reader-Macros (Syntactic Sugar)                                ---- *)
        (* ---------------------------------------------------------------------- *)

        reader_macro    ::= "'"  expression     (* (quote ...) *)
                          | "`"  expression     (* (quasiquote ...) *)
                          | "~"  expression     (* (unquote ...) *)
                          | "~@" expression     (* (unquote-splicing ...) *)

        (* ---------------------------------------------------------------------- *)
        (* ---- Lists (S-Expressions)                                          ---- *)
        (* ---------------------------------------------------------------------- *)

        (* A list is the primary structure for code. Empty lists () are invalid. *)
        list            ::= "(" list_content ")"

        (* The parser distinguishes between special forms (like 'if') and
           general function calls based on the first element. *)
        list_content    ::= special_form | function_call

        special_form    ::= "if" expression expression expression?
                          | "?" expression expression expression
                          | "def" identifier expression?
                          | "defmacro" identifier parameter_list expression
                          | "assign" identifier expression
                          | "fn" parameter_list expression
                          | "do" expression*
                          | "recur" expression*
                          | "get" expression expression
                          | dot_identifier expression

        (* A function call is any list not recognized as a special form.
           The first 'expression' is the callee, the rest are the arguments. *)
        function_call   ::= expression expression*

        (* ---------------------------------------------------------------------- *)
        (* ---- Parameter Lists and Records                                    ---- *)
        (* ---------------------------------------------------------------------- *)

        (* A parameter list is *only* valid inside 'fn' and 'defmacro' *)
        parameter_list  ::= "[" identifier* "]"

        (* A record literal consists of 0 or more keyword/value pairs *)
        record_literal  ::= "{" (keyword expression)* "}"

        (* ---------------------------------------------------------------------- *)
        (* ---- Terminals (Lexer Tokens)                                     ---- *)
        (* ---------------------------------------------------------------------- *)

        number          ::= ["-"] digit+ ["." digit+]
        string          ::= '"' ( ? any char except \ or " ? | '\' ( '"' | '\' | 'n' | 'r' | 't' ) )* '"'
        keyword         ::= ":" identifier

        (* An identifier for member access, handled specially by the parser *)
        dot_identifier  ::= "." identifier

        (* An identifier is a sequence of characters that are not delimiters.
           The lexer is very permissive. *)
        identifier      ::= ? any sequence of chars not containing whitespace, '()[]{}'`~:; ?

        digit           ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9"
        ''';

type
    // Provides a high-level facade for parsing and printing the AST.
    TAstScript = record
    public
        class function Parse(const ASource: string): IAstNode; static;
        class function Print(const ANode: IAstNode): string; static;
    end;

implementation

uses
    System.Classes,
    System.Generics.Collections,
    System.Character,
    System.Math,
    Myc.Data.Scalar,
    Myc.Data.Value,
    Myc.Data.Keyword,
    Myc.Ast;

type

    // --- Internal Parser Implementation ---

    TTokenKind = (
        tkLeftParen, // (
        tkRightParen, // )
        tkLeftBracket, // [
        tkRightBracket, // ]
        tkLeftBrace, // {
        tkRightBrace, // }
        tkQuote, // '
        tkBacktick, // `
        tkTilde, // ~
        tkAt, // @
        tkIdentifier,
        tkKeyword,
        tkNumber,
        tkString,
        tkEOF,
        tkError
    );

    TTokenKindHelper = record helper for TTokenKind
        function ToString: String;
    end;

    TToken = record
        Kind: TTokenKind;
        Text: string;
    end;

    TLexer = class
    private
        FSource: string;
        FCurrentPos: Integer;
        function Peek: Char;
        procedure Advance;
        function ReadNumber: string;
        function ReadString: string;
        function ReadIdentifier: string;
    public
        constructor Create(const ASource: string);
        function GetNextToken: TToken;
    end;

    TExpr = record
        Token: TToken;
        Node: IAstNode;
        Params: TArray<IIdentifierNode>;
    end;

    TParser = class
    private
        FLexer: TLexer;
        FCurrentToken: TToken;
        procedure Consume(AExpectedKind: TTokenKind);
        procedure NextToken;
        function ParseList: IAstNode;
        function ParseRecordLiteral: IAstNode;
        function ParseParameterList: TArray<IIdentifierNode>;
        function ParseExpression: TExpr;
    public
        constructor Create(const ASource: string);
        destructor Destroy; override;
        function Parse: IAstNode;
    end;

    // --- Internal Printer Implementation ---

    // Inherits from the new non-generic TAstVisitor
    TPrettyPrintVisitor = class(TAstVisitor)
    private
        FBuilder: TStringBuilder;
        FIndentLevel: Integer;
        procedure Indent;
        procedure Unindent;
        procedure Append(const S: string);
        procedure NewLine;
    public
        constructor Create;
        destructor Destroy; override;
        function GetResult: string;
        // Helper
        function Execute(const RootNode: IAstNode): TDataValue;
        // Override abstract procedures from TAstVisitor
        procedure VisitConstant(const Node: IConstantNode); override;
        procedure VisitIdentifier(const Node: IIdentifierNode); override;
        procedure VisitKeyword(const Node: IKeywordNode); override;
        procedure VisitBinaryExpression(const Node: IBinaryExpressionNode); override;
        procedure VisitUnaryExpression(const Node: IUnaryExpressionNode); override;
        procedure VisitIfExpression(const Node: IIfExpressionNode); override;
        procedure VisitTernaryExpression(const Node: ITernaryExpressionNode); override;
        procedure VisitLambdaExpression(const Node: ILambdaExpressionNode); 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 VisitFunctionCall(const Node: IFunctionCallNode); override;
        procedure VisitMacroExpansionNode(const Node: IMacroExpansionNode); override;
        procedure VisitBlockExpression(const Node: IBlockExpressionNode); override;
        procedure VisitVariableDeclaration(const Node: IVariableDeclarationNode); override;
        procedure VisitAssignment(const Node: IAssignmentNode); 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 VisitRecurNode(const Node: IRecurNode); override;
        procedure VisitNop(const Node: INopNode); override;
    end;

{ TLexer }

constructor TLexer.Create(const ASource: string);
begin
    inherited Create;
    FSource := ASource;
    FCurrentPos := 1;
end;

function TLexer.Peek: Char;
begin
    if FCurrentPos > Length(FSource) then
        Result := #0
    else
        Result := FSource[FCurrentPos];
end;

procedure TLexer.Advance;
begin
    inc(FCurrentPos);
end;

function TLexer.ReadIdentifier: string;
var
    startPos: Integer;
begin
    startPos := FCurrentPos;
    // Reader macro characters and comments are now also delimiters for identifiers.
    while (Peek <> #0) and (not (Peek.IsWhiteSpace or CharInSet(Peek, ['(', ')', '[', ']', '{', '}', '''', '`', '~', ';']))) do
        Advance;
    Result := Copy(FSource, startPos, FCurrentPos - startPos);
end;

function TLexer.ReadNumber: string;
var
    startPos: Integer;
begin
    startPos := FCurrentPos;

    // Handle the optional leading minus sign
    if (Peek = '-') then
        Advance;

    while (Peek <> #0) and (Peek.IsDigit or (Peek = '.')) do
        Advance;
    Result := Copy(FSource, startPos, FCurrentPos - startPos);
end;

function TLexer.ReadString: string;
var
    builder: TStringBuilder;
    c: Char;
begin
    Advance; // Skip opening "
    builder := TStringBuilder.Create;
    try
        while (FCurrentPos <= Length(FSource)) do
        begin
            c := Peek;
            if c = '"' then
            begin
                Advance; // Consume closing "
                Result := builder.ToString;
                exit;
            end;

            if c = '\' then
            begin
                Advance; // Consume '\'
                if FCurrentPos > Length(FSource) then
                    raise Exception.Create('Syntax Error: String literal ends with an escape character.');

                c := Peek; // Get escaped char
                case c of
                    '"': builder.Append('"');
                    '\': builder.Append('\');
                    'n': builder.Append(sLineBreak); // Use system's line break
                    't': builder.Append(#9);
                    'r': builder.Append(#13);
                else
                    // Pass through unknown escapes (e.g., "\z" becomes "z")
                    builder.Append(c);
                end;
                Advance; // Consume escaped char
            end
            else
            begin
                // Append regular char (including literal newlines)
                if c = #0 then // Check for unexpected EOF
                    break;
                builder.Append(c);
                Advance;
            end;
        end;

        // If we fall out of the loop, we hit EOF without a closing quote.
        raise Exception.Create('Syntax Error: Unterminated string literal.');

    finally
        builder.Free;
    end;
end;

function TLexer.GetNextToken: TToken;
begin
    // Skip whitespace and comments
    while FCurrentPos <= Length(FSource) do
    begin
        if FSource[FCurrentPos].IsWhiteSpace then
        begin
            Advance;
            continue;
        end;

        if FSource[FCurrentPos] = ';' then
        begin
            // Comment found, skip to the end of the line
            while (FCurrentPos <= Length(FSource)) and (not CharInSet(FSource[FCurrentPos], [#10, #13])) do
                Advance;
            continue;
        end;

        // No whitespace or comment, so break out and process the token
        break;
    end;

    if FCurrentPos > Length(FSource) then
    begin
        Result.Kind := tkEOF;
        exit;
    end;

    var c := Peek;
    case c of
        '(':
        begin
            Result.Kind := tkLeftParen;
            Advance;
        end;
        ')':
        begin
            Result.Kind := tkRightParen;
            Advance;
        end;
        '[':
        begin
            Result.Kind := tkLeftBracket;
            Advance;
        end;
        ']':
        begin
            Result.Kind := tkRightBracket;
            Advance;
        end;
        '{':
        begin
            Result.Kind := tkLeftBrace;
            Advance;
        end;
        '}':
        begin
            Result.Kind := tkRightBrace;
            Advance;
        end;
        '''':
        begin
            Result.Kind := tkQuote;
            Advance;
        end;
        '`':
        begin
            Result.Kind := tkBacktick;
            Advance;
        end;
        '~':
        begin
            Result.Kind := tkTilde;
            Advance;
        end;
        '@':
        begin
            Result.Kind := tkAt;
            Advance;
        end;
        '"':
        begin
            Result.Kind := tkString;
            Result.Text := ReadString;
        end;
        ':':
        begin
            Advance; // Skip :
            Result.Kind := tkKeyword;
            Result.Text := ReadIdentifier;
            if Result.Text.IsEmpty then
                Result.Kind := tkError;
        end;
    else
        if c.IsDigit or ((c = '-') and (FCurrentPos < Length(FSource)) and FSource[FCurrentPos + 1].IsDigit) then
        begin
            Result.Kind := tkNumber;
            Result.Text := ReadNumber;
        end
        else
        begin
            Result.Kind := tkIdentifier;
            Result.Text := ReadIdentifier;
        end;
    end;
end;

{ TParser }

constructor TParser.Create(const ASource: string);
begin
    inherited Create;
    FLexer := TLexer.Create(ASource);
    NextToken; // Load the first token
end;

destructor TParser.Destroy;
begin
    FLexer.Free;
    inherited;
end;

procedure TParser.NextToken;
begin
    FCurrentToken := FLexer.GetNextToken;
end;

procedure TParser.Consume(AExpectedKind: TTokenKind);
begin
    if FCurrentToken.Kind <> AExpectedKind then
        raise Exception.CreateFmt('Syntax Error: Expected token %s, but found %s', [AExpectedKind.ToString, FCurrentToken.Kind.ToString]);
    NextToken;
end;

function TParser.ParseParameterList: TArray<IIdentifierNode>;
var
    params: TList<IIdentifierNode>;
begin
    Consume(tkLeftBracket);
    params := TList<IIdentifierNode>.Create;
    try
        while FCurrentToken.Kind <> tkRightBracket do
        begin
            if FCurrentToken.Kind = tkEOF then
                raise Exception.Create('Syntax Error: Unexpected end of file.');
            if FCurrentToken.Kind <> tkIdentifier then
                raise Exception.Create('Syntax Error: Expected identifier in parameter list.');
            params.Add(TAst.Identifier(FCurrentToken.Text));
            NextToken;
        end;
        Result := params.ToArray;
    finally
        params.Free;
    end;
    Consume(tkRightBracket);
end;

function TParser.ParseRecordLiteral: IAstNode;
var
    fields: TList<TRecordFieldLiteral>;
    fieldName: string;
    fieldValue: IAstNode;
begin
    Consume(tkLeftBrace);
    fields := TList<TRecordFieldLiteral>.Create;
    try
        while FCurrentToken.Kind <> tkRightBrace do
        begin
            if FCurrentToken.Kind = tkEOF then
                raise Exception.Create('Syntax Error: Unexpected end of file in record literal.');

            // Key must be a keyword
            if FCurrentToken.Kind <> tkKeyword then
                raise Exception.Create('Syntax Error: Expected keyword (e.g., :key) as field name in record literal.');
            fieldName := FCurrentToken.Text;
            NextToken;

            // Value can be any expression
            if FCurrentToken.Kind = tkRightBrace then
                raise Exception.Create('Syntax Error: Missing value for key ' + fieldName + ' in record literal.');
            fieldValue := ParseExpression.Node;

            fields.Add(TRecordFieldLiteral.Create(TAst.Keyword(fieldName), fieldValue));
        end;

        Result := TAst.RecordLiteral(fields.ToArray);
    finally
        fields.Free;
    end;
    Consume(tkRightBrace);
end;

function TParser.ParseList: IAstNode;

var
    elements: TList<TExpr>;
    head: TExpr;
    tailTokens: TArray<TToken>;
    tailNodes: TArray<IAstNode>;
    initializer: IAstNode;
begin
    Consume(tkLeftParen);
    if FCurrentToken.Kind = tkRightParen then
        raise Exception.Create('Syntax Error: Empty list () is not a valid expression.');

    elements := TList<TExpr>.Create;
    try
        while FCurrentToken.Kind <> tkRightParen do
        begin
            if FCurrentToken.Kind = tkEOF then
                raise Exception.Create('Syntax Error: Unexpected end of file.');
            elements.Add(ParseExpression);
        end;

        head := elements[0];

        SetLength(tailTokens, elements.Count - 1);
        SetLength(tailNodes, elements.Count - 1);
        for var i := 0 to High(tailNodes) do
        begin
            tailTokens[i] := elements[i + 1].Token;
            tailNodes[i] := elements[i + 1].Node;
        end;

        if head.Token.Kind = tkIdentifier then
        begin
            // Handle special forms
            if SameText(head.Token.Text, 'if') then
            begin
                if not (Length(tailNodes) in [2, 3]) then
                    raise Exception.Create('Syntax Error in if statement.');

                var elseBranch: IAstNode := nil;
                if Length(tailNodes) = 3 then
                    elseBranch := tailNodes[2];

                Result := TAst.IfExpr(tailNodes[0], tailNodes[1], elseBranch);
            end
            else if SameText(head.Token.Text, '?') then
            begin
                if Length(tailNodes) <> 3 then
                    raise Exception.Create('Syntax Error in ternary statement.');

                Result := TAst.TernaryExpr(tailNodes[0], tailNodes[1], tailNodes[2]);
            end
            else if SameText(head.Token.Text, 'def') then
            begin
                // Validate argument count for 'def' special form.
                if not (Length(tailNodes) in [1, 2]) then
                    raise Exception.CreateFmt(
                        'Syntax Error: ''def'' requires an identifier and an optional initializer (1 or 2 arguments), but got %d.',
                        [Length(tailNodes)]);

                if tailTokens[0].Kind <> tkIdentifier then
                    raise Exception.Create('Syntax Error: Expected an identifier for def statement.');

                initializer := nil;
                if Length(tailNodes) = 2 then
                    initializer := tailNodes[1];

                Result := TAst.VarDecl(IIdentifierNode(tailNodes[0]), initializer);
            end
            else if SameText(head.Token.Text, 'defmacro') then
            begin
                if (Length(tailNodes) <> 3) or (tailTokens[0].Kind <> tkIdentifier) then
                    raise Exception.Create('Syntax Error: ''defmacro'' requires a name, a parameter list, and a body.');

                var macroName := tailNodes[0].AsIdentifier;
                var macroParams := elements[2].Params;

                if tailTokens[2].Kind <> tkBacktick then
                    raise Exception.Create('Syntax Error: Expected a quasiquote as macro body.');

                var macroBody := IQuasiQuoteNode(tailNodes[2]);

                Result := TAst.MacroDef(macroName, macroParams, macroBody);
            end
            else if SameText(head.Token.Text, 'assign') then
            begin
                if Length(tailNodes) <> 2 then
                    raise Exception.Create('Syntax Error: ''assign'' requires exactly 2 arguments (identifier and value).');
                if tailTokens[0].Kind <> tkIdentifier then
                    raise Exception.Create('Syntax Error: Expected an identifier for assignment.');
                Result := TAst.Assign(IIdentifierNode(tailNodes[0]), tailNodes[1]);
            end
            else if SameText(head.Token.Text, 'fn') then
            begin
                if Length(tailNodes) <> 2 then
                    raise Exception.Create('Syntax Error: ''fn'' requires a parameter list and a body.');
                Result := TAst.LambdaExpr(elements[1].Params, tailNodes[1]);
            end
            else if SameText(head.Token.Text, 'do') then
                Result := TAst.Block(tailNodes)
            else if SameText(head.Token.Text, 'recur') then
                Result := TAst.Recur(tailNodes)
            else if SameText(head.Token.Text, 'get') then
            begin
                if Length(tailNodes) <> 2 then
                    raise Exception.Create('Syntax Error: ''get'' requires exactly 2 arguments (base and index).');
                Result := TAst.Indexer(tailNodes[0], tailNodes[1])
            end
            else if (Length(head.Token.Text) > 1) and (head.Token.Text.StartsWith('.')) then
            begin
                if Length(tailNodes) <> 1 then
                    raise Exception.CreateFmt(
                        'Syntax Error: Member access (e.g., ''%s'') requires exactly 1 argument (the base object).',
                        [head.Token.Text]);
                Result := TAst.MemberAccess(tailNodes[0], TAst.Keyword(head.Token.Text.Substring(1)));
            end;
        end;

        // If no special form matched, treat it as a generic function call.
        if Result = nil then
            Result := TAst.FunctionCall(head.Node, tailNodes);

    finally
        elements.Free;
    end;

    Consume(tkRightParen);
end;

function TParser.ParseExpression: TExpr;
var
    i64: Int64;
    dbl: Double;
    expr: TExpr;
begin
    // Handle reader macros.
    Result.Token := FCurrentToken;
    case FCurrentToken.Kind of
        tkBacktick:
        begin
            NextToken;
            expr := ParseExpression;
            Result.Node := TAst.Quasiquote(expr.Node);
            exit;
        end;
        tkTilde:
        begin
            NextToken;
            if FCurrentToken.Kind = tkAt then
            begin
                NextToken;
                expr := ParseExpression;
                Result.Node := TAst.UnquoteSplicing(expr.Node.AsQuasiquote);
            end
            else
            begin
                expr := ParseExpression;
                Result.Node := TAst.Unquote(expr.Node);
            end;
            exit;
        end;
        tkQuote:
        begin
            NextToken;
            expr := ParseExpression;
            Result.Node := TAst.FunctionCall(TAst.Identifier('quote'), [expr.Node]);
            exit;
        end;
    end;

    Result.Token := FCurrentToken;
    case FCurrentToken.Kind of
        tkNumber:
        begin
            if TryStrToInt64(FCurrentToken.Text, i64) then
                Result.Node :=
                    TAst.Constant(i64)
                        // Use invariant format settings for float parsing.
            else if TryStrToFloat(FCurrentToken.Text, dbl, TFormatSettings.Invariant) then
                Result.Node := TAst.Constant(dbl)
            else
                raise Exception.CreateFmt('Syntax Error: Invalid number format "%s"', [FCurrentToken.Text]);
            NextToken;
        end;
        tkString:
        begin
            Result.Node := TAst.Constant(FCurrentToken.Text);
            NextToken;
        end;
        tkKeyword:
        begin
            Result.Node := TAst.Keyword(FCurrentToken.Text);
            NextToken;
        end;
        tkIdentifier:
        begin
            // Check for the NOP token ('...')
            if FCurrentToken.Text = '...' then
            begin
                // The token '...' represents the Nop node, a non-compilable placeholder used exclusively
                // for visual representations (e.g., UI drag targets).
                //
                // We handle it as a special case of tkIdentifier instead of introducing a dedicated tkNop
                // TokenKind because of its **unofficial and transient status**.
                //
                // This allows the Parser to immediately apply the syntactic policy: mapping this
                // specific identifier string directly to the non-standard TAst.Nop node, ensuring
                // it bypasses the regular identifier creation and maintains its "placeholder" identity.
                Result.Node := TAst.Nop;
            end
            else
            begin
                Result.Node := TAst.Identifier(FCurrentToken.Text);
            end;
            NextToken;
        end;
        tkLeftParen: Result.Node := ParseList;
        tkLeftBracket: Result.Params := ParseParameterList;
        tkLeftBrace: Result.Node := ParseRecordLiteral;
        tkEOF: {nop};
    else
        raise Exception.CreateFmt('Syntax Error: Unexpected token %s', [FCurrentToken.Kind.ToString]);
    end;
end;

function TParser.Parse: IAstNode;
begin
    var expr := ParseExpression;
    if FCurrentToken.Kind <> tkEOF then
        raise Exception.Create('Syntax Error: Unexpected characters after end of expression.');
    Result := expr.Node;
end;

{ TPrettyPrintVisitor }
constructor TPrettyPrintVisitor.Create;
begin
    inherited Create;
    FBuilder := TStringBuilder.Create;
    FIndentLevel := 0;
end;

destructor TPrettyPrintVisitor.Destroy;
begin
    FBuilder.Free;
    inherited Destroy;
end;

function TPrettyPrintVisitor.GetResult: string;
begin
    Result := FBuilder.ToString;
end;

procedure TPrettyPrintVisitor.Indent;
begin
    inc(FIndentLevel, 2);
end;

procedure TPrettyPrintVisitor.Unindent;
begin
    dec(FIndentLevel, 2);
end;

procedure TPrettyPrintVisitor.Append(const S: string);
begin
    FBuilder.Append(S);
end;

procedure TPrettyPrintVisitor.NewLine;
begin
    FBuilder.AppendLine;
    FBuilder.Append(''.PadLeft(FIndentLevel));
end;

function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
    if Assigned(RootNode) then
        RootNode.Accept(Self);
    Result := TDataValue.Void;
end;

procedure TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode);
var
    val: TDataValue;
begin
    val := Node.Value;
    if val.Kind = vkText then
        Append('"' + val.AsText + '"')
    else
        Append(val.ToString);
end;

procedure TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode);
begin
    Append(Node.Name);
end;

procedure TPrettyPrintVisitor.VisitKeyword(const Node: IKeywordNode);
begin
    Append(':' + Node.Value.Name);
end;

procedure TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode);
begin
    Append('(' + Node.Operator.ToString);
    Append(' ');
    Node.Left.Accept(Self);
    Append(' ');
    Node.Right.Accept(Self);
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode);
begin
    Append('(' + Node.Operator.ToString);
    Append(' ');
    Node.Right.Accept(Self);
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode);
begin
    Append('(if ');
    Node.Condition.Accept(Self);
    Indent;
    NewLine;
    Node.ThenBranch.Accept(Self);
    if Assigned(Node.ElseBranch) then
    begin
        NewLine;
        Node.ElseBranch.Accept(Self);
    end;
    Unindent;
    NewLine;
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode);
begin
    Append('(? ');
    Node.Condition.Accept(Self);
    Indent;
    NewLine;
    Node.ThenBranch.Accept(Self);
    NewLine;
    Node.ElseBranch.Accept(Self);
    Unindent;
    NewLine;
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode);
var
    sb: TStringBuilder;
begin
    sb := TStringBuilder.Create;
    try
        for var param in Node.Parameters do
            sb.Append(param.Name + ' ');
        if sb.Length > 0 then
            sb.Remove(sb.Length - 1, 1); // remove trailing space

        Append('(fn [' + sb.ToString + ']');
    finally
        sb.Free;
    end;

    Indent;
    NewLine;
    Node.Body.Accept(Self);
    Unindent;
    NewLine;
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode);
var
    sb: TStringBuilder;
begin
    sb := TStringBuilder.Create;
    try
        for var param in Node.Parameters do
            sb.Append(param.Name + ' ');
        if sb.Length > 0 then
            sb.Remove(sb.Length - 1, 1);

        Append('(defmacro ' + Node.Name.Name + ' [' + sb.ToString + ']');
    finally
        sb.Free;
    end;

    Indent;
    NewLine;
    Node.Body.Accept(Self);
    Unindent;
    NewLine;
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitQuasiquote(const Node: IQuasiquoteNode);
begin
    Append('`');
    Node.Expression.Accept(Self);
end;

procedure TPrettyPrintVisitor.VisitUnquote(const Node: IUnquoteNode);
begin
    Append('~');
    Node.Expression.Accept(Self);
end;

procedure TPrettyPrintVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode);
begin
    // To handle '~@', we need to check if the expression is an identifier '@'.
    // However, the parser logic now handles this, so we just print '~@'.
    Append('~@');
    Node.Expression.Accept(Self);
end;

procedure TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode);
var
    arg: IAstNode;
begin
    // Special case for (quote ...) to print it as '...
    if (Node.Callee.Kind = akIdentifier) and (Node.Callee.AsIdentifier.Name = 'quote') and (Length(Node.Arguments) = 1) then
    begin
        Append('''');
        Node.Arguments[0].Accept(Self);
        exit;
    end;

    Append('(');
    Node.Callee.Accept(Self);

    Indent;
    for arg in Node.Arguments do
    begin
        Append(' ');
        arg.Accept(Self);
    end;
    Unindent;

    Append(')');
end;

procedure TPrettyPrintVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode);
begin
    // For pretty-printing, show the original macro call, not the expanded body.
    // Delegate to the regular VisitFunctionCall to print it as such.
    VisitFunctionCall(Node.CallNode);
end;

procedure TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode);
var
    arg: IAstNode;
begin
    Append('(recur');
    Indent;
    for arg in Node.Arguments do
    begin
        Append(' ');
        arg.Accept(Self);
    end;
    Unindent;

    Append(')');
end;

procedure TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode);
var
    expr: IAstNode;
begin
    Append('(do');
    Indent;
    for expr in Node.Expressions do
    begin
        NewLine;
        expr.Accept(Self);
    end;
    Unindent;
    NewLine;
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode);
begin
    Append('(def ');
    Node.Identifier.Accept(Self);
    if Assigned(Node.Initializer) then
    begin
        Append(' ');
        Node.Initializer.Accept(Self);
    end;
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode);
begin
    Append('(assign ');
    Node.Identifier.Accept(Self);
    Append(' ');
    Node.Value.Accept(Self);
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode);
begin
    Append('(get ');
    Node.Base.Accept(Self);
    Append(' ');
    Node.Index.Accept(Self);
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode);
begin
    Append('(.');
    Node.Member.Accept(Self);
    Append(' ');
    Node.Base.Accept(Self);
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode);
var
    field: TRecordFieldLiteral;
begin
    if Length(Node.Fields) = 0 then
    begin
        Append('{}');
        exit;
    end;

    Append('{');
    Indent;
    for field in Node.Fields do
    begin
        NewLine;
        Append(':' + field.Key.Value.Name);
        Append(' ');
        field.Value.Accept(Self);
    end;
    Unindent;
    NewLine;
    Append('}');
end;

procedure TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode);
begin
    Append(Format('(new-series "%s")', [Node.Definition]));
end;

procedure TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode);
begin
    Append('(add-item ');
    Node.Series.Accept(Self);
    Append(' ');
    Node.Value.Accept(Self);
    if Assigned(Node.Lookback) then
    begin
        Append(' ');
        Node.Lookback.Accept(Self);
    end;
    Append(')');
end;

procedure TPrettyPrintVisitor.VisitNop(const Node: INopNode);
begin
    // A placeholder node, usually for UI.
    Append('...');
end;

procedure TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode);
begin
    Append('(count ');
    Node.Series.Accept(Self);
    Append(')');
end;

{ TAstScript }

class function TAstScript.Parse(const ASource: string): IAstNode;
var
    p: TParser;
begin
    if ASource.Trim.IsEmpty then
        exit(nil);
    p := TParser.Create(ASource);
    try
        Result := p.Parse;
    finally
        p.Free;
    end;
end;

class function TAstScript.Print(const ANode: IAstNode): string;
var
    visitor: TPrettyPrintVisitor;
begin
    if not Assigned(ANode) then
        exit('');
    visitor := TPrettyPrintVisitor.Create;
    try
        visitor.Execute(ANode);
        Result := visitor.GetResult;
    finally
        visitor.Free;
    end;
end;

function TTokenKindHelper.ToString: String;
begin
    case Self of
        tkLeftParen: Result := '(';
        tkRightParen: Result := ')';
        tkLeftBracket: Result := '[';
        tkRightBracket: Result := ']';
        tkLeftBrace: Result := '{';
        tkRightBrace: Result := '}';
        tkQuote: Result := '''';
        tkBacktick: Result := '`';
        tkTilde: Result := '~';
        tkAt: Result := '@';
        tkIdentifier: Result := '<identifier>';
        tkKeyword: Result := '<keyword>';
        tkNumber: Result := '<number>';
        tkString: Result := '<string>';
        tkEOF: Result := '<EOF>';
    else
        Result := '<error>';
    end;
end;

end.