From 85ef043b04fda4a03eb3477cf43b7c9b2ccea3ec Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Tue, 25 Nov 2025 18:11:04 +0100 Subject: [PATCH] Compiler errors --- ASTPlayground/MainForm.pas | 21 ++- Src/AST/Myc.Ast.Compiler.Binder.pas | 73 ++++++-- Src/AST/Myc.Ast.Compiler.TypeChecker.pas | 221 +++++++++++++++++------ Src/AST/Myc.Ast.Environment.pas | 77 ++++++-- Src/AST/Myc.Ast.Nodes.pas | 175 +++++++++++++++++- 5 files changed, 464 insertions(+), 103 deletions(-) diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 0e15bd2..c826914 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -245,7 +245,7 @@ begin begin var layout: IScopeLayout; // Bind now returns the bound AST and provides the layout - Result := FEnvironment.Environment.Bind(Result, layout); + Result := FEnvironment.Environment.Bind(Result, layout, [], nil); if CompilerStageBox.ItemIndex > 2 then // Specialize no longer needs descriptor @@ -286,6 +286,25 @@ begin Result := FCurrExec.Func([]); except + on E: ECompilationFailed do + begin + Memo1.Lines.BeginUpdate; + try + Memo1.Lines.Clear; + // Die Hauptnachricht der Exception (z.B. "Compilation failed with 5 error(s)...") + Memo1.Lines.Add(E.Message); + Memo1.Lines.Add(''); // Leerzeile zur optischen Trennung + + // Iteration durch alle gesammelten Fehler im Log + for var err in E.Errors do + begin + // err.ToString formatiert automatisch als "[Error] Nachricht" etc. + Memo1.Lines.Add(err.ToString); + end; + finally + Memo1.Lines.EndUpdate; + end; + end; on E: Exception do begin FCurrExec.Func := nil; diff --git a/Src/AST/Myc.Ast.Compiler.Binder.pas b/Src/AST/Myc.Ast.Compiler.Binder.pas index 3bb7a78..f6ea453 100644 --- a/Src/AST/Myc.Ast.Compiler.Binder.pas +++ b/Src/AST/Myc.Ast.Compiler.Binder.pas @@ -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; FFunctionRegistry: IFunctionDefinitionRegistry; FBoxedDeclarations: THashSet; + 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 + const AArgTypes: TArray; + 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 = nil ): IAstNode; static; @@ -110,7 +110,8 @@ end; constructor TAstBinder.Create( const AParentLayout: IScopeLayout; const AFunctionRegistry: IFunctionDefinitionRegistry; - const AArgTypes: TArray + const AArgTypes: TArray; + 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 = 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); diff --git a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas index d47c357..f6abaa5 100644 --- a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas +++ b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas @@ -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 ) 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; diff --git a/Src/AST/Myc.Ast.Environment.pas b/Src/AST/Myc.Ast.Environment.pas index cb90125..5f9013e 100644 --- a/Src/AST/Myc.Ast.Environment.pas +++ b/Src/AST/Myc.Ast.Environment.pas @@ -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 = []): IAstNode; + + // Updated Bind signature to accept Log + function Bind( + const Node: IAstNode; + out Layout: IScopeLayout; + const AArgTypes: TArray; + const Log: ICompilerLog + ): IAstNode; + function Specialize(const Node: IAstNode): IAstNode; function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray = []): 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): IAstNode; + + function Bind( + const Node: IAstNode; + out Layout: IScopeLayout; + const ArgTypes: TArray; + const Log: ICompilerLog + ): IAstNode; + function Specialize(const Node: IAstNode): IAstNode; function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray): 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): IAstNode; +function TEnvironment.Bind( + const Node: IAstNode; + out Layout: IScopeLayout; + const ArgTypes: TArray; + 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; diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 98cc628..b5dac0d 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -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; + + property Entries: TArray read GetEntries; + end; + + // Standard implementation of the log + TCompilerLog = class(TInterfacedObject, ICompilerLog) + private + FEntries: TList; + 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; + 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; + public + constructor Create(const AErrors: TArray); + function ToString: string; override; + property Errors: TArray 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; - function GetIsPure: Boolean; // (* ADDED *) + function GetIsPure: Boolean; {$endregion} property Body: IAstNode read GetBody; property Parameters: TArray read GetParameters; @@ -249,7 +310,7 @@ type function GetArguments: TArray; function GetIsTailCall: Boolean; function GetStaticTarget: TDataValue.TFunc; - function GetIsTargetPure: Boolean; // (* ADDED *) + function GetIsTargetPure: Boolean; {$endregion} property Callee: IAstNode read GetCallee; property Arguments: TArray 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.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; +begin + Result := FEntries.ToArray; +end; + +{ ECompilationFailed } + +constructor ECompilationFailed.Create(const AErrors: TArray); +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.