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

Compiler errors

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-25 18:11:04 +01:00
parent 0a1df4e9fe
commit 85ef043b04
5 changed files with 464 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Compiler.Binder.pas
+57 -16
View File
@@ -16,9 +16,6 @@ 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;
@@ -40,6 +37,7 @@ type
FArgTypes: TArray<IStaticType>;
FFunctionRegistry: IFunctionDefinitionRegistry;
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
FLog: ICompilerLog;
// Counts lambdas encountered to determine if a lambda has nested children
FLambdaCounter: Integer;
@@ -63,7 +61,8 @@ type
constructor Create(
const AParentLayout: IScopeLayout;
const AFunctionRegistry: IFunctionDefinitionRegistry;
const AArgTypes: TArray<IStaticType>
const AArgTypes: TArray<IStaticType>;
const ALog: ICompilerLog
);
destructor Destroy; override;
@@ -73,6 +72,7 @@ type
const ParentLayout: IScopeLayout;
const RootNode: IAstNode;
out Layout: IScopeLayout;
const ALog: ICompilerLog;
const AFunctionRegistry: IFunctionDefinitionRegistry = nil;
const AArgTypes: TArray<IStaticType> = nil
): IAstNode; static;
@@ -110,7 +110,8 @@ end;
constructor TAstBinder.Create(
const AParentLayout: IScopeLayout;
const AFunctionRegistry: IFunctionDefinitionRegistry;
const AArgTypes: TArray<IStaticType>
const AArgTypes: TArray<IStaticType>;
const ALog: ICompilerLog
);
begin
inherited Create;
@@ -120,6 +121,7 @@ begin
FFunctionRegistry := AFunctionRegistry;
FArgTypes := AArgTypes;
FLog := ALog;
FBoxedDeclarations := nil;
FLambdaCounter := 0;
end;
@@ -135,11 +137,12 @@ class function TAstBinder.Bind(
const ParentLayout: IScopeLayout;
const RootNode: IAstNode;
out Layout: IScopeLayout;
const ALog: ICompilerLog;
const AFunctionRegistry: IFunctionDefinitionRegistry = nil;
const AArgTypes: TArray<IStaticType> = nil
): IAstNode;
begin
var binder := TAstBinder.Create(ParentLayout, AFunctionRegistry, AArgTypes);
var binder := TAstBinder.Create(ParentLayout, AFunctionRegistry, AArgTypes, ALog);
try
Result := binder.Execute(RootNode, Layout);
finally
@@ -239,7 +242,13 @@ begin
if Node.Address.Kind = akUnresolved then
begin
if not ResolveSymbol(Node.Name, physAddr) then
raise EBinderException.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
begin
// Log error but don't crash. Return unresolved node (Poison Pill).
if Assigned(FLog) then
FLog.AddError(Format('Undefined identifier: "%s"', [Node.Name]), Node);
Result := Node;
Exit;
end;
if physAddr.ScopeDepth > 0 then
begin
@@ -264,12 +273,28 @@ var
isBoxed: Boolean;
begin
var identifier := Node.Target.AsIdentifier;
if not IsValidIdentifier(identifier.Name) then
raise EBinderException.CreateFmt('Invalid identifier name: "%s".', [identifier.Name]);
// Check if the identifier is already defined in the current scope builder to avoid Scope Asserts.
if not IsValidIdentifier(identifier.Name) then
begin
if Assigned(FLog) then
FLog.AddError(Format('Invalid identifier name: "%s".', [identifier.Name]), Node);
// Continue to try processing the initializer
end;
// Check for duplicates before defining
if FCurrentBuilder.FindSlot(identifier.Name) >= 0 then
raise EBinderException.CreateFmt('Variable "%s" is already defined in this scope.', [identifier.Name]);
begin
if Assigned(FLog) then
FLog.AddError(Format('Variable "%s" is already defined in this scope.', [identifier.Name]), Node);
// Do NOT define the slot to avoid scope corruption.
// Visit initializer to catch errors there, then return original node or dummy.
if Assigned(Node.Initializer) then
Accept(Node.Initializer);
Result := Node;
Exit;
end;
slot := FCurrentBuilder.Define(identifier.Name);
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
@@ -300,6 +325,7 @@ begin
if Assigned(FFunctionRegistry) and (newValue <> nil) and (newValue.Kind = akLambdaExpression) then
begin
// Only register if it resolved correctly
if newIdent.AsIdentifier.Address.Kind = akLocalOrParent then
FFunctionRegistry.Register(newIdent.AsIdentifier.Address, newValue.AsLambdaExpression);
end;
@@ -338,18 +364,33 @@ begin
SetLength(newParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
// Parameter names must also be checked for uniqueness, though usually guaranteed by Parser/AST construction
if FCurrentBuilder.FindSlot(Node.Parameters[i].Name) >= 0 then
raise EBinderException.CreateFmt('Duplicate parameter name "%s".', [Node.Parameters[i].Name]);
var paramName := Node.Parameters[i].Name;
// Check duplicate parameters
if FCurrentBuilder.FindSlot(paramName) >= 0 then
begin
if Assigned(FLog) then
FLog.AddError(Format('Duplicate parameter name "%s".', [paramName]), Node);
// Skip defining this parameter to avoid scope crash, but create a dummy binding
// so index alignment isn't completely broken if we were to continue harder.
// Here we just skip definition.
end
else
FCurrentBuilder.Define(paramName);
// Note: We still create a valid (or attempted) identifier node mapping
// even if definition failed, to keep AST shape consistent.
slot := FCurrentBuilder.FindSlot(paramName); // might return <0 or previous slot if duplicate
if slot < 0 then
slot := 0; // Fallback for duplicates
slot := FCurrentBuilder.Define(Node.Parameters[i].Name);
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
paramType := TTypes.Unknown;
if (parentBuilder.Parent = nil) and (FArgTypes <> nil) and (i < Length(FArgTypes)) then
paramType := FArgTypes[i];
newParams[i] := TAst.Identifier(Node.Parameters[i].Name, addr, paramType);
newParams[i] := TAst.Identifier(paramName, addr, paramType);
end;
newBody := Accept(Node.Body);
Src/AST/Myc.Ast.Compiler.TypeChecker.pas
+163 -58
View File
@@ -15,9 +15,6 @@ 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;
@@ -40,6 +37,8 @@ type
private
FCurrentContext: TTypeContext;
FLog: ICompilerLog;
function CreateContextChain(L: IScopeLayout): TTypeContext;
protected
@@ -64,12 +63,12 @@ type
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
public
constructor Create(const RootLayout: IScopeLayout);
constructor Create(const RootLayout: IScopeLayout; const ALog: ICompilerLog);
destructor Destroy; override;
function Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
class function CheckTypes(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode; static;
class function CheckTypes(const RootNode: IAstNode; const Layout: IScopeLayout; const ALog: ICompilerLog): IAstNode; static;
end;
implementation
@@ -107,8 +106,11 @@ begin
for i := 1 to Address.ScopeDepth do
begin
if not Assigned(ctx.FParent) then
raise ETypeCheckException
.CreateFmt('Scope depth mismatch during type lookup. Requested Depth: %d.', [Address.ScopeDepth]);
begin
// Should technically not happen if Binder did its job, but safe guard it.
Result := TTypes.Unknown;
Exit;
end;
ctx := ctx.FParent;
end;
@@ -148,9 +150,10 @@ begin
Result := TTypeContext.Create(p, L, []);
end;
constructor TTypeChecker.Create(const RootLayout: IScopeLayout);
constructor TTypeChecker.Create(const RootLayout: IScopeLayout; const ALog: ICompilerLog);
begin
inherited Create;
FLog := ALog;
FCurrentContext := CreateContextChain(RootLayout);
if FCurrentContext = nil then
FCurrentContext := TTypeContext.Create(nil, nil, []);
@@ -167,9 +170,9 @@ begin
inherited;
end;
class function TTypeChecker.CheckTypes(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
class function TTypeChecker.CheckTypes(const RootNode: IAstNode; const Layout: IScopeLayout; const ALog: ICompilerLog): IAstNode;
begin
var checker := TTypeChecker.Create(Layout) as IAstTypeChecker;
var checker := TTypeChecker.Create(Layout, ALog) as IAstTypeChecker;
Result := checker.Execute(RootNode, Layout);
end;
@@ -182,13 +185,11 @@ end;
function TTypeChecker.VisitConstant(const Node: IConstantNode): IAstNode;
begin
Assert(Node.StaticType.Kind <> stUnknown);
Result := Node;
end;
function TTypeChecker.VisitKeyword(const Node: IKeywordNode): IAstNode;
begin
Assert(Node.StaticType.Kind = stKeyword);
Result := Node;
end;
@@ -198,6 +199,14 @@ var
adr: TResolvedAddress;
begin
adr := Node.Address;
// If binder failed to resolve, we propagate Unknown type to prevent cascading errors.
if adr.Kind = akUnresolved then
begin
Result := TAst.Identifier(Node.Name, adr, TTypes.Unknown);
Exit;
end;
typ := FCurrentContext.LookupType(adr);
Result := TAst.Identifier(Node.Name, adr, typ);
end;
@@ -226,6 +235,15 @@ begin
adr := Node.Target.AsIdentifier.Address;
initType := TTypes.Unknown;
// If address is unresolved (binder error), we just process the initializer and return.
if adr.Kind = akUnresolved then
begin
if Assigned(Node.Initializer) then
Accept(Node.Initializer);
Result := Node;
Exit;
end;
placeholderType := nil;
if (Node.Initializer <> nil) and (Node.Initializer.Kind = akLambdaExpression) then
begin
@@ -270,6 +288,14 @@ begin
targetType := newIdent.AsTypedNode.StaticType;
adr := newIdent.AsIdentifier.Address;
// If binder failed, address is unresolved. We still check the value but skip assignment logic.
if adr.Kind = akUnresolved then
begin
Accept(Node.Value);
Result := Node;
Exit;
end;
placeholderType := nil;
if (Node.Value <> nil) and (Node.Value.Kind = akLambdaExpression) then
begin
@@ -290,17 +316,18 @@ begin
newValue := Accept(Node.Value);
sourceType := newValue.AsTypedNode.StaticType;
if not TTypeRules.CanAssign(targetType, sourceType) then
// Only check assignment if both types are known to avoid cascading error reports
if (targetType.Kind <> stUnknown) and (sourceType.Kind <> stUnknown) then
begin
if (targetType.Kind = stUnknown) then
if not TTypeRules.CanAssign(targetType, sourceType) then
begin
if not TTypeRules.CanAssign(sourceType, targetType) then
raise ETypeCheckException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
end
else
raise ETypeCheckException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
if Assigned(FLog) then
FLog.AddError(Format('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]), Node);
// We continue, effectively ignoring the assignment type-wise (variable keeps old type).
end;
end;
// Type Inference for 'Unknown' targets
if ((targetType.Kind = stUnknown) or Assigned(placeholderType)) and (sourceType.Kind <> stUnknown) then
begin
FCurrentContext.SetType(adr.SlotIndex, sourceType);
@@ -337,14 +364,20 @@ begin
var paramIdent := Node.Parameters[i];
var paramAdr := paramIdent.Address;
paramTypes[i] := TTypes.Unknown;
FCurrentContext.SetType(paramAdr.SlotIndex, paramTypes[i]);
if paramAdr.Kind <> akUnresolved then
FCurrentContext.SetType(paramAdr.SlotIndex, paramTypes[i]);
newParams[i] := TAst.Identifier(paramIdent.Name, paramAdr, paramTypes[i]);
end;
newBody := Accept(Node.Body);
bodyType := newBody.AsTypedNode.StaticType;
methodType := TTypes.CreateMethod(paramTypes, bodyType);
// Set self-reference type (slot 0 is <self>)
FCurrentContext.SetType(0, methodType);
finalDescriptor := TScope.CreateDescriptor(Node.Layout, FCurrentContext.Types);
finally
var temp := FCurrentContext;
@@ -367,6 +400,7 @@ var
bestSig: IMethodSignature;
sig: IMethodSignature;
match: Boolean;
argsStr: string;
begin
newCallee := Accept(Node.Callee);
SetLength(newArgs, Length(Node.Arguments));
@@ -415,16 +449,34 @@ begin
retType := bestSig.ReturnType
else
begin
var argsStr: string := '';
for i := 0 to High(argTypes) do
argsStr := argsStr + argTypes[i].ToString + ' ';
raise ETypeCheckException
.CreateFmt('No matching signature for call with args (%s) found on method %s', [argsStr, calleeType.ToString]);
// Log error, but don't crash
if Assigned(FLog) then
begin
argsStr := '';
for i := 0 to High(argTypes) do
argsStr := argsStr + argTypes[i].ToString + ' ';
FLog.AddError(
Format('No matching signature for call with args (%s) found on method %s', [argsStr, calleeType.ToString]),
Node
);
end;
retType := TTypes.Unknown; // Poison result
end;
end
else
begin
// We have unknown arguments (probably due to upstream errors).
// We cannot resolve the signature, so the result is Unknown.
// We do NOT log an error here to avoid spam.
retType := TTypes.Unknown;
end;
end
else if calleeType.Kind <> TStaticTypeKind.stUnknown then
raise ETypeCheckException.CreateFmt('Cannot invoke type %s as a function.', [calleeType.ToString]);
begin
if Assigned(FLog) then
FLog.AddError(Format('Cannot invoke type %s as a function.', [calleeType.ToString]), Node);
retType := TTypes.Unknown;
end;
Result := TAst.FunctionCall(newCallee, newArgs, retType, Node.IsTailCall);
end;
@@ -457,10 +509,14 @@ begin
newElse := Accept(Node.ElseBranch);
conditionType := newCond.AsTypedNode.StaticType;
if (conditionType.Kind <> stUnknown)
and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType)
and not TTypeRules.CanAssign(TTypes.Boolean, conditionType) then
raise ETypeCheckException.CreateFmt('If condition must be Boolean or Ordinal, but got %s', [conditionType.ToString]);
begin
if Assigned(FLog) then
FLog.AddError(Format('If condition must be Boolean or Ordinal, but got %s', [conditionType.ToString]), Node);
end;
thenType := newThen.AsTypedNode.StaticType;
elseType :=
@@ -469,7 +525,11 @@ begin
resultType := TTypeRules.Promote(thenType, elseType);
if resultType = nil then
raise ETypeCheckException.CreateFmt('Cannot promote types %s and %s in If-Expression', [thenType.ToString, elseType.ToString]);
begin
if Assigned(FLog) then
FLog.AddError(Format('Cannot promote types %s and %s in If-Expression', [thenType.ToString, elseType.ToString]), Node);
resultType := TTypes.Unknown;
end;
Result := TAst.IfExpr(newCond, newThen, newElse, resultType);
end;
@@ -487,14 +547,21 @@ begin
if (conditionType.Kind <> stUnknown)
and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType)
and not TTypeRules.CanAssign(TTypes.Boolean, conditionType) then
raise ETypeCheckException.CreateFmt('Ternary condition must be Boolean or Ordinal, but got %s', [conditionType.ToString]);
begin
if Assigned(FLog) then
FLog.AddError(Format('Ternary condition must be Boolean or Ordinal, but got %s', [conditionType.ToString]), Node);
end;
thenType := newThen.AsTypedNode.StaticType;
elseType := newElse.AsTypedNode.StaticType;
resultType := TTypeRules.Promote(thenType, elseType);
if resultType = nil then
raise ETypeCheckException.CreateFmt('Cannot promote types %s and %s in Ternary-Expression', [thenType.ToString, elseType.ToString]);
begin
if Assigned(FLog) then
FLog.AddError(Format('Cannot promote types %s and %s in Ternary-Expression', [thenType.ToString, elseType.ToString]), Node);
resultType := TTypes.Unknown;
end;
Result := TAst.TernaryExpr(newCond, newThen, newElse, resultType);
end;
@@ -517,25 +584,36 @@ begin
begin
fieldIndex := baseType.Definition.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
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);
if baseType.Kind = TStaticTypeKind.stRecord then
elemType := fieldType
begin
if Assigned(FLog) then
FLog.AddError(Format('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]), Node);
end
else
elemType := TTypes.CreateSeries(fieldType);
begin
var fieldType := TTypes.FromScalarKind(baseType.Definition.Fields[fieldIndex].Value);
if baseType.Kind = TStaticTypeKind.stRecord then
elemType := fieldType
else
elemType := TTypes.CreateSeries(fieldType);
end;
end
else if (baseType.Kind = TStaticTypeKind.stGenericRecord) then
begin
var genDef := baseType.GenericDefinition;
fieldIndex := genDef.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
raise ETypeCheckException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]);
elemType := genDef.Fields[fieldIndex].Value;
begin
if Assigned(FLog) then
FLog.AddError(Format('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]), Node);
end
else
elemType := genDef.Fields[fieldIndex].Value;
end
else
raise ETypeCheckException.CreateFmt('Member access requires a record type, but got %s', [baseType.ToString]);
begin
if Assigned(FLog) then
FLog.AddError(Format('Member access requires a record type, but got %s', [baseType.ToString]), Node);
end;
end;
Result := TAst.MemberAccess(newBase, newMember.AsKeyword, elemType);
@@ -556,15 +634,23 @@ begin
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (baseType.Kind <> TStaticTypeKind.stSeries) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then
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 ETypeCheckException.CreateFmt('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]);
if baseType.Kind = TStaticTypeKind.stSeries then
elemType := baseType.ElementType
begin
if Assigned(FLog) then
FLog.AddError(Format('Indexer `[]` can only be applied to series types, but got %s', [baseType.ToString]), Node);
end
else
elemType := TTypes.CreateRecord(baseType.Definition);
begin
if baseType.Kind = TStaticTypeKind.stSeries then
elemType := baseType.ElementType
else
elemType := TTypes.CreateRecord(baseType.Definition);
end;
end;
if (indexType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, indexType) then
begin
if Assigned(FLog) then
FLog.AddError(Format('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]), Node);
end;
Result := TAst.Indexer(newBase, newIndex, elemType);
@@ -639,12 +725,14 @@ var
elemType: IStaticType;
begin
try
// TScalar.StringToKind might throw EConvertError or generic Exception if string is invalid
elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition));
except
on E: Exception do
// Instead of silently using Unknown, we now raise a proper compiler error
raise ETypeCheckException.CreateFmt('Invalid type definition "%s" in new-series.', [Node.Definition]);
begin
if Assigned(FLog) then
FLog.AddError(Format('Invalid type definition "%s" in new-series: %s', [Node.Definition, E.Message]), Node);
elemType := TTypes.Unknown;
end;
end;
Result := TAst.CreateSeries(Node.Definition, TTypes.CreateSeries(elemType));
@@ -665,18 +753,32 @@ begin
if (seriesType.Kind <> stUnknown) then
begin
if (seriesType.Kind <> TStaticTypeKind.stSeries) then
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 ETypeCheckException
.CreateFmt('Cannot add item of type %s to series of type %s', [valueType.ToString, seriesType.ElementType.ToString]);
begin
if Assigned(FLog) then
FLog.AddError(Format('"add" requires a series as its first argument, but got %s', [seriesType.ToString]), Node);
end
else
begin
// Only check assignment compatibility if value type is known
if (valueType.Kind <> stUnknown) and not TTypeRules.CanAssign(seriesType.ElementType, valueType) then
begin
if Assigned(FLog) then
FLog.AddError(
Format('Cannot add item of type %s to series of type %s', [valueType.ToString, seriesType.ElementType.ToString]),
Node
);
end;
end;
end;
if (newLookback <> nil) then
begin
var lookbackType := newLookback.AsTypedNode.StaticType;
if (lookbackType.Kind <> stUnknown) and not (lookbackType.Kind = TStaticTypeKind.stOrdinal) then
raise ETypeCheckException.Create('Lookback parameter for "add" must be an ordinal value.');
begin
if Assigned(FLog) then
FLog.AddError('Lookback parameter for "add" must be an ordinal value.', Node);
end;
end;
Result := TAst.AddSeriesItem(newSeries.AsIdentifier, newValue, newLookback, TTypes.Void);
@@ -698,7 +800,10 @@ begin
if (seriesType.Kind <> stUnknown)
and (seriesType.Kind <> TStaticTypeKind.stSeries)
and (seriesType.Kind <> TStaticTypeKind.stRecordSeries) then
raise ETypeCheckException.CreateFmt('"length" requires a series, but got %s', [seriesType.ToString]);
begin
if Assigned(FLog) then
FLog.AddError(Format('"length" requires a series, but got %s', [seriesType.ToString]), Node);
end;
Result := TAst.SeriesLength(newSeries.AsIdentifier, TTypes.Ordinal);
end;
Src/AST/Myc.Ast.Environment.pas
+57 -20
View File
@@ -39,7 +39,15 @@ type
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
function ExpandMacros(const Node: IAstNode): IAstNode;
function Bind(const Node: IAstNode; out Layout: IScopeLayout; const AArgTypes: TArray<IStaticType> = []): IAstNode;
// Updated Bind signature to accept Log
function Bind(
const Node: IAstNode;
out Layout: IScopeLayout;
const AArgTypes: TArray<IStaticType>;
const Log: ICompilerLog
): IAstNode;
function Specialize(const Node: IAstNode): IAstNode;
function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): TCompiledFunction;
@@ -162,7 +170,14 @@ type
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
function ExpandMacros(const Node: IAstNode): IAstNode;
function Bind(const Node: IAstNode; out Layout: IScopeLayout; const ArgTypes: TArray<IStaticType>): IAstNode;
function Bind(
const Node: IAstNode;
out Layout: IScopeLayout;
const ArgTypes: TArray<IStaticType>;
const Log: ICompilerLog
): IAstNode;
function Specialize(const Node: IAstNode): IAstNode;
function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction; overload;
@@ -227,8 +242,6 @@ end;
procedure TAstEnvironment.Define(const Name: String; const AScript: IAstNode);
begin
var compiled := Compile(AScript);
// Note: Define now potentially handles Pure flags internally via the Node metadata,
// but the runtime value is just the TDataValue.
RootScope.Define(Name, compiled.Func([]), compiled.StaticType);
end;
@@ -318,13 +331,18 @@ begin
Result := FMonomorphCache;
end;
function TEnvironment.Bind(const Node: IAstNode; out Layout: IScopeLayout; const ArgTypes: TArray<IStaticType>): IAstNode;
function TEnvironment.Bind(
const Node: IAstNode;
out Layout: IScopeLayout;
const ArgTypes: TArray<IStaticType>;
const Log: ICompilerLog
): IAstNode;
begin
// 1. Bind (produces Layout and Bound AST with Addresses)
var boundAst := TAstBinder.Bind(FRootScope.Descriptor.Layout, Node, Layout, FFunctionRegistry, ArgTypes);
var boundAst := TAstBinder.Bind(FRootScope.Descriptor.Layout, Node, Layout, Log, FFunctionRegistry, ArgTypes);
// 2. Check Types (produces Typed AST with Descriptors baked into nodes)
Result := TTypeChecker.CheckTypes(boundAst, Layout);
Result := TTypeChecker.CheckTypes(boundAst, Layout, Log);
end;
function TEnvironment.GetMacroRegistry: IMacroRegistry;
@@ -356,21 +374,38 @@ var
typedNode, specialized, tcoOptimized: IAstNode;
isPure: Boolean;
begin
// Same steps as above, but Node is already a definition (Lambda)
var expanded := ExpandMacros(Node);
typedNode := Bind(expanded, layout, ArgTypes);
log: ICompilerLog;
begin
log := TCompilerLog.Create;
// 1. Expand Macros
var expanded := ExpandMacros(Node);
// 2. Bind & TypeCheck (accumulating errors)
typedNode := Bind(expanded, layout, ArgTypes, log);
// 3. Check for compilation errors
if log.HasErrors then
raise ECompilationFailed.Create(log.GetEntries);
// Note: If types are Unknown but no errors were logged (edge case), we proceed.
// But Binder/TypeChecker logic ensures errors are logged for Unknowns that matter.
// 4. Specialization & Optimization
descriptor := typedNode.AsLambdaExpression.Descriptor;
// Descriptor might be nil if Bind failed badly, but HasErrors check above covers that.
Assert(Assigned(descriptor));
funcType := typedNode.AsTypedNode.StaticType;
specialized := Specialize(typedNode);
tcoOptimized := TAstTCO.Optimize(specialized);
// Purity Inference
// 5. Purity Inference
isPure := TPurityAnalyzer.IsPure(tcoOptimized.AsLambdaExpression.Body);
// 6. Generate Visitor/Closure
var visitor := FExecutionStrategy.CreateVisitor(descriptor.CreateScope(FRootScope));
var closure := tcoOptimized.Accept(visitor);
@@ -397,10 +432,18 @@ begin
evaluator: IEvaluatorVisitor;
boundSubAst: IAstNode;
scratchScope: IExecutionScope;
tempLog: ICompilerLog;
begin
// Create temporary log for the macro context
tempLog := TCompilerLog.Create;
// 1. Binding
// Note: Scope is dynamic (from TMacroExpander), so Descriptor.Layout describes current variables.
boundSubAst := TAstBinder.Bind(Scope.Descriptor.Layout, ANode, tmpLayout);
boundSubAst := TAstBinder.Bind(Scope.Descriptor.Layout, ANode, tmpLayout, tempLog);
// Macro execution is strictly fail-fast. If we can't bind arguments, we can't run the macro.
if tempLog.HasErrors then
raise EMacroException.Create('Macro Argument Error: ' + tempLog.GetEntries[0].Message);
// 2. Scope Matching
// Create a child scope to ensure correct depth resolution (Binder sees Layout at depth 0 relative to itself)
@@ -411,13 +454,7 @@ begin
Result := evaluator.Execute(boundSubAst);
end;
Result :=
TMacroExpander.ExpandMacros(
FMacroRegistry,
FRootScope,
Node,
macroEvaluator // Injected single dependency
);
Result := TMacroExpander.ExpandMacros(FMacroRegistry, FRootScope, Node, macroEvaluator);
end;
function TEnvironment.GetFunctionRegistry: IFunctionDefinitionRegistry;
Src/AST/Myc.Ast.Nodes.pas
+167 -8
View File
@@ -12,9 +12,70 @@ uses
Myc.Ast.Types;
type
// --- Forward Declarations to break cycles ---
IAstVisitor = interface;
// --- Forward Declarations ---
IAstNode = interface;
// --- Error Handling Infrastructure ---
TCompilerErrorLevel = (elHint, elWarning, elError);
TCompilerError = record
Level: TCompilerErrorLevel;
Message: string;
Node: IAstNode; // Context node where the error occurred
constructor Create(ALevel: TCompilerErrorLevel; const AMessage: string; const ANode: IAstNode = nil);
function ToString: string;
end;
ICompilerLog = interface
procedure Add(ALevel: TCompilerErrorLevel; const AMessage: string; const ANode: IAstNode = nil);
procedure AddError(const AMessage: string; const ANode: IAstNode = nil);
procedure AddWarning(const AMessage: string; const ANode: IAstNode = nil);
function HasErrors: Boolean;
function GetEntryCount: Integer;
function GetEntries: TArray<TCompilerError>;
property Entries: TArray<TCompilerError> read GetEntries;
end;
// Standard implementation of the log
TCompilerLog = class(TInterfacedObject, ICompilerLog)
private
FEntries: TList<TCompilerError>;
public
constructor Create;
destructor Destroy; override;
procedure Add(ALevel: TCompilerErrorLevel; const AMessage: string; const ANode: IAstNode = nil);
procedure AddError(const AMessage: string; const ANode: IAstNode = nil);
procedure AddWarning(const AMessage: string; const ANode: IAstNode = nil);
function HasErrors: Boolean;
function GetEntryCount: Integer;
function GetEntries: TArray<TCompilerError>;
end;
// 1. The abstract base class for all Compiler related exceptions.
// Catching this will catch compilation failures AND internal logic errors.
EAstException = class(Exception);
// 2. The concrete exception thrown at the END of a compilation pass if errors occurred.
// It wraps the accumulated log.
ECompilationFailed = class(EAstException)
private
FErrors: TArray<TCompilerError>;
public
constructor Create(const AErrors: TArray<TCompilerError>);
function ToString: string; override;
property Errors: TArray<TCompilerError> read FErrors;
end;
// 3. (Optional) Exception for critical internal bugs (e.g. implementation defects).
// This should ideally never happen in production.
EInternalCompilerError = class(EAstException);
// --- AST Interfaces ---
IAstVisitor = interface;
IFunctionDefinition = interface;
IIdentifierNode = interface;
IConstantNode = interface;
@@ -158,7 +219,7 @@ type
{$region 'private'}
function GetBody: IAstNode;
function GetParameters: TArray<IIdentifierNode>;
function GetIsPure: Boolean; // (* ADDED *)
function GetIsPure: Boolean;
{$endregion}
property Body: IAstNode read GetBody;
property Parameters: TArray<IIdentifierNode> read GetParameters;
@@ -249,7 +310,7 @@ type
function GetArguments: TArray<IAstNode>;
function GetIsTailCall: Boolean;
function GetStaticTarget: TDataValue.TFunc;
function GetIsTargetPure: Boolean; // (* ADDED *)
function GetIsTargetPure: Boolean;
{$endregion}
property Callee: IAstNode read GetCallee;
property Arguments: TArray<IAstNode> read GetArguments;
@@ -401,10 +462,6 @@ 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
@@ -429,4 +486,106 @@ begin
Value := AValue;
end;
{ TCompilerError }
constructor TCompilerError.Create(ALevel: TCompilerErrorLevel; const AMessage: string; const ANode: IAstNode);
begin
Level := ALevel;
Message := AMessage;
Node := ANode;
end;
function TCompilerError.ToString: string;
begin
// Simplified string representation for quick debugging
case Level of
elHint: Result := '[Hint] ';
elWarning: Result := '[Warning] ';
elError: Result := '[Error] ';
end;
Result := Result + Message;
end;
{ TCompilerLog }
constructor TCompilerLog.Create;
begin
inherited Create;
FEntries := TList<TCompilerError>.Create;
end;
destructor TCompilerLog.Destroy;
begin
FEntries.Free;
inherited;
end;
procedure TCompilerLog.Add(ALevel: TCompilerErrorLevel; const AMessage: string; const ANode: IAstNode);
begin
FEntries.Add(TCompilerError.Create(ALevel, AMessage, ANode));
end;
procedure TCompilerLog.AddError(const AMessage: string; const ANode: IAstNode);
begin
Add(elError, AMessage, ANode);
end;
procedure TCompilerLog.AddWarning(const AMessage: string; const ANode: IAstNode);
begin
Add(elWarning, AMessage, ANode);
end;
function TCompilerLog.HasErrors: Boolean;
var
entry: TCompilerError;
begin
Result := False;
for entry in FEntries do
if entry.Level = elError then
Exit(True);
end;
function TCompilerLog.GetEntryCount: Integer;
begin
Result := FEntries.Count;
end;
function TCompilerLog.GetEntries: TArray<TCompilerError>;
begin
Result := FEntries.ToArray;
end;
{ ECompilationFailed }
constructor ECompilationFailed.Create(const AErrors: TArray<TCompilerError>);
var
msg: string;
begin
if Length(AErrors) > 0 then
msg := Format('Compilation failed with %d error(s). First: %s', [Length(AErrors), AErrors[0].Message])
else
msg := 'Compilation failed with unspecified errors.';
inherited Create(msg);
FErrors := AErrors;
end;
function ECompilationFailed.ToString: string;
var
sb: TStringBuilder;
err: TCompilerError;
begin
sb := TStringBuilder.Create;
try
sb.AppendLine(Message);
for err in FErrors do
begin
sb.Append(' - ');
sb.AppendLine(err.ToString);
end;
Result := sb.ToString;
finally
sb.Free;
end;
end;
end.