Indicator with new types
This commit is contained in:
+89
-14
@@ -8,7 +8,7 @@ uses
|
||||
System.RTTI;
|
||||
|
||||
type
|
||||
TDataKind = (dkOrdinal, dkFloat, dkText, dkTimestamp, dkRecord, dkTuple, dkArray, dkEnum);
|
||||
TDataKind = (dkOrdinal, dkFloat, dkText, dkTimestamp, dkRecord, dkTuple, dkArray, dkEnum, dkMethod);
|
||||
|
||||
IDataType = interface
|
||||
function GetName: String;
|
||||
@@ -76,6 +76,28 @@ type
|
||||
property Identifiers[Idx: Integer]: string read GetIdentifier; default;
|
||||
end;
|
||||
|
||||
// A method that transforms one data value into another.
|
||||
TMethodProc = reference to function(const AValue: IDataValue): IDataValue;
|
||||
|
||||
// Represents an executable method data value.
|
||||
IDataMethodValue = interface(IDataValue)
|
||||
{$region 'private'}
|
||||
function GetValue: TMethodProc;
|
||||
{$endregion}
|
||||
property Value: TMethodProc read GetValue;
|
||||
end;
|
||||
|
||||
// Represents the type of a method data value, including its signature.
|
||||
IDataMethodType = interface(IDataType)
|
||||
{$region 'private'}
|
||||
function GetArgType: IDataType;
|
||||
function GetResultType: IDataType;
|
||||
{$endregion}
|
||||
property ArgType: IDataType read GetArgType;
|
||||
property ResultType: IDataType read GetResultType;
|
||||
function CreateValue(const AValue: TMethodProc): IDataMethodValue;
|
||||
end;
|
||||
|
||||
IDataRecordValue = interface(IDataValue)
|
||||
function GetItem(Idx: Integer): IDataValue;
|
||||
property Items[Idx: Integer]: IDataValue read GetItem; default;
|
||||
@@ -125,18 +147,15 @@ type
|
||||
FDataType: IDataType;
|
||||
function GetName: String; inline;
|
||||
function GetKind: TDataKind; inline;
|
||||
|
||||
class var
|
||||
FArrayTypeRegistry: TDictionary<IDataType, IDataArrayType>;
|
||||
class var
|
||||
FRecordTypeRegistry: TDictionary<TArray<TRecordField>, IDataRecordType>;
|
||||
FMethodTypeRegistry: TDictionary<TPair<IDataType, IDataType>, IDataMethodType>;
|
||||
class constructor CreateClass;
|
||||
class destructor DestroyClass;
|
||||
public
|
||||
constructor Create(const ADataType: IDataType);
|
||||
|
||||
class procedure ClearRegistries; static;
|
||||
|
||||
class operator Implicit(const A: IDataType): TDataType; overload;
|
||||
class operator Implicit(const A: TDataType): IDataType; overload;
|
||||
|
||||
@@ -146,7 +165,8 @@ type
|
||||
class function Text: IDataTextType; static;
|
||||
class function Timestamp: IDataTimestampType; static;
|
||||
class function Tuple: IDataTupleType; static;
|
||||
class function ArrayOfType(const AElementType: IDataType): IDataArrayType; static;
|
||||
class function MethodOf(const AArgType, AResultType: IDataType): IDataMethodType; static;
|
||||
class function ArrayOf(const AElementType: IDataType): IDataArrayType; static;
|
||||
class function RecordOf(const Fields: TArray<TRecordField>): IDataRecordType; overload; static;
|
||||
class function RecordOf(const Fields: array of TRecordField): IDataRecordType; overload; static;
|
||||
class function EnumOf(const AName: string; const AIdentifiers: array of string): IDataEnumType; static;
|
||||
@@ -160,6 +180,7 @@ type
|
||||
function AsTuple: IDataTupleType;
|
||||
function AsArray: IDataArrayType;
|
||||
function AsEnum: IDataEnumType;
|
||||
function AsMethod: IDataMethodType;
|
||||
|
||||
property DataType: IDataType read FDataType;
|
||||
property Name: String read GetName;
|
||||
@@ -182,6 +203,7 @@ type
|
||||
function AsTuple: IDataTupleValue;
|
||||
function AsArray: IDataArrayValue;
|
||||
function AsEnum: IDataEnumValue;
|
||||
function AsMethod: IDataMethodValue;
|
||||
|
||||
class operator Implicit(const A: IDataValue): TDataValue; overload;
|
||||
class operator Implicit(const A: TDataValue): IDataValue; overload;
|
||||
@@ -192,6 +214,7 @@ type
|
||||
class function FromText(const AValue: string): IDataTextValue; static;
|
||||
class function FromTimestamp(const AValue: TDateTime): IDataTimestampValue; static;
|
||||
class function FromTuple(const AItems: array of IDataValue): IDataTupleValue; static;
|
||||
class function FromMethod(const AMethodType: IDataMethodType; const AValue: TMethodProc): IDataMethodValue; static;
|
||||
|
||||
property DataValue: IDataValue read FDataValue;
|
||||
property DataType: IDataType read GetDataType;
|
||||
@@ -209,7 +232,8 @@ uses
|
||||
Myc.Data.Types.Arrays,
|
||||
Myc.Data.Types.Records,
|
||||
Myc.Data.Types.Tuple,
|
||||
Myc.Data.Types.Enum;
|
||||
Myc.Data.Types.Enum,
|
||||
Myc.Data.Types.Method;
|
||||
|
||||
{ TRecordField }
|
||||
|
||||
@@ -230,15 +254,34 @@ class constructor TDataType.CreateClass;
|
||||
begin
|
||||
FArrayTypeRegistry := TDictionary<IDataType, IDataArrayType>.Create;
|
||||
FRecordTypeRegistry := TDictionary<TArray<TRecordField>, IDataRecordType>.Create(TRecordFieldComparer.Create);
|
||||
FMethodTypeRegistry :=
|
||||
TDictionary<TPair<IDataType, IDataType>, IDataMethodType>.Create(
|
||||
TEqualityComparer<TPair<IDataType, IDataType>>.Construct(
|
||||
function(const Left, Right: TPair<IDataType, IDataType>): Boolean
|
||||
begin
|
||||
Result := (Left.Key = Right.Key) and (Left.Value = Right.Value);
|
||||
end,
|
||||
function(const Value: TPair<IDataType, IDataType>): Integer
|
||||
var
|
||||
hash1, hash2: NativeInt;
|
||||
begin
|
||||
hash1 := NativeInt(Value.Key);
|
||||
hash2 := NativeInt(Value.Value);
|
||||
// Simple XOR combination for pointer hashes
|
||||
Result := Integer(hash1 xor hash2);
|
||||
end
|
||||
)
|
||||
);
|
||||
end;
|
||||
|
||||
class destructor TDataType.DestroyClass;
|
||||
begin
|
||||
FArrayTypeRegistry.Free;
|
||||
FRecordTypeRegistry.Free;
|
||||
FMethodTypeRegistry.Free;
|
||||
end;
|
||||
|
||||
class function TDataType.ArrayOfType(const AElementType: IDataType): IDataArrayType;
|
||||
class function TDataType.ArrayOf(const AElementType: IDataType): IDataArrayType;
|
||||
begin
|
||||
if not Assigned(AElementType) then
|
||||
raise EArgumentException.Create('Cannot create an array type with a nil element type.');
|
||||
@@ -277,6 +320,13 @@ begin
|
||||
Result := IDataFloatType(FDataType);
|
||||
end;
|
||||
|
||||
function TDataType.AsMethod: IDataMethodType;
|
||||
begin
|
||||
if (FDataType.Kind <> dkMethod) then
|
||||
raise EInvalidCast.Create('Method expected');
|
||||
Result := IDataMethodType(FDataType);
|
||||
end;
|
||||
|
||||
function TDataType.AsOrdinal: IDataOrdinalType;
|
||||
begin
|
||||
if (FDataType.Kind <> dkOrdinal) then
|
||||
@@ -312,12 +362,6 @@ begin
|
||||
Result := IDataTupleType(FDataType);
|
||||
end;
|
||||
|
||||
class procedure TDataType.ClearRegistries;
|
||||
begin
|
||||
FArrayTypeRegistry.Clear;
|
||||
FRecordTypeRegistry.Clear;
|
||||
end;
|
||||
|
||||
class function TDataType.Float: IDataFloatType;
|
||||
begin
|
||||
Result := TDataFloatType.Singleton;
|
||||
@@ -331,6 +375,23 @@ begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
class function TDataType.MethodOf(const AArgType, AResultType: IDataType): IDataMethodType;
|
||||
var
|
||||
key: TPair<IDataType, IDataType>;
|
||||
begin
|
||||
key := TPair<IDataType, IDataType>.Create(AArgType, AResultType);
|
||||
TMonitor.Enter(FMethodTypeRegistry);
|
||||
try
|
||||
if not FMethodTypeRegistry.TryGetValue(key, Result) then
|
||||
begin
|
||||
Result := TDataMethodType.Create(AArgType, AResultType);
|
||||
FMethodTypeRegistry.Add(key, Result);
|
||||
end;
|
||||
finally
|
||||
TMonitor.Exit(FMethodTypeRegistry);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDataType.Ordinal: IDataOrdinalType;
|
||||
begin
|
||||
Result := TDataOrdinalType.Singleton;
|
||||
@@ -417,6 +478,13 @@ begin
|
||||
Result := IDataFloatValue(FDataValue);
|
||||
end;
|
||||
|
||||
function TDataValue.AsMethod: IDataMethodValue;
|
||||
begin
|
||||
if FDataValue.DataType.Kind <> dkMethod then
|
||||
raise EInvalidCast.Create('Method expected');
|
||||
Result := IDataMethodValue(FDataValue);
|
||||
end;
|
||||
|
||||
function TDataValue.AsText: IDataTextValue;
|
||||
begin
|
||||
if FDataValue.DataType.Kind <> dkText then
|
||||
@@ -469,6 +537,13 @@ begin
|
||||
Result := TDataFloatType.Singleton.CreateValue(AValue);
|
||||
end;
|
||||
|
||||
class function TDataValue.FromMethod(const AMethodType: IDataMethodType; const AValue: TMethodProc): IDataMethodValue;
|
||||
begin
|
||||
if not Assigned(AMethodType) then
|
||||
raise EArgumentException.Create('AMethodType');
|
||||
Result := AMethodType.CreateValue(AValue);
|
||||
end;
|
||||
|
||||
class function TDataValue.FromText(const AValue: string): IDataTextValue;
|
||||
begin
|
||||
Result := TDataTextType.Singleton.CreateValue(AValue);
|
||||
|
||||
Reference in New Issue
Block a user