1601 lines
47 KiB
ObjectPascal
1601 lines
47 KiB
ObjectPascal
unit Myc.Ast.Types;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Generics.Collections,
|
|
System.Generics.Defaults,
|
|
Myc.Data.Scalar,
|
|
Myc.Data.Keyword;
|
|
|
|
type
|
|
// Forward declarations
|
|
IStaticType = interface;
|
|
ITupleType = interface;
|
|
IVectorType = interface;
|
|
IMatrixType = interface;
|
|
ISeriesType = interface;
|
|
IMethodType = interface;
|
|
IRecordType = interface;
|
|
IGenericRecordType = interface;
|
|
|
|
TStaticTypeKind = (
|
|
stUnknown,
|
|
stVoid,
|
|
stOrdinal,
|
|
stFloat,
|
|
stBoolean,
|
|
stDateTime,
|
|
stText,
|
|
stKeyword,
|
|
stMethod,
|
|
stSeries,
|
|
stRecord,
|
|
stRecordSeries,
|
|
stGenericRecord,
|
|
// New N-dimensional types
|
|
stTuple,
|
|
stVector,
|
|
stMatrix
|
|
);
|
|
|
|
TStaticTypeKindHelper = record helper for TStaticTypeKind
|
|
public
|
|
function ToString: string;
|
|
end;
|
|
|
|
IMethodSignature = interface
|
|
{$region 'private'}
|
|
function GetParamTypes: TArray<IStaticType>;
|
|
function GetReturnType: IStaticType;
|
|
{$endregion}
|
|
property ParamTypes: TArray<IStaticType> read GetParamTypes;
|
|
property ReturnType: IStaticType read GetReturnType;
|
|
function GetHashCode: Integer;
|
|
end;
|
|
|
|
IScalarRecordDefinition = Myc.Data.Scalar.IScalarRecordDefinition;
|
|
|
|
// Base Interface
|
|
IStaticType = interface
|
|
{$region 'private'}
|
|
function GetKind: TStaticTypeKind;
|
|
function GetIsOptional: Boolean;
|
|
function GetIsScalarPure: Boolean;
|
|
{$endregion}
|
|
|
|
property Kind: TStaticTypeKind read GetKind;
|
|
property IsOptional: Boolean read GetIsOptional;
|
|
property IsScalarPure: Boolean read GetIsScalarPure;
|
|
|
|
function IsEqual(const Other: IStaticType): Boolean;
|
|
function IsStructurallyEqual(const Other: IStaticType): Boolean;
|
|
function ToString: string;
|
|
function GetHashCode: Integer;
|
|
|
|
// Hard casts to specialized interfaces
|
|
function AsTuple: ITupleType;
|
|
function AsVector: IVectorType;
|
|
function AsMatrix: IMatrixType;
|
|
function AsSeries: ISeriesType;
|
|
function AsMethod: IMethodType;
|
|
function AsRecord: IRecordType;
|
|
function AsGenericRecord: IGenericRecordType;
|
|
end;
|
|
|
|
// --- Specialized Interfaces ---
|
|
|
|
ITupleType = interface(IStaticType)
|
|
{$region 'private'}
|
|
function GetElements: TArray<IStaticType>;
|
|
function GetCount: Integer;
|
|
{$endregion}
|
|
property Elements: TArray<IStaticType> read GetElements;
|
|
property Count: Integer read GetCount;
|
|
end;
|
|
|
|
IVectorType = interface(IStaticType)
|
|
{$region 'private'}
|
|
function GetElementType: IStaticType;
|
|
function GetCount: Integer;
|
|
{$endregion}
|
|
property ElementType: IStaticType read GetElementType;
|
|
property Count: Integer read GetCount;
|
|
end;
|
|
|
|
IMatrixType = interface(IStaticType)
|
|
{$region 'private'}
|
|
function GetElementType: IStaticType;
|
|
function GetDimensions: TArray<Integer>;
|
|
{$endregion}
|
|
property ElementType: IStaticType read GetElementType;
|
|
property Dimensions: TArray<Integer> read GetDimensions;
|
|
end;
|
|
|
|
ISeriesType = interface(IStaticType)
|
|
{$region 'private'}
|
|
function GetElementType: IStaticType;
|
|
{$endregion}
|
|
property ElementType: IStaticType read GetElementType;
|
|
end;
|
|
|
|
IMethodType = interface(IStaticType)
|
|
{$region 'private'}
|
|
function GetSignatures: TArray<IMethodSignature>;
|
|
{$endregion}
|
|
property Signatures: TArray<IMethodSignature> read GetSignatures;
|
|
end;
|
|
|
|
IRecordType = interface(IStaticType)
|
|
{$region 'private'}
|
|
function GetDefinition: IScalarRecordDefinition;
|
|
{$endregion}
|
|
property Definition: IScalarRecordDefinition read GetDefinition;
|
|
end;
|
|
|
|
IGenericRecordDefinition = IKeywordMapping<IStaticType>;
|
|
TGenericRecordRegistry = TKeywordMappingRegistry<IStaticType>;
|
|
|
|
IGenericRecordType = interface(IStaticType)
|
|
{$region 'private'}
|
|
function GetGenericDefinition: IGenericRecordDefinition;
|
|
{$endregion}
|
|
property GenericDefinition: IGenericRecordDefinition read GetGenericDefinition;
|
|
end;
|
|
|
|
// --- Factory ---
|
|
|
|
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<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
|
|
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<IStaticType>; const AReturnType: IStaticType): IStaticType; static;
|
|
class function CreateMethodSet(const ASignatures: TArray<IMethodSignature>): 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 CreateTuple(const AElements: TArray<IStaticType>): ITupleType; static;
|
|
class function CreateVector(const AElementType: IStaticType; ACount: Integer): IVectorType; static;
|
|
class function CreateMatrix(const AElementType: IStaticType; const ADimensions: TArray<Integer>): IMatrixType; 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<IStaticType>;
|
|
FReturnType: IStaticType;
|
|
function GetParamTypes: TArray<IStaticType>;
|
|
function GetReturnType: IStaticType;
|
|
public
|
|
constructor Create(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType);
|
|
function GetHashCode: Integer; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
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';
|
|
stTuple: Result := 'Tuple';
|
|
stVector: Result := 'Vector';
|
|
stMatrix: Result := 'Matrix';
|
|
else
|
|
Result := 'ErrorType';
|
|
end;
|
|
end;
|
|
|
|
// --- Abstract Base Implementation ---
|
|
|
|
type
|
|
TAbstractStaticType = class(TInterfacedObject, IStaticType)
|
|
protected
|
|
function GetKind: TStaticTypeKind; virtual; abstract;
|
|
function GetIsOptional: Boolean; virtual;
|
|
function GetIsScalarPure: Boolean; virtual;
|
|
function IsEqual(const Other: IStaticType): Boolean; virtual;
|
|
function IsStructurallyEqual(const Other: IStaticType): Boolean; virtual;
|
|
function GetHashCode: Integer; override; abstract;
|
|
function ToString: string; override;
|
|
|
|
function AsTuple: ITupleType; virtual;
|
|
function AsVector: IVectorType; virtual;
|
|
function AsMatrix: IMatrixType; virtual;
|
|
function AsSeries: ISeriesType; virtual;
|
|
function AsMethod: IMethodType; virtual;
|
|
function AsRecord: IRecordType; virtual;
|
|
function AsGenericRecord: IGenericRecordType; virtual;
|
|
end;
|
|
|
|
function TAbstractStaticType.GetIsOptional: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TAbstractStaticType.GetIsScalarPure: Boolean;
|
|
begin
|
|
Result := False;
|
|
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;
|
|
|
|
// Cast Defaults
|
|
function TAbstractStaticType.AsTuple: ITupleType;
|
|
begin
|
|
raise EInvalidCast.Create('Type is not a Tuple.');
|
|
end;
|
|
function TAbstractStaticType.AsVector: IVectorType;
|
|
begin
|
|
raise EInvalidCast.Create('Type is not a Vector.');
|
|
end;
|
|
function TAbstractStaticType.AsMatrix: IMatrixType;
|
|
begin
|
|
raise EInvalidCast.Create('Type is not a Matrix.');
|
|
end;
|
|
function TAbstractStaticType.AsSeries: ISeriesType;
|
|
begin
|
|
raise EInvalidCast.Create('Type is not a Series.');
|
|
end;
|
|
function TAbstractStaticType.AsMethod: IMethodType;
|
|
begin
|
|
raise EInvalidCast.Create('Type is not a Method.');
|
|
end;
|
|
function TAbstractStaticType.AsRecord: IRecordType;
|
|
begin
|
|
raise EInvalidCast.Create('Type is not a Record.');
|
|
end;
|
|
function TAbstractStaticType.AsGenericRecord: IGenericRecordType;
|
|
begin
|
|
raise EInvalidCast.Create('Type is not a Generic Record.');
|
|
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 GetIsScalarPure: Boolean;
|
|
function IsStructurallyEqual(const Other: IStaticType): Boolean;
|
|
function IsEqual(const Other: IStaticType): Boolean;
|
|
function GetHashCode: Integer; override;
|
|
function ToString: string; override;
|
|
|
|
function AsTuple: ITupleType;
|
|
function AsVector: IVectorType;
|
|
function AsMatrix: IMatrixType;
|
|
function AsSeries: ISeriesType;
|
|
function AsMethod: IMethodType;
|
|
function AsRecord: IRecordType;
|
|
function AsGenericRecord: IGenericRecordType;
|
|
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.GetIsScalarPure: Boolean;
|
|
begin
|
|
Result := False;
|
|
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
|
|
h := FInner.GetHashCode;
|
|
optionalMarker := $11111111;
|
|
Result := THashBobJenkins.GetHashValue(optionalMarker, SizeOf(Integer), h);
|
|
end;
|
|
|
|
function TOptionalType.ToString: string;
|
|
begin
|
|
Result := FInner.ToString + '?';
|
|
end;
|
|
|
|
// Delegation
|
|
function TOptionalType.AsTuple: ITupleType;
|
|
begin
|
|
Result := FInner.AsTuple;
|
|
end;
|
|
function TOptionalType.AsVector: IVectorType;
|
|
begin
|
|
Result := FInner.AsVector;
|
|
end;
|
|
function TOptionalType.AsMatrix: IMatrixType;
|
|
begin
|
|
Result := FInner.AsMatrix;
|
|
end;
|
|
function TOptionalType.AsSeries: ISeriesType;
|
|
begin
|
|
Result := FInner.AsSeries;
|
|
end;
|
|
function TOptionalType.AsMethod: IMethodType;
|
|
begin
|
|
Result := FInner.AsMethod;
|
|
end;
|
|
function TOptionalType.AsRecord: IRecordType;
|
|
begin
|
|
Result := FInner.AsRecord;
|
|
end;
|
|
function TOptionalType.AsGenericRecord: IGenericRecordType;
|
|
begin
|
|
Result := FInner.AsGenericRecord;
|
|
end;
|
|
|
|
// --- Simple (Flyweight) Type Implementations ---
|
|
|
|
type
|
|
TSimpleStaticType = class(TAbstractStaticType)
|
|
private
|
|
FKind: TStaticTypeKind;
|
|
public
|
|
constructor Create(AKind: TStaticTypeKind);
|
|
function GetKind: TStaticTypeKind; override;
|
|
function GetIsScalarPure: Boolean; 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.GetIsScalarPure: Boolean;
|
|
begin
|
|
Result := FKind in [stOrdinal, stFloat, stBoolean, stDateTime, stKeyword];
|
|
end;
|
|
|
|
function TSimpleStaticType.GetHashCode: Integer;
|
|
begin
|
|
Result := THashBobJenkins.GetHashValue(FKind, SizeOf(TStaticTypeKind), 0);
|
|
end;
|
|
|
|
// --- Complex Type Implementations ---
|
|
|
|
type
|
|
TSeriesType = class(TAbstractStaticType, ISeriesType)
|
|
private
|
|
FElementType: IStaticType;
|
|
public
|
|
constructor Create(AElementType: IStaticType);
|
|
function GetKind: TStaticTypeKind; override;
|
|
function GetElementType: IStaticType;
|
|
function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
|
|
function GetHashCode: Integer; override;
|
|
function ToString: string; override;
|
|
function AsSeries: ISeriesType; 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.AsSeries: ISeriesType;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TSeriesType.IsStructurallyEqual(const Other: IStaticType): Boolean;
|
|
begin
|
|
var uOther := TTypes.Unwrap(Other);
|
|
if uOther.Kind <> stSeries then
|
|
exit(False);
|
|
Result := FElementType.IsEqual(uOther.AsSeries.ElementType);
|
|
end;
|
|
|
|
function TSeriesType.GetHashCode: Integer;
|
|
var
|
|
h: Integer;
|
|
begin
|
|
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 := inherited + '<' + FElementType.ToString + '>';
|
|
end;
|
|
|
|
// --- Tuple ---
|
|
|
|
type
|
|
TTupleType = class(TAbstractStaticType, ITupleType)
|
|
private
|
|
FElements: TArray<IStaticType>;
|
|
public
|
|
constructor Create(const AElements: TArray<IStaticType>);
|
|
function GetKind: TStaticTypeKind; override;
|
|
function GetIsScalarPure: Boolean; override;
|
|
function GetElements: TArray<IStaticType>;
|
|
function GetCount: Integer;
|
|
function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
|
|
function GetHashCode: Integer; override;
|
|
function ToString: string; override;
|
|
function AsTuple: ITupleType; override;
|
|
end;
|
|
|
|
constructor TTupleType.Create(const AElements: TArray<IStaticType>);
|
|
begin
|
|
inherited Create;
|
|
FElements := AElements;
|
|
end;
|
|
|
|
function TTupleType.GetKind: TStaticTypeKind;
|
|
begin
|
|
Result := stTuple;
|
|
end;
|
|
|
|
function TTupleType.GetIsScalarPure: Boolean;
|
|
begin
|
|
for var elem in FElements do
|
|
if not elem.IsScalarPure then
|
|
exit(False);
|
|
Result := True;
|
|
end;
|
|
|
|
function TTupleType.GetElements: TArray<IStaticType>;
|
|
begin
|
|
Result := FElements;
|
|
end;
|
|
|
|
function TTupleType.GetCount: Integer;
|
|
begin
|
|
Result := Length(FElements);
|
|
end;
|
|
|
|
function TTupleType.AsTuple: ITupleType;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TTupleType.IsStructurallyEqual(const Other: IStaticType): Boolean;
|
|
var
|
|
otherTuple: ITupleType;
|
|
i: Integer;
|
|
begin
|
|
var uOther := TTypes.Unwrap(Other);
|
|
if uOther.Kind <> stTuple then
|
|
exit(False);
|
|
otherTuple := uOther.AsTuple;
|
|
|
|
if Length(FElements) <> otherTuple.Count then
|
|
exit(False);
|
|
for i := 0 to High(FElements) do
|
|
if not FElements[i].IsEqual(otherTuple.Elements[i]) then
|
|
exit(False);
|
|
Result := True;
|
|
end;
|
|
|
|
function TTupleType.GetHashCode: Integer;
|
|
var
|
|
h, i: Integer;
|
|
begin
|
|
h := Ord(stTuple);
|
|
Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0);
|
|
for i := 0 to High(FElements) do
|
|
begin
|
|
h := FElements[i].GetHashCode;
|
|
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
|
|
end;
|
|
end;
|
|
|
|
function TTupleType.ToString: string;
|
|
var
|
|
sb: TStringBuilder;
|
|
i: Integer;
|
|
begin
|
|
sb := TStringBuilder.Create;
|
|
try
|
|
sb.Append('[');
|
|
for i := 0 to High(FElements) do
|
|
begin
|
|
sb.Append(FElements[i].ToString);
|
|
if i < High(FElements) then
|
|
sb.Append(', ');
|
|
end;
|
|
sb.Append(']');
|
|
Result := sb.ToString;
|
|
finally
|
|
sb.Free;
|
|
end;
|
|
end;
|
|
|
|
// --- Vector ---
|
|
|
|
type
|
|
TVectorType = class(TAbstractStaticType, IVectorType)
|
|
private
|
|
FElementType: IStaticType;
|
|
FCount: Integer;
|
|
public
|
|
constructor Create(const AElementType: IStaticType; ACount: Integer);
|
|
function GetKind: TStaticTypeKind; override;
|
|
function GetIsScalarPure: Boolean; override;
|
|
function GetElementType: IStaticType;
|
|
function GetCount: Integer;
|
|
function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
|
|
function GetHashCode: Integer; override;
|
|
function ToString: string; override;
|
|
function AsVector: IVectorType; override;
|
|
end;
|
|
|
|
constructor TVectorType.Create(const AElementType: IStaticType; ACount: Integer);
|
|
begin
|
|
inherited Create;
|
|
FElementType := AElementType;
|
|
FCount := ACount;
|
|
end;
|
|
|
|
function TVectorType.GetKind: TStaticTypeKind;
|
|
begin
|
|
Result := stVector;
|
|
end;
|
|
|
|
function TVectorType.GetIsScalarPure: Boolean;
|
|
begin
|
|
Result := FElementType.IsScalarPure;
|
|
end;
|
|
|
|
function TVectorType.GetElementType: IStaticType;
|
|
begin
|
|
Result := FElementType;
|
|
end;
|
|
|
|
function TVectorType.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
function TVectorType.AsVector: IVectorType;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TVectorType.IsStructurallyEqual(const Other: IStaticType): Boolean;
|
|
var
|
|
otherVec: IVectorType;
|
|
begin
|
|
var uOther := TTypes.Unwrap(Other);
|
|
if uOther.Kind <> stVector then
|
|
exit(False);
|
|
otherVec := uOther.AsVector;
|
|
Result := (FCount = otherVec.Count) and (FElementType.IsEqual(otherVec.ElementType));
|
|
end;
|
|
|
|
function TVectorType.GetHashCode: Integer;
|
|
var
|
|
h: Integer;
|
|
begin
|
|
h := Ord(stVector);
|
|
Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0);
|
|
h := FElementType.GetHashCode;
|
|
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
|
|
Result := THashBobJenkins.GetHashValue(FCount, SizeOf(Integer), Result);
|
|
end;
|
|
|
|
function TVectorType.ToString: string;
|
|
begin
|
|
Result := inherited + Format('[%s; %d]', [FElementType.ToString, FCount]);
|
|
end;
|
|
|
|
// --- Matrix ---
|
|
|
|
type
|
|
TMatrixType = class(TAbstractStaticType, IMatrixType)
|
|
private
|
|
FElementType: IStaticType;
|
|
FDimensions: TArray<Integer>;
|
|
public
|
|
constructor Create(const AElementType: IStaticType; const ADimensions: TArray<Integer>);
|
|
function GetKind: TStaticTypeKind; override;
|
|
function GetIsScalarPure: Boolean; override;
|
|
function GetElementType: IStaticType;
|
|
function GetDimensions: TArray<Integer>;
|
|
function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
|
|
function GetHashCode: Integer; override;
|
|
function ToString: string; override;
|
|
function AsMatrix: IMatrixType; override;
|
|
end;
|
|
|
|
constructor TMatrixType.Create(const AElementType: IStaticType; const ADimensions: TArray<Integer>);
|
|
begin
|
|
inherited Create;
|
|
FElementType := AElementType;
|
|
FDimensions := ADimensions;
|
|
end;
|
|
|
|
function TMatrixType.GetKind: TStaticTypeKind;
|
|
begin
|
|
Result := stMatrix;
|
|
end;
|
|
|
|
function TMatrixType.GetIsScalarPure: Boolean;
|
|
begin
|
|
Result := FElementType.IsScalarPure;
|
|
end;
|
|
|
|
function TMatrixType.GetElementType: IStaticType;
|
|
begin
|
|
Result := FElementType;
|
|
end;
|
|
|
|
function TMatrixType.GetDimensions: TArray<Integer>;
|
|
begin
|
|
Result := FDimensions;
|
|
end;
|
|
|
|
function TMatrixType.AsMatrix: IMatrixType;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMatrixType.IsStructurallyEqual(const Other: IStaticType): Boolean;
|
|
var
|
|
otherMat: IMatrixType;
|
|
i: Integer;
|
|
dims: TArray<Integer>;
|
|
begin
|
|
var uOther := TTypes.Unwrap(Other);
|
|
if uOther.Kind <> stMatrix then
|
|
exit(False);
|
|
otherMat := uOther.AsMatrix;
|
|
|
|
if not FElementType.IsEqual(otherMat.ElementType) then
|
|
exit(False);
|
|
|
|
dims := otherMat.Dimensions;
|
|
if Length(FDimensions) <> Length(dims) then
|
|
exit(False);
|
|
for i := 0 to High(FDimensions) do
|
|
if FDimensions[i] <> dims[i] then
|
|
exit(False);
|
|
Result := True;
|
|
end;
|
|
|
|
function TMatrixType.GetHashCode: Integer;
|
|
var
|
|
h, i: Integer;
|
|
begin
|
|
h := Ord(stMatrix);
|
|
Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0);
|
|
h := FElementType.GetHashCode;
|
|
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
|
|
for i := 0 to High(FDimensions) do
|
|
Result := THashBobJenkins.GetHashValue(FDimensions[i], SizeOf(Integer), Result);
|
|
end;
|
|
|
|
function TMatrixType.ToString: string;
|
|
var
|
|
sb: TStringBuilder;
|
|
i: Integer;
|
|
begin
|
|
sb := TStringBuilder.Create;
|
|
try
|
|
sb.Append('[');
|
|
sb.Append(FElementType.ToString);
|
|
sb.Append('; ');
|
|
for i := 0 to High(FDimensions) do
|
|
begin
|
|
sb.Append(FDimensions[i]);
|
|
if i < High(FDimensions) then
|
|
sb.Append('x');
|
|
end;
|
|
sb.Append(']');
|
|
Result := inherited + sb.ToString;
|
|
finally
|
|
sb.Free;
|
|
end;
|
|
end;
|
|
|
|
// --- Method Type ---
|
|
|
|
type
|
|
TMethodType = class(TAbstractStaticType, IMethodType)
|
|
private
|
|
FSignatures: TArray<IMethodSignature>;
|
|
function SignatureToString(const Sig: IMethodSignature): string;
|
|
public
|
|
constructor Create(const ASignatures: TArray<IMethodSignature>);
|
|
function GetKind: TStaticTypeKind; override;
|
|
function GetSignatures: TArray<IMethodSignature>;
|
|
function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
|
|
function GetHashCode: Integer; override;
|
|
function ToString: string; override;
|
|
function AsMethod: IMethodType; override;
|
|
end;
|
|
|
|
constructor TMethodType.Create(const ASignatures: TArray<IMethodSignature>);
|
|
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<IMethodSignature>;
|
|
begin
|
|
Result := FSignatures;
|
|
end;
|
|
|
|
function TMethodType.AsMethod: IMethodType;
|
|
begin
|
|
Result := Self;
|
|
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
|
|
otherMeth: IMethodType;
|
|
i, j: Integer;
|
|
s1, s2: IMethodSignature;
|
|
begin
|
|
var uOther := TTypes.Unwrap(Other);
|
|
if uOther.Kind <> stMethod then
|
|
exit(False);
|
|
otherMeth := uOther.AsMethod;
|
|
|
|
if Length(FSignatures) <> Length(otherMeth.Signatures) then
|
|
exit(False);
|
|
for i := 0 to High(FSignatures) do
|
|
begin
|
|
s1 := FSignatures[i];
|
|
s2 := otherMeth.Signatures[i];
|
|
if not s1.ReturnType.IsEqual(s2.ReturnType) then
|
|
exit(False);
|
|
if Length(s1.ParamTypes) <> Length(s2.ParamTypes) then
|
|
exit(False);
|
|
for j := 0 to High(s1.ParamTypes) do
|
|
if not s1.ParamTypes[j].IsEqual(s2.ParamTypes[j]) then
|
|
exit(False);
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function TMethodType.GetHashCode: Integer;
|
|
var
|
|
h: Integer;
|
|
sig: IMethodSignature;
|
|
begin
|
|
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;
|
|
|
|
// --- Record Type ---
|
|
|
|
type
|
|
TRecordType = class(TAbstractStaticType, IRecordType)
|
|
private
|
|
FKind: TStaticTypeKind;
|
|
FDefinition: IScalarRecordDefinition;
|
|
public
|
|
constructor Create(AKind: TStaticTypeKind; ADef: IScalarRecordDefinition);
|
|
function GetKind: TStaticTypeKind; override;
|
|
function GetDefinition: IScalarRecordDefinition;
|
|
function GetHashCode: Integer; override;
|
|
function AsRecord: IRecordType; override;
|
|
function IsStructurallyEqual(const Other: IStaticType): Boolean; 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.AsRecord: IRecordType;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TRecordType.IsStructurallyEqual(const Other: IStaticType): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
var uOther := TTypes.Unwrap(Other);
|
|
if uOther.Kind <> FKind then
|
|
exit(False);
|
|
var otherDef := uOther.AsRecord.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.Keywords[i] <> otherDef.Keywords[i]) or (Self.FDefinition[i] <> otherDef[i]) then
|
|
exit(False);
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function TRecordType.GetHashCode: Integer;
|
|
var
|
|
i, h: Integer;
|
|
begin
|
|
Result := THashBobJenkins.GetHashValue(FKind, SizeOf(TStaticTypeKind), 0);
|
|
if Assigned(FDefinition) then
|
|
begin
|
|
for i := 0 to FDefinition.Count - 1 do
|
|
begin
|
|
h := FDefinition.Keywords[i].Idx;
|
|
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
|
|
h := Ord(FDefinition[i]);
|
|
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRecordType.ToString: string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := GetKind.ToString + '{';
|
|
if Assigned(FDefinition) then
|
|
begin
|
|
for i := 0 to FDefinition.Count - 1 do
|
|
begin
|
|
Result := Result + FDefinition.Keywords[i].Name + ': ' + FDefinition[i].ToString;
|
|
if i < FDefinition.Count - 1 then
|
|
Result := Result + ', ';
|
|
end;
|
|
end;
|
|
Result := Result + '}';
|
|
end;
|
|
|
|
// --- Generic Record Type ---
|
|
|
|
type
|
|
TGenericRecordType = class(TAbstractStaticType, IGenericRecordType)
|
|
private
|
|
FDefinition: IGenericRecordDefinition;
|
|
public
|
|
constructor Create(const ADef: IGenericRecordDefinition);
|
|
function GetKind: TStaticTypeKind; override;
|
|
function GetGenericDefinition: IGenericRecordDefinition;
|
|
function GetHashCode: Integer; override;
|
|
function AsGenericRecord: IGenericRecordType; override;
|
|
function IsStructurallyEqual(const Other: IStaticType): Boolean; 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.AsGenericRecord: IGenericRecordType;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
function TGenericRecordType.IsStructurallyEqual(const Other: IStaticType): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
var uOther := TTypes.Unwrap(Other);
|
|
if uOther.Kind <> stGenericRecord then
|
|
exit(False);
|
|
var otherDef := uOther.AsGenericRecord.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.Keywords[i] <> otherDef.Keywords[i]) or (not Self.FDefinition[i].IsEqual(otherDef[i])) then
|
|
exit(False);
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function TGenericRecordType.GetHashCode: Integer;
|
|
var
|
|
i, h: Integer;
|
|
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
|
|
h := FDefinition.Keywords[i].Idx;
|
|
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
|
|
var val := FDefinition[i];
|
|
if Assigned(val) then
|
|
begin
|
|
h := val.GetHashCode;
|
|
Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TGenericRecordType.ToString: string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := GetKind.ToString + '{';
|
|
if Assigned(FDefinition) then
|
|
begin
|
|
for i := 0 to FDefinition.Count - 1 do
|
|
begin
|
|
Result := Result + FDefinition.Keywords[i].Name + ': ' + FDefinition[i].ToString;
|
|
if i < FDefinition.Count - 1 then
|
|
Result := Result + ', ';
|
|
end;
|
|
end;
|
|
Result := Result + '}';
|
|
end;
|
|
|
|
// --- 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;
|
|
|
|
{ TMethodSignature }
|
|
|
|
constructor TMethodSignature.Create(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType);
|
|
begin
|
|
inherited Create;
|
|
FParamTypes := AParamTypes;
|
|
FReturnType := AReturnType;
|
|
end;
|
|
|
|
function TMethodSignature.GetParamTypes: TArray<IStaticType>;
|
|
begin
|
|
Result := FParamTypes;
|
|
end;
|
|
|
|
function TMethodSignature.GetReturnType: IStaticType;
|
|
begin
|
|
Result := FReturnType;
|
|
end;
|
|
|
|
function TMethodSignature.GetHashCode: Integer;
|
|
var
|
|
i, h: Integer;
|
|
begin
|
|
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;
|
|
|
|
{ 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);
|
|
|
|
FOrdinalOpt := TOptionalType.Create(FOrdinal);
|
|
FFloatOpt := TOptionalType.Create(FFloat);
|
|
FBooleanOpt := TOptionalType.Create(FBoolean);
|
|
FDateTimeOpt := TOptionalType.Create(FDateTime);
|
|
FTextOpt := TOptionalType.Create(FText);
|
|
FKeywordOpt := TOptionalType.Create(FKeyword);
|
|
|
|
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 not FSeriesCache.TryGetValue(AElementType, Result) then
|
|
begin
|
|
Result := TSeriesType.Create(AElementType);
|
|
FSeriesCache.Add(AElementType, Result);
|
|
end;
|
|
finally
|
|
TMonitor.Exit(FSeriesCache);
|
|
end;
|
|
end;
|
|
|
|
class function TTypes.CreateRecord(const ADef: IScalarRecordDefinition): IStaticType;
|
|
begin
|
|
TMonitor.Enter(FRecordCache);
|
|
try
|
|
if not FRecordCache.TryGetValue(ADef, Result) then
|
|
begin
|
|
Result := TRecordType.Create(stRecord, ADef);
|
|
FRecordCache.Add(ADef, Result);
|
|
end;
|
|
finally
|
|
TMonitor.Exit(FRecordCache);
|
|
end;
|
|
end;
|
|
|
|
class function TTypes.CreateRecordSeries(const ADef: IScalarRecordDefinition): IStaticType;
|
|
begin
|
|
TMonitor.Enter(FRecordSeriesCache);
|
|
try
|
|
if not FRecordSeriesCache.TryGetValue(ADef, Result) then
|
|
begin
|
|
Result := TRecordType.Create(stRecordSeries, ADef);
|
|
FRecordSeriesCache.Add(ADef, Result);
|
|
end;
|
|
finally
|
|
TMonitor.Exit(FRecordSeriesCache);
|
|
end;
|
|
end;
|
|
|
|
class function TTypes.CreateGenericRecord(const ADef: IGenericRecordDefinition): IStaticType;
|
|
begin
|
|
TMonitor.Enter(FGenericRecordCache);
|
|
try
|
|
if not FGenericRecordCache.TryGetValue(ADef, Result) then
|
|
begin
|
|
Result := TGenericRecordType.Create(ADef);
|
|
FGenericRecordCache.Add(ADef, Result);
|
|
end;
|
|
finally
|
|
TMonitor.Exit(FGenericRecordCache);
|
|
end;
|
|
end;
|
|
|
|
class function TTypes.CreateMethod(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType): IStaticType;
|
|
begin
|
|
Result := CreateMethodSet([TMethodSignature.Create(AParamTypes, AReturnType)]);
|
|
end;
|
|
|
|
class function TTypes.CreateMethodSet(const ASignatures: TArray<IMethodSignature>): IStaticType;
|
|
begin
|
|
if Length(ASignatures) = 0 then
|
|
exit(FUnknown);
|
|
|
|
TMonitor.Enter(FMethodCache);
|
|
try
|
|
if not FMethodCache.TryGetValue(ASignatures, Result) then
|
|
begin
|
|
Result := TMethodType.Create(ASignatures);
|
|
FMethodCache.Add(ASignatures, Result);
|
|
end;
|
|
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 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(FDateTime) then
|
|
exit(FDateTimeOpt);
|
|
if Pointer(AType) = Pointer(FText) then
|
|
exit(FTextOpt);
|
|
if Pointer(AType) = Pointer(FKeyword) then
|
|
exit(FKeywordOpt);
|
|
|
|
TMonitor.Enter(FOptionalCache);
|
|
try
|
|
if not FOptionalCache.TryGetValue(AType, Result) then
|
|
begin
|
|
Result := TOptionalType.Create(AType);
|
|
FOptionalCache.Add(AType, Result);
|
|
end;
|
|
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;
|
|
|
|
// --- New Factories ---
|
|
|
|
class function TTypes.CreateTuple(const AElements: TArray<IStaticType>): ITupleType;
|
|
begin
|
|
Result := TTupleType.Create(AElements);
|
|
end;
|
|
|
|
class function TTypes.CreateVector(const AElementType: IStaticType; ACount: Integer): IVectorType;
|
|
begin
|
|
Result := TVectorType.Create(AElementType, ACount);
|
|
end;
|
|
|
|
class function TTypes.CreateMatrix(const AElementType: IStaticType; const ADimensions: TArray<Integer>): IMatrixType;
|
|
begin
|
|
Result := TMatrixType.Create(AElementType, ADimensions);
|
|
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 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);
|
|
|
|
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.
|