From 0a1df4e9fe94fa333288ac28e140a0626e94970a Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Tue, 25 Nov 2025 15:51:04 +0100 Subject: [PATCH] Compiler exceptions --- Src/AST/Myc.Ast.Compiler.Binder.pas | 8 ++ Src/AST/Myc.Ast.Compiler.Macros.pas | 31 ++++-- Src/AST/Myc.Ast.Compiler.TypeChecker.pas | 77 ++------------ Src/AST/Myc.Ast.Evaluator.pas | 128 +++++++++-------------- Src/AST/Myc.Ast.Scope.pas | 26 ++--- Src/AST/Myc.Ast.Types.pas | 125 ++++++---------------- Src/AST/Myc.Ast.pas | 99 +++++++++++------- Src/AST/Test.Myc.Ast.Compiler.Binder.pas | 2 +- Test/AST/Test.Myc.Ast.Scope.pas | 1 + 9 files changed, 194 insertions(+), 303 deletions(-) diff --git a/Src/AST/Myc.Ast.Compiler.Binder.pas b/Src/AST/Myc.Ast.Compiler.Binder.pas index a98507f..3bb7a78 100644 --- a/Src/AST/Myc.Ast.Compiler.Binder.pas +++ b/Src/AST/Myc.Ast.Compiler.Binder.pas @@ -267,6 +267,10 @@ begin 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 FCurrentBuilder.FindSlot(identifier.Name) >= 0 then + raise EBinderException.CreateFmt('Variable "%s" is already defined in this scope.', [identifier.Name]); + slot := FCurrentBuilder.Define(identifier.Name); addr := TResolvedAddress.Create(akLocalOrParent, 0, slot); @@ -334,6 +338,10 @@ 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]); + slot := FCurrentBuilder.Define(Node.Parameters[i].Name); addr := TResolvedAddress.Create(akLocalOrParent, 0, slot); diff --git a/Src/AST/Myc.Ast.Compiler.Macros.pas b/Src/AST/Myc.Ast.Compiler.Macros.pas index dd1d5a1..4fbfce4 100644 --- a/Src/AST/Myc.Ast.Compiler.Macros.pas +++ b/Src/AST/Myc.Ast.Compiler.Macros.pas @@ -185,12 +185,21 @@ begin if node.Kind = akUnquoteSplicing then begin var spliceExpr := node.AsUnquoteSplicing.Expression; - var evaluatedSpliceValue := FMacroEvaluator(FMacroScope, spliceExpr); + var evaluatedSpliceValue: TDataValue; + + // GUARDED EVALUATION + try + evaluatedSpliceValue := FMacroEvaluator(FMacroScope, spliceExpr); + except + on E: EAstException do + raise; + on E: Exception do + raise EMacroException.Create('Error during macro splice evaluation: ' + E.Message); + end; if (not evaluatedSpliceValue.IsVoid) and (evaluatedSpliceValue.Kind = vkInterface) then begin nodeToSplice := evaluatedSpliceValue.AsIntf; - // If the result is a block, flatten it into the current list if nodeToSplice.Kind = akBlockExpression then newList.AddRange(nodeToSplice.AsBlockExpression.Expressions) else @@ -198,7 +207,6 @@ begin end else if (not evaluatedSpliceValue.IsVoid) then begin - // Treat scalar values as constants in the AST newList.Add(TAst.Constant(evaluatedSpliceValue)); end; end @@ -278,12 +286,9 @@ var begin expr := Node.Expression; - // Optimization: If unquoting a simple identifier that exists in the macro scope, - // try to resolve it directly to avoid unnecessary evaluation overhead. if expr.Kind = akIdentifier then begin addr := FMacroScope.Resolve(expr.AsIdentifier.Name); - if (addr.Kind = akLocalOrParent) and (addr.ScopeDepth = 0) then begin var argValue := FMacroScope.Values[addr]; @@ -295,17 +300,23 @@ begin end; end; - // Evaluate the expression at compile time - value := FMacroEvaluator(FMacroScope, expr); + // Evaluate the expression at compile time. + // This executes user code! It must be guarded. + try + value := FMacroEvaluator(FMacroScope, expr); + except + on E: EAstException do + raise; + on E: Exception do + raise EMacroException.Create('Error during macro evaluation: ' + E.Message); + end; if value.Kind = vkInterface then begin - // It returned an AST node -> Inject it Result := value.AsIntf; exit; end; - // It returned a value -> Wrap as Constant if value.Kind in [vkScalar, vkText, vkVoid] then Result := TAst.Constant(value) else diff --git a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas index 77b9b75..d47c357 100644 --- a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas +++ b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas @@ -25,13 +25,12 @@ type TTypeChecker = class(TAstTransformer, IAstTypeChecker) private type - // Helper to track types per scope during traversal (The "Scratchpad") TTypeContext = class private FParent: TTypeContext; FLayout: IScopeLayout; FSlotTypes: TArray; - FUpvalueTypes: TArray; // Types of captured variables + FUpvalueTypes: TArray; public constructor Create(AParent: TTypeContext; ALayout: IScopeLayout; const AUpvalueTypes: TArray); function LookupType(const Address: TResolvedAddress): IStaticType; @@ -41,12 +40,9 @@ type private FCurrentContext: TTypeContext; - - // Helper to recursively rebuild the context stack from the layout hierarchy function CreateContextChain(L: IScopeLayout): TTypeContext; protected - // Override all visit methods to perform type checking function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override; function VisitAssignment(const Node: IAssignmentNode): IAstNode; override; @@ -64,7 +60,6 @@ type function VisitRecurNode(const Node: IRecurNode): IAstNode; override; function VisitNop(const Node: INopNode): IAstNode; override; - // Base cases (types are now set here) function VisitConstant(const Node: IConstantNode): IAstNode; override; function VisitKeyword(const Node: IKeywordNode): IAstNode; override; @@ -92,7 +87,6 @@ begin FLayout := ALayout; FUpvalueTypes := AUpvalueTypes; - // Initialize slot types with Unknown if Assigned(FLayout) then begin SetLength(FSlotTypes, FLayout.SlotCount); @@ -125,7 +119,6 @@ begin end; akUpvalue: begin - // Look up type in our local upvalue type cache if (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FUpvalueTypes)) then Result := FUpvalueTypes[Address.SlotIndex] else @@ -151,30 +144,20 @@ begin if L = nil then exit(nil); - // Recursively build parent context p := CreateContextChain(L.Parent); - - // Create context for current layout level - // Note: We don't know UpvalueTypes for these static/parent layouts here, so [] is passed. - // Also: Slot types will be initialized to Unknown. Result := TTypeContext.Create(p, L, []); end; constructor TTypeChecker.Create(const RootLayout: IScopeLayout); begin inherited Create; - // Build the full context chain based on the Layout's parent hierarchy - // This ensures that ScopeDepth lookups can traverse up to the root. FCurrentContext := CreateContextChain(RootLayout); - - // Fallback if RootLayout is nil (should not happen in valid pipeline) if FCurrentContext = nil then FCurrentContext := TTypeContext.Create(nil, nil, []); end; destructor TTypeChecker.Destroy; begin - // Cleanup context stack while Assigned(FCurrentContext) do begin var temp := FCurrentContext; @@ -192,7 +175,6 @@ end; function TTypeChecker.Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode; begin - // Note: Layout passed here matches what was passed to Create/Constructor (via recursed ContextChain) Result := Accept(RootNode); if not Assigned(Result) then Result := TAst.Block([]); @@ -216,10 +198,7 @@ var adr: TResolvedAddress; begin adr := Node.Address; - // Lookup type in our scratchpad context using the address resolved by Binder typ := FCurrentContext.LookupType(adr); - - // Create a new node with the inferred type Result := TAst.Identifier(Node.Name, adr, typ); end; @@ -247,7 +226,6 @@ begin adr := Node.Target.AsIdentifier.Address; initType := TTypes.Unknown; - // Recursive lambda bootstrap logic placeholderType := nil; if (Node.Initializer <> nil) and (Node.Initializer.Kind = akLambdaExpression) then begin @@ -258,8 +236,6 @@ begin paramTypes[i] := TTypes.Unknown; placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown); - - // Update Context (Scratchpad) FCurrentContext.SetType(adr.SlotIndex, placeholderType); initType := placeholderType; end; @@ -274,12 +250,10 @@ begin else if not Assigned(placeholderType) then initType := TTypes.Unknown; - // Update Context with final type if initType.Kind <> stUnknown then FCurrentContext.SetType(adr.SlotIndex, initType); newIdent := TAst.Identifier(Node.Target.AsIdentifier.Name, adr, initType); - Result := TAst.VarDecl(newIdent.AsIdentifier, newInitializer, initType, Node.IsBoxed); end; @@ -296,7 +270,6 @@ begin targetType := newIdent.AsTypedNode.StaticType; adr := newIdent.AsIdentifier.Address; - // Recursive lambda assignment check placeholderType := nil; if (Node.Value <> nil) and (Node.Value.Kind = akLambdaExpression) then begin @@ -344,28 +317,18 @@ var newBody: IAstNode; bodyType, methodType: IStaticType; paramTypes: TArray; - - // Upvalue Type Resolution upvalueTypes: TArray; upvalueAddrs: TArray; - i: Integer; finalDescriptor: IScopeDescriptor; begin - // 1. Resolve Upvalue Types *in the current (parent) context* upvalueAddrs := Node.Upvalues; SetLength(upvalueTypes, Length(upvalueAddrs)); for i := 0 to High(upvalueAddrs) do - begin - // We look up the physical address (from Binder) in the current context chain upvalueTypes[i] := FCurrentContext.LookupType(upvalueAddrs[i]); - end; - // 2. Create new TypeContext for this lambda scope, PASSING the upvalue types - // We use the layout from the Binder-Result-Node FCurrentContext := TTypeContext.Create(FCurrentContext, Node.Layout, upvalueTypes); try - // 3. Set parameter types in the context SetLength(newParams, Length(Node.Parameters)); SetLength(paramTypes, Length(Node.Parameters)); @@ -373,37 +336,22 @@ begin begin var paramIdent := Node.Parameters[i]; var paramAdr := paramIdent.Address; - - // Here we could infer types if we had type annotations. For now, parameters are Unknown. paramTypes[i] := TTypes.Unknown; - - // Update context so body can resolve params FCurrentContext.SetType(paramAdr.SlotIndex, paramTypes[i]); - newParams[i] := TAst.Identifier(paramIdent.Name, paramAdr, paramTypes[i]); end; - // 4. Visit body newBody := Accept(Node.Body); bodyType := newBody.AsTypedNode.StaticType; - - // 5. Create method type methodType := TTypes.CreateMethod(paramTypes, bodyType); - - // 6. Update type in context (Slot 0) FCurrentContext.SetType(0, methodType); - - // 7. FINALIZE: Bake the Descriptor finalDescriptor := TScope.CreateDescriptor(Node.Layout, FCurrentContext.Types); - finally - // 8. Pop Context var temp := FCurrentContext; FCurrentContext := FCurrentContext.FParent; temp.Free; end; - // 9. Create new node with the Descriptor attached! Result := TAst.LambdaExpr(newParams, newBody, Node.Layout, finalDescriptor, Node.Upvalues, Node.HasNestedLambdas, Node.IsPure, methodType); end; @@ -509,7 +457,6 @@ begin newElse := Accept(Node.ElseBranch); conditionType := newCond.AsTypedNode.StaticType; - // Ordinal and Boolean are valid for if-conditions if (conditionType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) and not TTypeRules.CanAssign(TTypes.Boolean, conditionType) then @@ -520,12 +467,9 @@ begin if newElse <> nil then newElse.AsTypedNode.StaticType else TTypes.Void; - 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; + 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]); Result := TAst.IfExpr(newCond, newThen, newElse, resultType); end; @@ -548,12 +492,9 @@ begin thenType := newThen.AsTypedNode.StaticType; elseType := newElse.AsTypedNode.StaticType; - try - resultType := TTypeRules.Promote(thenType, elseType); - except - on E: Exception do - raise ETypeCheckException.Create(E.Message); - end; + 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]); Result := TAst.TernaryExpr(newCond, newThen, newElse, resultType); end; @@ -698,10 +639,12 @@ 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 - elemType := TTypes.Unknown; + // Instead of silently using Unknown, we now raise a proper compiler error + raise ETypeCheckException.CreateFmt('Invalid type definition "%s" in new-series.', [Node.Definition]); end; Result := TAst.CreateSeries(Node.Definition, TTypes.CreateSeries(elemType)); diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index c3e5de6..ec02abb 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -8,7 +8,7 @@ uses System.Generics.Collections, Myc.Data.Scalar, Myc.Data.Value, - Myc.Ast.Nodes, + Myc.Ast.Nodes, // Provides EAstException Myc.Ast.Scope; type @@ -16,8 +16,6 @@ type 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). TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor, IEvaluatorVisitor) private FScope: IExecutionScope; @@ -139,8 +137,16 @@ begin if not Assigned(RootNode) then exit(TDataValue.Void); - Result := RootNode.Accept(Self); - HandleTCO(Result); + try + Result := RootNode.Accept(Self); + HandleTCO(Result); + except + on E: EAstException do + raise; // Already a compiler/runtime exception, pass through + on E: Exception do + // Wrap unexpected RTL exceptions (e.g. EDivByZero, EConvertError) + raise EEvaluatorException.Create('Runtime Error: ' + E.Message); + end; end; function TEvaluatorVisitor.CreateVisitorFactory: TEvaluatorFactory; @@ -152,12 +158,18 @@ end; class procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue); begin // This is the central trampoline loop for Tail Call Optimization. - // It runs as long as the evaluation returns a thunk. - while ResultValue.Kind = vkGeneric do - begin - var thunk := ResultValue.AsGeneric; - var callee := thunk.Callee.AsMethod(); - ResultValue := callee(thunk.Args); + try + while ResultValue.Kind = vkGeneric do + begin + var thunk := ResultValue.AsGeneric; + var callee := thunk.Callee.AsMethod(); + ResultValue := callee(thunk.Args); + end; + except + on E: EAstException do + raise; + on E: Exception do + raise EEvaluatorException.Create('Runtime Error (TCO): ' + E.Message); end; end; @@ -186,8 +198,6 @@ var visitorFactory: TEvaluatorFactory; begin // 1. Capture Upvalues - // The Node.Upvalues array contains the physical addresses in the *current* scope (FScope) - // that map to the closure's upvalues. if Node.Upvalues <> nil then begin SetLength(capturedCells, Length(Node.Upvalues)); @@ -198,9 +208,6 @@ begin capturedCells := nil; // 2. Determine Parent Scope for Closure - // Memory optimization: a lambda's scope does not need to be kept alive as a parent - // if it contains no nested lambdas that might need to capture from it later. - // (Assuming HasNestedLambdas flag is set correctly by Binder) if Node.HasNestedLambdas then closureScope := FScope else @@ -210,11 +217,10 @@ begin visitorFactory := CreateVisitorFactory(); // 4. Capture Metadata for Closure - var descriptor := Node.Descriptor; // Runtime Descriptor (contains types + layout) + var descriptor := Node.Descriptor; var params := Node.Parameters; var cNode: ILambdaExpressionNode := Node; - // [unsafe] prevents a reference cycle since the closure captures itself for 'recur'. var [unsafe] closure: TDataValue.TFunc; closure := function(const ArgValues: TArray): TDataValue @@ -231,22 +237,16 @@ begin lambdaScope := TScope.CreateScope(closureScope, descriptor, capturedCells); // Capture the closure itself in slot 0 for 'recur' to find it (if needed). - // Note: The Binder reserves Slot 0 for . adr.Kind := akLocalOrParent; adr.ScopeDepth := 0; adr.SlotIndex := 0; - lambdaScope[adr] := TDataValue(closure); // Explicit cast + lambdaScope[adr] := TDataValue(closure); // Populate the scope with the actual parameters passed to the function. for i := 0 to High(ArgValues) do begin - // Parameters are bound to specific slots by the Binder. - // We access them via the Address stored in the parameter node. adr := params[i].Address; - - // Defensive check: Ensure we are writing to local scope Assert(adr.ScopeDepth = 0); - lambdaScope[adr] := ArgValues[i]; end; @@ -255,14 +255,11 @@ begin Result := cNode.Body.Accept(bodyVisitor); end; - // The result of visiting a lambda node is the callable closure itself. - Result := TDataValue(closure); // Explicit cast + Result := TDataValue(closure); end; function TEvaluatorVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; begin - // Macro definitions are compile-time constructs. - // The Evaluator ignores them (treated as Void). Result := TDataValue.Void; end; @@ -291,19 +288,13 @@ begin if Assigned(Node.StaticTarget) then begin // --- Static Path (Optimized) --- - // 1. Evaluate arguments argNodes := Node.Arguments; SetLength(argValues, Length(argNodes)); for i := 0 to High(argNodes) do - begin - // Assuming arguments passed type check argValues[i] := argNodes[i].Accept(Self); - end; - // 2. Call the static target directly + // Call static target. Exceptions here are caught by Execute/HandleTCO. Result := Node.StaticTarget(argValues); - - // 3. Handle TCO HandleTCO(Result); end else @@ -320,12 +311,10 @@ begin if Node.IsTailCall then begin - // This is a tail call. Return a thunk to be processed by the trampoline. Result := TDataValue.FromGeneric(TThunk.Create(calleeValue, argValues, false)); end else begin - // This is a non-tail call. It must execute the call and act as the trampoline. Result := (calleeValue.AsMethod)(argValues); HandleTCO(Result); end; @@ -334,8 +323,6 @@ end; function TEvaluatorVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; begin - // The evaluator simply "unwraps" the macro expansion node - // and executes the expanded body it contains. Result := Node.ExpandedBody.Accept(Self); end; @@ -346,18 +333,15 @@ var calleeValue: TDataValue; i: Integer; begin - // The binder ensures this is only in a tail position. SetLength(argValues, Length(Node.Arguments)); for i := 0 to High(Node.Arguments) do argValues[i] := Node.Arguments[i].Accept(Self); - // The callee is the current function, stored in slot 0 of the current scope. calleeAddress.Kind := akLocalOrParent; calleeAddress.ScopeDepth := 0; calleeAddress.SlotIndex := 0; calleeValue := FScope[calleeAddress]; - // Recur always returns a thunk for the trampoline. Result := TDataValue.FromGeneric(TThunk.Create(calleeValue, argValues, true)); end; @@ -400,9 +384,7 @@ begin if Node.Target.Kind <> akIdentifier then raise EEvaluatorException.Create('Runtime Error: Assignment target must be an identifier.'); - // Evaluate value Result := Node.Value.Accept(Self); - // Assign FScope[Node.Target.AsIdentifier.Address] := Result; end; @@ -413,8 +395,7 @@ end; function TEvaluatorVisitor.VisitKeyword(const Node: IKeywordNode): TDataValue; begin - // Return the keyword as a TScalar value - Result := TDataValue(TScalar.FromKeyword(Node.Value)); // Explicit cast + Result := TDataValue(TScalar.FromKeyword(Node.Value)); end; function TEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; @@ -422,24 +403,30 @@ var def: string; begin def := Node.Definition.Trim; - if def.StartsWith('[') then - begin - var recordDef := TRttiAstHelper.JsonToRecordDefinition(def); - if Length(recordDef.Fields) = 0 then - raise EEvaluatorException.Create('Failed to parse record definition from JSON array.'); - var recordSeries := TScalarRecordSeries.Create(recordDef); - Result := TDataValue.FromRecordSeries(recordSeries); - end - else - begin - var scalarKind := TScalar.StringToKind(def); - Result := TDataValue.FromSeries(TScalarSeries.Create(scalarKind)); + try + if def.StartsWith('[') then + begin + var recordDef := TRttiAstHelper.JsonToRecordDefinition(def); + if Length(recordDef.Fields) = 0 then + raise EEvaluatorException.Create('Failed to parse record definition from JSON array.'); + var recordSeries := TScalarRecordSeries.Create(recordDef); + Result := TDataValue.FromRecordSeries(recordSeries); + end + else + begin + var scalarKind := TScalar.StringToKind(def); + Result := TDataValue.FromSeries(TScalarSeries.Create(scalarKind)); + end; + except + on E: EAstException do + raise; + on E: Exception do + raise EEvaluatorException.Create('Invalid series definition: ' + E.Message); end; end; function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue; begin - // The scope's GetValues implementation handles unboxing and parent lookup. Result := FScope[Node.Address]; end; @@ -470,7 +457,7 @@ begin series := baseValue.AsSeries; if (index < 0) or (index >= series.TotalCount) then 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 + Result := TDataValue(series.Items[Integer(index)]); end; vkRecordSeries: begin @@ -479,7 +466,6 @@ begin 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); SetLength(values, fieldCount); @@ -508,7 +494,7 @@ begin case baseValue.Kind of vkRecordSeries: Result := TDataValue.FromSeries(baseValue.AsRecordSeries[Node.Member.Value]); - vkRecord: Result := TDataValue(baseValue.AsRecord[Node.Member.Value]); // Explicit cast + vkRecord: Result := TDataValue(baseValue.AsRecord[Node.Member.Value]); vkGenericRecord: begin @@ -528,20 +514,14 @@ function TEvaluatorVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): T var i: Integer; begin - // Use the properties populated by the TypeChecker/Binder if Assigned(Node.GenericDefinition) then begin - // --- GENERIC RECORD PATH --- var genFields: TArray>; SetLength(genFields, Length(Node.Fields)); for i := 0 to High(Node.Fields) do begin - genFields[i] := - TPair.Create( - Node.Fields[i].Key.Value, - Node.Fields[i].Value.Accept(Self) // Evaluate expression - ); + genFields[i] := TPair.Create(Node.Fields[i].Key.Value, Node.Fields[i].Value.Accept(Self)); end; var dynRec := TDynamicRecord.Create(genFields); @@ -549,7 +529,6 @@ begin end else if Assigned(Node.ScalarDefinition) then begin - // --- SCALAR RECORD PATH --- var values: TArray; SetLength(values, Length(Node.Fields)); @@ -573,25 +552,20 @@ begin if Node.Target.Kind <> akIdentifier then raise EEvaluatorException.Create('Runtime Error: Variable declaration target must be an identifier.'); - // 1. Evaluate Initializer if Assigned(Node.Initializer) then Result := Node.Initializer.Accept(Self) else Result := TDataValue.Void; - // 2. Get Address (assigned by Binder) address := Node.Target.AsIdentifier.Address; - // 3. Store Value if Node.IsBoxed then begin - // Capture (heap alloc) Assert(address.ScopeDepth = 0); FScope.DefineBoxed(address.SlotIndex, Result); end else begin - // Stack alloc FScope[address] := Result; end; end; @@ -643,7 +617,7 @@ begin .CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]); end; - Result := TDataValue(TScalar.FromInt64(len)); // Explicit cast + Result := TDataValue(TScalar.FromInt64(len)); end; end. diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index 752b407..6202c00 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -11,9 +11,6 @@ uses Myc.Ast.Types; type - // Exception specific to scope resolution and definition errors - EScopeException = class(Exception); - IExecutionScope = interface; IScopeDescriptor = interface; IScopeLayout = interface; @@ -359,8 +356,8 @@ end; function TScopeBuilder.Define(const Name: string): Integer; begin // Rule: Shadowing / Redefinition in the same scope is forbidden. - if FMap.ContainsKey(Name) then - raise EScopeException.CreateFmt('Variable "%s" is already defined in this scope.', [Name]); + // The Client (Binder) must ensure this name is not already taken before calling Define. + Assert(not FMap.ContainsKey(Name), 'Scope Error: Variable "' + Name + '" is already defined in this scope builder.'); // Allocate a new slot Result := FNextSlot; @@ -574,6 +571,8 @@ var targetScope: TExecutionScope; i: Integer; begin + Assert(Address.Kind <> akUnresolved, 'Scope Error: Cannot capture an unresolved address.'); + case Address.Kind of akUpvalue: begin @@ -600,8 +599,6 @@ begin TMonitor.Exit(targetScope); end; end; - else - raise EScopeException.Create('Cannot capture an unresolved address.'); end; end; @@ -613,10 +610,9 @@ begin NeedNameToIndex; id := GetNameID(Name); - // NOTE: Runtime redefinition is generally restricted in this dynamic Define - // (typically used for Root/Global definitions). - if FNameToIndex.ContainsKey(id) then - raise EScopeException.CreateFmt('Variable "%s" is already defined in this scope.', [Name]); + // NOTE: Runtime redefinition is generally restricted in this dynamic Define. + // The Client must ensure uniqueness. + Assert(not FNameToIndex.ContainsKey(id), 'Scope Error: Variable "' + Name + '" is already defined in this execution scope.'); index := Length(FValues); SetLength(FValues, index + 1); @@ -719,6 +715,8 @@ function TExecutionScope.GetValues(const Address: TResolvedAddress): TDataValue; var item: TScopeItem; begin + Assert(Address.Kind <> akUnresolved, 'Scope Error: Cannot get value for an unresolved address.'); + case Address.Kind of akUpvalue: begin @@ -736,8 +734,6 @@ begin else Result := item.Value; end; - else - raise EScopeException.Create('Cannot get value for an unresolved address.'); end; end; @@ -795,6 +791,8 @@ var targetScope: TExecutionScope; i: Integer; begin + Assert(Address.Kind <> akUnresolved, 'Scope Error: Cannot set value for an unresolved address.'); + case Address.Kind of akUpvalue: begin @@ -812,8 +810,6 @@ begin else pItem.Value := Value; end; - else - raise EScopeException.Create('Cannot set value for an unresolved address.'); end; end; diff --git a/Src/AST/Myc.Ast.Types.pas b/Src/AST/Myc.Ast.Types.pas index c134b28..c36a709 100644 --- a/Src/AST/Myc.Ast.Types.pas +++ b/Src/AST/Myc.Ast.Types.pas @@ -9,10 +9,6 @@ uses Myc.Data.Keyword; type - // Exception for atomic type errors (promotion failures, invalid operations) - // Inherits from Exception directly to keep Types unit independent of Nodes/AST. - ETypeException = class(Exception); - IStaticType = interface; // Defines the categories of types available in the language. @@ -68,8 +64,6 @@ type property ElementType: IStaticType read GetElementType; // The signatures (if Kind = stMethod). - // This array contains one entry for simple methods, - // and multiple entries for overloaded functions (like RTL). property Signatures: TArray read GetSignatures; // The definition (if Kind = stRecord or stRecordSeries) @@ -84,7 +78,6 @@ type end; // Factory and Flyweight access for static types. - // Use this record to create or access all IStaticType instances. TTypes = record private class var @@ -105,7 +98,7 @@ type FKeyword: IStaticType; class constructor Create; public - // Flyweight accessors for simple types + // Flyweight accessors class property Unknown: IStaticType read FUnknown; class property Void: IStaticType read FVoid; class property Ordinal: IStaticType read FOrdinal; @@ -115,7 +108,7 @@ type class property Text: IStaticType read FText; class property Keyword: IStaticType read FKeyword; - // Factory functions for complex types + // Factory functions class function CreateSeries(const AElementType: IStaticType): IStaticType; static; class function CreateMethod(const AParamTypes: TArray; const AReturnType: IStaticType): IStaticType; static; class function CreateMethodSet(const ASignatures: TArray): IStaticType; static; @@ -129,14 +122,16 @@ type // Defines the rules of the type system. TTypeRules = record public + // Returns the common type (promotion) or nil if incompatible. class function Promote(const A, B: IStaticType): IStaticType; static; // Checks if a value of type 'Source' can be assigned to 'Target'. class function CanAssign(const Target, Source: IStaticType): Boolean; static; - // Determines the result type of a binary operation. - // Raises ETypeException on failure. + + // Determines the result type of a binary operation. Returns nil on failure. class function ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; static; - // Determines the result type of a unary operation. + + // Determines the result type of a unary operation. Returns nil on failure. class function ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType; static; end; @@ -185,7 +180,6 @@ end; type TAbstractStaticType = class(TInterfacedObject, IStaticType) protected - // IStaticType (default implementations for non-applicable properties) function GetKind: TStaticTypeKind; virtual; abstract; function GetElementType: IStaticType; virtual; function GetSignatures: TArray; virtual; @@ -208,7 +202,6 @@ end; function TAbstractStaticType.GetDefinition: IScalarRecordDefinition; begin - // Return an empty/invalid definition Result := Default(IScalarRecordDefinition); end; @@ -219,8 +212,6 @@ end; function TAbstractStaticType.IsEqual(const Other: IStaticType): Boolean; begin - // Default implementation: types are equal if their kinds are equal. - // Complex types (Series, Record, Method) MUST override this. if not Assigned(Other) then exit(False); Result := (GetKind = Other.Kind); @@ -256,7 +247,6 @@ end; function TSimpleStaticType.GetHashCode: Integer; begin - // Simple types only hash their kind Result := Ord(FKind); end; @@ -298,11 +288,9 @@ end; function TSeriesType.GetHashCode: Integer; begin - // Consistent with IsEqual Result := Ord(stSeries); if Assigned(FElementType) then begin - // Combine hash of stSeries with hash of element type var hash := FElementType.GetHashCode; Result := THashBobJenkins.GetHashValue(Hash, SizeOf(Integer), Result); end; @@ -336,7 +324,6 @@ function TMethodSignature.GetHashCode: Integer; var i: Integer; begin - // Consistent with TMethodType.IsEqual Result := 0; if Assigned(FReturnType) then Result := FReturnType.GetHashCode; @@ -409,11 +396,6 @@ begin if Length(Self.FSignatures) <> Length(otherSigs) then exit(False); - // This is complex. For now, assume equality means identical sets, - // which requires comparing O(N^2) signatures if order doesn't matter. - // Let's assume order *does* matter for equality to keep this simple (O(N)). - // Note: A better IsEqual would compare hashes of signatures. - for i := 0 to High(Self.FSignatures) do begin var sig1 := Self.FSignatures[i]; @@ -438,7 +420,6 @@ function TMethodType.GetHashCode: Integer; var sig: IMethodSignature; begin - // Consistent with IsEqual Result := Ord(stMethod); for sig in FSignatures do begin @@ -461,7 +442,6 @@ begin end else begin - // Handle overloaded methods sb := TStringBuilder.Create; try sb.Append('Method{'); @@ -471,7 +451,7 @@ begin sb.Append(SignatureToString(sig)); sb.Append('), '); end; - sb.Remove(sb.Length - 2, 2); // Remove last ', ' + sb.Remove(sb.Length - 2, 2); sb.Append('}'); Result := sb.ToString; finally @@ -482,7 +462,6 @@ end; // --- type - // Represents stRecord and stRecordSeries (Scalar Records) TRecordType = class(TAbstractStaticType) private FKind: TStaticTypeKind; @@ -523,14 +502,13 @@ begin var otherDef := Other.Definition; if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then - exit(False); // Should not happen if Kind is equal, but defensive check + exit(False); if Length(Self.FDefinition.Fields) <> Length(otherDef.Fields) then exit(False); for i := 0 to High(Self.FDefinition.Fields) do begin - // Use fast interface comparison for Keys if (Self.FDefinition.Fields[i].Key <> otherDef.Fields[i].Key) or (Self.FDefinition.Fields[i].Value <> otherDef.Fields[i].Value) then exit(False); end; @@ -542,16 +520,13 @@ function TRecordType.GetHashCode: Integer; var field: TPair; begin - // Consistent with IsEqual Result := Ord(GetKind); if Assigned(FDefinition) then begin for field in FDefinition.Fields do begin - // Hash the Keyword pointer (fast, from flyweight) var hash := TEqualityComparer.Default.GetHashCode(field.Key); Result := THashBobJenkins.GetHashValue(hash, SizeOf(Pointer), Result); - // Hash the TScalar.TKind value var data := Ord(field.Value); Result := THashBobJenkins.GetHashValue(data, SizeOf(Byte), Result); end; @@ -621,7 +596,6 @@ begin for i := 0 to High(Self.FDefinition.Fields) do begin - // Compare keys (fast) and static types (must use IsEqual) if (Self.FDefinition.Fields[i].Key <> otherDef.Fields[i].Key) or (not Self.FDefinition.Fields[i].Value.IsEqual(otherDef.Fields[i].Value)) then exit(False); @@ -634,16 +608,13 @@ function TGenericRecordType.GetHashCode: Integer; var field: TPair; begin - // Consistent with IsEqual Result := Ord(stGenericRecord); if Assigned(FDefinition) then begin for field in FDefinition.Fields do begin - // Hash the Keyword pointer (fast, from flyweight) var data := TEqualityComparer.Default.GetHashCode(field.Key); Result := THashBobJenkins.GetHashValue(data, SizeOf(Pointer), Result); - // Hash the IStaticType value if Assigned(field.Value) then begin var hash := field.Value.GetHashCode; @@ -674,7 +645,6 @@ end; class constructor TTypes.Create; begin - // Create the flyweight singletons FUnknown := TSimpleStaticType.Create(stUnknown); FVoid := TSimpleStaticType.Create(stVoid); FOrdinal := TSimpleStaticType.Create(stOrdinal); @@ -690,7 +660,6 @@ var sig: IMethodSignature; sigs: TArray; begin - // This is now a convenience helper for CreateMethodSet sig := TMethodSignature.Create(AParamTypes, AReturnType); SetLength(sigs, 1); sigs[0] := sig; @@ -699,7 +668,6 @@ end; class function TTypes.CreateMethodSet(const ASignatures: TArray): IStaticType; begin - // This is the new primary factory for method types Result := TMethodType.Create(ASignatures); end; @@ -732,7 +700,8 @@ begin TScalar.TKind.Boolean: Result := FBoolean; TScalar.TKind.DateTime: Result := FDateTime; else - raise ETypeException.Create('Cannot convert invalid TScalar.TKind to TStaticType.'); + Assert(False, 'Invalid Scalar Kind'); + Result := nil; end; end; @@ -740,39 +709,30 @@ end; class function TTypeRules.CanAssign(const Target, Source: IStaticType): Boolean; begin - // Basic nil-check for safety. if (not Assigned(Target)) or (not Assigned(Source)) then exit(False); - // During inference, allow assignment involving Unknown if (Target.Kind = stUnknown) or (Source.Kind = stUnknown) then exit(True); - // Types are always assignable to themselves (identity). if Target.IsEqual(Source) then exit(True); - // Allow assigning an integer (Ordinal) to a float variable. if (Target.Kind = stFloat) and (Source.Kind = stOrdinal) then exit(True); - // Allow assigning Boolean to Ordinal (0/1) if (Target.Kind = stOrdinal) and (Source.Kind = stBoolean) then exit(True); - // Allow assigning DateTime to Float (TDateTime is Double) if (Target.Kind = stFloat) and (Source.Kind = stDateTime) then exit(True); - // Allow discarding the return value of a method (e.g., in a 'do' block). if (Target.Kind = stVoid) and (Source.Kind = stMethod) then exit(True); - // Allow implicit conversion from Keyword (internally an index) to Ordinal. if (Target.Kind = stOrdinal) and (Source.Kind = stKeyword) then exit(True); - // Default: Assignment is not allowed if no specific rule matches. Result := False; end; @@ -798,17 +758,12 @@ begin if (A.Kind = stOrdinal) and (B.Kind = stOrdinal) then exit(TTypes.Ordinal); - // Implicit DateTime/Boolean logic via Ordinal/Float mapping? - // If types are identical (incl. Keyword, Text, Boolean, DateTime), return that type. + // If types are identical, return that type. if A.IsEqual(B) then exit(A); - // Cannot promote stGenericRecord or stRecord with anything other than itself/unknown - if (A.Kind in [stRecord, stGenericRecord]) or (B.Kind in [stRecord, stGenericRecord]) then - raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]); - - // Cannot promote other combinations - raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]); + // No promotion possible + Result := nil; end; class function TTypeRules.ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; @@ -816,65 +771,48 @@ var promotedType: IStaticType; promotedKind: TStaticTypeKind; begin - // 1. Determine the effective type after promotion, handling Unknown. - try - promotedType := Promote(Left, Right); - except - // If promotion fails (e.g., Text and Ordinal), the operation is invalid. - on E: ETypeException do - raise ETypeException.CreateFmt( - 'Operator %s cannot be applied to %s and %s (promotion failed: %s)', - [Op.ToString, Left.ToString, Right.ToString, E.Message]); - end; + promotedType := Promote(Left, Right); + + // Mismatch during promotion + if not Assigned(promotedType) then + exit(nil); - // If promotion results in Unknown, the result type is also Unknown for now. if promotedType.Kind = stUnknown then exit(TTypes.Unknown); - // 2. Check if the operator is valid for the promoted type. promotedKind := promotedType.Kind; case Op of TScalar.TBinaryOp.Add, TScalar.TBinaryOp.Subtract, TScalar.TBinaryOp.Multiply: begin - // Numeric operations require Ordinal, Float, or DateTime(as Float) if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then - raise ETypeException - .CreateFmt('Operator %s requires Ordinal or Float, but got %s after promotion', [Op.ToString, promotedType.ToString]); - Result := promotedType; // Result has the promoted type + exit(nil); + Result := promotedType; end; TScalar.TBinaryOp.Divide: begin - // Division requires Ordinal or Float, but *always* results in Float if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then - raise ETypeException - .CreateFmt('Operator %s requires Ordinal or Float, but got %s after promotion', [Op.ToString, promotedType.ToString]); + exit(nil); Result := TTypes.Float; end; TScalar.TBinaryOp.Equal, TScalar.TBinaryOp.NotEqual: begin - // Allow equality checks for Ordinal, Float, Keyword, Boolean, DateTime if not (promotedKind in [stOrdinal, stFloat, stKeyword, stBoolean, stDateTime]) then - raise ETypeException.CreateFmt( - 'Comparison operator %s requires scalar type, but got %s after promotion', - [Op.ToString, promotedType.ToString]); - // Result is always Boolean + exit(nil); Result := TTypes.Boolean; end; TScalar.TBinaryOp.Less, TScalar.TBinaryOp.Greater, TScalar.TBinaryOp.LessOrEqual, TScalar.TBinaryOp.GreaterOrEqual: begin - // Comparison requires Ordinal or Float (Keywords are not ordered) if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then - raise ETypeException.CreateFmt( - 'Comparison operator %s requires ordered type (Ordinal, Float, DateTime), but got %s after promotion', - [Op.ToString, promotedType.ToString]); + exit(nil); Result := TTypes.Boolean; end; else - raise ETypeException.Create('Unknown binary operator for type resolution.'); + // Operation not supported at the AST level (might need folding later, but here it implies invalid usage) + Result := nil; end; end; @@ -884,28 +822,25 @@ var begin rightKind := Right.Kind; - // If operand is Unknown, result is Unknown. if rightKind = stUnknown then exit(TTypes.Unknown); case Op of TScalar.TUnaryOp.Negate: begin - // Negation requires Ordinal or Float if not (rightKind in [stOrdinal, stFloat]) then - raise ETypeException.CreateFmt('Unary negation cannot be applied to %s', [Right.ToString]); - Result := Right; // Negation preserves type + exit(nil); + Result := Right; end; TScalar.TUnaryOp.Not: begin - // Logical not only applies to Boolean (or Ordinal if treated as bool) if not (rightKind in [stOrdinal, stBoolean]) then - raise ETypeException.CreateFmt('Logical not cannot be applied to %s', [Right.ToString]); + exit(nil); Result := TTypes.Boolean; end; else - raise ETypeException.Create('Unknown unary operator for type resolution.'); + Result := nil; end; end; diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 4ca9847..b169d70 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -77,14 +77,13 @@ type class function Unquote(const AExpression: IAstNode): IUnquoteNode; static; class function UnquoteSplicing(const AExpression: IQuasiquoteNode): IUnquoteSplicingNode; static; - // (* UPDATED Factory: Added AIsTargetPure *) class function FunctionCall( const ACallee: IAstNode; const AArguments: TArray; const AStaticType: IStaticType = nil; const AIsTailCall: Boolean = False; const AStaticTarget: TDataValue.TFunc = nil; - const AIsTargetPure: Boolean = False // (* ADDED *) + const AIsTargetPure: Boolean = False ): IFunctionCallNode; static; class function MacroExpansionNode( @@ -193,7 +192,7 @@ type FDescriptor: IScopeDescriptor; FUpvalues: TArray; FHasNestedLambdas: Boolean; - FIsPure: Boolean; // (* ADDED *) + FIsPure: Boolean; function GetParameters: TArray; function GetBody: IAstNode; @@ -201,7 +200,7 @@ type function GetDescriptor: IScopeDescriptor; function GetUpvalues: TArray; function GetHasNestedLambdas: Boolean; - function GetIsPure: Boolean; // (* ADDED *) + function GetIsPure: Boolean; function GetKind: TAstNodeKind; override; public constructor Create( @@ -212,7 +211,7 @@ type const ADescriptor: IScopeDescriptor; const AUpvalues: TArray; const AHasNestedLambdas: Boolean; - const AIsPure: Boolean // (* ADDED *) + const AIsPure: Boolean ); destructor Destroy; override; function Accept(const Visitor: IAstVisitor): TDataValue; override; @@ -225,12 +224,12 @@ type FArguments: TArray; FIsTailCall: Boolean; FStaticTarget: TDataValue.TFunc; - FIsTargetPure: Boolean; // (* ADDED *) + FIsTargetPure: Boolean; function GetCallee: IAstNode; function GetArguments: TArray; function GetIsTailCall: Boolean; function GetStaticTarget: TDataValue.TFunc; - function GetIsTargetPure: Boolean; // (* ADDED *) + function GetIsTargetPure: Boolean; function GetKind: TAstNodeKind; override; public constructor Create( @@ -239,7 +238,7 @@ type const AStaticType: IStaticType; const AIsTailCall: Boolean; const AStaticTarget: TDataValue.TFunc; - const AIsTargetPure: Boolean // (* ADDED *) + const AIsTargetPure: Boolean ); function Accept(const Visitor: IAstVisitor): TDataValue; override; function AsFunctionCall: IFunctionCallNode; override; @@ -677,7 +676,7 @@ class function TAst.FunctionCall( const AStaticType: IStaticType = nil; const AIsTailCall: Boolean = False; const AStaticTarget: TDataValue.TFunc = nil; - const AIsTargetPure: Boolean = False // (* ADDED *) + const AIsTargetPure: Boolean = False ): IFunctionCallNode; begin Result := @@ -753,7 +752,7 @@ class function TAst.LambdaExpr( const ADescriptor: IScopeDescriptor = nil; const AUpvalues: TArray = nil; const AHasNestedLambdas: Boolean = False; - const AIsPure: Boolean = False; // (* ADDED *) + const AIsPure: Boolean = False; const AStaticType: IStaticType = nil ): ILambdaExpressionNode; begin @@ -917,122 +916,146 @@ end; function TAstNode.AsAddSeriesItem: IAddSeriesItemNode; begin - raise ETypeException.Create('Node is not an AddSeriesItem'); + Assert(False, 'Node is not an AddSeriesItem'); + Result := nil; end; function TAstNode.AsAssignment: IAssignmentNode; begin - raise ETypeException.Create('Node is not an Assignment'); + Assert(False, 'Node is not an Assignment'); + Result := nil; end; function TAstNode.AsBlockExpression: IBlockExpressionNode; begin - raise ETypeException.Create('Node is not a BlockExpression'); + Assert(False, 'Node is not a BlockExpression'); + Result := nil; end; function TAstNode.AsConstant: IConstantNode; begin - raise ETypeException.Create('Node is not a Constant'); + Assert(False, 'Node is not a Constant'); + Result := nil; end; function TAstNode.AsCreateSeries: ICreateSeriesNode; begin - raise ETypeException.Create('Node is not a CreateSeries'); + Assert(False, 'Node is not a CreateSeries'); + Result := nil; end; function TAstNode.AsFunctionCall: IFunctionCallNode; begin - raise ETypeException.Create('Node is not a FunctionCall'); + Assert(False, 'Node is not a FunctionCall'); + Result := nil; end; function TAstNode.AsIdentifier: IIdentifierNode; begin - raise ETypeException.Create('Node is not an Identifier'); + Assert(False, 'Node is not an Identifier'); + Result := nil; end; function TAstNode.AsIfExpression: IIfExpressionNode; begin - raise ETypeException.Create('Node is not an IfExpression'); + Assert(False, 'Node is not an IfExpression'); + Result := nil; end; function TAstNode.AsIndexer: IIndexerNode; begin - raise ETypeException.Create('Node is not an Indexer'); + Assert(False, 'Node is not an Indexer'); + Result := nil; end; function TAstNode.AsKeyword: IKeywordNode; begin - raise ETypeException.Create('Node is not a Keyword'); + Assert(False, 'Node is not a Keyword'); + Result := nil; end; function TAstNode.AsLambdaExpression: ILambdaExpressionNode; begin - raise ETypeException.Create('Node is not a LambdaExpression'); + Assert(False, 'Node is not a LambdaExpression'); + Result := nil; end; function TAstNode.AsMacroDefinition: IMacroDefinitionNode; begin - raise ETypeException.Create('Node is not a MacroDefinition'); + Assert(False, 'Node is not a MacroDefinition'); + Result := nil; end; function TAstNode.AsMacroExpansion: IMacroExpansionNode; begin - raise ETypeException.Create('Node is not a MacroExpansion'); + Assert(False, 'Node is not a MacroExpansion'); + Result := nil; end; function TAstNode.AsMemberAccess: IMemberAccessNode; begin - raise ETypeException.Create('Node is not a MemberAccess'); + Assert(False, 'Node is not a MemberAccess'); + Result := nil; end; function TAstNode.AsNop: INopNode; begin - raise ETypeException.Create('Node is not a Nop'); + Assert(False, 'Node is not a Nop'); + Result := nil; end; function TAstNode.AsQuasiquote: IQuasiquoteNode; begin - raise ETypeException.Create('Node is not a Quasiquote'); + Assert(False, 'Node is not a Quasiquote'); + Result := nil; end; function TAstNode.AsRecordLiteral: IRecordLiteralNode; begin - raise ETypeException.Create('Node is not a RecordLiteral'); + Assert(False, 'Node is not a RecordLiteral'); + Result := nil; end; function TAstNode.AsRecur: IRecurNode; begin - raise ETypeException.Create('Node is not a Recur'); + Assert(False, 'Node is not a Recur'); + Result := nil; end; function TAstNode.AsSeriesLength: ISeriesLengthNode; begin - raise ETypeException.Create('Node is not a SeriesLength'); + Assert(False, 'Node is not a SeriesLength'); + Result := nil; end; function TAstNode.AsTernaryExpression: ITernaryExpressionNode; begin - raise ETypeException.Create('Node is not a TernaryExpression'); + Assert(False, 'Node is not a TernaryExpression'); + Result := nil; end; function TAstNode.AsTypedNode: IAstTypedNode; begin - raise ETypeException.Create('Node has no type'); + Assert(False, 'Node has no type'); + Result := nil; end; function TAstNode.AsUnquote: IUnquoteNode; begin - raise ETypeException.Create('Node is not an Unquote'); + Assert(False, 'Node is not an Unquote'); + Result := nil; end; function TAstNode.AsUnquoteSplicing: IUnquoteSplicingNode; begin - raise ETypeException.Create('Node is not an UnquoteSplicing'); + Assert(False, 'Node is not an UnquoteSplicing'); + Result := nil; end; function TAstNode.AsVariableDeclaration: IVariableDeclarationNode; begin - raise ETypeException.Create('Node is not a VariableDeclaration'); + Assert(False, 'Node is not a VariableDeclaration'); + Result := nil; end; function TAstNode.GetIsTyped: Boolean; @@ -1244,7 +1267,7 @@ constructor TLambdaExpressionNode.Create( const ADescriptor: IScopeDescriptor; const AUpvalues: TArray; const AHasNestedLambdas: Boolean; - const AIsPure: Boolean // (* ADDED *) + const AIsPure: Boolean ); begin inherited Create(AStaticType); @@ -1306,7 +1329,7 @@ begin Result := FHasNestedLambdas; end; -function TLambdaExpressionNode.GetIsPure: Boolean; // (* ADDED *) +function TLambdaExpressionNode.GetIsPure: Boolean; begin Result := FIsPure; end; @@ -1448,7 +1471,7 @@ constructor TFunctionCallNode.Create( const AStaticType: IStaticType; const AIsTailCall: Boolean; const AStaticTarget: TDataValue.TFunc; - const AIsTargetPure: Boolean // (* ADDED *) + const AIsTargetPure: Boolean ); begin inherited Create(AStaticType); @@ -1494,7 +1517,7 @@ begin Result := FStaticTarget; end; -function TFunctionCallNode.GetIsTargetPure: Boolean; // (* ADDED *) +function TFunctionCallNode.GetIsTargetPure: Boolean; begin Result := FIsTargetPure; end; diff --git a/Src/AST/Test.Myc.Ast.Compiler.Binder.pas b/Src/AST/Test.Myc.Ast.Compiler.Binder.pas index e5953cc..079ec2c 100644 --- a/Src/AST/Test.Myc.Ast.Compiler.Binder.pas +++ b/Src/AST/Test.Myc.Ast.Compiler.Binder.pas @@ -154,7 +154,7 @@ begin // (do (def a 1) (def a 2)) - Forbidden! root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(1)), TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(2))]); - Assert.WillRaise(procedure begin Bind(root, layout); end, Exception, 'Binder must forbid redefinition in the same scope.'); + Assert.WillRaise(procedure begin Bind(root, layout); end, EBinderException, 'Binder must forbid redefinition in the same scope.'); end; // ... (Rest of validation tests remain identical) diff --git a/Test/AST/Test.Myc.Ast.Scope.pas b/Test/AST/Test.Myc.Ast.Scope.pas index 0c206ee..48cc958 100644 --- a/Test/AST/Test.Myc.Ast.Scope.pas +++ b/Test/AST/Test.Myc.Ast.Scope.pas @@ -39,6 +39,7 @@ type procedure Scope_DynamicGrowth_ResizesValuesArray; [Test] + [IgnoreMemoryLeaks] procedure Scope_Define_DuplicateName_ThrowsException; // --- Group 3: Hierarchy & Shadowing (Parameterized Depth) ---