unit Myc.Ast.TypeChecker; interface uses System.SysUtils, System.Classes, System.Generics.Collections, Myc.Data.Scalar, Myc.Data.Value, Myc.Ast.Nodes, Myc.Ast.Visitor, Myc.Ast.Scope, Myc.Ast.Types, Myc.Ast; type IAstTypeChecker = interface(IAstVisitor) function Execute(const RootNode: IAstNode; const ADecriptor: IScopeDescriptor): IAstNode; end; // This transformer runs *after* the TAstBinder. // It takes the "Bound AST" (which has addresses but mostly TTypes.Unknown) // and traverses it bottom-up to infer and check all static types. // It *replaces* all IAstTypedNodes with new nodes containing the correct type. TTypeChecker = class(TAstTransformer, IAstTypeChecker) private FCurrentDescriptor: IScopeDescriptor; 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; function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override; function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override; function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override; function VisitIfExpression(const Node: IIfExpressionNode): IAstNode; override; function VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode; override; function VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; override; function VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; override; function VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; override; function VisitIndexer(const Node: IIndexerNode): IAstNode; override; function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override; function VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; override; function VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode; override; function VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode; override; function VisitRecurNode(const Node: IRecurNode): IAstNode; override; // Base cases (types are now set here) function VisitConstant(const Node: IConstantNode): IAstNode; override; function VisitKeyword(const Node: IKeywordNode): IAstNode; override; public constructor Create(const ADescriptor: IScopeDescriptor); function Execute(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode; class function CheckTypes(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode; static; end; implementation uses System.Generics.Defaults, Myc.Data.Keyword; { TTypeChecker } constructor TTypeChecker.Create(const ADescriptor: IScopeDescriptor); begin inherited Create; Assert(Assigned(ADescriptor)); FCurrentDescriptor := ADescriptor; end; class function TTypeChecker.CheckTypes(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode; begin var checker := TTypeChecker.Create(ADescriptor) as IAstTypeChecker; Result := checker.Execute(RootNode, ADescriptor); end; function TTypeChecker.Execute(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode; begin FCurrentDescriptor := ADescriptor; Result := Accept(RootNode); // Use IAstNode-returning Accept if not Assigned(Result) then Result := TAst.Block([]); end; function TTypeChecker.VisitConstant(const Node: IConstantNode): IAstNode; begin // This is a leaf node. // If the constructor couldn't set the type, nobody can Assert(Node.StaticType.Kind <> stUnknown); Result := Node; end; function TTypeChecker.VisitKeyword(const Node: IKeywordNode): IAstNode; begin // This is a leaf node. // The TKeywordNode constructor *forces* the type to be TTypes.Keyword. Assert(Node.StaticType.Kind = stKeyword); Result := Node; end; function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): IAstNode; var symbol: TResolvedSymbol; adr: TResolvedAddress; begin // This is a leaf node (guaranteed to be IBoundIdentifierNode by Binder) // Get the type from the descriptor (which was populated by Binder/RTL) symbol := FCurrentDescriptor.FindSymbol(Node.Name); adr := Node.AsBoundIdentifierNode.Address; // Create a new node, copying the address and assigning the inferred type Result := TAst.BoundIdentifier(Node.Name, adr, symbol.StaticType); end; function TTypeChecker.VisitRecurNode(const Node: IRecurNode): IAstNode; var newArgs: TArray; i: Integer; begin // 1. Visit children SetLength(newArgs, Length(Node.Arguments)); for i := 0 to High(Node.Arguments) do newArgs[i] := Accept(Node.Arguments[i]); // 2. Create new node with inferred type Result := TRecurNode.Create(newArgs, TTypes.Void); end; function TTypeChecker.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; var initType: IStaticType; newInitializer, newIdent: IAstNode; boundIdent: IIdentifierNode; adr: TResolvedAddress; N: TVariableDeclarationNode; begin // 1. Visit Initializer first (if it exists) if Assigned(Node.Initializer) then newInitializer := Accept(Node.Initializer) else newInitializer := nil; // 2. Get initializer type if Assigned(newInitializer) then initType := newInitializer.AsTypedNode.StaticType else initType := TTypes.Unknown; // (def fib) // 3. Get the address from the bound identifier (SAFE CAST) boundIdent := Node.Identifier; adr := boundIdent.AsBoundIdentifierNode.Address; // 4. Update the type in the scope descriptor (which was set to Unknown by the binder). if initType.Kind <> stUnknown then FCurrentDescriptor.UpdateType(adr.SlotIndex, initType); // 5. Create the new (typed) identifier node newIdent := TAst.BoundIdentifier(boundIdent.Name, adr, initType); // 6. Create the new VariableDeclaration node Result := TVariableDeclarationNode.Create(newIdent.AsIdentifier, newInitializer, initType); // 7. Copy runtime flags (IsBoxed) N := (Result as TVariableDeclarationNode); N.IsBoxed := (Node as TVariableDeclarationNode).IsBoxed; end; function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): IAstNode; var targetType, sourceType: IStaticType; newIdent, newValue: IAstNode; adr: TResolvedAddress; begin // 1. Visit children first (Identifier, Value) newValue := Accept(Node.Value); newIdent := Accept(Node.Identifier); // 2. Get types targetType := newIdent.AsTypedNode.StaticType; sourceType := newValue.AsTypedNode.StaticType; // 3. Check assignment if not TTypeRules.CanAssign(targetType, sourceType) then raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]); // 4. If the target was 'Unknown' (from 'def'), update the descriptor // with the new, inferred type. This enables recursion. if (targetType.Kind = stUnknown) and (sourceType.Kind <> stUnknown) then begin adr := newIdent.AsBoundIdentifierNode.Address; FCurrentDescriptor.UpdateType(adr.SlotIndex, sourceType); // Re-create the identifier node *with the new type* newIdent := TAst.BoundIdentifier(newIdent.AsIdentifier.Name, adr, sourceType); targetType := sourceType; end; // 5. Create the new Assignment node Result := TAssignmentNode.Create(newIdent.AsIdentifier, newValue, targetType); end; function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; var boundNode: TLambdaExpressionNode; newParams: TArray; newBody: IAstNode; bodyType, methodType: IStaticType; paramTypes: TArray; i: Integer; savedDescriptor: IScopeDescriptor; begin boundNode := (Node as TLambdaExpressionNode); // 1. Enter the lambda's scope (which Binder already created) savedDescriptor := FCurrentDescriptor; FCurrentDescriptor := boundNode.ScopeDescriptor; try // 2. Visit parameters (they are already bound, just need typing) SetLength(newParams, Length(boundNode.Parameters)); SetLength(paramTypes, Length(boundNode.Parameters)); for i := 0 to High(boundNode.Parameters) do begin // Parameters are leaves, but we must *replace* them with typed versions // (even if they are just TTypes.Unknown for now, for type inference placeholders) var paramIdent := boundNode.Parameters[i]; var paramAdr := paramIdent.AsBoundIdentifierNode.Address; var newParam := TAst.BoundIdentifier(paramIdent.Name, paramAdr); newParams[i] := newParam; paramTypes[i] := TTypes.Unknown; end; // 3. Visit the body to infer its return type newBody := Accept(boundNode.Body); bodyType := newBody.AsTypedNode.StaticType; // 4. Create the final method type methodType := TTypes.CreateMethod(paramTypes, bodyType); // 5. Update the type for (Slot 0) in the descriptor FCurrentDescriptor.UpdateType(0, methodType); finally // 6. Restore parent descriptor FCurrentDescriptor := savedDescriptor; end; // 7. Create the new (typed) lambda node Result := TLambdaExpressionNode.Create(newParams, newBody, methodType); // 8. Copy runtime properties var newLambda := (Result as TLambdaExpressionNode); newLambda.ScopeDescriptor := boundNode.ScopeDescriptor; newLambda.Upvalues := boundNode.Upvalues; newLambda.HasNestedLambdas := boundNode.HasNestedLambdas; end; function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; var calleeType, retType: IStaticType; i: Integer; newCallee: IAstNode; newArgs: TArray; begin // 1. Visit children first (bottom-up) newCallee := Accept(Node.Callee); SetLength(newArgs, Length(Node.Arguments)); for i := 0 to High(Node.Arguments) do newArgs[i] := Accept(Node.Arguments[i]); // 2. Get callee type (now inferred) calleeType := newCallee.AsTypedNode.StaticType; retType := TTypes.Unknown; // Default if not a method // 3. Perform type checking if calleeType.Kind = TStaticTypeKind.stMethod then begin var signature := calleeType.Signature; if Length(newArgs) <> Length(signature.ParamTypes) then raise ETypeException.CreateFmt('Function expects %d arguments, but got %d', [Length(signature.ParamTypes), Length(newArgs)]); retType := signature.ReturnType; // Check argument types for i := 0 to High(newArgs) do begin var argType := newArgs[i].AsTypedNode.StaticType; var paramType := signature.ParamTypes[i]; if not TTypeRules.CanAssign(paramType, argType) then raise ETypeException .CreateFmt('Cannot assign argument %d (type %s) to parameter (type %s)', [i, argType.ToString, paramType.ToString]); end; end else if calleeType.Kind <> TStaticTypeKind.stUnknown then raise ETypeException.CreateFmt('Cannot invoke type %s as a function.', [calleeType.ToString]); // 4. Create the new (typed) call node Result := TFunctionCallNode.Create(newCallee, newArgs, retType); // 5. Copy runtime properties (Result as TFunctionCallNode).IsTailCall := (Node as TFunctionCallNode).IsTailCall; end; function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; var blockType: IStaticType; newExprs: TArray; i: Integer; begin // 1. Visit children SetLength(newExprs, Length(Node.Expressions)); for i := 0 to High(Node.Expressions) do newExprs[i] := Accept(Node.Expressions[i]); // 2. Type is type of last expression if Length(newExprs) > 0 then blockType := newExprs[High(newExprs)].AsTypedNode.StaticType else blockType := TTypes.Void; // 3. Create new node Result := TBlockExpressionNode.Create(newExprs, blockType); end; function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): IAstNode; var conditionType, thenType, elseType, resultType: IStaticType; newCond, newThen, newElse: IAstNode; begin // 1. Visit children newCond := Accept(Node.Condition); newThen := Accept(Node.ThenBranch); newElse := Accept(Node.ElseBranch); // Accept handles nil // 2. Check condition conditionType := newCond.AsTypedNode.StaticType; if (conditionType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) then raise ETypeException.CreateFmt('If condition must be Ordinal, but got %s', [conditionType.ToString]); // 3. Promote branch types thenType := newThen.AsTypedNode.StaticType; elseType := if newElse <> nil then newElse.AsTypedNode.StaticType else TTypes.Void; resultType := TTypeRules.Promote(thenType, elseType); // 4. Create new node Result := TIfExpressionNode.Create(newCond, newThen, newElse, resultType); end; function TTypeChecker.VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode; var conditionType, thenType, elseType, resultType: IStaticType; newCond, newThen, newElse: IAstNode; begin // 1. Visit children newCond := Accept(Node.Condition); newThen := Accept(Node.ThenBranch); newElse := Accept(Node.ElseBranch); // 2. Check condition conditionType := newCond.AsTypedNode.StaticType; if (conditionType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) then raise ETypeException.CreateFmt('Ternary condition must be Ordinal, but got %s', [conditionType.ToString]); // 3. Promote branch types thenType := newThen.AsTypedNode.StaticType; elseType := newElse.AsTypedNode.StaticType; resultType := TTypeRules.Promote(thenType, elseType); // 4. Create new node Result := TTernaryExpressionNode.Create(newCond, newThen, newElse, resultType); end; function TTypeChecker.VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; var leftType, rightType, resultType: IStaticType; newLeft, newRight: IAstNode; begin // 1. Visit children newLeft := Accept(Node.Left); newRight := Accept(Node.Right); // 2. Get types leftType := newLeft.AsTypedNode.StaticType; rightType := newRight.AsTypedNode.StaticType; // 3. Resolve resultType := TTypeRules.ResolveBinaryOp(Node.Operator, leftType, rightType); // 4. Create new node Result := TBinaryExpressionNode.Create(newLeft, Node.Operator, newRight, resultType); end; function TTypeChecker.VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; var rightType, resultType: IStaticType; newRight: IAstNode; begin // 1. Visit children newRight := Accept(Node.Right); // 2. Get types rightType := newRight.AsTypedNode.StaticType; // 3. Resolve resultType := TTypeRules.ResolveUnaryOp(Node.Operator, rightType); // 4. Create new node Result := TUnaryExpressionNode.Create(Node.Operator, newRight, resultType); end; function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; var baseType, elemType: IStaticType; fieldIndex: Integer; newBase, newMember: IAstNode; begin // 1. Visit children newBase := Accept(Node.Base); newMember := Accept(Node.Member); // Visits the TKeywordNode // 2. Get types baseType := newBase.AsTypedNode.StaticType; elemType := TTypes.Unknown; // 3. Resolve if (baseType.Kind <> TStaticTypeKind.stUnknown) then begin if (baseType.Kind = TStaticTypeKind.stRecord) or (baseType.Kind = TStaticTypeKind.stRecordSeries) then begin fieldIndex := baseType.Definition.IndexOf(Node.Member.Value); if fieldIndex < 0 then raise ETypeException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]); var fieldType := TTypes.FromScalarKind(baseType.Definition.Fields[fieldIndex].Value); if baseType.Kind = TStaticTypeKind.stRecord then elemType := fieldType else // stRecordSeries elemType := TTypes.CreateSeries(fieldType); end else if (baseType.Kind = TStaticTypeKind.stGenericRecord) then begin var genDef := baseType.GenericDefinition; fieldIndex := genDef.IndexOf(Node.Member.Value); if fieldIndex < 0 then raise ETypeException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]); elemType := genDef.Fields[fieldIndex].Value; end else begin raise ETypeException.CreateFmt('Member access requires a record type, but got %s', [baseType.ToString]); end; end; // 4. Create new node Result := TMemberAccessNode.Create(newBase, newMember.AsKeyword, elemType); end; function TTypeChecker.VisitIndexer(const Node: IIndexerNode): IAstNode; var baseType, indexType, elemType: IStaticType; newBase, newIndex: IAstNode; begin // 1. Visit children newBase := Accept(Node.Base); newIndex := Accept(Node.Index); // 2. Get types baseType := newBase.AsTypedNode.StaticType; indexType := newIndex.AsTypedNode.StaticType; elemType := TTypes.Unknown; // 3. Resolve if (baseType.Kind <> TStaticTypeKind.stUnknown) then begin if (baseType.Kind <> TStaticTypeKind.stSeries) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then raise ETypeException.CreateFmt('Indexer `[]` can only be applied to series types, but got %s', [baseType.ToString]); if (indexType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, indexType) then raise ETypeException.CreateFmt('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]); if baseType.Kind = TStaticTypeKind.stSeries then elemType := baseType.ElementType else // stRecordSeries elemType := TTypes.CreateRecord(baseType.Definition); end; // 4. Create new node Result := TIndexerNode.Create(newBase, newIndex, elemType); end; function TTypeChecker.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; var i: Integer; scalarDefFields: TArray; def: IScalarRecordDefinition; staticType: IStaticType; valType: IStaticType; scalarKind: TScalar.TKind; allScalar: Boolean; oldNode: TGenericRecordLiteralNode; // Parser creates this type newFields: TArray; begin oldNode := (Node as TGenericRecordLiteralNode); // 1. Visit all child nodes first to infer their types SetLength(newFields, Length(oldNode.Fields)); for i := 0 to High(oldNode.Fields) do begin newFields[i].Key := Accept(oldNode.Fields[i].Key).AsKeyword; newFields[i].Value := Accept(oldNode.Fields[i].Value); end; SetLength(scalarDefFields, Length(newFields)); allScalar := True; // 2. Check if this record literal can be a TScalarRecord for i := 0 to High(newFields) do begin valType := newFields[i].Value.AsTypedNode.StaticType; if (valType.Kind = stOrdinal) then scalarKind := TScalar.TKind.Ordinal else if (valType.Kind = stFloat) then scalarKind := TScalar.TKind.Float else if (valType.Kind = stKeyword) then scalarKind := TScalar.TKind.Keyword else begin allScalar := False; scalarKind := TScalar.TKind.Ordinal; // Dummy end; if allScalar then scalarDefFields[i] := TScalarRecordField.Create(newFields[i].Key.Value, scalarKind); end; // 3. Create the new node and set its type/definitions if allScalar then begin def := TScalarRecordRegistry.Intern(scalarDefFields); staticType := TTypes.CreateRecord(def); Result := TRecordLiteralNode.Create(newFields, staticType); (Result as TRecordLiteralNode).Definition := def; end else begin var genDefFields: TArray>; SetLength(genDefFields, Length(newFields)); for i := 0 to High(newFields) do genDefFields[i] := TPair.Create(newFields[i].Key.Value, newFields[i].Value.AsTypedNode.StaticType); var genDef := TGenericRecordRegistry.Intern(genDefFields); staticType := TTypes.CreateGenericRecord(genDef); Result := TGenericRecordLiteralNode.Create(newFields, staticType); (Result as TGenericRecordLiteralNode).GenericDefinition := genDef; end; end; function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; var elemType: IStaticType; begin // This is a leaf node // Assign the type try elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition)); except on E: Exception do elemType := TTypes.Unknown; end; // Create new node Result := TCreateSeriesNode.Create(Node.Definition, TTypes.CreateSeries(elemType)); end; function TTypeChecker.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode; var seriesType, valueType: IStaticType; newSeries, newValue, newLookback: IAstNode; begin // 1. Visit children newSeries := Accept(Node.Series); newValue := Accept(Node.Value); newLookback := Accept(Node.Lookback); // Handles nil // 2. Get types seriesType := newSeries.AsTypedNode.StaticType; valueType := newValue.AsTypedNode.StaticType; // 3. Check types if (seriesType.Kind <> stUnknown) then begin if (seriesType.Kind <> TStaticTypeKind.stSeries) then raise ETypeException.CreateFmt('"add" requires a series as its first argument, but got %s', [seriesType.ToString]); if not TTypeRules.CanAssign(seriesType.ElementType, valueType) then raise ETypeException .CreateFmt('Cannot add item of type %s to series of type %s', [valueType.ToString, seriesType.ElementType.ToString]); end; if (newLookback <> nil) then begin var lookbackType := newLookback.AsTypedNode.StaticType; if (lookbackType.Kind <> stUnknown) and not (lookbackType.Kind = TStaticTypeKind.stOrdinal) then raise ETypeException.Create('Lookback parameter for "add" must be an ordinal value.'); end; // 4. Create new node Result := TAddSeriesItemNode.Create(newSeries.AsIdentifier, newValue, newLookback, TTypes.Void); end; function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode; var seriesType: IStaticType; newSeries: IAstNode; begin // 1. Visit children newSeries := Accept(Node.Series); // 2. Get type seriesType := newSeries.AsTypedNode.StaticType; // 3. Check type if (seriesType.Kind <> stUnknown) and (seriesType.Kind <> TStaticTypeKind.stSeries) and (seriesType.Kind <> TStaticTypeKind.stRecordSeries) then raise ETypeException.CreateFmt('"length" requires a series, but got %s', [seriesType.ToString]); // 4. Create new node Result := TSeriesLengthNode.Create(newSeries.AsIdentifier, TTypes.Ordinal); end; end.