unit Myc.Ast.Types; interface uses System.SysUtils, System.Generics.Collections, System.Generics.Defaults, Myc.Data.Scalar, Myc.Data.Keyword; type IStaticType = interface; TStaticTypeKind = ( stUnknown, stVoid, stOrdinal, stFloat, stBoolean, stDateTime, stText, stKeyword, stMethod, stSeries, stRecord, stRecordSeries, stGenericRecord ); TStaticTypeKindHelper = record helper for TStaticTypeKind public function ToString: string; end; 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; IGenericRecordDefinition = IKeywordMapping; TGenericRecordRegistry = TKeywordMappingRegistry; IStaticType = interface {$region 'private'} function GetKind: TStaticTypeKind; function GetIsOptional: Boolean; function GetElementType: IStaticType; function GetSignatures: TArray; function GetDefinition: IScalarRecordDefinition; function GetGenericDefinition: IGenericRecordDefinition; {$endregion} property Kind: TStaticTypeKind read GetKind; property IsOptional: Boolean read GetIsOptional; property ElementType: IStaticType read GetElementType; property Signatures: TArray read GetSignatures; property Definition: IScalarRecordDefinition read GetDefinition; property GenericDefinition: IGenericRecordDefinition read GetGenericDefinition; function IsEqual(const Other: IStaticType): Boolean; function IsStructurallyEqual(const Other: IStaticType): Boolean; function ToString: string; function GetHashCode: Integer; end; 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; class var FOrdinalOpt: IStaticType; class var FFloatOpt: IStaticType; class var FBooleanOpt: IStaticType; class var FDateTimeOpt: IStaticType; class var FTextOpt: IStaticType; class var FKeywordOpt: IStaticType; class var FSeriesCache: TDictionary; class var FRecordCache: TDictionary; class var FRecordSeriesCache: TDictionary; class var FGenericRecordCache: TDictionary; class var FMethodCache: TDictionary, IStaticType>; class var FOptionalCache: TDictionary; class constructor Create; class destructor Destroy; public 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; class property OrdinalOpt: IStaticType read FOrdinalOpt; class property FloatOpt: IStaticType read FFloatOpt; class property BooleanOpt: IStaticType read FBooleanOpt; class property DateTimeOpt: IStaticType read FDateTimeOpt; class property TextOpt: IStaticType read FTextOpt; class property KeywordOpt: IStaticType read FKeywordOpt; 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 MakeOptional(const AType: IStaticType): IStaticType; static; class function Unwrap(const AType: IStaticType): IStaticType; static; class function FromScalarKind(AKind: TScalar.TKind): IStaticType; static; end; TTypeRules = record public class function Promote(const A, B: IStaticType): IStaticType; static; class function CanAssign(const Target, Source: IStaticType): Boolean; static; class function ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; static; 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.Hash; // Critical for robust hash calculations { 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'; else Result := 'ErrorType'; end; end; // --- Abstract Base Implementation --- type TAbstractStaticType = class(TInterfacedObject, IStaticType) protected function GetKind: TStaticTypeKind; virtual; abstract; function GetIsOptional: Boolean; virtual; function GetElementType: IStaticType; virtual; function GetSignatures: TArray; virtual; function GetDefinition: IScalarRecordDefinition; virtual; function GetGenericDefinition: IGenericRecordDefinition; virtual; function IsEqual(const Other: IStaticType): Boolean; virtual; function IsStructurallyEqual(const Other: IStaticType): Boolean; virtual; function GetHashCode: Integer; override; abstract; function ToString: string; override; end; function TAbstractStaticType.GetIsOptional: Boolean; begin Result := False; 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.IsStructurallyEqual(const Other: IStaticType): Boolean; begin if not Assigned(Other) then exit(False); Result := (GetKind = TTypes.Unwrap(Other).Kind); end; function TAbstractStaticType.IsEqual(const Other: IStaticType): Boolean; begin if not Assigned(Other) then exit(False); if GetIsOptional <> Other.IsOptional then exit(False); Result := IsStructurallyEqual(Other); end; function TAbstractStaticType.ToString: string; begin Result := GetKind.ToString; end; // --- Optional Type Decorator --- type TOptionalType = class(TInterfacedObject, IStaticType) private FInner: IStaticType; public constructor Create(const AInner: IStaticType); function GetKind: TStaticTypeKind; function GetIsOptional: Boolean; function GetElementType: IStaticType; function GetSignatures: TArray; function GetDefinition: IScalarRecordDefinition; function GetGenericDefinition: IGenericRecordDefinition; function IsStructurallyEqual(const Other: IStaticType): Boolean; function IsEqual(const Other: IStaticType): Boolean; function GetHashCode: Integer; override; function ToString: string; override; end; constructor TOptionalType.Create(const AInner: IStaticType); begin inherited Create; FInner := AInner; end; function TOptionalType.GetKind: TStaticTypeKind; begin Result := FInner.Kind; end; function TOptionalType.GetIsOptional: Boolean; begin Result := True; end; function TOptionalType.GetElementType: IStaticType; begin Result := FInner.ElementType; end; function TOptionalType.GetSignatures: TArray; begin Result := FInner.Signatures; end; function TOptionalType.GetDefinition: IScalarRecordDefinition; begin Result := FInner.Definition; end; function TOptionalType.GetGenericDefinition: IGenericRecordDefinition; begin Result := FInner.GenericDefinition; end; function TOptionalType.IsStructurallyEqual(const Other: IStaticType): Boolean; begin Result := FInner.IsStructurallyEqual(TTypes.Unwrap(Other)); end; function TOptionalType.IsEqual(const Other: IStaticType): Boolean; begin if not Assigned(Other) then exit(False); if not Other.IsOptional then exit(False); Result := IsStructurallyEqual(Other); end; function TOptionalType.GetHashCode: Integer; var h: Integer; optionalMarker: Integer; begin // We mix the Inner Hash with a constant marker using BobJenkins to ensure // T and T? have distinct, uncorrelated hashes. h := FInner.GetHashCode; optionalMarker := $11111111; // Arbitrary constant to signal "Optionality" Result := THashBobJenkins.GetHashValue(optionalMarker, SizeOf(Integer), h); end; function TOptionalType.ToString: string; begin Result := FInner.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 := THashBobJenkins.GetHashValue(FKind, SizeOf(TStaticTypeKind), 0); 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 IsStructurallyEqual(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.IsStructurallyEqual(const Other: IStaticType): Boolean; begin var uOther := TTypes.Unwrap(Other); Result := (uOther.Kind = stSeries) and (Self.FElementType.IsEqual(uOther.ElementType)); end; function TSeriesType.GetHashCode: Integer; var h: Integer; begin // Seed with Kind, then mix in ElementType's hash h := Ord(stSeries); Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0); if Assigned(FElementType) then begin h := FElementType.GetHashCode; Result := THashBobJenkins.GetHashValue(h, 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, h: Integer; begin // Start with 0 (or a signature constant), mix ReturnType, then Params Result := 0; if Assigned(FReturnType) then begin h := FReturnType.GetHashCode; Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result); end; for i := 0 to High(FParamTypes) do begin if Assigned(FParamTypes[i]) then begin h := FParamTypes[i].GetHashCode; Result := THashBobJenkins.GetHashValue(h, 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 IsStructurallyEqual(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.IsStructurallyEqual(const Other: IStaticType): Boolean; var i, j: Integer; begin var uOther := TTypes.Unwrap(Other); if (not Assigned(uOther)) or (uOther.Kind <> stMethod) then exit(False); var otherSigs := uOther.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; h: Integer; begin // Seed with stMethod, then mix in each signature's hash h := Ord(stMethod); Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0); for sig in FSignatures do begin if Assigned(sig) then begin h := sig.GetHashCode; Result := THashBobJenkins.GetHashValue(h, 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 IsStructurallyEqual(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.IsStructurallyEqual(const Other: IStaticType): Boolean; var i: Integer; begin var uOther := TTypes.Unwrap(Other); if (not Assigned(uOther)) or (uOther.Kind <> GetKind) then exit(False); var otherDef := uOther.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, h: Integer; field: TPair; begin // Seed with Kind Result := THashBobJenkins.GetHashValue(FKind, SizeOf(TStaticTypeKind), 0); if Assigned(FDefinition) then begin for i := 0 to FDefinition.Count - 1 do begin field := FDefinition[i]; // Hash Key // Keyword identities are unique by pointer, but let's hash their internal ID/Index for safety h := field.Key.Idx; Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result); // Hash Field Type Kind h := Ord(field.Value); Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), 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 IsStructurallyEqual(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.IsStructurallyEqual(const Other: IStaticType): Boolean; var i: Integer; begin var uOther := TTypes.Unwrap(Other); if (not Assigned(uOther)) or (uOther.Kind <> stGenericRecord) then exit(False); var otherDef := uOther.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 // Deep Check of Field Types 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, h: Integer; field: TPair; begin h := Ord(stGenericRecord); Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0); if Assigned(FDefinition) then begin for i := 0 to FDefinition.Count - 1 do begin field := FDefinition[i]; // Hash Key (using Idx) h := field.Key.Idx; Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result); // Hash Value Type if Assigned(field.Value) then begin h := field.Value.GetHashCode; Result := THashBobJenkins.GetHashValue(h, 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; // --- TMethodSigArrayComparer --- type TMethodSigArrayComparer = class(TEqualityComparer>) public function Equals(const Left, Right: TArray): Boolean; override; function GetHashCode(const Value: TArray): Integer; override; end; function TMethodSigArrayComparer.Equals(const Left, Right: TArray): Boolean; var i, j: Integer; begin if Length(Left) <> Length(Right) then exit(False); for i := 0 to High(Left) do begin if not Left[i].ReturnType.IsEqual(Right[i].ReturnType) then exit(False); var pLeft := Left[i].ParamTypes; var pRight := Right[i].ParamTypes; if Length(pLeft) <> Length(pRight) then exit(False); for j := 0 to High(pLeft) do if not pLeft[j].IsEqual(pRight[j]) then exit(False); end; Result := True; end; function TMethodSigArrayComparer.GetHashCode(const Value: TArray): Integer; var sig: IMethodSignature; p: IStaticType; h: Integer; begin Result := 0; for sig in Value do begin if Assigned(sig.ReturnType) then begin h := sig.ReturnType.GetHashCode; Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result); end; for p in sig.ParamTypes do begin h := p.GetHashCode; Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result); end; end; end; { TTypes Factory } class constructor TTypes.Create; begin // 1. Primitives 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); // 2. Optional Primitives (pre-cached) FOrdinalOpt := TOptionalType.Create(FOrdinal); FFloatOpt := TOptionalType.Create(FFloat); FBooleanOpt := TOptionalType.Create(FBoolean); FDateTimeOpt := TOptionalType.Create(FDateTime); FTextOpt := TOptionalType.Create(FText); FKeywordOpt := TOptionalType.Create(FKeyword); // 3. Caches FSeriesCache := TDictionary.Create; FRecordCache := TDictionary.Create; FRecordSeriesCache := TDictionary.Create; FGenericRecordCache := TDictionary.Create; FMethodCache := TDictionary, IStaticType>.Create(TMethodSigArrayComparer.Create); FOptionalCache := TDictionary.Create; end; class destructor TTypes.Destroy; begin FSeriesCache.Free; FRecordCache.Free; FRecordSeriesCache.Free; FGenericRecordCache.Free; FMethodCache.Free; FOptionalCache.Free; end; class function TTypes.CreateSeries(const AElementType: IStaticType): IStaticType; begin if not Assigned(AElementType) then exit(FUnknown); TMonitor.Enter(FSeriesCache); try if FSeriesCache.TryGetValue(AElementType, Result) then exit; Result := TSeriesType.Create(AElementType); FSeriesCache.Add(AElementType, Result); finally TMonitor.Exit(FSeriesCache); end; end; class function TTypes.CreateRecord(const ADef: IScalarRecordDefinition): IStaticType; begin TMonitor.Enter(FRecordCache); try if FRecordCache.TryGetValue(ADef, Result) then exit; Result := TRecordType.Create(stRecord, ADef); FRecordCache.Add(ADef, Result); finally TMonitor.Exit(FRecordCache); end; end; class function TTypes.CreateRecordSeries(const ADef: IScalarRecordDefinition): IStaticType; begin TMonitor.Enter(FRecordSeriesCache); try if FRecordSeriesCache.TryGetValue(ADef, Result) then exit; Result := TRecordType.Create(stRecordSeries, ADef); FRecordSeriesCache.Add(ADef, Result); finally TMonitor.Exit(FRecordSeriesCache); end; end; class function TTypes.CreateGenericRecord(const ADef: IGenericRecordDefinition): IStaticType; begin TMonitor.Enter(FGenericRecordCache); try if FGenericRecordCache.TryGetValue(ADef, Result) then exit; Result := TGenericRecordType.Create(ADef); FGenericRecordCache.Add(ADef, Result); finally TMonitor.Exit(FGenericRecordCache); end; end; class function TTypes.CreateMethod(const AParamTypes: TArray; const AReturnType: IStaticType): IStaticType; var sig: IMethodSignature; begin sig := TMethodSignature.Create(AParamTypes, AReturnType); Result := CreateMethodSet([sig]); end; class function TTypes.CreateMethodSet(const ASignatures: TArray): IStaticType; begin if Length(ASignatures) = 0 then exit(FUnknown); TMonitor.Enter(FMethodCache); try if FMethodCache.TryGetValue(ASignatures, Result) then exit; Result := TMethodType.Create(ASignatures); FMethodCache.Add(ASignatures, Result); finally TMonitor.Exit(FMethodCache); end; end; class function TTypes.MakeOptional(const AType: IStaticType): IStaticType; begin if (not Assigned(AType)) or (AType.Kind = stUnknown) or (AType.Kind = stVoid) then exit(AType); if AType.IsOptional then exit(AType); // Fast-Path using pointer comparison on flyweights if Pointer(AType) = Pointer(FOrdinal) then exit(FOrdinalOpt); if Pointer(AType) = Pointer(FFloat) then exit(FFloatOpt); if Pointer(AType) = Pointer(FBoolean) then exit(FBooleanOpt); if Pointer(AType) = Pointer(FText) then exit(FTextOpt); if Pointer(AType) = Pointer(FKeyword) then exit(FKeywordOpt); if Pointer(AType) = Pointer(FDateTime) then exit(FDateTimeOpt); TMonitor.Enter(FOptionalCache); try if FOptionalCache.TryGetValue(AType, Result) then exit; Result := TOptionalType.Create(AType); FOptionalCache.Add(AType, Result); finally TMonitor.Exit(FOptionalCache); end; end; class function TTypes.Unwrap(const AType: IStaticType): IStaticType; begin if (Assigned(AType)) and (AType is TOptionalType) then Result := (AType as TOptionalType).FInner else Result := AType; 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 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); // STRICTNESS RULE: Cannot assign Optional to Non-Optional if Source.IsOptional and (not Target.IsOptional) then exit(False); var uTarget := TTypes.Unwrap(Target); var uSource := TTypes.Unwrap(Source); if uTarget.IsStructurallyEqual(uSource) then exit(True); // Auto-Promotion rules if (uTarget.Kind = stFloat) and (uSource.Kind = stOrdinal) then exit(True); if (uTarget.Kind = stOrdinal) and (uSource.Kind = stBoolean) then exit(True); if (uTarget.Kind = stFloat) and (uSource.Kind = stDateTime) then exit(True); if (uTarget.Kind = stVoid) and (uSource.Kind = stMethod) then exit(True); if (uTarget.Kind = stOrdinal) and (uSource.Kind = stKeyword) then exit(True); Result := False; end; class function TTypeRules.Promote(const A, B: IStaticType): IStaticType; begin if A.Kind = stUnknown then exit(B); if B.Kind = stUnknown then exit(A); // T + Void -> T? if (A.Kind = stVoid) and (B.Kind <> stVoid) then exit(TTypes.MakeOptional(B)); if (B.Kind = stVoid) and (A.Kind <> stVoid) then exit(TTypes.MakeOptional(A)); if (A.Kind = stVoid) and (B.Kind = stVoid) then exit(TTypes.Void); var uA := TTypes.Unwrap(A); var uB := TTypes.Unwrap(B); var common: IStaticType := nil; if uA.IsStructurallyEqual(uB) then common := uA else if (uA.Kind = stFloat) and (uB.Kind = stFloat) then common := TTypes.Float else if (uA.Kind = stFloat) and (uB.Kind = stOrdinal) then common := TTypes.Float else if (uA.Kind = stOrdinal) and (uB.Kind = stFloat) then common := TTypes.Float else if (uA.Kind = stOrdinal) and (uB.Kind = stOrdinal) then common := TTypes.Ordinal; if common = nil then exit(nil); if A.IsOptional or B.IsOptional then Result := TTypes.MakeOptional(common) else Result := common; end; class function TTypeRules.ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; begin if Left.IsOptional or Right.IsOptional then exit(nil); var promotedType := Promote(Left, Right); if not Assigned(promotedType) then exit(nil); if promotedType.Kind = stUnknown then exit(TTypes.Unknown); var 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 Result := nil; end; end; class function TTypeRules.ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType; begin if Right.IsOptional then exit(nil); var 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.