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
Src/AST/Myc.Ast.Script.pas
+100 -153
View File
@@ -20,44 +20,32 @@ type
end;
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.)
// This BNF should always be kept up to date and valid.
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-Macros (Syntactic Sugar) ---- *)
(* ---------------------------------------------------------------------- *)
reader_macro ::= "'" expression (* (quote ...) *)
| "`" expression (* (quasiquote ...) *)
| "~" expression (* (unquote ...) *)
| "~@" expression (* (unquote-splicing ...) *)
reader_macro ::= "'" expression (* (quote ...) *)
| "`" expression (* (quasiquote ...) *)
| "~" expression (* (unquote ...) *)
| "~@" expression (* (unquote-splicing ...) *)
(* ---------------------------------------------------------------------- *)
(* ---- Lists (S-Expressions) ---- *)
(* ---- 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?
@@ -71,35 +59,22 @@ var
| "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 ---- *)
(* ---- 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) ---- *)
(* ---- 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"
''';
@@ -121,10 +96,10 @@ uses
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Data.Keyword,
Myc.Ast;
Myc.Ast,
Myc.Ast.Identities;
type
// --- Internal Parser Implementation ---
TTokenKind = (
@@ -155,6 +130,7 @@ type
Text: string;
Line: Integer;
Col: Integer;
function GetLocation: ISourceLocation;
end;
TLexer = class
@@ -204,7 +180,6 @@ type
// --- Internal Printer Implementation ---
// Inherits from the new non-generic TAstVisitor
TPrettyPrintVisitor = class(TAstVisitor)
private
FBuilder: TStringBuilder;
@@ -217,9 +192,8 @@ type
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;
@@ -245,7 +219,41 @@ type
procedure VisitNop(const Node: INopNode); override;
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);
begin
@@ -254,8 +262,6 @@ begin
FCol := ACol;
end;
{ TLexer }
constructor TLexer.Create(const ASource: string);
begin
inherited Create;
@@ -320,8 +326,6 @@ var
startPos: Integer;
begin
startPos := FCurrentPos;
// Handle the optional leading minus sign
if (Peek = '-') then
Advance;
@@ -358,28 +362,23 @@ begin
case c of
'"': builder.Append('"');
'\': builder.Append('\');
'n': builder.Append(sLineBreak); // Use system's line break
'n': builder.Append(sLineBreak);
'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
if c = #0 then
break;
builder.Append(c);
Advance;
end;
end;
// If we fall out of the loop, we hit EOF without a closing quote.
Error('Syntax Error: Unterminated string literal.');
finally
builder.Free;
end;
@@ -387,7 +386,6 @@ end;
function TLexer.GetNextToken: TToken;
begin
// Skip whitespace and comments
while FCurrentPos <= Length(FSource) do
begin
if FSource[FCurrentPos].IsWhiteSpace then
@@ -398,17 +396,13 @@ begin
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;
// Capture location for the start of the token
Result.Line := CurrentLine;
Result.Col := CurrentCol;
@@ -477,7 +471,7 @@ begin
end;
':':
begin
Advance; // Skip :
Advance;
Result.Kind := tkKeyword;
Result.Text := ReadIdentifier;
if Result.Text.IsEmpty then
@@ -497,13 +491,15 @@ begin
end;
end;
{ TParser }
// -----------------------------------------------------------------------------
// IMPLEMENTATION: Parser
// -----------------------------------------------------------------------------
constructor TParser.Create(const ASource: string);
begin
inherited Create;
FLexer := TLexer.Create(ASource);
NextToken; // Load the first token
NextToken;
end;
destructor TParser.Destroy;
@@ -547,7 +543,9 @@ begin
Error('Syntax Error: Unexpected end of file.');
if FCurrentToken.Kind <> tkIdentifier then
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;
end;
Result := params.ToArray;
@@ -562,7 +560,9 @@ var
fields: TList<TRecordFieldLiteral>;
fieldName: string;
fieldValue: IAstNode;
keyToken: TToken;
begin
var startLoc := FCurrentToken.GetLocation;
Consume(tkLeftBrace);
fields := TList<TRecordFieldLiteral>.Create;
try
@@ -571,21 +571,21 @@ begin
if FCurrentToken.Kind = tkEOF then
Error('Syntax Error: Unexpected end of file in record literal.');
// Key must be a keyword
if FCurrentToken.Kind <> tkKeyword then
Error('Syntax Error: Expected keyword (e.g., :key) as field name in record literal.');
keyToken := FCurrentToken;
fieldName := FCurrentToken.Text;
NextToken;
// Value can be any expression
if FCurrentToken.Kind = tkRightBrace then
Error('Syntax Error: Missing value for key ' + fieldName + ' in record literal.');
fieldValue := ParseExpression.Node;
fields.Add(TRecordFieldLiteral.Create(TAst.Keyword(fieldName), fieldValue));
fields.Add(TRecordFieldLiteral.Create(TAst.Keyword(fieldName, keyToken.GetLocation), fieldValue));
end;
Result := TAst.RecordLiteral(fields.ToArray);
Result := TAst.RecordLiteral(fields.ToArray, startLoc);
finally
fields.Free;
end;
@@ -596,10 +596,11 @@ function TParser.ParseList: IAstNode;
var
elements: TList<TExpr>;
head: TExpr;
tailTokens: TArray<TToken>;
tailNodes: TArray<IAstNode>;
initializer: IAstNode;
startLoc: ISourceLocation;
begin
startLoc := FCurrentToken.GetLocation;
Consume(tkLeftParen);
if FCurrentToken.Kind = tkRightParen then
Error('Syntax Error: Empty list () is not a valid expression.');
@@ -615,85 +616,70 @@ begin
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
Error('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);
Result := TAst.IfExpr(tailNodes[0], tailNodes[1], elseBranch, startLoc);
end
else if SameText(head.Token.Text, '?') then
begin
if Length(tailNodes) <> 3 then
Error('Syntax Error in ternary statement.');
Result := TAst.TernaryExpr(tailNodes[0], tailNodes[1], tailNodes[2]);
Result := TAst.TernaryExpr(tailNodes[0], tailNodes[1], tailNodes[2], startLoc);
end
else if SameText(head.Token.Text, 'def') then
begin
// Identifier check removed to support macros (e.g. def ~x 1)
if not (Length(tailNodes) in [1, 2]) then
Error('Syntax Error: ''def'' requires a target and an optional initializer.');
initializer := nil;
if Length(tailNodes) = 2 then
initializer := tailNodes[1];
Result := TAst.VarDecl(tailNodes[0], initializer);
Result := TAst.VarDecl(tailNodes[0], initializer, startLoc);
end
else if SameText(head.Token.Text, 'defmacro') then
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.');
var macroName := tailNodes[0].AsIdentifier;
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.');
var macroBody := IQuasiQuoteNode(tailNodes[2]);
Result := TAst.MacroDef(macroName, macroParams, macroBody);
Result := TAst.MacroDef(macroName, macroParams, tailNodes[2], startLoc);
end
else if SameText(head.Token.Text, 'assign') then
begin
// Identifier check removed
if Length(tailNodes) <> 2 then
Error('Syntax Error: ''assign'' requires exactly 2 arguments (target and value).');
Result := TAst.Assign(tailNodes[0], tailNodes[1]);
Result := TAst.Assign(tailNodes[0], tailNodes[1], 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.');
Result := TAst.LambdaExpr(elements[1].Params, tailNodes[1]);
Result := TAst.LambdaExpr(elements[1].Params, tailNodes[1], startLoc);
end
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
Result := TAst.Recur(tailNodes)
Result := TAst.Recur(tailNodes, startLoc)
else if SameText(head.Token.Text, 'get') then
begin
if Length(tailNodes) <> 2 then
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
else if (Length(head.Token.Text) > 1) and (head.Token.Text.StartsWith('.')) then
begin
@@ -702,13 +688,12 @@ begin
'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)));
Result := TAst.MemberAccess(tailNodes[0], TAst.Keyword(head.Token.Text.Substring(1), head.Token.GetLocation), startLoc);
end;
end;
// If no special form matched, treat it as a generic function call.
if Result = nil then
Result := TAst.FunctionCall(head.Node, tailNodes);
Result := TAst.FunctionCall(head.Node, tailNodes, startLoc);
finally
elements.Free;
@@ -722,15 +707,17 @@ var
i64: Int64;
dbl: Double;
expr: TExpr;
startLoc: ISourceLocation;
begin
// Handle reader macros.
Result.Token := FCurrentToken;
startLoc := FCurrentToken.GetLocation;
case FCurrentToken.Kind of
tkBacktick:
begin
NextToken;
expr := ParseExpression;
Result.Node := TAst.Quasiquote(expr.Node);
Result.Node := TAst.Quasiquote(expr.Node, startLoc);
exit;
end;
tkTilde:
@@ -740,12 +727,12 @@ begin
begin
NextToken;
expr := ParseExpression;
Result.Node := TAst.UnquoteSplicing(expr.Node.AsQuasiquote);
Result.Node := TAst.UnquoteSplicing(expr.Node.AsQuasiquote, startLoc);
end
else
begin
expr := ParseExpression;
Result.Node := TAst.Unquote(expr.Node);
Result.Node := TAst.Unquote(expr.Node, startLoc);
end;
exit;
end;
@@ -753,7 +740,7 @@ begin
begin
NextToken;
expr := ParseExpression;
Result.Node := TAst.FunctionCall(TAst.Identifier('quote'), [expr.Node]);
Result.Node := TAst.FunctionCall(TAst.Identifier('quote', startLoc), [expr.Node], startLoc);
exit;
end;
end;
@@ -763,45 +750,29 @@ begin
tkNumber:
begin
if TryStrToInt64(FCurrentToken.Text, i64) then
Result.Node :=
TAst.Constant(i64)
// Use invariant format settings for float parsing.
Result.Node := TAst.Constant(i64, startLoc)
else if TryStrToFloat(FCurrentToken.Text, dbl, TFormatSettings.Invariant) then
Result.Node := TAst.Constant(dbl)
Result.Node := TAst.Constant(dbl, startLoc)
else
ErrorFmt('Syntax Error: Invalid number format "%s"', [FCurrentToken.Text]);
NextToken;
end;
tkString:
begin
Result.Node := TAst.Constant(FCurrentToken.Text);
Result.Node := TAst.Constant(FCurrentToken.Text, startLoc);
NextToken;
end;
tkKeyword:
begin
Result.Node := TAst.Keyword(FCurrentToken.Text);
Result.Node := TAst.Keyword(FCurrentToken.Text, startLoc);
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
Result.Node := TAst.Nop(startLoc)
else
begin
Result.Node := TAst.Identifier(FCurrentToken.Text);
end;
Result.Node := TAst.Identifier(FCurrentToken.Text, startLoc);
NextToken;
end;
tkLeftParen: Result.Node := ParseList;
@@ -821,7 +792,10 @@ begin
Result := expr.Node;
end;
{ TPrettyPrintVisitor }
// -----------------------------------------------------------------------------
// IMPLEMENTATION: PrettyPrintVisitor
// -----------------------------------------------------------------------------
constructor TPrettyPrintVisitor.Create;
begin
inherited Create;
@@ -929,7 +903,7 @@ begin
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
sb.Remove(sb.Length - 1, 1);
Append('(fn [' + sb.ToString + ']');
finally
@@ -982,8 +956,6 @@ 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;
@@ -992,7 +964,6 @@ 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('''');
@@ -1016,8 +987,6 @@ 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;
@@ -1137,7 +1106,6 @@ end;
procedure TPrettyPrintVisitor.VisitNop(const Node: INopNode);
begin
// A placeholder node, usually for UI.
Append('...');
end;
@@ -1148,7 +1116,9 @@ begin
Append(')');
end;
{ TAstScript }
// -----------------------------------------------------------------------------
// IMPLEMENTATION: TAstScript Facade
// -----------------------------------------------------------------------------
class function TAstScript.Parse(const ASource: string): IAstNode;
var
@@ -1179,27 +1149,4 @@ begin
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.