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

Tests for Parser

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-25 14:40:04 +01:00
parent 29c36c7ae0
commit d84509c034
6 changed files with 172 additions and 73 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Compiler.Binder.pas
+5 -2
View File
@@ -16,6 +16,9 @@ uses
Myc.Ast;
type
// Exception specific to the binding phase (e.g. undefined symbols, invalid identifiers)
EBinderException = class(EAstException);
IAstBinder = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; out Layout: IScopeLayout): IAstNode;
end;
@@ -236,7 +239,7 @@ begin
if Node.Address.Kind = akUnresolved then
begin
if not ResolveSymbol(Node.Name, physAddr) then
raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
raise EBinderException.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
if physAddr.ScopeDepth > 0 then
begin
@@ -262,7 +265,7 @@ var
begin
var identifier := Node.Target.AsIdentifier;
if not IsValidIdentifier(identifier.Name) then
raise Exception.CreateFmt('Invalid identifier name: "%s".', [identifier.Name]);
raise EBinderException.CreateFmt('Invalid identifier name: "%s".', [identifier.Name]);
slot := FCurrentBuilder.Define(identifier.Name);
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
Src/AST/Myc.Ast.Compiler.TypeChecker.pas
+32 -18
View File
@@ -15,6 +15,9 @@ uses
Myc.Ast;
type
// Exception for type mismatches during compilation
ETypeCheckException = class(EAstException);
IAstTypeChecker = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
end;
@@ -110,7 +113,8 @@ begin
for i := 1 to Address.ScopeDepth do
begin
if not Assigned(ctx.FParent) then
raise Exception.CreateFmt('Scope depth mismatch during type lookup. Requested Depth: %d.', [Address.ScopeDepth]);
raise ETypeCheckException
.CreateFmt('Scope depth mismatch during type lookup. Requested Depth: %d.', [Address.ScopeDepth]);
ctx := ctx.FParent;
end;
@@ -318,10 +322,10 @@ begin
if (targetType.Kind = stUnknown) then
begin
if not TTypeRules.CanAssign(sourceType, targetType) then
raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
raise ETypeCheckException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
end
else
raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
raise ETypeCheckException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
end;
if ((targetType.Kind = stUnknown) or Assigned(placeholderType)) and (sourceType.Kind <> stUnknown) then
@@ -466,13 +470,13 @@ begin
var argsStr: string := '';
for i := 0 to High(argTypes) do
argsStr := argsStr + argTypes[i].ToString + ' ';
raise ETypeException
raise ETypeCheckException
.CreateFmt('No matching signature for call with args (%s) found on method %s', [argsStr, calleeType.ToString]);
end;
end;
end
else if calleeType.Kind <> TStaticTypeKind.stUnknown then
raise ETypeException.CreateFmt('Cannot invoke type %s as a function.', [calleeType.ToString]);
raise ETypeCheckException.CreateFmt('Cannot invoke type %s as a function.', [calleeType.ToString]);
Result := TAst.FunctionCall(newCallee, newArgs, retType, Node.IsTailCall);
end;
@@ -509,14 +513,19 @@ begin
if (conditionType.Kind <> stUnknown)
and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType)
and not TTypeRules.CanAssign(TTypes.Boolean, conditionType) then
raise ETypeException.CreateFmt('If condition must be Boolean or Ordinal, but got %s', [conditionType.ToString]);
raise ETypeCheckException.CreateFmt('If condition must be Boolean or Ordinal, but got %s', [conditionType.ToString]);
thenType := newThen.AsTypedNode.StaticType;
elseType :=
if newElse <> nil then newElse.AsTypedNode.StaticType
else TTypes.Void;
resultType := TTypeRules.Promote(thenType, elseType);
try
resultType := TTypeRules.Promote(thenType, elseType);
except
on E: Exception do // Catch base exception (ETypeException from Myc.Ast.Types)
raise ETypeCheckException.Create(E.Message);
end;
Result := TAst.IfExpr(newCond, newThen, newElse, resultType);
end;
@@ -534,12 +543,17 @@ begin
if (conditionType.Kind <> stUnknown)
and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType)
and not TTypeRules.CanAssign(TTypes.Boolean, conditionType) then
raise ETypeException.CreateFmt('Ternary condition must be Boolean or Ordinal, but got %s', [conditionType.ToString]);
raise ETypeCheckException.CreateFmt('Ternary condition must be Boolean or Ordinal, but got %s', [conditionType.ToString]);
thenType := newThen.AsTypedNode.StaticType;
elseType := newElse.AsTypedNode.StaticType;
resultType := TTypeRules.Promote(thenType, elseType);
try
resultType := TTypeRules.Promote(thenType, elseType);
except
on E: Exception do
raise ETypeCheckException.Create(E.Message);
end;
Result := TAst.TernaryExpr(newCond, newThen, newElse, resultType);
end;
@@ -562,7 +576,7 @@ begin
begin
fieldIndex := baseType.Definition.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
raise ETypeException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]);
raise ETypeCheckException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]);
var fieldType := TTypes.FromScalarKind(baseType.Definition.Fields[fieldIndex].Value);
@@ -576,11 +590,11 @@ begin
var genDef := baseType.GenericDefinition;
fieldIndex := genDef.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
raise ETypeException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]);
raise ETypeCheckException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]);
elemType := genDef.Fields[fieldIndex].Value;
end
else
raise ETypeException.CreateFmt('Member access requires a record type, but got %s', [baseType.ToString]);
raise ETypeCheckException.CreateFmt('Member access requires a record type, but got %s', [baseType.ToString]);
end;
Result := TAst.MemberAccess(newBase, newMember.AsKeyword, elemType);
@@ -601,10 +615,10 @@ begin
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (baseType.Kind <> TStaticTypeKind.stSeries) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then
raise ETypeException.CreateFmt('Indexer `[]` can only be applied to series types, but got %s', [baseType.ToString]);
raise ETypeCheckException.CreateFmt('Indexer `[]` can only be applied to series types, but got %s', [baseType.ToString]);
if (indexType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, indexType) then
raise ETypeException.CreateFmt('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]);
raise ETypeCheckException.CreateFmt('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]);
if baseType.Kind = TStaticTypeKind.stSeries then
elemType := baseType.ElementType
@@ -708,10 +722,10 @@ begin
if (seriesType.Kind <> stUnknown) then
begin
if (seriesType.Kind <> TStaticTypeKind.stSeries) then
raise ETypeException.CreateFmt('"add" requires a series as its first argument, but got %s', [seriesType.ToString]);
raise ETypeCheckException.CreateFmt('"add" requires a series as its first argument, but got %s', [seriesType.ToString]);
if not TTypeRules.CanAssign(seriesType.ElementType, valueType) then
raise ETypeException
raise ETypeCheckException
.CreateFmt('Cannot add item of type %s to series of type %s', [valueType.ToString, seriesType.ElementType.ToString]);
end;
@@ -719,7 +733,7 @@ begin
begin
var lookbackType := newLookback.AsTypedNode.StaticType;
if (lookbackType.Kind <> stUnknown) and not (lookbackType.Kind = TStaticTypeKind.stOrdinal) then
raise ETypeException.Create('Lookback parameter for "add" must be an ordinal value.');
raise ETypeCheckException.Create('Lookback parameter for "add" must be an ordinal value.');
end;
Result := TAst.AddSeriesItem(newSeries.AsIdentifier, newValue, newLookback, TTypes.Void);
@@ -741,7 +755,7 @@ begin
if (seriesType.Kind <> stUnknown)
and (seriesType.Kind <> TStaticTypeKind.stSeries)
and (seriesType.Kind <> TStaticTypeKind.stRecordSeries) then
raise ETypeException.CreateFmt('"length" requires a series, but got %s', [seriesType.ToString]);
raise ETypeCheckException.CreateFmt('"length" requires a series, but got %s', [seriesType.ToString]);
Result := TAst.SeriesLength(newSeries.AsIdentifier, TTypes.Ordinal);
end;
Src/AST/Myc.Ast.Evaluator.pas
+24 -19
View File
@@ -12,6 +12,9 @@ uses
Myc.Ast.Scope;
type
// Exception for runtime errors during script evaluation
EEvaluatorException = class(EAstException);
// The standard AST evaluator for production use.
// This class inherits directly from TInterfacedObject as it is an
// Interpreter (AST -> TDataValue), not a Transformer (AST -> IAstNode).
@@ -222,7 +225,7 @@ begin
adr: TResolvedAddress;
begin
if (Length(ArgValues) <> Length(params)) then
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(params), Length(ArgValues)]);
raise EEvaluatorException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(params), Length(ArgValues)]);
// Create the new execution scope for this function call.
lambdaScope := TScope.CreateScope(closureScope, descriptor, capturedCells);
@@ -265,17 +268,17 @@ end;
function TEvaluatorVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
begin
raise Exception.Create('Quasiquote nodes are a compile-time construct and cannot be evaluated at runtime.');
raise EEvaluatorException.Create('Quasiquote nodes are a compile-time construct and cannot be evaluated at runtime.');
end;
function TEvaluatorVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
begin
raise Exception.Create('Unquote nodes are a compile-time construct and cannot be evaluated at runtime.');
raise EEvaluatorException.Create('Unquote nodes are a compile-time construct and cannot be evaluated at runtime.');
end;
function TEvaluatorVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
begin
raise Exception.Create('Unquote-splicing nodes are a compile-time construct and cannot be evaluated at runtime.');
raise EEvaluatorException.Create('Unquote-splicing nodes are a compile-time construct and cannot be evaluated at runtime.');
end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
@@ -308,7 +311,7 @@ begin
// --- Dynamic Path (Default) ---
calleeValue := Node.Callee.Accept(Self);
if calleeValue.Kind <> vkMethod then
raise EArgumentException.Create('Expression is not invokable in this context.');
raise EEvaluatorException.Create('Expression is not invokable in this context.');
argNodes := Node.Arguments;
SetLength(argValues, Length(argNodes));
@@ -371,7 +374,7 @@ begin
begin
lookbackValue := Node.Lookback.Accept(Self);
if (lookbackValue.Kind <> vkScalar) or (lookbackValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then
raise EArgumentException.Create('Lookback parameter must be an integer.');
raise EEvaluatorException.Create('Lookback parameter must be an integer.');
lookback := lookbackValue.AsScalar.Value.AsInt64;
end;
@@ -379,7 +382,7 @@ begin
vkRecordSeries:
begin
if (itemValue.Kind <> vkRecord) then
raise EArgumentException.Create('Can only add record values to a TScalarRecordSeries.');
raise EEvaluatorException.Create('Can only add record values to a TScalarRecordSeries.');
with seriesVar.AsRecordSeries do
begin
@@ -387,7 +390,7 @@ begin
end;
end;
else
raise EArgumentException.Create('"add" operation is only supported for series types.');
raise EEvaluatorException.Create('"add" operation is only supported for series types.');
end;
Result := TDataValue.Void;
end;
@@ -395,7 +398,7 @@ end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
if Node.Target.Kind <> akIdentifier then
raise ETypeException.Create('Runtime Error: Assignment target must be an identifier.');
raise EEvaluatorException.Create('Runtime Error: Assignment target must be an identifier.');
// Evaluate value
Result := Node.Value.Accept(Self);
@@ -423,7 +426,7 @@ begin
begin
var recordDef := TRttiAstHelper.JsonToRecordDefinition(def);
if Length(recordDef.Fields) = 0 then
raise EArgumentException.Create('Failed to parse record definition from JSON array.');
raise EEvaluatorException.Create('Failed to parse record definition from JSON array.');
var recordSeries := TScalarRecordSeries.Create(recordDef);
Result := TDataValue.FromRecordSeries(recordSeries);
end
@@ -457,7 +460,7 @@ begin
indexValue := Node.Index.Accept(Self);
if (indexValue.Kind <> vkScalar) or (indexValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then
raise EArgumentException.Create('Indexer `[]` requires an integer argument.');
raise EEvaluatorException.Create('Indexer `[]` requires an integer argument.');
index := indexValue.AsScalar.Value.AsInt64;
@@ -466,14 +469,15 @@ begin
begin
series := baseValue.AsSeries;
if (index < 0) or (index >= series.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]);
raise EEvaluatorException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]);
Result := TDataValue(series.Items[Integer(index)]); // Explicit cast
end;
vkRecordSeries:
begin
recSeries := baseValue.AsRecordSeries;
if (index < 0) or (index >= recSeries.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, recSeries.TotalCount]);
raise EEvaluatorException
.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, recSeries.TotalCount]);
// Materialize the TScalarRecord by accessing each member series by index
fieldCount := Length(recSeries.Def.Fields);
@@ -491,7 +495,7 @@ begin
Result := TDataValue.FromRecord(rec);
end;
else
raise EArgumentException.Create('Indexer `[]` is not supported for this value type.');
raise EEvaluatorException.Create('Indexer `[]` is not supported for this value type.');
end;
end;
@@ -511,12 +515,12 @@ begin
var rec := baseValue.AsGenericRecord;
var fieldIndex := rec.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
raise EArgumentException.CreateFmt('Member ":%s" not found in record.', [Node.Member.Value.Name]);
raise EEvaluatorException.CreateFmt('Member ":%s" not found in record.', [Node.Member.Value.Name]);
Result := rec.Fields[fieldIndex].Value;
end;
else
raise EArgumentException.Create('Member access operator `.` is not supported for this value type.');
raise EEvaluatorException.Create('Member access operator `.` is not supported for this value type.');
end;
end;
@@ -559,7 +563,7 @@ begin
Result := TDataValue.FromRecord(rec);
end
else
raise EInvalidOpException.Create('RecordLiteral has no definition (Binder/TypeChecker failure).');
raise EEvaluatorException.Create('RecordLiteral has no definition (Binder/TypeChecker failure).');
end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
@@ -567,7 +571,7 @@ var
address: TResolvedAddress;
begin
if Node.Target.Kind <> akIdentifier then
raise ETypeException.Create('Runtime Error: Variable declaration target must be an identifier.');
raise EEvaluatorException.Create('Runtime Error: Variable declaration target must be an identifier.');
// 1. Evaluate Initializer
if Assigned(Node.Initializer) then
@@ -635,7 +639,8 @@ begin
vkSeries: len := seriesValue.AsSeries.Count;
vkRecordSeries: len := seriesValue.AsRecordSeries.Count;
else
raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]);
raise EEvaluatorException
.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]);
end;
Result := TDataValue(TScalar.FromInt64(len)); // Explicit cast
Src/AST/Myc.Ast.Nodes.pas
+4
View File
@@ -401,6 +401,10 @@ type
// A factory for creating visitors
TEvaluatorFactory = reference to function(const Scope: IExecutionScope): IEvaluatorVisitor;
// Base class for ALL compiler exceptions.
// Renamed from IAstException to EAstException to follow standard Delphi naming convention.
EAstException = class(Exception);
implementation
uses
Src/AST/Myc.Ast.Script.pas
+102 -29
View File
@@ -7,10 +7,21 @@ uses
Myc.Ast.Nodes,
Myc.Ast.Visitor;
type
// Exception for parsing errors containing location information
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;
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.)
BNF: String =
'''
(* ---------------------------------------------------------------------- *)
@@ -46,7 +57,7 @@ var
list ::= "(" list_content ")"
(* The parser distinguishes between special forms (like 'if') and
general function calls based on the first element. *)
general function calls based on the first element. *)
list_content ::= special_form | function_call
special_form ::= "if" expression expression expression?
@@ -61,7 +72,7 @@ var
| 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. *)
The first 'expression' is the callee, the rest are the arguments. *)
function_call ::= expression expression*
(* ---------------------------------------------------------------------- *)
@@ -86,7 +97,7 @@ var
dot_identifier ::= "." identifier
(* An identifier is a sequence of characters that are not delimiters.
The lexer is very permissive. *)
The lexer is very permissive. *)
identifier ::= ? any sequence of chars not containing whitespace, '()[]{}'`~:; ?
digit ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9"
@@ -142,20 +153,29 @@ type
TToken = record
Kind: TTokenKind;
Text: string;
Line: Integer;
Col: Integer;
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
@@ -168,6 +188,8 @@ type
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;
@@ -223,6 +245,15 @@ type
procedure VisitNop(const Node: INopNode); override;
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);
@@ -230,6 +261,23 @@ 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;
@@ -241,8 +289,19 @@ begin
end;
procedure TLexer.Advance;
var
c: Char;
begin
inc(FCurrentPos);
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;
@@ -293,7 +352,7 @@ begin
begin
Advance; // Consume '\'
if FCurrentPos > Length(FSource) then
raise Exception.Create('Syntax Error: String literal ends with an escape character.');
Error('Syntax Error: String literal ends with an escape character.');
c := Peek; // Get escaped char
case c of
@@ -319,7 +378,7 @@ begin
end;
// If we fall out of the loop, we hit EOF without a closing quote.
raise Exception.Create('Syntax Error: Unterminated string literal.');
Error('Syntax Error: Unterminated string literal.');
finally
builder.Free;
@@ -349,6 +408,10 @@ begin
break;
end;
// Capture location for the start of the token
Result.Line := CurrentLine;
Result.Col := CurrentCol;
if FCurrentPos > Length(FSource) then
begin
Result.Kind := tkEOF;
@@ -449,6 +512,16 @@ begin
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;
@@ -457,7 +530,7 @@ end;
procedure TParser.Consume(AExpectedKind: TTokenKind);
begin
if FCurrentToken.Kind <> AExpectedKind then
raise Exception.CreateFmt('Syntax Error: Expected token %s, but found %s', [AExpectedKind.ToString, FCurrentToken.Kind.ToString]);
ErrorFmt('Syntax Error: Expected token %s, but found %s', [AExpectedKind.ToString, FCurrentToken.Kind.ToString]);
NextToken;
end;
@@ -471,9 +544,9 @@ begin
while FCurrentToken.Kind <> tkRightBracket do
begin
if FCurrentToken.Kind = tkEOF then
raise Exception.Create('Syntax Error: Unexpected end of file.');
Error('Syntax Error: Unexpected end of file.');
if FCurrentToken.Kind <> tkIdentifier then
raise Exception.Create('Syntax Error: Expected identifier in parameter list.');
Error('Syntax Error: Expected identifier in parameter list.');
params.Add(TAst.Identifier(FCurrentToken.Text));
NextToken;
end;
@@ -496,17 +569,17 @@ begin
while FCurrentToken.Kind <> tkRightBrace do
begin
if FCurrentToken.Kind = tkEOF then
raise Exception.Create('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
raise Exception.Create('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.');
fieldName := FCurrentToken.Text;
NextToken;
// Value can be any expression
if FCurrentToken.Kind = tkRightBrace then
raise Exception.Create('Syntax Error: Missing value for key ' + fieldName + ' in record literal.');
Error('Syntax Error: Missing value for key ' + fieldName + ' in record literal.');
fieldValue := ParseExpression.Node;
fields.Add(TRecordFieldLiteral.Create(TAst.Keyword(fieldName), fieldValue));
@@ -520,7 +593,6 @@ begin
end;
function TParser.ParseList: IAstNode;
var
elements: TList<TExpr>;
head: TExpr;
@@ -530,14 +602,14 @@ var
begin
Consume(tkLeftParen);
if FCurrentToken.Kind = tkRightParen then
raise Exception.Create('Syntax Error: Empty list () is not a valid expression.');
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
raise Exception.Create('Syntax Error: Unexpected end of file.');
Error('Syntax Error: Unexpected end of file.');
elements.Add(ParseExpression);
end;
@@ -557,7 +629,7 @@ begin
if SameText(head.Token.Text, 'if') then
begin
if not (Length(tailNodes) in [2, 3]) then
raise Exception.Create('Syntax Error in if statement.');
Error('Syntax Error in if statement.');
var elseBranch: IAstNode := nil;
if Length(tailNodes) = 3 then
@@ -568,7 +640,7 @@ begin
else if SameText(head.Token.Text, '?') then
begin
if Length(tailNodes) <> 3 then
raise Exception.Create('Syntax Error in ternary statement.');
Error('Syntax Error in ternary statement.');
Result := TAst.TernaryExpr(tailNodes[0], tailNodes[1], tailNodes[2]);
end
@@ -576,7 +648,7 @@ begin
begin
// Identifier check removed to support macros (e.g. def ~x 1)
if not (Length(tailNodes) in [1, 2]) then
raise Exception.CreateFmt('Syntax Error: ''def'' requires a target and an optional initializer.', []);
Error('Syntax Error: ''def'' requires a target and an optional initializer.');
initializer := nil;
if Length(tailNodes) = 2 then
@@ -587,13 +659,13 @@ begin
else if SameText(head.Token.Text, 'defmacro') then
begin
if (Length(tailNodes) <> 3) or (tailTokens[0].Kind <> tkIdentifier) then
raise Exception.Create('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 macroParams := elements[2].Params;
if tailTokens[2].Kind <> tkBacktick then
raise Exception.Create('Syntax Error: Expected a quasiquote as macro body.');
Error('Syntax Error: Expected a quasiquote as macro body.');
var macroBody := IQuasiQuoteNode(tailNodes[2]);
@@ -603,14 +675,14 @@ begin
begin
// Identifier check removed
if Length(tailNodes) <> 2 then
raise Exception.Create('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]);
end
else if SameText(head.Token.Text, 'fn') then
begin
if Length(tailNodes) <> 2 then
raise Exception.Create('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]);
end
else if SameText(head.Token.Text, 'do') then
@@ -620,15 +692,16 @@ begin
else if SameText(head.Token.Text, 'get') then
begin
if Length(tailNodes) <> 2 then
raise Exception.Create('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])
end
else if (Length(head.Token.Text) > 1) and (head.Token.Text.StartsWith('.')) then
begin
if Length(tailNodes) <> 1 then
raise Exception.CreateFmt(
ErrorFmt(
'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)));
end;
end;
@@ -696,7 +769,7 @@ begin
else if TryStrToFloat(FCurrentToken.Text, dbl, TFormatSettings.Invariant) then
Result.Node := TAst.Constant(dbl)
else
raise Exception.CreateFmt('Syntax Error: Invalid number format "%s"', [FCurrentToken.Text]);
ErrorFmt('Syntax Error: Invalid number format "%s"', [FCurrentToken.Text]);
NextToken;
end;
tkString:
@@ -736,7 +809,7 @@ begin
tkLeftBrace: Result.Node := ParseRecordLiteral;
tkEOF: {nop};
else
raise Exception.CreateFmt('Syntax Error: Unexpected token %s', [FCurrentToken.Kind.ToString]);
ErrorFmt('Syntax Error: Unexpected token %s', [FCurrentToken.Kind.ToString]);
end;
end;
@@ -744,7 +817,7 @@ function TParser.Parse: IAstNode;
begin
var expr := ParseExpression;
if FCurrentToken.Kind <> tkEOF then
raise Exception.Create('Syntax Error: Unexpected characters after end of expression.');
Error('Syntax Error: Unexpected characters after end of expression.');
Result := expr.Node;
end;
Test/AST/Test.Myc.Ast.Script.pas
+5 -5
View File
@@ -356,27 +356,27 @@ end;
procedure TTestMycAstScript.Parser_Error_UnbalancedParens_MissingRight;
begin
// FIX 2: Pass explicit Exception type to WillRaise
Assert.WillRaise(procedure begin Parse('(a b'); end, Exception);
Assert.WillRaise(procedure begin Parse('(a b'); end, EParserException);
end;
procedure TTestMycAstScript.Parser_Error_UnbalancedParens_ExtraRight;
begin
Assert.WillRaise(procedure begin Parse('a )'); end, Exception);
Assert.WillRaise(procedure begin Parse('a )'); end, EParserException);
end;
procedure TTestMycAstScript.Parser_Error_UnterminatedString;
begin
Assert.WillRaise(procedure begin Parse('"hello'); end, Exception);
Assert.WillRaise(procedure begin Parse('"hello'); end, EParserException);
end;
procedure TTestMycAstScript.Parser_Error_EmptyList;
begin
Assert.WillRaise(procedure begin Parse('()'); end, Exception);
Assert.WillRaise(procedure begin Parse('()'); end, EParserException);
end;
procedure TTestMycAstScript.Parser_Error_Record_MissingValue;
begin
Assert.WillRaise(procedure begin Parse('{:a 1 :b}'); end, Exception);
Assert.WillRaise(procedure begin Parse('{:a 1 :b}'); end, EParserException);
end;
end.