Files
MycLib/Src/AST/Myc.Ast.Script.pas
T
2026-01-07 00:28:38 +01:00

1128 lines
29 KiB
ObjectPascal

unit Myc.Ast.Script;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
System.Character,
System.Rtti, // Wichtig für die EBNF-Extraktion
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
Myc.Ast.Script.Print,
Myc.Ast;
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;
{ Attribut zur Dokumentation der Grammatik direkt am Code }
EbnfAttribute = class(TCustomAttribute)
private
FRule: string;
public
constructor Create(const ARule: string);
property Rule: string read FRule;
end;
TAstScript = record
public
class function Parse(const ASource: string): IAstNode; static;
class function Print(const ANode: IAstNode): string; static;
{ Extrahiert die vollständige EBNF-Grammatik aus den Annotationen des Parsers }
class function GetGrammar: string; static;
end;
implementation
uses
System.TypInfo,
System.Generics.Defaults,
Myc.Data.Scalar,
Myc.Data.Keyword,
Myc.Ast.Identities;
{ EbnfAttribute }
constructor EbnfAttribute.Create(const ARule: string);
begin
inherited Create;
FRule := ARule;
end;
type
TTokenKind = (
tkLeftParen, // (
tkRightParen, // )
tkLeftBracket, // [
tkRightBracket, // ]
tkLeftBrace, // {
tkRightBrace, // }
tkQuote, // '
tkBacktick, // `
tkTilde, // ~
tkAt, // @
tkIdentifier, // abc, +, .field
tkKeyword, // :abc
tkNumber, // 123, 12.34
tkString, // "..."
tkEOF,
tkError
);
TToken = record
Kind: TTokenKind;
Text: string;
Line: Integer;
Col: Integer;
function GetLocation: ISourceLocation;
end;
// -------------------------------------------------------------------------
// LEXER
// -------------------------------------------------------------------------
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;
// -------------------------------------------------------------------------
// PARSER
// -------------------------------------------------------------------------
// Wir erzwingen RTTI für private Methoden, damit wir die EbnfAttributes lesen können
{$RTTI EXPLICIT METHODS([vcPrivate, vcProtected, vcPublic])}
TParser = class
private
type
TSpecialFormParser = function: IAstNode of object;
private
FLexer: TLexer;
FCurrentToken: TToken;
FSpecialForms: TDictionary<string, TSpecialFormParser>;
procedure Error(const Msg: string);
procedure ErrorFmt(const Msg: string; const Args: array of const);
procedure Consume(AExpectedKind: TTokenKind);
procedure NextToken;
function Match(AKind: TTokenKind): Boolean;
// --- EBNF Non-Terminal Methods ---
// Entry Point
[Ebnf('script ::= expression EOF')]
function ParseScript: IAstNode;
// Core Expressions
[Ebnf('expression ::= atom | list | vector | map | reader-macro')]
function ParseExpression: IAstNode;
[Ebnf('atom ::= identifier | keyword | number | string | nop')]
function ParseAtom: IAstNode;
[Ebnf('list ::= "(" list-content ")"')]
function ParseList: IAstNode;
[Ebnf('vector ::= "[" { expression } "]"')]
function ParseVector: IAstNode;
[Ebnf('map ::= "{" { keyword expression } "}"')]
function ParseMap: IAstNode;
[Ebnf('reader-macro ::= "''" expression | "`" expression | "~" expression | "~@" expression')]
function ParseReaderMacro: IAstNode;
// Atoms
[Ebnf('identifier ::= ? defined by lexer ?')]
function ParseIdentifier: IAstNode;
[Ebnf('keyword ::= ":" identifier')]
function ParseKeyword: IAstNode;
[Ebnf('number ::= ? integer or float literal ?')]
function ParseNumber: IAstNode;
[Ebnf('string ::= """ ? characters ? """')]
function ParseString: IAstNode;
[Ebnf('nop ::= "..."')]
function ParseNop: IAstNode;
// List Content & Dispatch
[Ebnf('list-content ::= special-form | member-access-sugar | function-call')]
function ParseListContent: IAstNode;
[Ebnf('special-form ::= form-if | form-cond | form-fn | ... (* dispatched by head identifier *)')]
function ParseSpecialForm(const FormName: string): IAstNode;
[Ebnf('member-access-sugar ::= dot-identifier expression')]
function ParseMemberAccessSugar: IAstNode;
[Ebnf('function-call ::= expression { expression }')]
function ParseFunctionCall: IAstNode;
// Special Forms (Sub-Rules)
[Ebnf('form-if ::= "if" expression expression [ expression ]')]
function ParseIf: IAstNode;
[Ebnf('form-cond ::= "?" { expression expression } [ expression ]')]
function ParseCond: IAstNode;
[Ebnf('form-fn ::= "fn" vector expression')]
function ParseFn: IAstNode;
[Ebnf('form-defmacro ::= "defmacro" identifier vector expression')]
function ParseDefMacro: IAstNode;
[Ebnf('form-def ::= "def" expression [ expression ]')]
function ParseDef: IAstNode;
[Ebnf('form-assign ::= "assign" expression expression')]
function ParseAssign: IAstNode;
[Ebnf('form-do ::= "do" { expression }')]
function ParseDo: IAstNode;
[Ebnf('form-recur ::= "recur" { expression }')]
function ParseRecur: IAstNode;
[Ebnf('form-quote ::= "quote" expression')]
function ParseQuoteForm: IAstNode;
[Ebnf('form-pipe ::= "pipe" vector expression')]
function ParsePipe: IAstNode;
[Ebnf('form-series ::= "new-series" expression')]
function ParseNewSeries: IAstNode;
[Ebnf('form-add ::= "add-item" expression expression [ expression ]')]
function ParseAddItem: IAstNode;
[Ebnf('form-count ::= "count" expression')]
function ParseCount: IAstNode;
[Ebnf('form-get ::= "get" expression expression')]
function ParseGet: IAstNode;
// Helpers
function ParseTupleBody(StopToken: TTokenKind): TArray<IAstNode>;
function ExtractIdentifiers(const Node: IAstNode; const Context: string): TArray<IIdentifierNode>;
procedure InitSpecialForms;
public
constructor Create(const ASource: string);
destructor Destroy; override;
function Parse: IAstNode;
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;
{ TToken }
function TToken.GetLocation: ISourceLocation;
begin
Result := TIdentities.Location(Line, Col);
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;
begin
if FCurrentPos <= Length(FSource) then
begin
if FSource[FCurrentPos] = #10 then
begin
Inc(FLine);
FLineStart := FCurrentPos + 1;
end;
end;
Inc(FCurrentPos);
end;
function TLexer.ReadIdentifier: string;
var
startPos: Integer;
begin
startPos := FCurrentPos;
// Identifiers can contain almost anything except structural chars and whitespace
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
sb: TStringBuilder;
c: Char;
begin
Advance; // Skip opening quote
sb := TStringBuilder.Create;
try
while (FCurrentPos <= Length(FSource)) do
begin
c := Peek;
if c = '"' then
begin
Advance;
Result := sb.ToString;
exit;
end;
if c = '\' then
begin
Advance;
if FCurrentPos > Length(FSource) then
Error('Unterminated string');
c := Peek;
case c of
'n': sb.Append(#10);
'r': sb.Append(#13);
't': sb.Append(#9);
'"': sb.Append('"');
'\': sb.Append('\');
else
sb.Append(c);
end;
Advance;
end
else
begin
if c = #0 then
break;
sb.Append(c);
Advance;
end;
end;
Error('Unterminated string');
finally
sb.Free;
end;
end;
function TLexer.GetNextToken: TToken;
begin
while FCurrentPos <= Length(FSource) do
begin
// Skip Whitespace
if Peek.IsWhiteSpace then
begin
Advance;
continue;
end;
// Skip Comment
if Peek = ';' then
begin
while (Peek <> #0) and (Peek <> #10) and (Peek <> #13) do
Advance;
continue;
end;
break;
end;
Result.Line := FLine;
Result.Col := (FCurrentPos - FLineStart + 1);
if FCurrentPos > Length(FSource) then
begin
Result.Kind := tkEOF;
exit;
end;
var c := Peek;
case c of
'(':
begin
Result.Kind := tkLeftParen;
Result.Text := '(';
Advance;
end;
')':
begin
Result.Kind := tkRightParen;
Result.Text := ')';
Advance;
end;
'[':
begin
Result.Kind := tkLeftBracket;
Result.Text := '[';
Advance;
end;
']':
begin
Result.Kind := tkRightBracket;
Result.Text := ']';
Advance;
end;
'{':
begin
Result.Kind := tkLeftBrace;
Result.Text := '{';
Advance;
end;
'}':
begin
Result.Kind := tkRightBrace;
Result.Text := '}';
Advance;
end;
'''':
begin
Result.Kind := tkQuote;
Result.Text := '''';
Advance;
end;
'`':
begin
Result.Kind := tkBacktick;
Result.Text := '`';
Advance;
end;
'~':
begin
Result.Kind := tkTilde;
Result.Text := '~';
Advance;
end;
'@':
begin
Result.Kind := tkAt;
Result.Text := '@';
Advance;
end;
'"':
begin
Result.Kind := tkString;
Result.Text := ReadString;
end;
':':
begin
Advance;
Result.Kind := tkKeyword;
Result.Text := ReadIdentifier;
end;
else
// Number detection: digit or minus followed by digit
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);
InitSpecialForms;
NextToken;
end;
destructor TParser.Destroy;
begin
FSpecialForms.Free;
FLexer.Free;
inherited;
end;
procedure TParser.InitSpecialForms;
begin
FSpecialForms := TDictionary<string, TSpecialFormParser>.Create(TStringComparer.Ordinal);
FSpecialForms.Add('if', ParseIf);
FSpecialForms.Add('?', ParseCond);
FSpecialForms.Add('fn', ParseFn);
FSpecialForms.Add('defmacro', ParseDefMacro);
FSpecialForms.Add('def', ParseDef);
FSpecialForms.Add('assign', ParseAssign);
FSpecialForms.Add('do', ParseDo);
FSpecialForms.Add('recur', ParseRecur);
FSpecialForms.Add('quote', ParseQuoteForm);
FSpecialForms.Add('pipe', ParsePipe);
FSpecialForms.Add('new-series', ParseNewSeries);
FSpecialForms.Add('add-item', ParseAddItem);
FSpecialForms.Add('count', ParseCount);
FSpecialForms.Add('get', ParseGet);
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
Error(Format(Msg, Args));
end;
procedure TParser.NextToken;
begin
FCurrentToken := FLexer.GetNextToken;
end;
procedure TParser.Consume(AExpectedKind: TTokenKind);
begin
if FCurrentToken.Kind <> AExpectedKind then
ErrorFmt('Expected %s but found %s', [GetEnumName(TypeInfo(TTokenKind), Ord(AExpectedKind)), FCurrentToken.Text]);
NextToken;
end;
function TParser.Match(AKind: TTokenKind): Boolean;
begin
Result := FCurrentToken.Kind = AKind;
if Result then
NextToken;
end;
// =============================================================================
// EBNF Implementation
// =============================================================================
function TParser.Parse: IAstNode;
begin
Result := ParseScript;
end;
function TParser.ParseScript: IAstNode;
begin
Result := ParseExpression;
if FCurrentToken.Kind <> tkEOF then
Error('Unexpected chars after end of expression (EOF expected).');
end;
function TParser.ParseExpression: IAstNode;
begin
case FCurrentToken.Kind of
tkLeftParen: Result := ParseList;
tkLeftBracket: Result := ParseVector;
tkLeftBrace: Result := ParseMap;
tkQuote, tkBacktick, tkTilde: Result := ParseReaderMacro;
else
Result := ParseAtom;
end;
end;
function TParser.ParseList: IAstNode;
begin
Consume(tkLeftParen);
if FCurrentToken.Kind = tkRightParen then
Error('Syntax Error: Empty list () is not a valid expression.');
Result := ParseListContent;
Consume(tkRightParen);
end;
function TParser.ParseListContent: IAstNode;
var
headToken: TToken;
headName: string;
begin
// Look ahead at the head of the list
headToken := FCurrentToken;
if headToken.Kind = tkIdentifier then
begin
headName := headToken.Text;
// 1. Special Form?
if FSpecialForms.ContainsKey(headName) then
begin
NextToken; // Consume Head
Result := ParseSpecialForm(headName);
Exit;
end;
// 2. Member Access Sugar (.prop obj)?
if (headName.Length > 1) and (headName.StartsWith('.')) then
begin
Result := ParseMemberAccessSugar;
Exit;
end;
end;
// 3. Default: Function Call
Result := ParseFunctionCall;
end;
function TParser.ParseSpecialForm(const FormName: string): IAstNode;
var
parser: TSpecialFormParser;
begin
parser := FSpecialForms[FormName];
Result := parser();
end;
function TParser.ParseMemberAccessSugar: IAstNode;
var
loc: ISourceLocation;
propName: string;
propKey: IKeywordNode;
baseObj: IAstNode;
begin
// Current Token is the dot-identifier (e.g. ".price")
loc := FCurrentToken.GetLocation;
propName := FCurrentToken.Text.Substring(1); // Strip dot
NextToken; // Consume dot-identifier
baseObj := ParseExpression;
propKey := TAst.Keyword(propName, loc);
Result := TAst.MemberAccess(baseObj, propKey, loc);
end;
function TParser.ParseFunctionCall: IAstNode;
var
loc: ISourceLocation;
callee: IAstNode;
args: TArray<IAstNode>;
argList: TList<IAstNode>;
begin
loc := FCurrentToken.GetLocation;
// First expression is the callee
callee := ParseExpression;
// Remaining expressions until ')' are arguments
argList := TList<IAstNode>.Create;
try
while FCurrentToken.Kind <> tkRightParen do
begin
if FCurrentToken.Kind = tkEOF then
Error('Unexpected EOF in function call');
argList.Add(ParseExpression);
end;
args := argList.ToArray;
finally
argList.Free;
end;
Result := TAst.FunctionCall(callee, args, loc);
end;
function TParser.ParseAtom: IAstNode;
begin
case FCurrentToken.Kind of
tkIdentifier: Result := ParseIdentifier;
tkKeyword: Result := ParseKeyword;
tkNumber: Result := ParseNumber;
tkString: Result := ParseString;
else
ErrorFmt('Unexpected token for atom: %s', [FCurrentToken.Text]);
Result := nil; // satisfy compiler
end;
end;
function TParser.ParseIdentifier: IAstNode;
var
loc: ISourceLocation;
name: string;
begin
loc := FCurrentToken.GetLocation;
name := FCurrentToken.Text;
NextToken;
if name = '...' then
Result := ParseNop
else
Result := TAst.Identifier(name, loc);
end;
function TParser.ParseNop: IAstNode;
begin
// Nop is handled via Identifier branch, but structurally it's an atom kind
Result := TAst.Nop(FCurrentToken.GetLocation);
end;
function TParser.ParseKeyword: IAstNode;
var
loc: ISourceLocation;
begin
loc := FCurrentToken.GetLocation;
Result := TAst.Keyword(FCurrentToken.Text, loc);
NextToken;
end;
function TParser.ParseNumber: IAstNode;
var
loc: ISourceLocation;
s: string;
i64: Int64;
dbl: Double;
begin
loc := FCurrentToken.GetLocation;
s := FCurrentToken.Text;
NextToken;
if TryStrToInt64(s, i64) then
Result := TAst.Constant(i64, loc)
else if TryStrToFloat(s, dbl, TFormatSettings.Invariant) then
Result := TAst.Constant(dbl, loc)
else
Error('Invalid number format');
end;
function TParser.ParseString: IAstNode;
var
loc: ISourceLocation;
begin
loc := FCurrentToken.GetLocation;
Result := TAst.Constant(FCurrentToken.Text, loc);
NextToken;
end;
function TParser.ParseVector: IAstNode;
var
loc: ISourceLocation;
elems: TArray<IAstNode>;
begin
loc := FCurrentToken.GetLocation;
Consume(tkLeftBracket);
elems := ParseTupleBody(tkRightBracket);
Result := TAst.Tuple(elems, loc);
end;
function TParser.ParseMap: IAstNode;
var
loc: ISourceLocation;
fields: TList<IRecordFieldNode>;
keyNode: IAstNode;
valNode: IAstNode;
begin
loc := FCurrentToken.GetLocation;
Consume(tkLeftBrace);
fields := TList<IRecordFieldNode>.Create;
try
while FCurrentToken.Kind <> tkRightBrace do
begin
if FCurrentToken.Kind = tkEOF then
Error('Unexpected EOF in map');
keyNode := ParseExpression;
if keyNode.Kind <> akKeyword then
Error('Map keys must be keywords');
if FCurrentToken.Kind = tkRightBrace then
Error('Missing value in map');
valNode := ParseExpression;
fields.Add(TAst.RecordField(keyNode.AsKeyword, valNode));
end;
Consume(tkRightBrace);
Result := TAst.RecordLiteral(fields.ToArray, loc);
finally
fields.Free;
end;
end;
function TParser.ParseReaderMacro: IAstNode;
var
loc: ISourceLocation;
begin
loc := FCurrentToken.GetLocation;
if Match(tkQuote) then
begin
// 'expr -> (quote expr)
Result := TAst.FunctionCall(TAst.Identifier('quote', loc), [ParseExpression], loc);
end
else if Match(tkBacktick) then
begin
// `expr -> Quasiquote
Result := TAst.Quasiquote(ParseExpression, loc);
end
else if Match(tkTilde) then
begin
if Match(tkAt) then
// ~@expr -> UnquoteSplicing
Result := TAst.UnquoteSplicing(ParseExpression.AsQuasiquote, loc)
else
// ~expr -> Unquote
Result := TAst.Unquote(ParseExpression, loc);
end
else
begin
Error('Unknown reader macro');
Result := nil;
end;
end;
// --- Special Forms Sub-Parsers ---
function TParser.ParseIf: IAstNode;
var
cond, thenBr, elseBr: IAstNode;
begin
cond := ParseExpression;
thenBr := ParseExpression;
if FCurrentToken.Kind <> tkRightParen then
elseBr := ParseExpression
else
elseBr := nil;
Result := TAst.IfExpr(cond, thenBr, elseBr);
end;
function TParser.ParseCond: IAstNode;
var
pairs: TList<TCondPair>;
elseBr: IAstNode;
cond, br: IAstNode;
begin
pairs := TList<TCondPair>.Create;
try
while FCurrentToken.Kind <> tkRightParen do
begin
cond := ParseExpression;
if FCurrentToken.Kind = tkRightParen then
begin
// Odd number of args -> Last one is Else
elseBr := cond;
Result := TAst.CondExpr(pairs.ToArray, elseBr);
Exit;
end;
br := ParseExpression;
pairs.Add(TCondPair.Create(cond, br));
end;
// Even args -> No explicit else
Result := TAst.CondExpr(pairs.ToArray, nil);
finally
pairs.Free;
end;
end;
function TParser.ParseFn: IAstNode;
var
params, body: IAstNode;
begin
params := ParseVector; // Expects [ ... ]
body := ParseExpression;
Result := TAst.LambdaExpr(ExtractIdentifiers(params, 'fn'), body);
end;
function TParser.ParseDefMacro: IAstNode;
var
name, params, body: IAstNode;
begin
name := ParseExpression;
if name.Kind <> akIdentifier then
Error('defmacro name must be identifier');
params := ParseVector;
body := ParseExpression;
Result := TAst.MacroDef(name.AsIdentifier, ExtractIdentifiers(params, 'defmacro'), body);
end;
function TParser.ParseDef: IAstNode;
var
name, init: IAstNode;
begin
name := ParseExpression;
if FCurrentToken.Kind <> tkRightParen then
init := ParseExpression
else
init := nil;
Result := TAst.VarDecl(name, init);
end;
function TParser.ParseAssign: IAstNode;
var
target, val: IAstNode;
begin
target := ParseExpression;
val := ParseExpression;
Result := TAst.Assign(target, val);
end;
function TParser.ParseDo: IAstNode;
var
list: TList<IAstNode>;
begin
list := TList<IAstNode>.Create;
try
while FCurrentToken.Kind <> tkRightParen do
list.Add(ParseExpression);
Result := TAst.Block(list.ToArray);
finally
list.Free;
end;
end;
function TParser.ParseRecur: IAstNode;
var
list: TList<IAstNode>;
begin
list := TList<IAstNode>.Create;
try
while FCurrentToken.Kind <> tkRightParen do
list.Add(ParseExpression);
Result := TAst.Recur(list.ToArray);
finally
list.Free;
end;
end;
function TParser.ParseQuoteForm: IAstNode;
begin
Result := TAst.Quasiquote(ParseExpression);
end;
function TParser.ParsePipe: IAstNode;
var
inputs, transform: IAstNode;
begin
inputs := ParseVector;
transform := ParseExpression;
if inputs.Kind <> akTuple then
Error('Pipe inputs must be a vector');
if transform.Kind <> akLambdaExpression then
Error('Pipe transform must be a fn');
Result := TAst.Pipe(inputs.AsTuple, transform.AsLambdaExpression);
end;
function TParser.ParseNewSeries: IAstNode;
begin
Result := TAst.CreateSeries(ParseExpression);
end;
function TParser.ParseAddItem: IAstNode;
var
s, v, lb: IAstNode;
begin
s := ParseExpression;
if s.Kind <> akIdentifier then
Error('Series argument must be an identifier');
v := ParseExpression;
if FCurrentToken.Kind <> tkRightParen then
lb := ParseExpression
else
lb := nil;
Result := TAst.AddSeriesItem(s.AsIdentifier, v, lb);
end;
function TParser.ParseCount: IAstNode;
var
s: IAstNode;
begin
s := ParseExpression;
if s.Kind <> akIdentifier then
Error('Count argument must be an identifier');
Result := TAst.SeriesLength(s.AsIdentifier);
end;
function TParser.ParseGet: IAstNode;
var
base, idx: IAstNode;
begin
base := ParseExpression;
idx := ParseExpression;
Result := TAst.Indexer(base, idx);
end;
// --- Helpers ---
function TParser.ParseTupleBody(StopToken: TTokenKind): TArray<IAstNode>;
var
list: TList<IAstNode>;
begin
list := TList<IAstNode>.Create;
try
while FCurrentToken.Kind <> StopToken do
begin
if FCurrentToken.Kind = tkEOF then
Error('Unexpected EOF inside tuple/vector');
list.Add(ParseExpression);
end;
Result := list.ToArray;
finally
list.Free;
end;
Consume(StopToken);
end;
function TParser.ExtractIdentifiers(const Node: IAstNode; const Context: string): TArray<IIdentifierNode>;
begin
if Node.Kind <> akTuple then
ErrorFmt('%s expects a vector of identifiers.', [Context]);
var elements := Node.AsTuple.Elements;
SetLength(Result, Length(elements));
for var i := 0 to High(elements) do
begin
if elements[i].Kind <> akIdentifier then
ErrorFmt('Element at index %d in %s is not an identifier.', [i, Context]);
Result[i] := elements[i].AsIdentifier;
end;
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
v: TPrettyPrintVisitor;
begin
v := TPrettyPrintVisitor.Create;
try
v.Execute(ANode);
Result := v.GetResult;
finally
v.Free;
end;
end;
class function TAstScript.GetGrammar: string;
var
ctx: TRttiContext;
t: TRttiType;
m: TRttiMethod;
attr: TCustomAttribute;
sb: TStringBuilder;
rules: TList<string>;
begin
ctx := TRttiContext.Create;
rules := TList<string>.Create;
sb := TStringBuilder.Create;
try
t := ctx.GetType(TParser);
for m in t.GetMethods do
begin
for attr in m.GetAttributes do
begin
if attr is EbnfAttribute then
begin
rules.Add(EbnfAttribute(attr).Rule);
end;
end;
end;
// Sort to ensure deterministic output (optional, but good for docs)
rules.Sort;
sb.AppendLine('(* Myc Script Grammar (Auto-Generated) *)');
sb.AppendLine;
for var rule in rules do
sb.AppendLine(rule);
Result := sb.ToString;
finally
sb.Free;
rules.Free;
ctx.Free;
end;
end;
end.