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

unit Myc.Ast.Script;

interface

uses
    System.SysUtils,
    Myc.Data.Value,
    Myc.Ast.Nodes,
    Myc.Ast.Visitor,
    Myc.Ast.Script.Print;

type
    EParserException = class(EAstException)
    strict private
        FLine: Integer;
        FCol: Integer;
    public
        constructor Create(const AMessage: string; ALine, ACol: Integer);
        property Line: Integer read FLine;
        property Col: Integer read FCol;
    end;

    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.Keyword,
    Myc.Ast,
    Myc.Ast.Identities;

type
    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;
        Line: Integer;
        Col: Integer;
        function GetLocation: ISourceLocation;
    end;

    TLexer = class
    private
        FSource: string;
        FCurrentPos: Integer;
        FLine: Integer;
        FLineStart: Integer;
        function Peek: Char;
        procedure Advance;
        function ReadNumber: string;
        function ReadString: string;
        function ReadIdentifier: string;
        function GetCurrentLine: Integer;
        function GetCurrentCol: Integer;
        procedure Error(const Msg: string);
    public
        constructor Create(const ASource: string);
        function GetNextToken: TToken;
        property CurrentLine: Integer read GetCurrentLine;
        property CurrentCol: Integer read GetCurrentCol;
    end;

    TExpr = record
        Token: TToken;
        Node: IAstNode;
    end;

    TParser = class
    private
        FLexer: TLexer;
        FCurrentToken: TToken;
        procedure Error(const Msg: string);
        procedure ErrorFmt(const Msg: string; const Args: array of const);
        procedure Consume(AExpectedKind: TTokenKind);
        procedure NextToken;

        function ParseList: IAstNode;
        function ParseRecordLiteral: IAstNode;
        function ParseVector: IAstNode;
        function ParseExpression: TExpr;

        function ExtractIdentifiers(const Node: IAstNode; const Context: string): TArray<IIdentifierNode>;
    public
        constructor Create(const ASource: string);
        destructor Destroy; override;
        function Parse: IAstNode;
    end;

{ TTokenKindHelper }
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;

{ TToken }
function TToken.GetLocation: ISourceLocation;
begin
    Result := TIdentities.Location(Line, Col);
end;

{ EParserException }
constructor EParserException.Create(const AMessage: string; ALine, ACol: Integer);
begin
    inherited CreateFmt('[Line %d, Col %d] %s', [ALine, ACol, AMessage]);
    FLine := ALine;
    FCol := ACol;
end;

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

function TLexer.GetCurrentLine: Integer;
begin
    Result := FLine;
end;

function TLexer.GetCurrentCol: Integer;
begin
    Result := FCurrentPos - FLineStart + 1;
end;

procedure TLexer.Error(const Msg: string);
begin
    raise EParserException.Create(Msg, FLine, GetCurrentCol);
end;

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

procedure TLexer.Advance;
var
    c: Char;
begin
    if FCurrentPos <= Length(FSource) then
    begin
        c := FSource[FCurrentPos];
        if c = #10 then
        begin
            Inc(FLine);
            FLineStart := FCurrentPos + 1;
        end;
    end;
    Inc(FCurrentPos);
end;

function TLexer.ReadIdentifier: string;
var
    startPos: Integer;
begin
    startPos := FCurrentPos;
    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;
    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;
    builder := TStringBuilder.Create;
    try
        while (FCurrentPos <= Length(FSource)) do
        begin
            c := Peek;
            if c = '"' then
            begin
                Advance;
                Result := builder.ToString;
                exit;
            end;

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

                c := Peek;
                case c of
                    '"': builder.Append('"');
                    '\': builder.Append('\');
                    'n': builder.Append(sLineBreak);
                    't': builder.Append(#9);
                    'r': builder.Append(#13);
                else
                    builder.Append(c);
                end;
                Advance;
            end
            else
            begin
                if c = #0 then
                    break;
                builder.Append(c);
                Advance;
            end;
        end;
        Error('Syntax Error: Unterminated string literal.');
    finally
        builder.Free;
    end;
end;

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

        if FSource[FCurrentPos] = ';' then
        begin
            while (FCurrentPos <= Length(FSource)) and (not CharInSet(FSource[FCurrentPos], [#10, #13])) do
                Advance;
            continue;
        end;
        break;
    end;

    Result.Line := CurrentLine;
    Result.Col := CurrentCol;

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

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

procedure TParser.Error(const Msg: string);
begin
    raise EParserException.Create(Msg, FCurrentToken.Line, FCurrentToken.Col);
end;

procedure TParser.ErrorFmt(const Msg: string; const Args: array of const);
begin
    raise EParserException.Create(Format(Msg, Args), FCurrentToken.Line, FCurrentToken.Col);
end;

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

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

function TParser.ParseVector: IAstNode;
var
    items: TList<IAstNode>;
    startLoc: ISourceLocation;
begin
    startLoc := FCurrentToken.GetLocation;
    Consume(tkLeftBracket);
    items := TList<IAstNode>.Create;
    try
        while FCurrentToken.Kind <> tkRightBracket do
        begin
            if FCurrentToken.Kind = tkEOF then
                Error('Syntax Error: Unexpected end of file in vector.');
            items.Add(ParseExpression.Node);
        end;

        Result := TAst.Tuple(items.ToArray, startLoc);
    finally
        items.Free;
    end;
    Consume(tkRightBracket);
end;

function TParser.ExtractIdentifiers(const Node: IAstNode; const Context: string): TArray<IIdentifierNode>;
var
    tuple: ITupleNode;
    i: Integer;
begin
    if Node.Kind <> akTuple then
        ErrorFmt('%s expects a vector [...]', [Context]);

    tuple := Node.AsTuple;
    // Updated to use Elements property
    var elements := tuple.Elements;
    SetLength(Result, Length(elements));
    for i := 0 to High(elements) do
    begin
        if elements[i].Kind <> akIdentifier then
            ErrorFmt('%s vector must contain only identifiers.', [Context]);
        Result[i] := elements[i].AsIdentifier;
    end;
end;

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

            if FCurrentToken.Kind <> tkKeyword then
                Error('Syntax Error: Expected keyword (e.g., :key) as field name in record literal.');

            keyToken := FCurrentToken;
            fieldName := FCurrentToken.Text;
            keyNode := TAst.Keyword(fieldName, keyToken.GetLocation);
            NextToken;

            if FCurrentToken.Kind = tkRightBrace then
                Error('Syntax Error: Missing value for key ' + fieldName + ' in record literal.');

            fieldValue := ParseExpression.Node;

            fields.Add(TAst.RecordField(keyNode, fieldValue, keyToken.GetLocation));
        end;
        // Factory automatically wraps array into TupleNode
        Result := TAst.RecordLiteral(fields.ToArray, startLoc);
    finally
        fields.Free;
    end;
    Consume(tkRightBrace);
end;

function TParser.ParseList: IAstNode;
var
    elements: TList<TExpr>;
    head: TExpr;
    tailNodes: TArray<IAstNode>;
    startLoc: ISourceLocation;
begin
    startLoc := FCurrentToken.GetLocation;
    Consume(tkLeftParen);
    if FCurrentToken.Kind = tkRightParen then
        Error('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
                Error('Syntax Error: Unexpected end of file.');
            elements.Add(ParseExpression);
        end;

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

        if head.Token.Kind = tkIdentifier then
        begin
            if SameText(head.Token.Text, 'pipe') then
            begin
                // (pipe [[stream1 [:Key1 :Key2]] [stream2 [:Key3]]] (fn ...))
                if Length(tailNodes) <> 2 then
                    Error('Syntax Error: ''pipe'' requires [inputs] vector and (fn) transformation.');

                if tailNodes[0].Kind <> akTuple then
                    Error('Syntax Error: ''pipe'' first argument must be a vector [...].');

                // NOTE: We do NOT validate inner tuples or keywords here anymore.
                // It is just a Tuple of Tuples structurally.
                // The TypeChecker will ensure valid structure (Series + Keywords).

                if tailNodes[1].Kind <> akLambdaExpression then
                    Error('Syntax Error: Pipe transformation must be a lambda (fn).');

                Result := TAst.Pipe(tailNodes[0].AsTuple, tailNodes[1].AsLambdaExpression, startLoc);
            end
            else if SameText(head.Token.Text, 'fn') then
            begin
                if Length(tailNodes) <> 2 then
                    Error('Syntax Error: ''fn'' requires a parameter list and a body.');
                var params := ExtractIdentifiers(tailNodes[0], 'fn');
                Result := TAst.LambdaExpr(params, tailNodes[1], startLoc);
            end
            else if SameText(head.Token.Text, 'defmacro') then
            begin
                if (Length(tailNodes) <> 3) or (elements[1].Token.Kind <> tkIdentifier) then
                    Error('Syntax Error: ''defmacro'' requires name, params, body.');
                var params := ExtractIdentifiers(tailNodes[1], 'defmacro');
                Result := TAst.MacroDef(tailNodes[0].AsIdentifier, params, tailNodes[2], startLoc);
            end
            else if SameText(head.Token.Text, 'if') then
            begin
                var elseNode: IAstNode := nil;
                if Length(tailNodes) = 3 then
                    elseNode := tailNodes[2];
                Result := TAst.IfExpr(tailNodes[0], tailNodes[1], elseNode, startLoc);
            end
            else if SameText(head.Token.Text, '?') then
            begin
                var count := Length(tailNodes);
                if (count < 1) or ((count mod 2) = 0) then
                    Error('Syntax Error: ''?'' (cond) requires an odd number of arguments.');

                var pairs: TArray<TCondPair>;
                SetLength(pairs, count div 2);
                for var i := 0 to High(pairs) do
                    pairs[i] := TCondPair.Create(tailNodes[i * 2], tailNodes[i * 2 + 1]);

                var elseNode := tailNodes[High(tailNodes)];
                Result := TAst.CondExpr(pairs, elseNode, startLoc);
            end
            else if SameText(head.Token.Text, 'def') then
            begin
                var initializer: IAstNode := nil;
                if Length(tailNodes) = 2 then
                    initializer := tailNodes[1];
                Result := TAst.VarDecl(tailNodes[0], initializer, startLoc);
            end
            else if SameText(head.Token.Text, 'assign') then
            begin
                Result := TAst.Assign(tailNodes[0], tailNodes[1], startLoc);
            end
            else if SameText(head.Token.Text, 'do') then
            begin
                // Factory takes Array and creates Tuple
                Result := TAst.Block(tailNodes, startLoc)
            end
            else if SameText(head.Token.Text, 'recur') then
            begin
                // Factory takes Array and creates Tuple
                Result := TAst.Recur(tailNodes, startLoc)
            end
            else if SameText(head.Token.Text, 'get') then
            begin
                Result := TAst.Indexer(tailNodes[0], tailNodes[1], startLoc)
            end
            else if SameText(head.Token.Text, 'new-series') then
            begin
                if (tailNodes[0].Kind = akConstant) and (tailNodes[0].AsConstant.Value.Kind = vkText) then
                    Result := TAst.CreateSeries(tailNodes[0].AsConstant.Value.AsText, startLoc)
                else
                    Error('Syntax Error: ''new-series'' argument must be a string literal.');
            end
            else if SameText(head.Token.Text, 'add-item') then
            begin
                var lookback: IAstNode := nil;
                if Length(tailNodes) = 3 then
                    lookback := tailNodes[2];
                Result := TAst.AddSeriesItem(tailNodes[0].AsIdentifier, tailNodes[1], lookback, startLoc);
            end
            else if SameText(head.Token.Text, 'count') then
            begin
                Result := TAst.SeriesLength(tailNodes[0].AsIdentifier, startLoc);
            end
            else if (Length(head.Token.Text) > 1) and (head.Token.Text.StartsWith('.')) then
            begin
                Result := TAst.MemberAccess(tailNodes[0], TAst.Keyword(head.Token.Text.Substring(1), head.Token.GetLocation), startLoc);
            end
            else
                Result := nil;
        end;

        if Result = nil then
            // Factory automatically creates Tuple from Array for Arguments
            Result := TAst.FunctionCall(head.Node, tailNodes, startLoc);

    finally
        elements.Free;
    end;
    Consume(tkRightParen);
end;

function TParser.ParseExpression: TExpr;
var
    startLoc: ISourceLocation;
    i64: Int64;
    dbl: Double;
begin
    Result.Token := FCurrentToken;
    startLoc := FCurrentToken.GetLocation;

    case FCurrentToken.Kind of
        tkLeftBracket:
        begin
            Result.Node := ParseVector;
            exit;
        end;
        tkBacktick:
        begin
            NextToken;
            Result.Node := TAst.Quasiquote(ParseExpression.Node, startLoc);
            exit;
        end;
        tkTilde:
        begin
            NextToken;
            if FCurrentToken.Kind = tkAt then
            begin
                NextToken;
                Result.Node := TAst.UnquoteSplicing(ParseExpression.Node.AsQuasiquote, startLoc);
            end
            else
                Result.Node := TAst.Unquote(ParseExpression.Node, startLoc);
            exit;
        end;
        tkQuote:
        begin
            NextToken;
            Result.Node := TAst.FunctionCall(TAst.Identifier('quote', startLoc), [ParseExpression.Node], startLoc);
            exit;
        end;
    end;

    case FCurrentToken.Kind of
        tkNumber:
        begin
            if TryStrToInt64(FCurrentToken.Text, i64) then
                Result.Node := TAst.Constant(i64, startLoc)
            else if TryStrToFloat(FCurrentToken.Text, dbl, TFormatSettings.Invariant) then
                Result.Node := TAst.Constant(dbl, startLoc)
            else
                Error('Invalid number');
            NextToken;
        end;
        tkString:
        begin
            Result.Node := TAst.Constant(FCurrentToken.Text, startLoc);
            NextToken;
        end;
        tkKeyword:
        begin
            Result.Node := TAst.Keyword(FCurrentToken.Text, startLoc);
            NextToken;
        end;
        tkIdentifier:
        begin
            if FCurrentToken.Text = '...' then
                Result.Node := TAst.Nop(startLoc)
            else
                Result.Node := TAst.Identifier(FCurrentToken.Text, startLoc);
            NextToken;
        end;
        tkLeftParen: Result.Node := ParseList;
        tkLeftBrace: Result.Node := ParseRecordLiteral;
    else
        Error('Unexpected token');
    end;
end;

function TParser.Parse: IAstNode;
begin
    var expr := ParseExpression;
    if FCurrentToken.Kind <> tkEOF then
        Error('Unexpected chars after end.');
    Result := expr.Node;
end;

{ TAstScript }

class function TAstScript.Parse(const ASource: string): IAstNode;
var
    p: TParser;
begin
    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;

end.