unit Myc.Ast.Compiler.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.Identities, Myc.Ast; type IAstTypeChecker = interface(IAstVisitor) function Execute(const RootNode: IAstNode): IAstNode; end; TTypeChecker = class(TAstTransformer, IAstTypeChecker) private type TTypeContext = class private FParent: TTypeContext; FLayout: IScopeLayout; FSlotTypes: TArray; FUpvalueTypes: TArray; public constructor Create( AParent: TTypeContext; ALayout: IScopeLayout; const AUpvalueTypes: TArray; ADescriptor: IScopeDescriptor ); function LookupType(const Address: TResolvedAddress): IStaticType; procedure SetType(SlotIndex: Integer; AType: IStaticType); property Types: TArray read FSlotTypes; end; private FCurrentContext: TTypeContext; FLog: ICompilerLog; FRootScope: IExecutionScope; function CreateContextChain(L: IScopeLayout): TTypeContext; // Helpers for Null Propagation function PrepareBaseType(const BaseNode: IAstNode; out IsOptional: Boolean): IStaticType; function ApplyOptionality(const AType: IStaticType; IsOptional: Boolean): IStaticType; protected 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 VisitCondExpression(const Node: ICondExpressionNode): 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; function VisitNop(const Node: INopNode): IAstNode; override; function VisitConstant(const Node: IConstantNode): IAstNode; override; function VisitKeyword(const Node: IKeywordNode): IAstNode; override; public constructor Create(const RootLayout: IScopeLayout; const RootScope: IExecutionScope; const ALog: ICompilerLog); destructor Destroy; override; function Execute(const RootNode: IAstNode): IAstNode; class function CheckTypes( const RootNode: IAstNode; const Layout: IScopeLayout; const RootScope: IExecutionScope; const ALog: ICompilerLog ): IAstNode; static; end; implementation uses System.Generics.Defaults, Myc.Data.Keyword; { TTypeChecker.TTypeContext } constructor TTypeChecker.TTypeContext.Create( AParent: TTypeContext; ALayout: IScopeLayout; const AUpvalueTypes: TArray; ADescriptor: IScopeDescriptor ); var i: Integer; begin inherited Create; FParent := AParent; FLayout := ALayout; FUpvalueTypes := AUpvalueTypes; if Assigned(FLayout) then begin SetLength(FSlotTypes, FLayout.SlotCount); if Assigned(ADescriptor) then begin // Load known types from descriptor (e.g. for Root Scope / RTL) for i := 0 to High(FSlotTypes) do FSlotTypes[i] := ADescriptor.GetSymbolType(i); end else begin // Initialize with Unknown for new scopes for i := 0 to High(FSlotTypes) do FSlotTypes[i] := TTypes.Unknown; end; end; end; function TTypeChecker.TTypeContext.LookupType(const Address: TResolvedAddress): IStaticType; var ctx: TTypeContext; i: Integer; begin case Address.Kind of akLocalOrParent: begin ctx := Self; for i := 1 to Address.ScopeDepth do begin if not Assigned(ctx.FParent) then begin Result := TTypes.Unknown; Exit; end; ctx := ctx.FParent; end; if (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(ctx.FSlotTypes)) then Result := ctx.FSlotTypes[Address.SlotIndex] else Result := TTypes.Unknown; end; akUpvalue: begin if (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FUpvalueTypes)) then Result := FUpvalueTypes[Address.SlotIndex] else Result := TTypes.Unknown; end; else Result := TTypes.Unknown; end; end; procedure TTypeChecker.TTypeContext.SetType(SlotIndex: Integer; AType: IStaticType); begin if (SlotIndex >= 0) and (SlotIndex < Length(FSlotTypes)) then FSlotTypes[SlotIndex] := AType; end; { TTypeChecker } function TTypeChecker.CreateContextChain(L: IScopeLayout): TTypeContext; var p: TTypeContext; desc: IScopeDescriptor; begin if L = nil then exit(nil); p := CreateContextChain(L.Parent); desc := nil; // Check if this layout is the root layout (has no parent). // If so, attach the RootScope's descriptor to pull in RTL types (like +). if (L.Parent = nil) and Assigned(FRootScope) then begin desc := FRootScope.Descriptor; end; Result := TTypeContext.Create(p, L, [], desc); end; constructor TTypeChecker.Create(const RootLayout: IScopeLayout; const RootScope: IExecutionScope; const ALog: ICompilerLog); begin inherited Create; FLog := ALog; FRootScope := RootScope; FCurrentContext := CreateContextChain(RootLayout); if FCurrentContext = nil then FCurrentContext := TTypeContext.Create(nil, nil, [], nil); end; destructor TTypeChecker.Destroy; begin while Assigned(FCurrentContext) do begin var temp := FCurrentContext; FCurrentContext := FCurrentContext.FParent; temp.Free; end; inherited; end; class function TTypeChecker.CheckTypes( const RootNode: IAstNode; const Layout: IScopeLayout; const RootScope: IExecutionScope; const ALog: ICompilerLog ): IAstNode; var startLayout: IScopeLayout; begin // Determine the starting scope for the TypeChecker. // The 'Layout' parameter represents the *inner* scope of the script (the "Room"). // To correctly simulate entering this scope (via VisitLambdaExpression), the TypeChecker // must start in the *surrounding* scope (the "Hallway"), which is Layout.Parent. if Assigned(Layout) then startLayout := Layout.Parent else startLayout := nil; var checker := TTypeChecker.Create(startLayout, RootScope, ALog) as IAstTypeChecker; Result := checker.Execute(RootNode); end; function TTypeChecker.Execute(const RootNode: IAstNode): IAstNode; begin Result := Accept(RootNode); if not Assigned(Result) then Result := TAst.Block([], nil); end; // --- Helper --- function TTypeChecker.PrepareBaseType(const BaseNode: IAstNode; out IsOptional: Boolean): IStaticType; var baseType: IStaticType; begin baseType := BaseNode.AsTypedNode.StaticType; IsOptional := baseType.IsOptional; Result := TTypes.Unwrap(baseType); end; function TTypeChecker.ApplyOptionality(const AType: IStaticType; IsOptional: Boolean): IStaticType; begin if IsOptional and (AType.Kind <> stUnknown) then Result := TTypes.MakeOptional(AType) else Result := AType; end; // --- Visits --- function TTypeChecker.VisitConstant(const Node: IConstantNode): IAstNode; begin Result := Node; end; function TTypeChecker.VisitKeyword(const Node: IKeywordNode): IAstNode; begin Result := Node; end; function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): IAstNode; var typ: IStaticType; adr: TResolvedAddress; identity: INamedIdentity; begin adr := Node.Address; identity := Node.Identity.AsNamed; if adr.Kind = akUnresolved then begin Result := TAst.Identifier(identity, adr, TTypes.Unknown); Exit; end; typ := FCurrentContext.LookupType(adr); Result := TAst.Identifier(identity, adr, typ); end; function TTypeChecker.VisitRecurNode(const Node: IRecurNode): IAstNode; var newArgs: TArray; i: Integer; begin SetLength(newArgs, Node.Arguments.Count); for i := 0 to Node.Arguments.Count - 1 do newArgs[i] := Accept(Node.Arguments[i]); var argList := TArgumentList.Create(newArgs, Node.Arguments.Identity); Result := TAst.Recur(Node.Identity, argList, TTypes.Void); end; function TTypeChecker.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; var initType: IStaticType; newInitializer, newIdent: IAstNode; adr: TResolvedAddress; lambdaNode: ILambdaExpressionNode; placeholderType: IStaticType; i: Integer; identNode: IIdentifierNode; identIdentity: INamedIdentity; begin identNode := Node.Target.AsIdentifier; identIdentity := identNode.Identity.AsNamed; adr := identNode.Address; initType := TTypes.Unknown; 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 lambdaNode := Node.Initializer.AsLambdaExpression; var paramTypes: TArray; SetLength(paramTypes, lambdaNode.Parameters.Count); for i := 0 to High(paramTypes) do paramTypes[i] := TTypes.Unknown; placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown); FCurrentContext.SetType(adr.SlotIndex, placeholderType); initType := placeholderType; end; if Assigned(Node.Initializer) then newInitializer := Accept(Node.Initializer) else newInitializer := nil; if Assigned(newInitializer) then initType := newInitializer.AsTypedNode.StaticType else if not Assigned(placeholderType) then initType := TTypes.Unknown; if initType.Kind <> stUnknown then FCurrentContext.SetType(adr.SlotIndex, initType); newIdent := TAst.Identifier(identIdentity, adr, initType); Result := TAst.VarDecl(Node.Identity, newIdent, newInitializer, initType, Node.IsBoxed); end; function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): IAstNode; var targetType, sourceType: IStaticType; newIdent, newValue: IAstNode; adr: TResolvedAddress; lambdaNode: ILambdaExpressionNode; placeholderType: IStaticType; i: Integer; identNode: IIdentifierNode; identIdentity: INamedIdentity; begin identNode := Node.Target.AsIdentifier; identIdentity := identNode.Identity.AsNamed; newIdent := Accept(Node.Target); targetType := newIdent.AsTypedNode.StaticType; adr := identNode.Address; 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 lambdaNode := Node.Value.AsLambdaExpression; if (targetType.Kind <> stMethod) then begin var paramTypes: TArray; SetLength(paramTypes, lambdaNode.Parameters.Count); for i := 0 to High(paramTypes) do paramTypes[i] := TTypes.Unknown; placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown); FCurrentContext.SetType(adr.SlotIndex, placeholderType); targetType := placeholderType; end; end; newValue := Accept(Node.Value); sourceType := newValue.AsTypedNode.StaticType; if (targetType.Kind <> stUnknown) and (sourceType.Kind <> stUnknown) then begin if not TTypeRules.CanAssign(targetType, sourceType) then begin if Assigned(FLog) then FLog.AddError(Format('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]), Node); end; end; if ((targetType.Kind = stUnknown) or Assigned(placeholderType)) and (sourceType.Kind <> stUnknown) then begin FCurrentContext.SetType(adr.SlotIndex, sourceType); newIdent := TAst.Identifier(identIdentity, adr, sourceType); targetType := sourceType; end; Result := TAst.Assign(Node.Identity, newIdent, newValue, targetType); end; function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; var newParams: TArray; newBody: IAstNode; bodyType, methodType: IStaticType; paramTypes: TArray; upvalueTypes: TArray; upvalueAddrs: TArray; i: Integer; finalDescriptor: IScopeDescriptor; paramIdent: IIdentifierNode; paramIdentity: INamedIdentity; lookupAddr: TResolvedAddress; begin // 1. Resolve Upvalue Types upvalueAddrs := Node.Upvalues; SetLength(upvalueTypes, Length(upvalueAddrs)); for i := 0 to High(upvalueAddrs) do begin lookupAddr := upvalueAddrs[i]; // CRITICAL: Scope Depth Adjustment // The Binder calculated addresses relative to the *body* of this lambda (Internal View). // FCurrentContext currently points to the *defining* scope (External View/Parent). // Therefore, we must decrease the depth by 1 to look up the type in the current context. if lookupAddr.Kind = akLocalOrParent then begin // Check > 0 to prevent crash if Binder somehow produced 0 (though logic says it shouldn't). if lookupAddr.ScopeDepth > 0 then Dec(lookupAddr.ScopeDepth) else begin // Guard for Binder quirks or edge cases if Assigned(FLog) then FLog.AddWarning('Compiler integrity check warning: Upvalue Depth 0 encountered during type check.', Node); end; end; upvalueTypes[i] := FCurrentContext.LookupType(lookupAddr); end; // 2. Enter New Scope (The "Room") FCurrentContext := TTypeContext.Create(FCurrentContext, Node.Layout, upvalueTypes, nil); try // 3. Register Parameters SetLength(newParams, Node.Parameters.Count); SetLength(paramTypes, Node.Parameters.Count); for i := 0 to Node.Parameters.Count - 1 do begin paramIdent := Node.Parameters[i]; paramIdentity := paramIdent.Identity.AsNamed; var paramAdr := paramIdent.Address; paramTypes[i] := TTypes.Unknown; if paramAdr.Kind <> akUnresolved then FCurrentContext.SetType(paramAdr.SlotIndex, paramTypes[i]); newParams[i] := TAst.Identifier(paramIdentity, paramAdr, paramTypes[i]); end; // 4. Visit Body newBody := Accept(Node.Body); // 5. Determine Function Signature bodyType := newBody.AsTypedNode.StaticType; methodType := TTypes.CreateMethod(paramTypes, bodyType); finalDescriptor := TScope.CreateDescriptor(Node.Layout, FCurrentContext.Types); finally // 6. Leave Scope var temp := FCurrentContext; FCurrentContext := FCurrentContext.FParent; temp.Free; end; var paramList := TParameterList.Create(newParams, Node.Parameters.Identity); Result := TAst.LambdaExpr( Node.Identity, paramList, newBody, Node.Layout, finalDescriptor, Node.Upvalues, Node.HasNestedLambdas, Node.IsPure, methodType ); end; function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; var calleeType, retType: IStaticType; i, j: Integer; newCallee: IAstNode; newArgs: TArray; argTypes: TArray; hasUnknownArgs: Boolean; bestSig: IMethodSignature; sig: IMethodSignature; match: Boolean; argsStr: string; begin newCallee := Accept(Node.Callee); SetLength(newArgs, Node.Arguments.Count); SetLength(argTypes, Node.Arguments.Count); hasUnknownArgs := False; for i := 0 to Node.Arguments.Count - 1 do begin newArgs[i] := Accept(Node.Arguments[i]); argTypes[i] := newArgs[i].AsTypedNode.StaticType; if argTypes[i].Kind = stUnknown then hasUnknownArgs := True; end; calleeType := newCallee.AsTypedNode.StaticType; retType := TTypes.Unknown; if calleeType.Kind = TStaticTypeKind.stMethod then begin if not hasUnknownArgs then begin bestSig := nil; for sig in calleeType.Signatures do begin if Length(sig.ParamTypes) <> Length(argTypes) then continue; match := True; for j := 0 to High(argTypes) do begin if not TTypeRules.CanAssign(sig.ParamTypes[j], argTypes[j]) then begin match := False; break; end; end; if match then begin bestSig := sig; break; end; end; if Assigned(bestSig) then retType := bestSig.ReturnType else begin 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; end; end; end else if calleeType.Kind <> TStaticTypeKind.stUnknown then begin if Assigned(FLog) then FLog.AddError(Format('Cannot invoke type %s as a function.', [calleeType.ToString]), Node); retType := TTypes.Unknown; end; var argList := TArgumentList.Create(newArgs, Node.Arguments.Identity); Result := TAst.FunctionCall(Node.Identity, newCallee, argList, retType, Node.IsTailCall, nil, False); end; function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; var blockType: IStaticType; newExprs: TArray; i: Integer; begin SetLength(newExprs, Node.Expressions.Count); for i := 0 to Node.Expressions.Count - 1 do newExprs[i] := Accept(Node.Expressions[i]); if Length(newExprs) > 0 then blockType := newExprs[High(newExprs)].AsTypedNode.StaticType else blockType := TTypes.Void; var exprList := TExpressionList.Create(newExprs, Node.Expressions.Identity); Result := TAst.Block(Node.Identity, exprList, blockType); end; function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): IAstNode; var conditionType, thenType, elseType, resultType: IStaticType; newCond, newThen, newElse: IAstNode; begin newCond := Accept(Node.Condition); newThen := Accept(Node.ThenBranch); 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 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 := if newElse <> nil then newElse.AsTypedNode.StaticType else TTypes.Void; resultType := TTypeRules.Promote(thenType, elseType); if resultType = nil then 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(Node.Identity, newCond, newThen, newElse, resultType); end; function TTypeChecker.VisitCondExpression(const Node: ICondExpressionNode): IAstNode; var i: Integer; newPairs: TArray; newElse: IAstNode; condType, branchType, resultType: IStaticType; begin SetLength(newPairs, Length(Node.Pairs)); resultType := nil; for i := 0 to High(Node.Pairs) do begin var newCond := Accept(Node.Pairs[i].Condition); condType := newCond.AsTypedNode.StaticType; if (condType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, condType) and not TTypeRules.CanAssign(TTypes.Boolean, condType) then begin if Assigned(FLog) then FLog.AddError(Format('Cond condition must be Boolean or Ordinal, but got %s', [condType.ToString]), Node); end; var newBranch := Accept(Node.Pairs[i].Branch); branchType := newBranch.AsTypedNode.StaticType; newPairs[i] := TCondPair.Create(newCond, newBranch); if resultType = nil then resultType := branchType else begin var promoted := TTypeRules.Promote(resultType, branchType); if promoted = nil then begin if Assigned(FLog) then FLog.AddError( Format('Incompatible types in Cond branches: %s and %s', [resultType.ToString, branchType.ToString]), Node ); resultType := TTypes.Unknown; end else resultType := promoted; end; end; newElse := Accept(Node.ElseBranch); var elseType := newElse.AsTypedNode.StaticType; if resultType = nil then resultType := elseType else begin var promoted := TTypeRules.Promote(resultType, elseType); if promoted = nil then begin if Assigned(FLog) then FLog.AddError( Format('Incompatible types in Cond branches (Else): %s and %s', [resultType.ToString, elseType.ToString]), Node ); resultType := TTypes.Unknown; end else resultType := promoted; end; Result := TAst.CondExpr(Node.Identity, newPairs, newElse, resultType); end; function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; var unwrappedBaseType, elemType: IStaticType; fieldIndex: Integer; newBase, newMember: IAstNode; isOptionalAccess: Boolean; begin newBase := Accept(Node.Base); newMember := Accept(Node.Member); unwrappedBaseType := PrepareBaseType(newBase, isOptionalAccess); elemType := TTypes.Unknown; if (unwrappedBaseType.Kind <> TStaticTypeKind.stUnknown) then begin if (unwrappedBaseType.Kind = TStaticTypeKind.stRecord) or (unwrappedBaseType.Kind = TStaticTypeKind.stRecordSeries) then begin fieldIndex := unwrappedBaseType.Definition.IndexOf(Node.Member.Value); if fieldIndex < 0 then begin if Assigned(FLog) then FLog.AddError(Format('Member "%s" not found in type %s', [Node.Member.Value.Name, unwrappedBaseType.ToString]), Node); end else begin var fieldType := TTypes.FromScalarKind(unwrappedBaseType.Definition[fieldIndex].Value); if unwrappedBaseType.Kind = TStaticTypeKind.stRecord then elemType := fieldType else elemType := TTypes.CreateSeries(fieldType); end; end else if (unwrappedBaseType.Kind = TStaticTypeKind.stGenericRecord) then begin var genDef := unwrappedBaseType.GenericDefinition; fieldIndex := genDef.IndexOf(Node.Member.Value); if fieldIndex < 0 then begin if Assigned(FLog) then FLog.AddError(Format('Member "%s" not found in type %s', [Node.Member.Value.Name, unwrappedBaseType.ToString]), Node); end else elemType := genDef[fieldIndex].Value; end else begin if Assigned(FLog) then FLog.AddError(Format('Member access requires a record type, but got %s', [unwrappedBaseType.ToString]), Node); end; end; elemType := ApplyOptionality(elemType, isOptionalAccess); Result := TAst.MemberAccess(Node.Identity, newBase, newMember.AsKeyword, elemType); end; function TTypeChecker.VisitIndexer(const Node: IIndexerNode): IAstNode; var unwrappedBaseType, indexType, elemType: IStaticType; newBase, newIndex: IAstNode; isOptionalAccess: Boolean; begin newBase := Accept(Node.Base); newIndex := Accept(Node.Index); unwrappedBaseType := PrepareBaseType(newBase, isOptionalAccess); indexType := newIndex.AsTypedNode.StaticType; elemType := TTypes.Unknown; if (unwrappedBaseType.Kind <> TStaticTypeKind.stUnknown) then begin if (unwrappedBaseType.Kind <> TStaticTypeKind.stSeries) and (unwrappedBaseType.Kind <> TStaticTypeKind.stRecordSeries) then begin if Assigned(FLog) then FLog.AddError(Format('Indexer `[]` can only be applied to series types, but got %s', [unwrappedBaseType.ToString]), Node); end else begin if unwrappedBaseType.Kind = TStaticTypeKind.stSeries then elemType := unwrappedBaseType.ElementType else elemType := TTypes.CreateRecord(unwrappedBaseType.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; elemType := ApplyOptionality(elemType, isOptionalAccess); Result := TAst.Indexer(Node.Identity, 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; newFields: TArray; begin SetLength(newFields, Node.Fields.Count); for i := 0 to Node.Fields.Count - 1 do begin var field := Node.Fields[i]; var newKey := Accept(field.Key).AsKeyword; var newValue := Accept(field.Value); if (newKey = field.Key) and (newValue = field.Value) then newFields[i] := field else newFields[i] := TAst.RecordField(field.Identity, newKey, newValue); end; SetLength(scalarDefFields, Length(newFields)); allScalar := True; 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 if (valType.Kind = stBoolean) then scalarKind := TScalar.TKind.Boolean else if (valType.Kind = stDateTime) then scalarKind := TScalar.TKind.DateTime else begin allScalar := False; scalarKind := TScalar.TKind.Ordinal; end; if allScalar then scalarDefFields[i] := TScalarRecordField.Create(newFields[i].Key.Value, scalarKind); end; var fieldList := TRecordFieldList.Create(newFields, Node.Fields.Identity); if allScalar then begin def := TScalarRecord.TRegistry.Intern(scalarDefFields); staticType := TTypes.CreateRecord(def); Result := TAst.RecordLiteral(Node.Identity, fieldList, def, nil, staticType); 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 := TAst.RecordLiteral(Node.Identity, fieldList, nil, genDef, staticType); end; end; function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; var elemType: IStaticType; defIdentity: IDefinitionIdentity; begin try defIdentity := Node.Identity.AsDefinition; elemType := TTypes.FromScalarKind(TScalar.StringToKind(defIdentity.Definition)); except on E: Exception do 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(defIdentity, TTypes.CreateSeries(elemType)); end; function TTypeChecker.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode; var seriesType, valueType: IStaticType; newSeries, newValue, newLookback: IAstNode; begin newSeries := Accept(Node.Series); newValue := Accept(Node.Value); newLookback := Accept(Node.Lookback); seriesType := newSeries.AsTypedNode.StaticType; valueType := newValue.AsTypedNode.StaticType; if (seriesType.Kind <> stUnknown) then begin if (seriesType.Kind <> TStaticTypeKind.stSeries) then 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 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 begin if Assigned(FLog) then FLog.AddError('Lookback parameter for "add" must be an ordinal value.', Node); end; end; Result := TAst.AddSeriesItem(Node.Identity, newSeries.AsIdentifier, newValue, newLookback, TTypes.Void); end; function TTypeChecker.VisitNop(const Node: INopNode): IAstNode; begin Result := TAst.Nop(Node.Identity, TTypes.Void); end; function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode; var seriesType: IStaticType; newSeries: IAstNode; begin newSeries := Accept(Node.Series); seriesType := newSeries.AsTypedNode.StaticType; if (seriesType.Kind <> stUnknown) and (seriesType.Kind <> TStaticTypeKind.stSeries) and (seriesType.Kind <> TStaticTypeKind.stRecordSeries) then begin if Assigned(FLog) then FLog.AddError(Format('"length" requires a series, but got %s', [seriesType.ToString]), Node); end; Result := TAst.SeriesLength(Node.Identity, newSeries.AsIdentifier, TTypes.Ordinal); end; end.