Ast list nodes

This commit is contained in:
Michael Schimmel
2025-11-29 18:59:16 +01:00
parent 250f950a68
commit 851f56c63f
24 changed files with 1819 additions and 863 deletions
+88 -83
View File
@@ -4,6 +4,7 @@ interface
uses
System.SysUtils,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor;
@@ -35,7 +36,7 @@ var
atom ::= number | string | identifier | keyword
(* ---------------------------------------------------------------------- *)
(* ---- Reader-Macros (Syntactic Sugar) ---- *)
(* ---- Reader-Macros (Syntactic Sugar) ---- *)
(* ---------------------------------------------------------------------- *)
reader_macro ::= "'" expression (* (quote ...) *)
| "`" expression (* (quasiquote ...) *)
@@ -43,7 +44,7 @@ var
| "~@" expression (* (unquote-splicing ...) *)
(* ---------------------------------------------------------------------- *)
(* ---- Lists (S-Expressions) ---- *)
(* ---- Lists (S-Expressions) ---- *)
(* ---------------------------------------------------------------------- *)
list ::= "(" list_content ")"
list_content ::= special_form | function_call
@@ -62,13 +63,13 @@ var
function_call ::= expression expression*
(* ---------------------------------------------------------------------- *)
(* ---- Parameter Lists and Records ---- *)
(* ---- Parameter Lists and Records ---- *)
(* ---------------------------------------------------------------------- *)
parameter_list ::= "[" identifier* "]"
record_literal ::= "{" (keyword expression)* "}"
(* ---------------------------------------------------------------------- *)
(* ---- Terminals (Lexer Tokens) ---- *)
(* ---- Terminals (Lexer Tokens) ---- *)
(* ---------------------------------------------------------------------- *)
number ::= ["-"] digit+ ["." digit+]
string ::= '"' ( ? any char except \ or " ? | '\' ( '"' | '\' | 'n' | 'r' | 't' ) )* '"'
@@ -94,7 +95,6 @@ uses
System.Character,
System.Math,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Data.Keyword,
Myc.Ast,
Myc.Ast.Identities;
@@ -197,6 +197,14 @@ type
procedure VisitConstant(const Node: IConstantNode); override;
procedure VisitIdentifier(const Node: IIdentifierNode); override;
procedure VisitKeyword(const Node: IKeywordNode); override;
// List Visitors
procedure VisitParameterList(const Node: IParameterList); override;
procedure VisitArgumentList(const Node: IArgumentList); override;
procedure VisitExpressionList(const Node: IExpressionList); override;
procedure VisitRecordFieldList(const Node: IRecordFieldList); override;
procedure VisitRecordField(const Node: IRecordFieldNode); override;
procedure VisitIfExpression(const Node: IIfExpressionNode); override;
procedure VisitTernaryExpression(const Node: ITernaryExpressionNode); override;
procedure VisitLambdaExpression(const Node: ILambdaExpressionNode); override;
@@ -315,7 +323,6 @@ 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);
@@ -544,7 +551,6 @@ begin
if FCurrentToken.Kind <> tkIdentifier then
Error('Syntax Error: Expected identifier in parameter list.');
// Pass Location to Factory
params.Add(TAst.Identifier(FCurrentToken.Text, FCurrentToken.GetLocation));
NextToken;
end;
@@ -557,14 +563,15 @@ end;
function TParser.ParseRecordLiteral: IAstNode;
var
fields: TList<TRecordFieldLiteral>;
fields: TList<IRecordFieldNode>;
fieldName: string;
fieldValue: IAstNode;
keyToken: TToken;
keyNode: IKeywordNode;
begin
var startLoc := FCurrentToken.GetLocation;
Consume(tkLeftBrace);
fields := TList<TRecordFieldLiteral>.Create;
fields := TList<IRecordFieldNode>.Create;
try
while FCurrentToken.Kind <> tkRightBrace do
begin
@@ -576,13 +583,15 @@ begin
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(TRecordFieldLiteral.Create(TAst.Keyword(fieldName, keyToken.GetLocation), fieldValue));
fields.Add(TAst.RecordField(keyNode, fieldValue, keyToken.GetLocation));
end;
Result := TAst.RecordLiteral(fields.ToArray, startLoc);
@@ -863,6 +872,63 @@ begin
Append(':' + Node.Value.Name);
end;
// --- List Visitors Implementation ---
procedure TPrettyPrintVisitor.VisitParameterList(const Node: IParameterList);
begin
Append('[');
for var i := 0 to Node.Count - 1 do
begin
if i > 0 then
Append(' ');
Node[i].Accept(Self);
end;
Append(']');
end;
procedure TPrettyPrintVisitor.VisitArgumentList(const Node: IArgumentList);
begin
// Argument list does not have brackets of its own in Lisp call syntax
for var i := 0 to Node.Count - 1 do
begin
Append(' '); // Space before each argument
Node[i].Accept(Self);
end;
end;
procedure TPrettyPrintVisitor.VisitExpressionList(const Node: IExpressionList);
begin
Indent;
for var item in Node do
begin
NewLine;
item.Accept(Self);
end;
Unindent;
NewLine;
end;
procedure TPrettyPrintVisitor.VisitRecordFieldList(const Node: IRecordFieldList);
begin
Indent;
for var item in Node do
begin
NewLine;
item.Accept(Self);
end;
Unindent;
NewLine;
end;
procedure TPrettyPrintVisitor.VisitRecordField(const Node: IRecordFieldNode);
begin
Node.Key.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
end;
// --- Node Visitors ---
procedure TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode);
begin
Append('(if ');
@@ -895,21 +961,9 @@ begin
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);
Append('(fn [' + sb.ToString + ']');
finally
sb.Free;
end;
Append('(fn ');
Node.Parameters.Accept(Self);
Indent;
NewLine;
Node.Body.Accept(Self);
@@ -919,21 +973,11 @@ begin
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;
Append('(defmacro ');
Node.Name.Accept(Self);
Append(' ');
Node.Parameters.Accept(Self);
Indent;
NewLine;
Node.Body.Accept(Self);
@@ -961,10 +1005,8 @@ begin
end;
procedure TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode);
var
arg: IAstNode;
begin
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 (Node.Arguments.Count = 1) then
begin
Append('''');
Node.Arguments[0].Accept(Self);
@@ -973,15 +1015,7 @@ begin
Append('(');
Node.Callee.Accept(Self);
Indent;
for arg in Node.Arguments do
begin
Append(' ');
arg.Accept(Self);
end;
Unindent;
Node.Arguments.Accept(Self); // Prints separated by space
Append(')');
end;
@@ -991,34 +1025,16 @@ begin
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;
Node.Arguments.Accept(Self);
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;
Node.Expressions.Accept(Self);
Append(')');
end;
@@ -1062,26 +1078,15 @@ begin
end;
procedure TPrettyPrintVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode);
var
field: TRecordFieldLiteral;
begin
if Length(Node.Fields) = 0 then
if Node.Fields.Count = 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;
Node.Fields.Accept(Self);
Append('}');
end;