unit Myc.Ast.Types; interface uses System.SysUtils, System.Generics.Collections, Myc.Data.Scalar, Myc.Data.Keyword; type IStaticType = interface; // Defines the categories of types available in the language. TStaticTypeKind = ( stUnknown, // Used during inference before a type is known stVoid, stOrdinal, // Int64 stFloat, // Double stBoolean, stDateTime, stText, stKeyword, stMethod, stSeries, stRecord, stRecordSeries, stGenericRecord, // --- Pipeline Types --- stStreamProducer, // Source stStreamConverter, // Pipe (Source + Sink) stStreamConsumer // Sink ); TStaticTypeKindHelper = record helper for TStaticTypeKind public function ToString: string; end; // Defines the signature of a method IMethodSignature = interface {$region 'private'} function GetParamTypes: TArray; function GetReturnType: IStaticType; {$endregion} property ParamTypes: TArray read GetParamTypes; property ReturnType: IStaticType read GetReturnType; function GetHashCode: Integer; end; // Defines a mapping for generic record fields (Key -> StaticType) IGenericRecordDefinition = IKeywordMapping; TGenericRecordRegistry = TKeywordMappingRegistry; // Represents a complete static type definition. IStaticType = interface {$region 'private'} function GetKind: TStaticTypeKind; function GetElementType: IStaticType; function GetSignatures: TArray; function GetDefinition: IScalarRecordDefinition; function GetGenericDefinition: IGenericRecordDefinition; {$endregion} // The kind of type (e.g., Ordinal, Series, etc.) property Kind: TStaticTypeKind read GetKind; // The element type (if Kind = stSeries) property ElementType: IStaticType read GetElementType; // The signatures (if Kind = stMethod). property Signatures: TArray read GetSignatures; // The definition (if Kind = stRecord or stRecordSeries) property Definition: IScalarRecordDefinition read GetDefinition; // The definition (if Kind = stGenericRecord) property GenericDefinition: IGenericRecordDefinition read GetGenericDefinition; // Checks for type equality function IsEqual(const Other: IStaticType): Boolean; function ToString: string; function GetHashCode: Integer; end; // Factory and Flyweight access for static types. TTypes = record private class var FUnknown: IStaticType; class var FVoid: IStaticType; class var FOrdinal: IStaticType; class var FFloat: IStaticType; class var FBoolean: IStaticType; class var FDateTime: IStaticType; class var FText: IStaticType; class var FKeyword: IStaticType; // Stream Types class var FStreamProducer: IStaticType; class var FStreamConverter: IStaticType; class var FStreamConsumer: IStaticType; class constructor Create; public // Flyweight accessors class property Unknown: IStaticType read FUnknown; class property Void: IStaticType read FVoid; class property Ordinal: IStaticType read FOrdinal; class property Float: IStaticType read FFloat; class property Boolean: IStaticType read FBoolean; class property DateTime: IStaticType read FDateTime; class property Text: IStaticType read FText; class property Keyword: IStaticType read FKeyword; // Stream Accessors class property StreamProducer: IStaticType read FStreamProducer; class property StreamConverter: IStaticType read FStreamConverter; class property StreamConsumer: IStaticType read FStreamConsumer; // 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; class function CreateRecord(const ADef: IScalarRecordDefinition): IStaticType; static; class function CreateRecordSeries(const ADef: IScalarRecordDefinition): IStaticType; static; class function CreateGenericRecord(const ADef: IGenericRecordDefinition): IStaticType; static; class function FromScalarKind(AKind: TScalar.TKind): IStaticType; static; end; // 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. Returns nil on failure. class function ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; static; // Determines the result type of a unary operation. Returns nil on failure. class function ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType; static; end; TMethodSignature = class(TInterfacedObject, IMethodSignature) private FParamTypes: TArray; FReturnType: IStaticType; function GetParamTypes: TArray; function GetReturnType: IStaticType; public constructor Create(const AParamTypes: TArray; const AReturnType: IStaticType); function GetHashCode: Integer; override; end; implementation uses System.Generics.Defaults, System.Hash; { TStaticTypeKindHelper } function TStaticTypeKindHelper.ToString: string; begin case Self of stUnknown: Result := 'Unknown'; stVoid: Result := 'Void'; stOrdinal: Result := 'Ordinal'; stFloat: Result := 'Float'; stBoolean: Result := 'Boolean'; stDateTime: Result := 'DateTime'; stText: Result := 'Text'; stKeyword: Result := 'Keyword'; stMethod: Result := 'Method'; stSeries: Result := 'Series'; stRecord: Result := 'Record'; stRecordSeries: Result := 'RecordSeries'; stGenericRecord: Result := 'GenericRecord'; // New types stStreamProducer: Result := 'StreamProducer'; stStreamConverter: Result := 'StreamConverter'; stStreamConsumer: Result := 'StreamConsumer'; else Result := 'ErrorType'; end; end; // --- Abstract Base Implementation --- type TAbstractStaticType = class(TInterfacedObject, IStaticType) protected function GetKind: TStaticTypeKind; virtual; abstract; function GetElementType: IStaticType; virtual; function GetSignatures: TArray; virtual; function GetDefinition: IScalarRecordDefinition; virtual; function GetGenericDefinition: IGenericRecordDefinition; virtual; function IsEqual(const Other: IStaticType): Boolean; virtual; function GetHashCode: Integer; override; abstract; function ToString: string; override; end; function TAbstractStaticType.GetElementType: IStaticType; begin Result := nil; end; function TAbstractStaticType.GetSignatures: TArray; begin Result := nil; end; function TAbstractStaticType.GetDefinition: IScalarRecordDefinition; begin Result := Default(IScalarRecordDefinition); end; function TAbstractStaticType.GetGenericDefinition: IGenericRecordDefinition; begin Result := nil; end; function TAbstractStaticType.IsEqual(const Other: IStaticType): Boolean; begin if not Assigned(Other) then exit(False); Result := (GetKind = Other.Kind); end; function TAbstractStaticType.ToString: string; begin Result := GetKind.ToString; end; // --- Simple (Flyweight) Type Implementations --- type TSimpleStaticType = class(TAbstractStaticType) private FKind: TStaticTypeKind; public constructor Create(AKind: TStaticTypeKind); function GetKind: TStaticTypeKind; override; function GetHashCode: Integer; override; end; constructor TSimpleStaticType.Create(AKind: TStaticTypeKind); begin inherited Create; FKind := AKind; end; function TSimpleStaticType.GetKind: TStaticTypeKind; begin Result := FKind; end; function TSimpleStaticType.GetHashCode: Integer; begin Result := Ord(FKind); end; // --- Complex Type Implementations --- type TSeriesType = class(TAbstractStaticType) private FElementType: IStaticType; public constructor Create(AElementType: IStaticType); function GetKind: TStaticTypeKind; override; function GetElementType: IStaticType; override; function IsEqual(const Other: IStaticType): Boolean; override; function GetHashCode: Integer; override; function ToString: string; override; end; constructor TSeriesType.Create(AElementType: IStaticType); begin inherited Create; FElementType := AElementType; end; function TSeriesType.GetKind: TStaticTypeKind; begin Result := stSeries; end; function TSeriesType.GetElementType: IStaticType; begin Result := FElementType; end; function TSeriesType.IsEqual(const Other: IStaticType): Boolean; begin Result := (Assigned(Other)) and (Other.Kind = stSeries) and (Self.FElementType.IsEqual(Other.ElementType)); end; function TSeriesType.GetHashCode: Integer; begin Result := Ord(stSeries); if Assigned(FElementType) then begin var hash := FElementType.GetHashCode; Result := THashBobJenkins.GetHashValue(Hash, SizeOf(Integer), Result); end; end; function TSeriesType.ToString: string; begin Result := 'Series<' + FElementType.ToString + '>'; end; { TMethodSignature } constructor TMethodSignature.Create(const AParamTypes: TArray; const AReturnType: IStaticType); begin inherited Create; FParamTypes := AParamTypes; FReturnType := AReturnType; end; function TMethodSignature.GetParamTypes: TArray; begin Result := FParamTypes; end; function TMethodSignature.GetReturnType: IStaticType; begin Result := FReturnType; end; function TMethodSignature.GetHashCode: Integer; var i: Integer; begin Result := 0; if Assigned(FReturnType) then Result := FReturnType.GetHashCode; for i := 0 to High(FParamTypes) do begin if Assigned(FParamTypes[i]) then begin var hash := FParamTypes[i].GetHashCode; Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result); end; end; end; // --- type TMethodType = class(TAbstractStaticType) private FSignatures: TArray; function SignatureToString(const Sig: IMethodSignature): string; public constructor Create(const ASignatures: TArray); function GetKind: TStaticTypeKind; override; function GetSignatures: TArray; override; function IsEqual(const Other: IStaticType): Boolean; override; function GetHashCode: Integer; override; function ToString: string; override; end; constructor TMethodType.Create(const ASignatures: TArray); begin inherited Create; Assert(Length(ASignatures) > 0, 'Cannot create a method type with zero signatures'); FSignatures := ASignatures; end; function TMethodType.GetKind: TStaticTypeKind; begin Result := stMethod; end; function TMethodType.GetSignatures: TArray; begin Result := FSignatures; end; function TMethodType.SignatureToString(const Sig: IMethodSignature): string; var i: Integer; paramStr: string; begin paramStr := ''; for i := 0 to High(Sig.ParamTypes) do begin paramStr := paramStr + Sig.ParamTypes[i].ToString; if i < High(Sig.ParamTypes) then paramStr := paramStr + ', '; end; Result := Format('Method(%s): %s', [paramStr, Sig.ReturnType.ToString]); end; function TMethodType.IsEqual(const Other: IStaticType): Boolean; var i, j: Integer; begin if (not Assigned(Other)) or (Other.Kind <> stMethod) then exit(False); var otherSigs := Other.Signatures; if Length(Self.FSignatures) <> Length(otherSigs) then exit(False); for i := 0 to High(Self.FSignatures) do begin var sig1 := Self.FSignatures[i]; var sig2 := otherSigs[i]; if not sig1.ReturnType.IsEqual(sig2.ReturnType) then exit(False); if Length(sig1.ParamTypes) <> Length(sig2.ParamTypes) then exit(False); for j := 0 to High(sig1.ParamTypes) do begin if not sig1.ParamTypes[j].IsEqual(sig2.ParamTypes[j]) then exit(False); end; end; Result := True; end; function TMethodType.GetHashCode: Integer; var sig: IMethodSignature; begin Result := Ord(stMethod); for sig in FSignatures do begin if Assigned(sig) then begin var hash := sig.GetHashCode; Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result); end; end; end; function TMethodType.ToString: string; var sb: TStringBuilder; sig: IMethodSignature; begin if Length(FSignatures) = 1 then begin Result := SignatureToString(FSignatures[0]); end else begin sb := TStringBuilder.Create; try sb.Append('Method{'); for sig in FSignatures do begin sb.Append('('); sb.Append(SignatureToString(sig)); sb.Append('), '); end; sb.Remove(sb.Length - 2, 2); sb.Append('}'); Result := sb.ToString; finally sb.Free; end; end; end; // --- type TRecordType = class(TAbstractStaticType) private FKind: TStaticTypeKind; FDefinition: IScalarRecordDefinition; public constructor Create(AKind: TStaticTypeKind; ADef: IScalarRecordDefinition); function GetKind: TStaticTypeKind; override; function GetDefinition: IScalarRecordDefinition; override; function IsEqual(const Other: IStaticType): Boolean; override; function GetHashCode: Integer; override; function ToString: string; override; end; constructor TRecordType.Create(AKind: TStaticTypeKind; ADef: IScalarRecordDefinition); begin inherited Create; Assert(AKind in [stRecord, stRecordSeries]); FKind := AKind; FDefinition := ADef; end; function TRecordType.GetKind: TStaticTypeKind; begin Result := FKind; end; function TRecordType.GetDefinition: IScalarRecordDefinition; begin Result := FDefinition; end; function TRecordType.IsEqual(const Other: IStaticType): Boolean; var i: Integer; begin if (not Assigned(Other)) or (Other.Kind <> GetKind) then exit(False); var otherDef := Other.Definition; if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then exit(False); if Self.FDefinition.Count <> otherDef.Count then exit(False); for i := 0 to Self.FDefinition.Count - 1 do begin if (Self.FDefinition[i].Key <> otherDef[i].Key) or (Self.FDefinition[i].Value <> otherDef[i].Value) then exit(False); end; Result := True; end; function TRecordType.GetHashCode: Integer; var i: Integer; field: TPair; begin Result := Ord(GetKind); if Assigned(FDefinition) then begin for i := 0 to FDefinition.Count - 1 do begin field := FDefinition[i]; var hash := TEqualityComparer.Default.GetHashCode(field.Key); Result := THashBobJenkins.GetHashValue(hash, SizeOf(Pointer), Result); var data := Ord(field.Value); Result := THashBobJenkins.GetHashValue(data, SizeOf(Byte), Result); end; end; end; function TRecordType.ToString: string; var i: Integer; field: TPair; begin Result := GetKind.ToString + '{'; if Assigned(FDefinition) then begin for i := 0 to FDefinition.Count - 1 do begin field := FDefinition[i]; Result := Result + field.Key.Name + ': ' + field.Value.ToString; if i < FDefinition.Count - 1 then Result := Result + ', '; end; end; Result := Result + '}'; end; // --- type TGenericRecordType = class(TAbstractStaticType) private FDefinition: IGenericRecordDefinition; public constructor Create(const ADef: IGenericRecordDefinition); function GetKind: TStaticTypeKind; override; function GetGenericDefinition: IGenericRecordDefinition; override; function IsEqual(const Other: IStaticType): Boolean; override; function GetHashCode: Integer; override; function ToString: string; override; end; constructor TGenericRecordType.Create(const ADef: IGenericRecordDefinition); begin inherited Create; FDefinition := ADef; end; function TGenericRecordType.GetKind: TStaticTypeKind; begin Result := stGenericRecord; end; function TGenericRecordType.GetGenericDefinition: IGenericRecordDefinition; begin Result := FDefinition; end; function TGenericRecordType.IsEqual(const Other: IStaticType): Boolean; var i: Integer; begin if (not Assigned(Other)) or (Other.Kind <> stGenericRecord) then exit(False); var otherDef := Other.GenericDefinition; if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then exit(False); if Self.FDefinition.Count <> otherDef.Count then exit(False); for i := 0 to Self.FDefinition.Count - 1 do begin if (Self.FDefinition[i].Key <> otherDef[i].Key) or (not Self.FDefinition[i].Value.IsEqual(otherDef[i].Value)) then exit(False); end; Result := True; end; function TGenericRecordType.GetHashCode: Integer; var i: Integer; field: TPair; begin Result := Ord(stGenericRecord); if Assigned(FDefinition) then begin for i := 0 to FDefinition.Count - 1 do begin field := FDefinition[i]; var data := TEqualityComparer.Default.GetHashCode(field.Key); Result := THashBobJenkins.GetHashValue(data, SizeOf(Pointer), Result); if Assigned(field.Value) then begin var hash := field.Value.GetHashCode; Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result); end; end; end; end; function TGenericRecordType.ToString: string; var i: Integer; field: TPair; begin Result := GetKind.ToString + '{'; if Assigned(FDefinition) then begin for i := 0 to FDefinition.Count - 1 do begin field := FDefinition[i]; Result := Result + field.Key.Name + ': ' + field.Value.ToString; if i < FDefinition.Count - 1 then Result := Result + ', '; end; end; Result := Result + '}'; end; { TTypes (Factory) } class constructor TTypes.Create; begin FUnknown := TSimpleStaticType.Create(stUnknown); FVoid := TSimpleStaticType.Create(stVoid); FOrdinal := TSimpleStaticType.Create(stOrdinal); FFloat := TSimpleStaticType.Create(stFloat); FBoolean := TSimpleStaticType.Create(stBoolean); FDateTime := TSimpleStaticType.Create(stDateTime); FText := TSimpleStaticType.Create(stText); FKeyword := TSimpleStaticType.Create(stKeyword); // Initialize stream types FStreamProducer := TSimpleStaticType.Create(stStreamProducer); FStreamConverter := TSimpleStaticType.Create(stStreamConverter); FStreamConsumer := TSimpleStaticType.Create(stStreamConsumer); end; class function TTypes.CreateMethod(const AParamTypes: TArray; const AReturnType: IStaticType): IStaticType; var sig: IMethodSignature; sigs: TArray; begin sig := TMethodSignature.Create(AParamTypes, AReturnType); SetLength(sigs, 1); sigs[0] := sig; Result := TMethodType.Create(sigs); end; class function TTypes.CreateMethodSet(const ASignatures: TArray): IStaticType; begin Result := TMethodType.Create(ASignatures); end; class function TTypes.CreateRecord(const ADef: IScalarRecordDefinition): IStaticType; begin Result := TRecordType.Create(stRecord, ADef); end; class function TTypes.CreateRecordSeries(const ADef: IScalarRecordDefinition): IStaticType; begin Result := TRecordType.Create(stRecordSeries, ADef); end; class function TTypes.CreateGenericRecord(const ADef: IGenericRecordDefinition): IStaticType; begin Result := TGenericRecordType.Create(ADef); end; class function TTypes.CreateSeries(const AElementType: IStaticType): IStaticType; begin Result := TSeriesType.Create(AElementType); end; class function TTypes.FromScalarKind(AKind: TScalar.TKind): IStaticType; begin case AKind of TScalar.TKind.Ordinal: Result := FOrdinal; TScalar.TKind.Float: Result := FFloat; TScalar.TKind.Keyword: Result := FKeyword; TScalar.TKind.Boolean: Result := FBoolean; TScalar.TKind.DateTime: Result := FDateTime; else Assert(False, 'Invalid Scalar Kind'); Result := nil; end; end; { TTypeRules } class function TTypeRules.CanAssign(const Target, Source: IStaticType): Boolean; begin if (not Assigned(Target)) or (not Assigned(Source)) then exit(False); if (Target.Kind = stUnknown) or (Source.Kind = stUnknown) then exit(True); if Target.IsEqual(Source) then exit(True); if (Target.Kind = stFloat) and (Source.Kind = stOrdinal) then exit(True); if (Target.Kind = stOrdinal) and (Source.Kind = stBoolean) then exit(True); if (Target.Kind = stFloat) and (Source.Kind = stDateTime) then exit(True); if (Target.Kind = stVoid) and (Source.Kind = stMethod) then exit(True); if (Target.Kind = stOrdinal) and (Source.Kind = stKeyword) then exit(True); // Stream rules: // A Converter IS a Producer. if (Target.Kind = stStreamProducer) and (Source.Kind = stStreamConverter) then exit(True); Result := False; end; class function TTypeRules.Promote(const A, B: IStaticType): IStaticType; begin // Handle Unknown: If one is Unknown, the result is the other type. if A.Kind = stUnknown then exit(B); if B.Kind = stUnknown then exit(A); // all operations involving void result void if (A.Kind = stVoid) or (B.Kind = stVoid) then exit(TTypes.Void); // Standard Numeric promotion rule: Float wins if (A.Kind = stFloat) and (B.Kind = stFloat) then exit(TTypes.Float); if (A.Kind = stFloat) and (B.Kind = stOrdinal) then exit(TTypes.Float); if (A.Kind = stOrdinal) and (B.Kind = stFloat) then exit(TTypes.Float); if (A.Kind = stOrdinal) and (B.Kind = stOrdinal) then exit(TTypes.Ordinal); // If types are identical, return that type. if A.IsEqual(B) then exit(A); // No promotion possible Result := nil; end; class function TTypeRules.ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; var promotedType: IStaticType; promotedKind: TStaticTypeKind; begin promotedType := Promote(Left, Right); // Mismatch during promotion if not Assigned(promotedType) then exit(nil); if promotedType.Kind = stUnknown then exit(TTypes.Unknown); promotedKind := promotedType.Kind; case Op of TScalar.TBinaryOp.Add, TScalar.TBinaryOp.Subtract, TScalar.TBinaryOp.Multiply: begin if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then exit(nil); Result := promotedType; end; TScalar.TBinaryOp.Divide: begin if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then exit(nil); Result := TTypes.Float; end; TScalar.TBinaryOp.Equal, TScalar.TBinaryOp.NotEqual: begin if not (promotedKind in [stOrdinal, stFloat, stKeyword, stBoolean, stDateTime]) then exit(nil); Result := TTypes.Boolean; end; TScalar.TBinaryOp.Less, TScalar.TBinaryOp.Greater, TScalar.TBinaryOp.LessOrEqual, TScalar.TBinaryOp.GreaterOrEqual: begin if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then exit(nil); Result := TTypes.Boolean; end; else // Operation not supported at the AST level (might need folding later, but here it implies invalid usage) Result := nil; end; end; class function TTypeRules.ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType; var rightKind: TStaticTypeKind; begin rightKind := Right.Kind; if rightKind = stUnknown then exit(TTypes.Unknown); case Op of TScalar.TUnaryOp.Negate: begin if not (rightKind in [stOrdinal, stFloat]) then exit(nil); Result := Right; end; TScalar.TUnaryOp.Not: begin if not (rightKind in [stOrdinal, stBoolean]) then exit(nil); Result := TTypes.Boolean; end; else Result := nil; end; end; end.