Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

AST Identities

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-25 19:51:06 +01:00
parent aff4cec7d5
commit 874c0d9adf
2 changed files with 101 additions and 154 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.delphilsp.json
+1 -1
View File
File diff suppressed because one or more lines are too long
Src/AST/Myc.Ast.Script.pas
+100 -153
View File
@@ -20,44 +20,32 @@ type
end; end;
var var
// This BNF should always be kept up to date and valid. It is used to comunicate with LLMs. // This BNF should always be kept up to date and valid.
// (Nop isn't part of the language syntax.)
BNF: String = BNF: String =
''' '''
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ---- Main Productions (Start Symbols) ---- *) (* ---- Main Productions (Start Symbols) ---- *)
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* A program is a single expression, which can be followed by comments *)
program ::= expression program ::= expression
(* An expression is either an atom, a list, a record, or a macro character *)
expression ::= atom | list | record_literal | reader_macro expression ::= atom | list | record_literal | reader_macro
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ---- Atoms (Basic Values) ---- *) (* ---- Atoms (Basic Values) ---- *)
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
atom ::= number | string | identifier | keyword atom ::= number | string | identifier | keyword
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ---- Reader-Macros (Syntactic Sugar) ---- *) (* ---- Reader-Macros (Syntactic Sugar) ---- *)
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
reader_macro ::= "'" expression (* (quote ...) *)
reader_macro ::= "'" expression (* (quote ...) *) | "`" expression (* (quasiquote ...) *)
| "`" expression (* (quasiquote ...) *) | "~" expression (* (unquote ...) *)
| "~" expression (* (unquote ...) *) | "~@" expression (* (unquote-splicing ...) *)
| "~@" expression (* (unquote-splicing ...) *)
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ---- Lists (S-Expressions) ---- *) (* ---- Lists (S-Expressions) ---- *)
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* A list is the primary structure for code. Empty lists () are invalid. *)
list ::= "(" list_content ")" 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 list_content ::= special_form | function_call
special_form ::= "if" expression expression expression? special_form ::= "if" expression expression expression?
@@ -71,35 +59,22 @@ var
| "get" expression expression | "get" expression expression
| dot_identifier 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* function_call ::= expression expression*
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ---- Parameter Lists and Records ---- *) (* ---- Parameter Lists and Records ---- *)
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* A parameter list is *only* valid inside 'fn' and 'defmacro' *)
parameter_list ::= "[" identifier* "]" parameter_list ::= "[" identifier* "]"
(* A record literal consists of 0 or more keyword/value pairs *)
record_literal ::= "{" (keyword expression)* "}" record_literal ::= "{" (keyword expression)* "}"
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ---- Terminals (Lexer Tokens) ---- *) (* ---- Terminals (Lexer Tokens) ---- *)
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
number ::= ["-"] digit+ ["." digit+] number ::= ["-"] digit+ ["." digit+]
string ::= '"' ( ? any char except \ or " ? | '\' ( '"' | '\' | 'n' | 'r' | 't' ) )* '"' string ::= '"' ( ? any char except \ or " ? | '\' ( '"' | '\' | 'n' | 'r' | 't' ) )* '"'
keyword ::= ":" identifier keyword ::= ":" identifier
(* An identifier for member access, handled specially by the parser *)
dot_identifier ::= "." identifier 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, '()[]{}'`~:; ? identifier ::= ? any sequence of chars not containing whitespace, '()[]{}'`~:; ?
digit ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" digit ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9"
'''; ''';
@@ -121,10 +96,10 @@ uses
Myc.Data.Scalar, Myc.Data.Scalar,
Myc.Data.Value, Myc.Data.Value,
Myc.Data.Keyword, Myc.Data.Keyword,
Myc.Ast; Myc.Ast,
Myc.Ast.Identities;
type type
// --- Internal Parser Implementation --- // --- Internal Parser Implementation ---
TTokenKind = ( TTokenKind = (
@@ -155,6 +130,7 @@ type
Text: string; Text: string;
Line: Integer; Line: Integer;
Col: Integer; Col: Integer;
function GetLocation: ISourceLocation;
end; end;
TLexer = class TLexer = class
@@ -204,7 +180,6 @@ type
// --- Internal Printer Implementation --- // --- Internal Printer Implementation ---
// Inherits from the new non-generic TAstVisitor
TPrettyPrintVisitor = class(TAstVisitor) TPrettyPrintVisitor = class(TAstVisitor)
private private
FBuilder: TStringBuilder; FBuilder: TStringBuilder;
@@ -217,9 +192,8 @@ type
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
function GetResult: string; function GetResult: string;
// Helper
function Execute(const RootNode: IAstNode): TDataValue; function Execute(const RootNode: IAstNode): TDataValue;
// Override abstract procedures from TAstVisitor
procedure VisitConstant(const Node: IConstantNode); override; procedure VisitConstant(const Node: IConstantNode); override;
procedure VisitIdentifier(const Node: IIdentifierNode); override; procedure VisitIdentifier(const Node: IIdentifierNode); override;
procedure VisitKeyword(const Node: IKeywordNode); override; procedure VisitKeyword(const Node: IKeywordNode); override;
@@ -245,7 +219,41 @@ type
procedure VisitNop(const Node: INopNode); override; procedure VisitNop(const Node: INopNode); override;
end; end;
{ EParserException } // -----------------------------------------------------------------------------
// IMPLEMENTATION: Helpers & Basic Types
// -----------------------------------------------------------------------------
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;
function TToken.GetLocation: ISourceLocation;
begin
Result := TIdentities.Location(Line, Col);
end;
// -----------------------------------------------------------------------------
// IMPLEMENTATION: Lexer
// -----------------------------------------------------------------------------
constructor EParserException.Create(const AMessage: string; ALine, ACol: Integer); constructor EParserException.Create(const AMessage: string; ALine, ACol: Integer);
begin begin
@@ -254,8 +262,6 @@ begin
FCol := ACol; FCol := ACol;
end; end;
{ TLexer }
constructor TLexer.Create(const ASource: string); constructor TLexer.Create(const ASource: string);
begin begin
inherited Create; inherited Create;
@@ -320,8 +326,6 @@ var
startPos: Integer; startPos: Integer;
begin begin
startPos := FCurrentPos; startPos := FCurrentPos;
// Handle the optional leading minus sign
if (Peek = '-') then if (Peek = '-') then
Advance; Advance;
@@ -358,28 +362,23 @@ begin
case c of case c of
'"': builder.Append('"'); '"': builder.Append('"');
'\': builder.Append('\'); '\': builder.Append('\');
'n': builder.Append(sLineBreak); // Use system's line break 'n': builder.Append(sLineBreak);
't': builder.Append(#9); 't': builder.Append(#9);
'r': builder.Append(#13); 'r': builder.Append(#13);
else else
// Pass through unknown escapes (e.g., "\z" becomes "z")
builder.Append(c); builder.Append(c);
end; end;
Advance; // Consume escaped char Advance; // Consume escaped char
end end
else else
begin begin
// Append regular char (including literal newlines) if c = #0 then
if c = #0 then // Check for unexpected EOF
break; break;
builder.Append(c); builder.Append(c);
Advance; Advance;
end; end;
end; end;
// If we fall out of the loop, we hit EOF without a closing quote.
Error('Syntax Error: Unterminated string literal.'); Error('Syntax Error: Unterminated string literal.');
finally finally
builder.Free; builder.Free;
end; end;
@@ -387,7 +386,6 @@ end;
function TLexer.GetNextToken: TToken; function TLexer.GetNextToken: TToken;
begin begin
// Skip whitespace and comments
while FCurrentPos <= Length(FSource) do while FCurrentPos <= Length(FSource) do
begin begin
if FSource[FCurrentPos].IsWhiteSpace then if FSource[FCurrentPos].IsWhiteSpace then
@@ -398,17 +396,13 @@ begin
if FSource[FCurrentPos] = ';' then if FSource[FCurrentPos] = ';' then
begin begin
// Comment found, skip to the end of the line
while (FCurrentPos <= Length(FSource)) and (not CharInSet(FSource[FCurrentPos], [#10, #13])) do while (FCurrentPos <= Length(FSource)) and (not CharInSet(FSource[FCurrentPos], [#10, #13])) do
Advance; Advance;
continue; continue;
end; end;
// No whitespace or comment, so break out and process the token
break; break;
end; end;
// Capture location for the start of the token
Result.Line := CurrentLine; Result.Line := CurrentLine;
Result.Col := CurrentCol; Result.Col := CurrentCol;
@@ -477,7 +471,7 @@ begin
end; end;
':': ':':
begin begin
Advance; // Skip : Advance;
Result.Kind := tkKeyword; Result.Kind := tkKeyword;
Result.Text := ReadIdentifier; Result.Text := ReadIdentifier;
if Result.Text.IsEmpty then if Result.Text.IsEmpty then
@@ -497,13 +491,15 @@ begin
end; end;
end; end;
{ TParser } // -----------------------------------------------------------------------------
// IMPLEMENTATION: Parser
// -----------------------------------------------------------------------------
constructor TParser.Create(const ASource: string); constructor TParser.Create(const ASource: string);
begin begin
inherited Create; inherited Create;
FLexer := TLexer.Create(ASource); FLexer := TLexer.Create(ASource);
NextToken; // Load the first token NextToken;
end; end;
destructor TParser.Destroy; destructor TParser.Destroy;
@@ -547,7 +543,9 @@ begin
Error('Syntax Error: Unexpected end of file.'); Error('Syntax Error: Unexpected end of file.');
if FCurrentToken.Kind <> tkIdentifier then if FCurrentToken.Kind <> tkIdentifier then
Error('Syntax Error: Expected identifier in parameter list.'); Error('Syntax Error: Expected identifier in parameter list.');
params.Add(TAst.Identifier(FCurrentToken.Text));
// Pass Location to Factory
params.Add(TAst.Identifier(FCurrentToken.Text, FCurrentToken.GetLocation));
NextToken; NextToken;
end; end;
Result := params.ToArray; Result := params.ToArray;
@@ -562,7 +560,9 @@ var
fields: TList<TRecordFieldLiteral>; fields: TList<TRecordFieldLiteral>;
fieldName: string; fieldName: string;
fieldValue: IAstNode; fieldValue: IAstNode;
keyToken: TToken;
begin begin
var startLoc := FCurrentToken.GetLocation;
Consume(tkLeftBrace); Consume(tkLeftBrace);
fields := TList<TRecordFieldLiteral>.Create; fields := TList<TRecordFieldLiteral>.Create;
try try
@@ -571,21 +571,21 @@ begin
if FCurrentToken.Kind = tkEOF then if FCurrentToken.Kind = tkEOF then
Error('Syntax Error: Unexpected end of file in record literal.'); Error('Syntax Error: Unexpected end of file in record literal.');
// Key must be a keyword
if FCurrentToken.Kind <> tkKeyword then if FCurrentToken.Kind <> tkKeyword then
Error('Syntax Error: Expected keyword (e.g., :key) as field name in record literal.'); Error('Syntax Error: Expected keyword (e.g., :key) as field name in record literal.');
keyToken := FCurrentToken;
fieldName := FCurrentToken.Text; fieldName := FCurrentToken.Text;
NextToken; NextToken;
// Value can be any expression
if FCurrentToken.Kind = tkRightBrace then if FCurrentToken.Kind = tkRightBrace then
Error('Syntax Error: Missing value for key ' + fieldName + ' in record literal.'); Error('Syntax Error: Missing value for key ' + fieldName + ' in record literal.');
fieldValue := ParseExpression.Node; fieldValue := ParseExpression.Node;
fields.Add(TRecordFieldLiteral.Create(TAst.Keyword(fieldName), fieldValue)); fields.Add(TRecordFieldLiteral.Create(TAst.Keyword(fieldName, keyToken.GetLocation), fieldValue));
end; end;
Result := TAst.RecordLiteral(fields.ToArray); Result := TAst.RecordLiteral(fields.ToArray, startLoc);
finally finally
fields.Free; fields.Free;
end; end;
@@ -596,10 +596,11 @@ function TParser.ParseList: IAstNode;
var var
elements: TList<TExpr>; elements: TList<TExpr>;
head: TExpr; head: TExpr;
tailTokens: TArray<TToken>;
tailNodes: TArray<IAstNode>; tailNodes: TArray<IAstNode>;
initializer: IAstNode; initializer: IAstNode;
startLoc: ISourceLocation;
begin begin
startLoc := FCurrentToken.GetLocation;
Consume(tkLeftParen); Consume(tkLeftParen);
if FCurrentToken.Kind = tkRightParen then if FCurrentToken.Kind = tkRightParen then
Error('Syntax Error: Empty list () is not a valid expression.'); Error('Syntax Error: Empty list () is not a valid expression.');
@@ -615,85 +616,70 @@ begin
head := elements[0]; head := elements[0];
SetLength(tailTokens, elements.Count - 1);
SetLength(tailNodes, elements.Count - 1); SetLength(tailNodes, elements.Count - 1);
for var i := 0 to High(tailNodes) do for var i := 0 to High(tailNodes) do
begin
tailTokens[i] := elements[i + 1].Token;
tailNodes[i] := elements[i + 1].Node; tailNodes[i] := elements[i + 1].Node;
end;
if head.Token.Kind = tkIdentifier then if head.Token.Kind = tkIdentifier then
begin begin
// Handle special forms
if SameText(head.Token.Text, 'if') then if SameText(head.Token.Text, 'if') then
begin begin
if not (Length(tailNodes) in [2, 3]) then if not (Length(tailNodes) in [2, 3]) then
Error('Syntax Error in if statement.'); Error('Syntax Error in if statement.');
var elseBranch: IAstNode := nil; var elseBranch: IAstNode := nil;
if Length(tailNodes) = 3 then if Length(tailNodes) = 3 then
elseBranch := tailNodes[2]; elseBranch := tailNodes[2];
Result := TAst.IfExpr(tailNodes[0], tailNodes[1], elseBranch, startLoc);
Result := TAst.IfExpr(tailNodes[0], tailNodes[1], elseBranch);
end end
else if SameText(head.Token.Text, '?') then else if SameText(head.Token.Text, '?') then
begin begin
if Length(tailNodes) <> 3 then if Length(tailNodes) <> 3 then
Error('Syntax Error in ternary statement.'); Error('Syntax Error in ternary statement.');
Result := TAst.TernaryExpr(tailNodes[0], tailNodes[1], tailNodes[2], startLoc);
Result := TAst.TernaryExpr(tailNodes[0], tailNodes[1], tailNodes[2]);
end end
else if SameText(head.Token.Text, 'def') then else if SameText(head.Token.Text, 'def') then
begin begin
// Identifier check removed to support macros (e.g. def ~x 1)
if not (Length(tailNodes) in [1, 2]) then if not (Length(tailNodes) in [1, 2]) then
Error('Syntax Error: ''def'' requires a target and an optional initializer.'); Error('Syntax Error: ''def'' requires a target and an optional initializer.');
initializer := nil; initializer := nil;
if Length(tailNodes) = 2 then if Length(tailNodes) = 2 then
initializer := tailNodes[1]; initializer := tailNodes[1];
Result := TAst.VarDecl(tailNodes[0], initializer, startLoc);
Result := TAst.VarDecl(tailNodes[0], initializer);
end end
else if SameText(head.Token.Text, 'defmacro') then else if SameText(head.Token.Text, 'defmacro') then
begin begin
if (Length(tailNodes) <> 3) or (tailTokens[0].Kind <> tkIdentifier) then if (Length(tailNodes) <> 3) or (elements[1].Token.Kind <> tkIdentifier) then
Error('Syntax Error: ''defmacro'' requires a name, a parameter list, and a body.'); Error('Syntax Error: ''defmacro'' requires a name, a parameter list, and a body.');
var macroName := tailNodes[0].AsIdentifier; var macroName := tailNodes[0].AsIdentifier;
var macroParams := elements[2].Params; var macroParams := elements[2].Params;
if tailTokens[2].Kind <> tkBacktick then if tailNodes[2].Kind <> akQuasiquote then
Error('Syntax Error: Expected a quasiquote as macro body.'); Error('Syntax Error: Expected a quasiquote as macro body.');
var macroBody := IQuasiQuoteNode(tailNodes[2]); Result := TAst.MacroDef(macroName, macroParams, tailNodes[2], startLoc);
Result := TAst.MacroDef(macroName, macroParams, macroBody);
end end
else if SameText(head.Token.Text, 'assign') then else if SameText(head.Token.Text, 'assign') then
begin begin
// Identifier check removed
if Length(tailNodes) <> 2 then if Length(tailNodes) <> 2 then
Error('Syntax Error: ''assign'' requires exactly 2 arguments (target and value).'); Error('Syntax Error: ''assign'' requires exactly 2 arguments (target and value).');
Result := TAst.Assign(tailNodes[0], tailNodes[1], startLoc);
Result := TAst.Assign(tailNodes[0], tailNodes[1]);
end end
else if SameText(head.Token.Text, 'fn') then else if SameText(head.Token.Text, 'fn') then
begin begin
if Length(tailNodes) <> 2 then if Length(tailNodes) <> 2 then
Error('Syntax Error: ''fn'' requires a parameter list and a body.'); Error('Syntax Error: ''fn'' requires a parameter list and a body.');
Result := TAst.LambdaExpr(elements[1].Params, tailNodes[1]); Result := TAst.LambdaExpr(elements[1].Params, tailNodes[1], startLoc);
end end
else if SameText(head.Token.Text, 'do') then else if SameText(head.Token.Text, 'do') then
Result := TAst.Block(tailNodes) Result := TAst.Block(tailNodes, startLoc)
else if SameText(head.Token.Text, 'recur') then else if SameText(head.Token.Text, 'recur') then
Result := TAst.Recur(tailNodes) Result := TAst.Recur(tailNodes, startLoc)
else if SameText(head.Token.Text, 'get') then else if SameText(head.Token.Text, 'get') then
begin begin
if Length(tailNodes) <> 2 then if Length(tailNodes) <> 2 then
Error('Syntax Error: ''get'' requires exactly 2 arguments (base and index).'); Error('Syntax Error: ''get'' requires exactly 2 arguments (base and index).');
Result := TAst.Indexer(tailNodes[0], tailNodes[1]) Result := TAst.Indexer(tailNodes[0], tailNodes[1], startLoc)
end end
else if (Length(head.Token.Text) > 1) and (head.Token.Text.StartsWith('.')) then else if (Length(head.Token.Text) > 1) and (head.Token.Text.StartsWith('.')) then
begin begin
@@ -702,13 +688,12 @@ begin
'Syntax Error: Member access (e.g., ''%s'') requires exactly 1 argument (the base object).', 'Syntax Error: Member access (e.g., ''%s'') requires exactly 1 argument (the base object).',
[head.Token.Text] [head.Token.Text]
); );
Result := TAst.MemberAccess(tailNodes[0], TAst.Keyword(head.Token.Text.Substring(1))); Result := TAst.MemberAccess(tailNodes[0], TAst.Keyword(head.Token.Text.Substring(1), head.Token.GetLocation), startLoc);
end; end;
end; end;
// If no special form matched, treat it as a generic function call.
if Result = nil then if Result = nil then
Result := TAst.FunctionCall(head.Node, tailNodes); Result := TAst.FunctionCall(head.Node, tailNodes, startLoc);
finally finally
elements.Free; elements.Free;
@@ -722,15 +707,17 @@ var
i64: Int64; i64: Int64;
dbl: Double; dbl: Double;
expr: TExpr; expr: TExpr;
startLoc: ISourceLocation;
begin begin
// Handle reader macros.
Result.Token := FCurrentToken; Result.Token := FCurrentToken;
startLoc := FCurrentToken.GetLocation;
case FCurrentToken.Kind of case FCurrentToken.Kind of
tkBacktick: tkBacktick:
begin begin
NextToken; NextToken;
expr := ParseExpression; expr := ParseExpression;
Result.Node := TAst.Quasiquote(expr.Node); Result.Node := TAst.Quasiquote(expr.Node, startLoc);
exit; exit;
end; end;
tkTilde: tkTilde:
@@ -740,12 +727,12 @@ begin
begin begin
NextToken; NextToken;
expr := ParseExpression; expr := ParseExpression;
Result.Node := TAst.UnquoteSplicing(expr.Node.AsQuasiquote); Result.Node := TAst.UnquoteSplicing(expr.Node.AsQuasiquote, startLoc);
end end
else else
begin begin
expr := ParseExpression; expr := ParseExpression;
Result.Node := TAst.Unquote(expr.Node); Result.Node := TAst.Unquote(expr.Node, startLoc);
end; end;
exit; exit;
end; end;
@@ -753,7 +740,7 @@ begin
begin begin
NextToken; NextToken;
expr := ParseExpression; expr := ParseExpression;
Result.Node := TAst.FunctionCall(TAst.Identifier('quote'), [expr.Node]); Result.Node := TAst.FunctionCall(TAst.Identifier('quote', startLoc), [expr.Node], startLoc);
exit; exit;
end; end;
end; end;
@@ -763,45 +750,29 @@ begin
tkNumber: tkNumber:
begin begin
if TryStrToInt64(FCurrentToken.Text, i64) then if TryStrToInt64(FCurrentToken.Text, i64) then
Result.Node := Result.Node := TAst.Constant(i64, startLoc)
TAst.Constant(i64)
// Use invariant format settings for float parsing.
else if TryStrToFloat(FCurrentToken.Text, dbl, TFormatSettings.Invariant) then else if TryStrToFloat(FCurrentToken.Text, dbl, TFormatSettings.Invariant) then
Result.Node := TAst.Constant(dbl) Result.Node := TAst.Constant(dbl, startLoc)
else else
ErrorFmt('Syntax Error: Invalid number format "%s"', [FCurrentToken.Text]); ErrorFmt('Syntax Error: Invalid number format "%s"', [FCurrentToken.Text]);
NextToken; NextToken;
end; end;
tkString: tkString:
begin begin
Result.Node := TAst.Constant(FCurrentToken.Text); Result.Node := TAst.Constant(FCurrentToken.Text, startLoc);
NextToken; NextToken;
end; end;
tkKeyword: tkKeyword:
begin begin
Result.Node := TAst.Keyword(FCurrentToken.Text); Result.Node := TAst.Keyword(FCurrentToken.Text, startLoc);
NextToken; NextToken;
end; end;
tkIdentifier: tkIdentifier:
begin begin
// Check for the NOP token ('...')
if FCurrentToken.Text = '...' then if FCurrentToken.Text = '...' then
begin Result.Node := TAst.Nop(startLoc)
// 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 else
begin Result.Node := TAst.Identifier(FCurrentToken.Text, startLoc);
Result.Node := TAst.Identifier(FCurrentToken.Text);
end;
NextToken; NextToken;
end; end;
tkLeftParen: Result.Node := ParseList; tkLeftParen: Result.Node := ParseList;
@@ -821,7 +792,10 @@ begin
Result := expr.Node; Result := expr.Node;
end; end;
{ TPrettyPrintVisitor } // -----------------------------------------------------------------------------
// IMPLEMENTATION: PrettyPrintVisitor
// -----------------------------------------------------------------------------
constructor TPrettyPrintVisitor.Create; constructor TPrettyPrintVisitor.Create;
begin begin
inherited Create; inherited Create;
@@ -929,7 +903,7 @@ begin
for var param in Node.Parameters do for var param in Node.Parameters do
sb.Append(param.Name + ' '); sb.Append(param.Name + ' ');
if sb.Length > 0 then if sb.Length > 0 then
sb.Remove(sb.Length - 1, 1); // remove trailing space sb.Remove(sb.Length - 1, 1);
Append('(fn [' + sb.ToString + ']'); Append('(fn [' + sb.ToString + ']');
finally finally
@@ -982,8 +956,6 @@ end;
procedure TPrettyPrintVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode); procedure TPrettyPrintVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode);
begin 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('~@'); Append('~@');
Node.Expression.Accept(Self); Node.Expression.Accept(Self);
end; end;
@@ -992,7 +964,6 @@ procedure TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode);
var var
arg: IAstNode; arg: IAstNode;
begin 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 if (Node.Callee.Kind = akIdentifier) and (Node.Callee.AsIdentifier.Name = 'quote') and (Length(Node.Arguments) = 1) then
begin begin
Append(''''); Append('''');
@@ -1016,8 +987,6 @@ end;
procedure TPrettyPrintVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode); procedure TPrettyPrintVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode);
begin 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); VisitFunctionCall(Node.CallNode);
end; end;
@@ -1137,7 +1106,6 @@ end;
procedure TPrettyPrintVisitor.VisitNop(const Node: INopNode); procedure TPrettyPrintVisitor.VisitNop(const Node: INopNode);
begin begin
// A placeholder node, usually for UI.
Append('...'); Append('...');
end; end;
@@ -1148,7 +1116,9 @@ begin
Append(')'); Append(')');
end; end;
{ TAstScript } // -----------------------------------------------------------------------------
// IMPLEMENTATION: TAstScript Facade
// -----------------------------------------------------------------------------
class function TAstScript.Parse(const ASource: string): IAstNode; class function TAstScript.Parse(const ASource: string): IAstNode;
var var
@@ -1179,27 +1149,4 @@ begin
end; end;
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. end.