Optional types and null propagation

This commit is contained in:
Michael Schimmel
2025-12-21 15:20:59 +01:00
parent e7fdbc3312
commit ac96a105a5
10 changed files with 840 additions and 190 deletions
+460 -127
View File
@@ -5,18 +5,18 @@ interface
uses
System.SysUtils,
System.Generics.Collections,
System.Generics.Defaults,
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
stUnknown,
stVoid,
stOrdinal, // Int64
stFloat, // Double
stOrdinal,
stFloat,
stBoolean,
stDateTime,
stText,
@@ -33,7 +33,6 @@ type
function ToString: string;
end;
// Defines the signature of a method
IMethodSignature = interface
{$region 'private'}
function GetParamTypes: TArray<IStaticType>;
@@ -44,40 +43,32 @@ type
function GetHashCode: Integer;
end;
// Defines a mapping for generic record fields (Key -> StaticType)
IGenericRecordDefinition = IKeywordMapping<IStaticType>;
TGenericRecordRegistry = TKeywordMappingRegistry<IStaticType>;
// Represents a complete static type definition.
IStaticType = interface
{$region 'private'}
function GetKind: TStaticTypeKind;
function GetIsOptional: Boolean;
function GetElementType: IStaticType;
function GetSignatures: TArray<IMethodSignature>;
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 IsOptional: Boolean read GetIsOptional;
property ElementType: IStaticType read GetElementType;
// The signatures (if Kind = stMethod).
property Signatures: TArray<IMethodSignature> 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 IsStructurallyEqual(const Other: IStaticType): Boolean;
function ToString: string;
function GetHashCode: Integer;
end;
// Factory and Flyweight access for static types.
TTypes = record
private
class var
@@ -97,9 +88,35 @@ type
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<IStaticType, IStaticType>;
class var
FRecordCache: TDictionary<IScalarRecordDefinition, IStaticType>;
class var
FRecordSeriesCache: TDictionary<IScalarRecordDefinition, IStaticType>;
class var
FGenericRecordCache: TDictionary<IGenericRecordDefinition, IStaticType>;
class var
FMethodCache: TDictionary<TArray<IMethodSignature>, IStaticType>;
class var
FOptionalCache: TDictionary<IStaticType, IStaticType>;
class constructor Create;
class destructor Destroy;
public
// Flyweight accessors
class property Unknown: IStaticType read FUnknown;
class property Void: IStaticType read FVoid;
class property Ordinal: IStaticType read FOrdinal;
@@ -109,7 +126,13 @@ type
class property Text: IStaticType read FText;
class property Keyword: IStaticType read FKeyword;
// Factory functions
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<IStaticType>; const AReturnType: IStaticType): IStaticType; static;
class function CreateMethodSet(const ASignatures: TArray<IMethodSignature>): IStaticType; static;
@@ -117,22 +140,16 @@ type
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;
// 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;
@@ -150,8 +167,7 @@ type
implementation
uses
System.Generics.Defaults,
System.Hash;
System.Hash; // Critical for robust hash calculations
{ TStaticTypeKindHelper }
@@ -182,15 +198,22 @@ type
TAbstractStaticType = class(TInterfacedObject, IStaticType)
protected
function GetKind: TStaticTypeKind; virtual; abstract;
function GetIsOptional: Boolean; virtual;
function GetElementType: IStaticType; virtual;
function GetSignatures: TArray<IMethodSignature>; 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;
@@ -211,11 +234,20 @@ 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);
Result := (GetKind = Other.Kind);
if GetIsOptional <> Other.IsOptional then
exit(False);
Result := IsStructurallyEqual(Other);
end;
function TAbstractStaticType.ToString: string;
@@ -223,6 +255,93 @@ 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<IMethodSignature>;
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<IMethodSignature>;
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
@@ -248,7 +367,7 @@ end;
function TSimpleStaticType.GetHashCode: Integer;
begin
Result := Ord(FKind);
Result := THashBobJenkins.GetHashValue(FKind, SizeOf(TStaticTypeKind), 0);
end;
// --- Complex Type Implementations ---
@@ -261,7 +380,7 @@ type
constructor Create(AElementType: IStaticType);
function GetKind: TStaticTypeKind; override;
function GetElementType: IStaticType; override;
function IsEqual(const Other: IStaticType): Boolean; override;
function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
function GetHashCode: Integer; override;
function ToString: string; override;
end;
@@ -282,18 +401,24 @@ begin
Result := FElementType;
end;
function TSeriesType.IsEqual(const Other: IStaticType): Boolean;
function TSeriesType.IsStructurallyEqual(const Other: IStaticType): Boolean;
begin
Result := (Assigned(Other)) and (Other.Kind = stSeries) and (Self.FElementType.IsEqual(Other.ElementType));
var uOther := TTypes.Unwrap(Other);
Result := (uOther.Kind = stSeries) and (Self.FElementType.IsEqual(uOther.ElementType));
end;
function TSeriesType.GetHashCode: Integer;
var
h: Integer;
begin
Result := Ord(stSeries);
// Seed with Kind, then mix in ElementType's hash
h := Ord(stSeries);
Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0);
if Assigned(FElementType) then
begin
var hash := FElementType.GetHashCode;
Result := THashBobJenkins.GetHashValue(Hash, SizeOf(Integer), Result);
h := FElementType.GetHashCode;
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
end;
end;
@@ -323,18 +448,23 @@ end;
function TMethodSignature.GetHashCode: Integer;
var
i: Integer;
i, h: Integer;
begin
// Start with 0 (or a signature constant), mix ReturnType, then Params
Result := 0;
if Assigned(FReturnType) then
Result := FReturnType.GetHashCode;
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
var hash := FParamTypes[i].GetHashCode;
Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result);
h := FParamTypes[i].GetHashCode;
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
end;
end;
end;
@@ -349,7 +479,7 @@ type
constructor Create(const ASignatures: TArray<IMethodSignature>);
function GetKind: TStaticTypeKind; override;
function GetSignatures: TArray<IMethodSignature>; override;
function IsEqual(const Other: IStaticType): Boolean; override;
function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
function GetHashCode: Integer; override;
function ToString: string; override;
end;
@@ -386,14 +516,15 @@ begin
Result := Format('Method(%s): %s', [paramStr, Sig.ReturnType.ToString]);
end;
function TMethodType.IsEqual(const Other: IStaticType): Boolean;
function TMethodType.IsStructurallyEqual(const Other: IStaticType): Boolean;
var
i, j: Integer;
begin
if (not Assigned(Other)) or (Other.Kind <> stMethod) then
var uOther := TTypes.Unwrap(Other);
if (not Assigned(uOther)) or (uOther.Kind <> stMethod) then
exit(False);
var otherSigs := Other.Signatures;
var otherSigs := uOther.Signatures;
if Length(Self.FSignatures) <> Length(otherSigs) then
exit(False);
@@ -420,14 +551,18 @@ end;
function TMethodType.GetHashCode: Integer;
var
sig: IMethodSignature;
h: Integer;
begin
Result := Ord(stMethod);
// 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
var hash := sig.GetHashCode;
Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result);
h := sig.GetHashCode;
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
end;
end;
end;
@@ -471,7 +606,7 @@ type
constructor Create(AKind: TStaticTypeKind; ADef: IScalarRecordDefinition);
function GetKind: TStaticTypeKind; override;
function GetDefinition: IScalarRecordDefinition; override;
function IsEqual(const Other: IStaticType): Boolean; override;
function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
function GetHashCode: Integer; override;
function ToString: string; override;
end;
@@ -494,14 +629,15 @@ begin
Result := FDefinition;
end;
function TRecordType.IsEqual(const Other: IStaticType): Boolean;
function TRecordType.IsStructurallyEqual(const Other: IStaticType): Boolean;
var
i: Integer;
begin
if (not Assigned(Other)) or (Other.Kind <> GetKind) then
var uOther := TTypes.Unwrap(Other);
if (not Assigned(uOther)) or (uOther.Kind <> GetKind) then
exit(False);
var otherDef := Other.Definition;
var otherDef := uOther.Definition;
if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then
exit(False);
@@ -519,19 +655,26 @@ end;
function TRecordType.GetHashCode: Integer;
var
i: Integer;
i, h: Integer;
field: TPair<IKeyword, TScalar.TKind>;
begin
Result := Ord(GetKind);
// 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];
var hash := TEqualityComparer<IKeyword>.Default.GetHashCode(field.Key);
Result := THashBobJenkins.GetHashValue(hash, SizeOf(Pointer), Result);
var data := Ord(field.Value);
Result := THashBobJenkins.GetHashValue(data, SizeOf(Byte), Result);
// 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;
@@ -564,7 +707,7 @@ type
constructor Create(const ADef: IGenericRecordDefinition);
function GetKind: TStaticTypeKind; override;
function GetGenericDefinition: IGenericRecordDefinition; override;
function IsEqual(const Other: IStaticType): Boolean; override;
function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
function GetHashCode: Integer; override;
function ToString: string; override;
end;
@@ -585,14 +728,15 @@ begin
Result := FDefinition;
end;
function TGenericRecordType.IsEqual(const Other: IStaticType): Boolean;
function TGenericRecordType.IsStructurallyEqual(const Other: IStaticType): Boolean;
var
i: Integer;
begin
if (not Assigned(Other)) or (Other.Kind <> stGenericRecord) then
var uOther := TTypes.Unwrap(Other);
if (not Assigned(uOther)) or (uOther.Kind <> stGenericRecord) then
exit(False);
var otherDef := Other.GenericDefinition;
var otherDef := uOther.GenericDefinition;
if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then
exit(False);
@@ -601,6 +745,7 @@ begin
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;
@@ -610,21 +755,27 @@ end;
function TGenericRecordType.GetHashCode: Integer;
var
i: Integer;
i, h: Integer;
field: TPair<IKeyword, IStaticType>;
begin
Result := Ord(stGenericRecord);
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];
var data := TEqualityComparer<IKeyword>.Default.GetHashCode(field.Key);
Result := THashBobJenkins.GetHashValue(data, SizeOf(Pointer), Result);
// Hash Key (using Idx)
h := field.Key.Idx;
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
// Hash Value Type
if Assigned(field.Value) then
begin
var hash := field.Value.GetHashCode;
Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result);
h := field.Value.GetHashCode;
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
end;
end;
end;
@@ -649,10 +800,66 @@ begin
Result := Result + '}';
end;
{ TTypes (Factory) }
// --- TMethodSigArrayComparer ---
type
TMethodSigArrayComparer = class(TEqualityComparer<TArray<IMethodSignature>>)
public
function Equals(const Left, Right: TArray<IMethodSignature>): Boolean; override;
function GetHashCode(const Value: TArray<IMethodSignature>): Integer; override;
end;
function TMethodSigArrayComparer.Equals(const Left, Right: TArray<IMethodSignature>): 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<IMethodSignature>): 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);
@@ -661,42 +868,158 @@ begin
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<IStaticType, IStaticType>.Create;
FRecordCache := TDictionary<IScalarRecordDefinition, IStaticType>.Create;
FRecordSeriesCache := TDictionary<IScalarRecordDefinition, IStaticType>.Create;
FGenericRecordCache := TDictionary<IGenericRecordDefinition, IStaticType>.Create;
FMethodCache := TDictionary<TArray<IMethodSignature>, IStaticType>.Create(TMethodSigArrayComparer.Create);
FOptionalCache := TDictionary<IStaticType, IStaticType>.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<IStaticType>; const AReturnType: IStaticType): IStaticType;
var
sig: IMethodSignature;
sigs: TArray<IMethodSignature>;
begin
sig := TMethodSignature.Create(AParamTypes, AReturnType);
SetLength(sigs, 1);
sigs[0] := sig;
Result := TMethodType.Create(sigs);
Result := CreateMethodSet([sig]);
end;
class function TTypes.CreateMethodSet(const ASignatures: TArray<IMethodSignature>): IStaticType;
begin
Result := TMethodType.Create(ASignatures);
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.CreateRecord(const ADef: IScalarRecordDefinition): IStaticType;
class function TTypes.MakeOptional(const AType: IStaticType): IStaticType;
begin
Result := TRecordType.Create(stRecord, ADef);
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.CreateRecordSeries(const ADef: IScalarRecordDefinition): IStaticType;
class function TTypes.Unwrap(const AType: IStaticType): 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);
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;
@@ -708,7 +1031,6 @@ begin
TScalar.TKind.Boolean: Result := FBoolean;
TScalar.TKind.DateTime: Result := FDateTime;
else
Assert(False, 'Invalid Scalar Kind');
Result := nil;
end;
end;
@@ -723,22 +1045,26 @@ begin
if (Target.Kind = stUnknown) or (Source.Kind = stUnknown) then
exit(True);
if Target.IsEqual(Source) then
// 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);
if (Target.Kind = stFloat) and (Source.Kind = stOrdinal) then
// Auto-Promotion rules
if (uTarget.Kind = stFloat) and (uSource.Kind = stOrdinal) then
exit(True);
if (Target.Kind = stOrdinal) and (Source.Kind = stBoolean) then
if (uTarget.Kind = stOrdinal) and (uSource.Kind = stBoolean) then
exit(True);
if (Target.Kind = stFloat) and (Source.Kind = stDateTime) then
if (uTarget.Kind = stFloat) and (uSource.Kind = stDateTime) then
exit(True);
if (Target.Kind = stVoid) and (Source.Kind = stMethod) then
if (uTarget.Kind = stVoid) and (uSource.Kind = stMethod) then
exit(True);
if (Target.Kind = stOrdinal) and (Source.Kind = stKeyword) then
if (uTarget.Kind = stOrdinal) and (uSource.Kind = stKeyword) then
exit(True);
Result := False;
@@ -746,49 +1072,57 @@ 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
// 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);
// 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);
var uA := TTypes.Unwrap(A);
var uB := TTypes.Unwrap(B);
var common: IStaticType := nil;
// If types are identical, return that type.
if A.IsEqual(B) then
exit(A);
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;
// No promotion possible
Result := nil;
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;
var
promotedType: IStaticType;
promotedKind: TStaticTypeKind;
begin
promotedType := Promote(Left, Right);
// Mismatch during promotion
if not Assigned(promotedType) then
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);
promotedKind := promotedType.Kind;
var promotedKind := promotedType.Kind;
case Op of
TScalar.TBinaryOp.Add, TScalar.TBinaryOp.Subtract, TScalar.TBinaryOp.Multiply:
@@ -819,17 +1153,16 @@ begin
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 Right.IsOptional then
exit(nil);
var rightKind := Right.Kind;
if rightKind = stUnknown then
exit(TTypes.Unknown);