Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Type System

Browse Source
This commit is contained in:
Michael Schimmel
2025-08-26 11:06:35 +02:00
parent e4681e2bf7
commit 5adbe67d0b
15 changed files with 1426 additions and 612 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Data/Myc.Data.Types.Arrays.pas
+35 -35
View File
@@ -9,7 +9,7 @@ uses
type
// Implements the array data type.
TDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType)
TImplDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType)
private
FElementType: IDataType;
FEmptyValue: IDataArrayValue; // Cached empty array value for this type
@@ -29,7 +29,7 @@ uses
type
// Implements the array data value.
TDataArrayValue = class(TInterfacedObject, IDataValue, IDataArrayValue)
TImplDataArrayValue = class(TInterfacedObject, IDataValue, IDataArrayValue)
private
FArrayType: IDataArrayType;
FItems: TArray<IDataValue>;
@@ -43,7 +43,7 @@ type
end;
// Optimized implementation for an array with 0 elements.
TDataArrayValue0 = class(TInterfacedObject, IDataValue, IDataArrayValue)
TImplDataArrayValue0 = class(TInterfacedObject, IDataValue, IDataArrayValue)
strict private
class var
FEmptyTValue: TValue; // Singleton TValue for an empty array
@@ -60,7 +60,7 @@ type
end;
// Optimized implementation for an array with 1 element.
TDataArrayValue1 = class(TInterfacedObject, IDataValue, IDataArrayValue)
TImplDataArrayValue1 = class(TInterfacedObject, IDataValue, IDataArrayValue)
private
FArrayType: IDataArrayType;
FItem0: IDataValue;
@@ -73,9 +73,9 @@ type
constructor Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
end;
{ TDataArrayValue (generic implementation for N > 1 elements) }
{ TImplDataArrayValue (generic implementation for N > 1 elements) }
constructor TDataArrayValue.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
constructor TImplDataArrayValue.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
var
i: Integer;
begin
@@ -86,12 +86,12 @@ begin
FItems[i] := AItems[i];
end;
function TDataArrayValue.GetDataType: IDataType;
function TImplDataArrayValue.GetDataType: IDataType;
begin
Result := FArrayType;
end;
function TDataArrayValue.GetAsString: string;
function TImplDataArrayValue.GetAsString: string;
var
sb: TStringBuilder;
i: Integer;
@@ -112,7 +112,7 @@ begin
end;
end;
function TDataArrayValue.AsTValue: TValue;
function TImplDataArrayValue.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
i: Integer;
@@ -123,70 +123,70 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataArrayValue.GetElementCount: Integer;
function TImplDataArrayValue.GetElementCount: Integer;
begin
Result := Length(FItems);
end;
function TDataArrayValue.GetItem(Idx: Integer): IDataValue;
function TImplDataArrayValue.GetItem(Idx: Integer): IDataValue;
begin
Result := FItems[Idx];
end;
{ TDataArrayValue0 }
{ TImplDataArrayValue0 }
class constructor TDataArrayValue0.CreateClass;
class constructor TImplDataArrayValue0.CreateClass;
begin
// Create a singleton TValue representing an empty dynamic array.
FEmptyTValue := TValue.From<TArray<TValue>>([]);
end;
constructor TDataArrayValue0.Create(const AArrayType: IDataArrayType);
constructor TImplDataArrayValue0.Create(const AArrayType: IDataArrayType);
begin
inherited Create;
FArrayType := AArrayType;
end;
function TDataArrayValue0.GetAsString: string;
function TImplDataArrayValue0.GetAsString: string;
begin
Result := '[]';
end;
function TDataArrayValue0.AsTValue: TValue;
function TImplDataArrayValue0.AsTValue: TValue;
begin
Result := FEmptyTValue;
end;
function TDataArrayValue0.GetDataType: IDataType;
function TImplDataArrayValue0.GetDataType: IDataType;
begin
Result := FArrayType;
end;
function TDataArrayValue0.GetElementCount: Integer;
function TImplDataArrayValue0.GetElementCount: Integer;
begin
Result := 0;
end;
function TDataArrayValue0.GetItem(Idx: Integer): IDataValue;
function TImplDataArrayValue0.GetItem(Idx: Integer): IDataValue;
begin
raise EArgumentException.Create('Index out of bounds');
end;
{ TDataArrayValue1 }
{ TImplDataArrayValue1 }
constructor TDataArrayValue1.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
constructor TImplDataArrayValue1.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
begin
inherited Create;
FArrayType := AArrayType;
FItem0 := AItems[0];
end;
function TDataArrayValue1.GetAsString: string;
function TImplDataArrayValue1.GetAsString: string;
begin
Result := '[' + FItem0.AsString + ']';
end;
function TDataArrayValue1.AsTValue: TValue;
function TImplDataArrayValue1.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
@@ -195,17 +195,17 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataArrayValue1.GetDataType: IDataType;
function TImplDataArrayValue1.GetDataType: IDataType;
begin
Result := FArrayType;
end;
function TDataArrayValue1.GetElementCount: Integer;
function TImplDataArrayValue1.GetElementCount: Integer;
begin
Result := 1;
end;
function TDataArrayValue1.GetItem(Idx: Integer): IDataValue;
function TImplDataArrayValue1.GetItem(Idx: Integer): IDataValue;
begin
case Idx of
0: Result := FItem0;
@@ -214,16 +214,16 @@ begin
end;
end;
{ TDataArrayType }
{ TImplDataArrayType }
constructor TDataArrayType.Create(const AElementType: IDataType);
constructor TImplDataArrayType.Create(const AElementType: IDataType);
begin
inherited Create;
FElementType := AElementType;
FEmptyValue := TDataArrayValue0.Create(Self);
FEmptyValue := TImplDataArrayValue0.Create(Self);
end;
function TDataArrayType.CreateValue(const AItems: array of IDataValue): IDataArrayValue;
function TImplDataArrayType.CreateValue(const AItems: array of IDataValue): IDataArrayValue;
var
item: IDataValue;
i: Integer;
@@ -242,24 +242,24 @@ begin
// Use optimized implementations for arrays with 0 or 1 elements.
case Length(AItems) of
0: Result := FEmptyValue;
1: Result := TDataArrayValue1.Create(Self, AItems);
1: Result := TImplDataArrayValue1.Create(Self, AItems);
else
// Use the generic implementation for arrays with more than 1 element.
Result := TDataArrayValue.Create(Self, AItems);
Result := TImplDataArrayValue.Create(Self, AItems);
end;
end;
function TDataArrayType.GetElementType: IDataType;
function TImplDataArrayType.GetElementType: IDataType;
begin
Result := FElementType;
end;
function TDataArrayType.GetName: String;
function TImplDataArrayType.GetName: String;
begin
Result := Format('Array<%s>', [FElementType.Name]);
end;
function TDataArrayType.GetKind: TDataKind;
function TImplDataArrayType.GetKind: TDataKind;
begin
Result := dkArray;
end;
Src/Data/Myc.Data.Types.Enum.pas
+19 -19
View File
@@ -8,7 +8,7 @@ uses
Myc.Data.Types;
type
TDataEnumType = class(TInterfacedObject, IDataEnumType)
TImplDataEnumType = class(TInterfacedObject, IDataEnumType)
private
FName: string;
FIdentifiers: TArray<string>;
@@ -31,7 +31,7 @@ uses
System.Rtti;
type
TDataEnumValue = class(TInterfacedObject, IDataEnumValue)
TImplDataEnumValue = class(TInterfacedObject, IDataEnumValue)
private
FDataType: IDataEnumType;
FValue: Integer;
@@ -43,9 +43,9 @@ type
constructor Create(const ADataType: IDataEnumType; const AValue: Integer);
end;
{ TDataEnumType }
{ TImplDataEnumType }
constructor TDataEnumType.Create(const AName: string; const AIdentifiers: array of string);
constructor TImplDataEnumType.Create(const AName: string; const AIdentifiers: array of string);
var
i: Integer;
begin
@@ -62,46 +62,46 @@ begin
end;
end;
destructor TDataEnumType.Destroy;
destructor TImplDataEnumType.Destroy;
begin
FIdentifierMap.Free;
inherited;
end;
function TDataEnumType.GetName: String;
function TImplDataEnumType.GetName: String;
begin
Result := FName;
end;
function TDataEnumType.GetKind: TDataKind;
function TImplDataEnumType.GetKind: TDataKind;
begin
Result := dkEnum;
end;
function TDataEnumType.GetIdentifier(Idx: Integer): string;
function TImplDataEnumType.GetIdentifier(Idx: Integer): string;
begin
Result := FIdentifiers[Idx];
end;
function TDataEnumType.GetIdentifierCount: Integer;
function TImplDataEnumType.GetIdentifierCount: Integer;
begin
Result := Length(FIdentifiers);
end;
function TDataEnumType.IndexOf(const AIdentifier: string): Integer;
function TImplDataEnumType.IndexOf(const AIdentifier: string): Integer;
begin
if not FIdentifierMap.TryGetValue(AIdentifier, Result) then
Result := -1;
end;
function TDataEnumType.CreateValue(const AValue: Integer): IDataEnumValue;
function TImplDataEnumType.CreateValue(const AValue: Integer): IDataEnumValue;
begin
if (AValue < 0) or (AValue >= Length(FIdentifiers)) then
raise EArgumentException.Create('Invalid enum value');
Result := TDataEnumValue.Create(Self, AValue);
Result := TImplDataEnumValue.Create(Self, AValue);
end;
function TDataEnumType.CreateValue(const AIdentifier: string): IDataEnumValue;
function TImplDataEnumType.CreateValue(const AIdentifier: string): IDataEnumValue;
var
idx: Integer;
begin
@@ -111,30 +111,30 @@ begin
Result := CreateValue(idx);
end;
{ TDataEnumValue }
{ TImplDataEnumValue }
constructor TDataEnumValue.Create(const ADataType: IDataEnumType; const AValue: Integer);
constructor TImplDataEnumValue.Create(const ADataType: IDataEnumType; const AValue: Integer);
begin
FDataType := ADataType;
FValue := AValue;
end;
function TDataEnumValue.GetDataType: IDataType;
function TImplDataEnumValue.GetDataType: IDataType;
begin
Result := FDataType;
end;
function TDataEnumValue.GetAsString: string;
function TImplDataEnumValue.GetAsString: string;
begin
Result := FDataType.Identifiers[FValue];
end;
function TDataEnumValue.GetValue: Integer;
function TImplDataEnumValue.GetValue: Integer;
begin
Result := FValue;
end;
function TDataEnumValue.AsTValue: TValue;
function TImplDataEnumValue.AsTValue: TValue;
begin
Result := TValue.From<Integer>(FValue);
end;
Src/Data/Myc.Data.Types.Float.pas
+34 -34
View File
@@ -8,7 +8,7 @@ uses
type
// Implements the float data type.
TDataFloatType = class(TInterfacedObject, IDataType, IDataFloatType)
TImplDataFloatType = class(TInterfacedObject, IDataType, IDataFloatType)
strict private
class var
FSingleton: IDataFloatType;
@@ -30,7 +30,7 @@ uses
type
// Implements the float data value.
TDataFloatValue = class(TInterfacedObject, IDataValue, IDataFloatValue)
TImplDataFloatValue = class(TInterfacedObject, IDataValue, IDataFloatValue)
private
FValue: Double;
public
@@ -46,7 +46,7 @@ type
end;
// Special implementation for the value 0.0 (Singleton)
TDataFloatValueZero = class(TInterfacedObject, IDataValue, IDataFloatValue)
TImplDataFloatValueZero = class(TInterfacedObject, IDataValue, IDataFloatValue)
strict private
class var
FValue: TValue;
@@ -59,7 +59,7 @@ type
end;
// Special implementation for NaN (Not a Number) (Singleton)
TDataFloatValueNaN = class(TInterfacedObject, IDataValue, IDataFloatValue)
TImplDataFloatValueNaN = class(TInterfacedObject, IDataValue, IDataFloatValue)
strict private
class var
FValue: TValue;
@@ -71,108 +71,108 @@ type
function AsTValue: TValue;
end;
{ TDataFloatValue }
{ TImplDataFloatValue }
constructor TDataFloatValue.Create(const AValue: Double);
constructor TImplDataFloatValue.Create(const AValue: Double);
begin
inherited Create;
FValue := AValue;
end;
function TDataFloatValue.GetDataType: IDataType;
function TImplDataFloatValue.GetDataType: IDataType;
begin
Result := TDataFloatType.Singleton;
Result := TImplDataFloatType.Singleton;
end;
function TDataFloatValue.GetAsString: string;
function TImplDataFloatValue.GetAsString: string;
begin
Result := FloatToStr(FValue);
end;
function TDataFloatValue.AsTValue: TValue;
function TImplDataFloatValue.AsTValue: TValue;
begin
Result := TValue.From<Double>(FValue);
end;
function TDataFloatValue.GetValue: Double;
function TImplDataFloatValue.GetValue: Double;
begin
Result := FValue;
end;
{ TDataFloatValueZero }
{ TImplDataFloatValueZero }
class constructor TDataFloatValueZero.CreateClass;
class constructor TImplDataFloatValueZero.CreateClass;
begin
FValue := TValue.From<Double>(0.0);
end;
function TDataFloatValueZero.GetAsString: string;
function TImplDataFloatValueZero.GetAsString: string;
begin
Result := '0';
end;
function TDataFloatValueZero.GetDataType: IDataType;
function TImplDataFloatValueZero.GetDataType: IDataType;
begin
Result := TDataFloatType.Singleton;
Result := TImplDataFloatType.Singleton;
end;
function TDataFloatValueZero.GetValue: Double;
function TImplDataFloatValueZero.GetValue: Double;
begin
Result := 0.0;
end;
function TDataFloatValueZero.AsTValue: TValue;
function TImplDataFloatValueZero.AsTValue: TValue;
begin
Result := FValue;
end;
{ TDataFloatValueNaN }
{ TImplDataFloatValueNaN }
class constructor TDataFloatValueNaN.CreateClass;
class constructor TImplDataFloatValueNaN.CreateClass;
begin
FValue := TValue.From<Double>(NaN);
end;
function TDataFloatValueNaN.GetAsString: string;
function TImplDataFloatValueNaN.GetAsString: string;
begin
Result := 'NaN';
end;
function TDataFloatValueNaN.GetDataType: IDataType;
function TImplDataFloatValueNaN.GetDataType: IDataType;
begin
Result := TDataFloatType.Singleton;
Result := TImplDataFloatType.Singleton;
end;
function TDataFloatValueNaN.GetValue: Double;
function TImplDataFloatValueNaN.GetValue: Double;
begin
Result := NaN;
end;
function TDataFloatValueNaN.AsTValue: TValue;
function TImplDataFloatValueNaN.AsTValue: TValue;
begin
Result := FValue;
end;
{ TDataFloatType }
{ TImplDataFloatType }
class constructor TDataFloatType.CreateClass;
class constructor TImplDataFloatType.CreateClass;
begin
FSingleton := TDataFloatType.Create;
FZero := TDataFloatValueZero.Create;
FNaN := TDataFloatValueNaN.Create;
FSingleton := TImplDataFloatType.Create;
FZero := TImplDataFloatValueZero.Create;
FNaN := TImplDataFloatValueNaN.Create;
end;
function TDataFloatType.GetName: String;
function TImplDataFloatType.GetName: String;
begin
Result := 'Float';
end;
function TDataFloatType.GetKind: TDataKind;
function TImplDataFloatType.GetKind: TDataKind;
begin
Result := dkFloat;
end;
function TDataFloatType.CreateValue(Init: Double): IDataFloatValue;
function TImplDataFloatType.CreateValue(Init: Double): IDataFloatValue;
begin
// Return singleton instances for 0.0 and NaN to avoid unnecessary allocations.
if (Init = 0.0) then
@@ -180,7 +180,7 @@ begin
else if IsNaN(Init) then
Result := FNaN
else
Result := TDataFloatValue.Create(Init);
Result := TImplDataFloatValue.Create(Init);
end;
end.
Src/Data/Myc.Data.Types.Method.pas
+21 -21
View File
@@ -9,7 +9,7 @@ uses
type
// Implements the IDataMethodType interface.
TDataMethodType = class(TInterfacedObject, IDataMethodType)
TImplDataMethodType = class(TInterfacedObject, IDataMethodType)
private
FArgType: IDataType;
FResultType: IDataType;
@@ -17,7 +17,7 @@ type
function GetKind: TDataKind;
function GetArgType: IDataType;
function GetResultType: IDataType;
function CreateValue(const AValue: TMethodProc): IDataMethodValue;
function CreateValue(const AValue: TDataMethodProc): IDataMethodValue;
public
constructor Create(const AArgType, AResultType: IDataType);
end;
@@ -29,51 +29,51 @@ uses
type
// Implements the IDataMethodValue interface.
TDataMethodValue = class(TInterfacedObject, IDataMethodValue)
TImplDataMethodValue = class(TInterfacedObject, IDataMethodValue)
private
FDataType: IDataMethodType;
FValue: TMethodProc;
FValue: TDataMethodProc;
function GetDataType: IDataType;
function GetAsString: string;
function AsTValue: TValue;
function GetValue: TMethodProc;
function GetValue: TDataMethodProc;
public
constructor Create(const ADataType: IDataMethodType; const AValue: TMethodProc);
constructor Create(const ADataType: IDataMethodType; const AValue: TDataMethodProc);
end;
{ TDataMethodType }
{ TImplDataMethodType }
constructor TDataMethodType.Create(const AArgType, AResultType: IDataType);
constructor TImplDataMethodType.Create(const AArgType, AResultType: IDataType);
begin
inherited Create;
FArgType := AArgType;
FResultType := AResultType;
end;
function TDataMethodType.CreateValue(const AValue: TMethodProc): IDataMethodValue;
function TImplDataMethodType.CreateValue(const AValue: TDataMethodProc): IDataMethodValue;
begin
if not Assigned(AValue) then
raise EArgumentException.Create('AValue');
Result := TDataMethodValue.Create(Self, AValue);
Result := TImplDataMethodValue.Create(Self, AValue);
end;
function TDataMethodType.GetArgType: IDataType;
function TImplDataMethodType.GetArgType: IDataType;
begin
Result := FArgType;
end;
function TDataMethodType.GetResultType: IDataType;
function TImplDataMethodType.GetResultType: IDataType;
begin
Result := FResultType;
end;
function TDataMethodType.GetKind: TDataKind;
function TImplDataMethodType.GetKind: TDataKind;
begin
Result := dkMethod;
end;
function TDataMethodType.GetName: String;
function TImplDataMethodType.GetName: String;
var
sb: TStringBuilder;
argName, resultName: string;
@@ -101,31 +101,31 @@ begin
end;
end;
{ TDataMethodValue }
{ TImplDataMethodValue }
constructor TDataMethodValue.Create(const ADataType: IDataMethodType; const AValue: TMethodProc);
constructor TImplDataMethodValue.Create(const ADataType: IDataMethodType; const AValue: TDataMethodProc);
begin
inherited Create;
FDataType := ADataType;
FValue := AValue;
end;
function TDataMethodValue.GetDataType: IDataType;
function TImplDataMethodValue.GetDataType: IDataType;
begin
Result := FDataType;
end;
function TDataMethodValue.GetAsString: string;
function TImplDataMethodValue.GetAsString: string;
begin
Result := '<METHOD>';
end;
function TDataMethodValue.AsTValue: TValue;
function TImplDataMethodValue.AsTValue: TValue;
begin
Result := TValue.From<TMethodProc>(FValue);
Result := TValue.From<TDataMethodProc>(FValue);
end;
function TDataMethodValue.GetValue: TMethodProc;
function TImplDataMethodValue.GetValue: TDataMethodProc;
begin
Result := FValue;
end;
Src/Data/Myc.Data.Types.Ordinal.pas
+19 -19
View File
@@ -8,7 +8,7 @@ uses
type
// Implements the ordinal data type.
TDataOrdinalType = class(TInterfacedObject, IDataType, IDataOrdinalType)
TImplDataOrdinalType = class(TInterfacedObject, IDataType, IDataOrdinalType)
strict private
class var
FSingleton: IDataOrdinalType;
@@ -28,7 +28,7 @@ uses
type
// Implements the ordinal data value.
TDataOrdinalValue = class(TInterfacedObject, IDataValue, IDataOrdinalValue)
TImplDataOrdinalValue = class(TInterfacedObject, IDataValue, IDataOrdinalValue)
private
FValue: Int64;
public
@@ -82,31 +82,31 @@ type
function AsTValue: TValue;
end;
{ TDataOrdinalValue }
{ TImplDataOrdinalValue }
constructor TDataOrdinalValue.Create(const AValue: Int64);
constructor TImplDataOrdinalValue.Create(const AValue: Int64);
begin
inherited Create;
FValue := AValue;
end;
function TDataOrdinalValue.GetDataType: IDataType;
function TImplDataOrdinalValue.GetDataType: IDataType;
begin
Result := TDataOrdinalType.Singleton;
Result := TImplDataOrdinalType.Singleton;
end;
function TDataOrdinalValue.GetAsString: string;
function TImplDataOrdinalValue.GetAsString: string;
begin
Result := FValue.ToString;
end;
function TDataOrdinalValue.AsTValue: TValue;
function TImplDataOrdinalValue.AsTValue: TValue;
begin
// Convert Int64 to TValue
Result := TValue.From<Int64>(FValue);
end;
function TDataOrdinalValue.GetValue: Int64;
function TImplDataOrdinalValue.GetValue: Int64;
begin
Result := FValue;
end;
@@ -120,7 +120,7 @@ end;
function TDataOrdinalValueMinusOne.GetDataType: IDataType;
begin
Result := TDataOrdinalType.Singleton;
Result := TImplDataOrdinalType.Singleton;
end;
function TDataOrdinalValueMinusOne.GetAsString: string;
@@ -148,7 +148,7 @@ end;
function TDataOrdinalValueZero.GetDataType: IDataType;
begin
Result := TDataOrdinalType.Singleton;
Result := TImplDataOrdinalType.Singleton;
end;
function TDataOrdinalValueZero.GetAsString: string;
@@ -176,7 +176,7 @@ end;
function TDataOrdinalValueOne.GetDataType: IDataType;
begin
Result := TDataOrdinalType.Singleton;
Result := TImplDataOrdinalType.Singleton;
end;
function TDataOrdinalValueOne.GetAsString: string;
@@ -195,27 +195,27 @@ begin
Result := 1;
end;
{ TDataOrdinalType }
{ TImplDataOrdinalType }
class constructor TDataOrdinalType.CreateClass;
class constructor TImplDataOrdinalType.CreateClass;
begin
FSingleton := TDataOrdinalType.Create;
FSingleton := TImplDataOrdinalType.Create;
FMinusOne := TDataOrdinalValueMinusOne.Create;
FZero := TDataOrdinalValueZero.Create;
FOne := TDataOrdinalValueOne.Create;
end;
function TDataOrdinalType.GetName: String;
function TImplDataOrdinalType.GetName: String;
begin
Result := 'Integer';
end;
function TDataOrdinalType.GetKind: TDataKind;
function TImplDataOrdinalType.GetKind: TDataKind;
begin
Result := dkOrdinal;
end;
function TDataOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue;
function TImplDataOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue;
begin
// Use specialized singletons for common values.
case Init of
@@ -223,7 +223,7 @@ begin
0: Result := FZero;
1: Result := FOne;
else
Result := TDataOrdinalValue.Create(Init);
Result := TImplDataOrdinalValue.Create(Init);
end;
end;
Src/Data/Myc.Data.Types.Records.pas
+43 -43
View File
@@ -18,7 +18,7 @@ type
end;
// Implements the record data type.
TDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType)
TImplDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType)
private
FFields: TArray<TRecordField>;
FFieldMap: TDictionary<string, Integer>; // For fast lookups by name
@@ -42,7 +42,7 @@ uses
type
// Implements the record data value.
TDataRecordValue = class(TInterfacedObject, IDataValue, IDataRecordValue)
TImplDataRecordValue = class(TInterfacedObject, IDataValue, IDataRecordValue)
private
FDataType: IDataRecordType;
FItems: TArray<IDataValue>;
@@ -55,7 +55,7 @@ type
end;
// Optimized implementation for a record with 0 fields.
TDataRecordValue0 = class(TInterfacedObject, IDataValue, IDataRecordValue)
TImplDataRecordValue0 = class(TInterfacedObject, IDataValue, IDataRecordValue)
strict private
class var
FEmptyTValue: TValue; // Singleton TValue for an empty record
@@ -71,7 +71,7 @@ type
end;
// Optimized implementation for a record with 1 field.
TDataRecordValue1 = class(TInterfacedObject, IDataValue, IDataRecordValue)
TImplDataRecordValue1 = class(TInterfacedObject, IDataValue, IDataRecordValue)
private
FDataType: IDataRecordType;
FItem0: IDataValue;
@@ -84,7 +84,7 @@ type
end;
// Optimized implementation for a record with 2 fields.
TDataRecordValue2 = class(TInterfacedObject, IDataValue, IDataRecordValue)
TImplDataRecordValue2 = class(TInterfacedObject, IDataValue, IDataRecordValue)
private
FDataType: IDataRecordType;
FItem0, FItem1: IDataValue;
@@ -124,9 +124,9 @@ begin
end;
end;
{ TDataRecordValue (generic implementation for N > 2 fields) }
{ TImplDataRecordValue (generic implementation for N > 2 fields) }
constructor TDataRecordValue.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
constructor TImplDataRecordValue.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
var
i: Integer;
begin
@@ -137,12 +137,12 @@ begin
FItems[i] := AItems[i];
end;
function TDataRecordValue.GetDataType: IDataType;
function TImplDataRecordValue.GetDataType: IDataType;
begin
Result := FDataType;
end;
function TDataRecordValue.GetAsString: string;
function TImplDataRecordValue.GetAsString: string;
var
sb: TStringBuilder;
i: Integer;
@@ -167,7 +167,7 @@ begin
end;
end;
function TDataRecordValue.AsTValue: TValue;
function TImplDataRecordValue.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
i: Integer;
@@ -178,14 +178,14 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataRecordValue.GetItem(Idx: Integer): IDataValue;
function TImplDataRecordValue.GetItem(Idx: Integer): IDataValue;
begin
Result := FItems[Idx];
end;
{ TDataRecordValue0 }
{ TImplDataRecordValue0 }
class constructor TDataRecordValue0.CreateClass;
class constructor TImplDataRecordValue0.CreateClass;
var
emptyArray: TArray<TValue>;
begin
@@ -193,42 +193,42 @@ begin
FEmptyTValue := TValue.From<TArray<TValue>>(emptyArray);
end;
constructor TDataRecordValue0.Create(const ADataType: IDataRecordType);
constructor TImplDataRecordValue0.Create(const ADataType: IDataRecordType);
begin
inherited Create;
FDataType := ADataType;
end;
function TDataRecordValue0.GetAsString: string;
function TImplDataRecordValue0.GetAsString: string;
begin
Result := '<>';
end;
function TDataRecordValue0.AsTValue: TValue;
function TImplDataRecordValue0.AsTValue: TValue;
begin
Result := FEmptyTValue;
end;
function TDataRecordValue0.GetDataType: IDataType;
function TImplDataRecordValue0.GetDataType: IDataType;
begin
Result := FDataType;
end;
function TDataRecordValue0.GetItem(Idx: Integer): IDataValue;
function TImplDataRecordValue0.GetItem(Idx: Integer): IDataValue;
begin
raise EArgumentException.Create('Index out of bounds');
end;
{ TDataRecordValue1 }
{ TImplDataRecordValue1 }
constructor TDataRecordValue1.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
constructor TImplDataRecordValue1.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
begin
inherited Create;
FDataType := ADataType;
FItem0 := AItems[0];
end;
function TDataRecordValue1.GetAsString: string;
function TImplDataRecordValue1.GetAsString: string;
var
recordType: IDataRecordType;
begin
@@ -236,7 +236,7 @@ begin
Result := Format('<%s: %s>', [recordType.Fields[0].Name, FItem0.AsString]);
end;
function TDataRecordValue1.AsTValue: TValue;
function TImplDataRecordValue1.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
@@ -245,12 +245,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataRecordValue1.GetDataType: IDataType;
function TImplDataRecordValue1.GetDataType: IDataType;
begin
Result := FDataType;
end;
function TDataRecordValue1.GetItem(Idx: Integer): IDataValue;
function TImplDataRecordValue1.GetItem(Idx: Integer): IDataValue;
begin
case Idx of
0: Result := FItem0;
@@ -259,9 +259,9 @@ begin
end;
end;
{ TDataRecordValue2 }
{ TImplDataRecordValue2 }
constructor TDataRecordValue2.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
constructor TImplDataRecordValue2.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
begin
inherited Create;
FDataType := ADataType;
@@ -269,7 +269,7 @@ begin
FItem1 := AItems[1];
end;
function TDataRecordValue2.GetAsString: string;
function TImplDataRecordValue2.GetAsString: string;
var
recordType: IDataRecordType;
sb: TStringBuilder;
@@ -292,7 +292,7 @@ begin
end;
end;
function TDataRecordValue2.AsTValue: TValue;
function TImplDataRecordValue2.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
@@ -302,12 +302,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataRecordValue2.GetDataType: IDataType;
function TImplDataRecordValue2.GetDataType: IDataType;
begin
Result := FDataType;
end;
function TDataRecordValue2.GetItem(Idx: Integer): IDataValue;
function TImplDataRecordValue2.GetItem(Idx: Integer): IDataValue;
begin
case Idx of
0: Result := FItem0;
@@ -317,9 +317,9 @@ begin
end;
end;
{ TDataRecordType }
{ TImplDataRecordType }
constructor TDataRecordType.Create(const AFields: array of TRecordField);
constructor TImplDataRecordType.Create(const AFields: array of TRecordField);
var
i: Integer;
field: TRecordField;
@@ -338,16 +338,16 @@ begin
// Pre-create the singleton value instance if this is a zero-field record.
if (Length(FFields) = 0) then
FEmptyValue := TDataRecordValue0.Create(Self);
FEmptyValue := TImplDataRecordValue0.Create(Self);
end;
destructor TDataRecordType.Destroy;
destructor TImplDataRecordType.Destroy;
begin
FFieldMap.Free;
inherited;
end;
function TDataRecordType.CreateValue(const AItems: array of IDataValue): IDataRecordValue;
function TImplDataRecordType.CreateValue(const AItems: array of IDataValue): IDataRecordValue;
var
i: Integer;
begin
@@ -364,25 +364,25 @@ begin
// Use optimized implementations for records with 0, 1, or 2 fields.
case Length(FFields) of
0: Result := FEmptyValue; // Return the pre-cached instance.
1: Result := TDataRecordValue1.Create(Self, AItems);
2: Result := TDataRecordValue2.Create(Self, AItems);
1: Result := TImplDataRecordValue1.Create(Self, AItems);
2: Result := TImplDataRecordValue2.Create(Self, AItems);
else
// Use the generic implementation for records with more than 2 fields.
Result := TDataRecordValue.Create(Self, AItems);
Result := TImplDataRecordValue.Create(Self, AItems);
end;
end;
function TDataRecordType.GetField(Idx: Integer): TRecordField;
function TImplDataRecordType.GetField(Idx: Integer): TRecordField;
begin
Result := FFields[Idx];
end;
function TDataRecordType.GetFieldCount: Integer;
function TImplDataRecordType.GetFieldCount: Integer;
begin
Result := Length(FFields);
end;
function TDataRecordType.GetName: String;
function TImplDataRecordType.GetName: String;
var
i: Integer;
sb: TStringBuilder;
@@ -405,12 +405,12 @@ begin
end;
end;
function TDataRecordType.GetKind: TDataKind;
function TImplDataRecordType.GetKind: TDataKind;
begin
Result := dkRecord;
end;
function TDataRecordType.IndexOf(const AName: string): Integer;
function TImplDataRecordType.IndexOf(const AName: string): Integer;
begin
if not FFieldMap.TryGetValue(AName, Result) then
Result := -1;
Src/Data/Myc.Data.Types.Text.pas
+26 -26
View File
@@ -7,7 +7,7 @@ uses
Myc.Data.Types;
type
TDataTextType = class(TInterfacedObject, IDataType, IDataTextType)
TImplDataTextType = class(TInterfacedObject, IDataType, IDataTextType)
strict private
class var
FSingleton: IDataTextType;
@@ -25,7 +25,7 @@ uses
System.Rtti;
type
TDataTextValue = class(TInterfacedObject, IDataValue, IDataTextValue)
TImplDataTextValue = class(TInterfacedObject, IDataValue, IDataTextValue)
private
FValue: string;
function GetDataType: IDataType;
@@ -37,7 +37,7 @@ type
end;
// Singleton implementation for the empty string value.
TDataTextValueEmpty = class(TInterfacedObject, IDataValue, IDataTextValue)
TImplDataTextValueEmpty = class(TInterfacedObject, IDataValue, IDataTextValue)
strict private
class var
FSingleton: IDataTextValue;
@@ -52,84 +52,84 @@ type
class property Singleton: IDataTextValue read FSingleton;
end;
{ TDataTextType }
{ TImplDataTextType }
class constructor TDataTextType.CreateClass;
class constructor TImplDataTextType.CreateClass;
begin
FSingleton := TDataTextType.Create;
FSingleton := TImplDataTextType.Create;
end;
function TDataTextType.CreateValue(const AValue: string): IDataTextValue;
function TImplDataTextType.CreateValue(const AValue: string): IDataTextValue;
begin
// Use the singleton for empty strings.
if (AValue = '') then
Result := TDataTextValueEmpty.Singleton
Result := TImplDataTextValueEmpty.Singleton
else
Result := TDataTextValue.Create(AValue);
Result := TImplDataTextValue.Create(AValue);
end;
function TDataTextType.GetName: String;
function TImplDataTextType.GetName: String;
begin
Result := 'Text';
end;
function TDataTextType.GetKind: TDataKind;
function TImplDataTextType.GetKind: TDataKind;
begin
Result := dkText;
end;
{ TDataTextValue }
{ TImplDataTextValue }
constructor TDataTextValue.Create(const AValue: string);
constructor TImplDataTextValue.Create(const AValue: string);
begin
inherited Create;
FValue := AValue;
end;
function TDataTextValue.GetDataType: IDataType;
function TImplDataTextValue.GetDataType: IDataType;
begin
Result := TDataTextType.Singleton;
Result := TImplDataTextType.Singleton;
end;
function TDataTextValue.GetAsString: string;
function TImplDataTextValue.GetAsString: string;
begin
Result := FValue;
end;
function TDataTextValue.GetValue: string;
function TImplDataTextValue.GetValue: string;
begin
Result := FValue;
end;
function TDataTextValue.AsTValue: TValue;
function TImplDataTextValue.AsTValue: TValue;
begin
Result := TValue.From<string>(FValue);
end;
{ TDataTextValueEmpty }
{ TImplDataTextValueEmpty }
class constructor TDataTextValueEmpty.CreateClass;
class constructor TImplDataTextValueEmpty.CreateClass;
begin
FSingleton := TDataTextValueEmpty.Create;
FSingleton := TImplDataTextValueEmpty.Create;
FEmptyTValue := TValue.From<string>('');
end;
function TDataTextValueEmpty.GetAsString: string;
function TImplDataTextValueEmpty.GetAsString: string;
begin
Result := '';
end;
function TDataTextValueEmpty.GetDataType: IDataType;
function TImplDataTextValueEmpty.GetDataType: IDataType;
begin
Result := TDataTextType.Singleton;
Result := TImplDataTextType.Singleton;
end;
function TDataTextValueEmpty.GetValue: string;
function TImplDataTextValueEmpty.GetValue: string;
begin
Result := '';
end;
function TDataTextValueEmpty.AsTValue: TValue;
function TImplDataTextValueEmpty.AsTValue: TValue;
begin
Result := FEmptyTValue;
end;
Src/Data/Myc.Data.Types.Timestamp.pas
+16 -16
View File
@@ -7,7 +7,7 @@ uses
Myc.Data.Types;
type
TDataTimestampType = class(TInterfacedObject, IDataType, IDataTimestampType)
TImplDataTimestampType = class(TInterfacedObject, IDataType, IDataTimestampType)
strict private
class var
FSingleton: IDataTimestampType;
@@ -25,7 +25,7 @@ uses
System.Rtti;
type
TDataTimestampValue = class(TInterfacedObject, IDataValue, IDataTimestampValue)
TImplDataTimestampValue = class(TInterfacedObject, IDataValue, IDataTimestampValue)
private
FValue: TDateTime;
function GetDataType: IDataType;
@@ -36,52 +36,52 @@ type
constructor Create(const AValue: TDateTime);
end;
{ TDataTimestampType }
{ TImplDataTimestampType }
class constructor TDataTimestampType.CreateClass;
class constructor TImplDataTimestampType.CreateClass;
begin
FSingleton := TDataTimestampType.Create;
FSingleton := TImplDataTimestampType.Create;
end;
function TDataTimestampType.CreateValue(const AValue: TDateTime): IDataTimestampValue;
function TImplDataTimestampType.CreateValue(const AValue: TDateTime): IDataTimestampValue;
begin
Result := TDataTimestampValue.Create(AValue);
Result := TImplDataTimestampValue.Create(AValue);
end;
function TDataTimestampType.GetName: String;
function TImplDataTimestampType.GetName: String;
begin
Result := 'Timestamp';
end;
function TDataTimestampType.GetKind: TDataKind;
function TImplDataTimestampType.GetKind: TDataKind;
begin
Result := dkTimestamp;
end;
{ TDataTimestampValue }
{ TImplDataTimestampValue }
constructor TDataTimestampValue.Create(const AValue: TDateTime);
constructor TImplDataTimestampValue.Create(const AValue: TDateTime);
begin
inherited Create;
FValue := AValue;
end;
function TDataTimestampValue.GetDataType: IDataType;
function TImplDataTimestampValue.GetDataType: IDataType;
begin
Result := TDataTimestampType.Singleton;
Result := TImplDataTimestampType.Singleton;
end;
function TDataTimestampValue.GetAsString: string;
function TImplDataTimestampValue.GetAsString: string;
begin
Result := DateTimeToStr(FValue);
end;
function TDataTimestampValue.GetValue: TDateTime;
function TImplDataTimestampValue.GetValue: TDateTime;
begin
Result := FValue;
end;
function TDataTimestampValue.AsTValue: TValue;
function TImplDataTimestampValue.AsTValue: TValue;
begin
Result := TValue.From<TDateTime>(FValue);
end;
Src/Data/Myc.Data.Types.Tuple.pas
+78 -78
View File
@@ -8,7 +8,7 @@ uses
type
// Implements the singleton tuple data type.
TDataTupleType = class(TInterfacedObject, IDataType, IDataTupleType)
TImplDataTupleType = class(TInterfacedObject, IDataType, IDataTupleType)
strict private
class var
FSingleton: IDataTupleType;
@@ -28,7 +28,7 @@ uses
type
// Implements the simple tuple data value.
TDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue)
TImplDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue)
private
FItems: TArray<IDataValue>;
function GetDataType: IDataType;
@@ -41,7 +41,7 @@ type
end;
// Optimized singleton implementation for a tuple with 0 elements.
TDataTupleValue0 = class(TInterfacedObject, IDataValue, IDataTupleValue)
TImplDataTupleValue0 = class(TInterfacedObject, IDataValue, IDataTupleValue)
strict private
class var
FSingleton: IDataTupleValue;
@@ -58,7 +58,7 @@ type
end;
// Optimized implementation for a tuple with 1 element.
TDataTupleValue1 = class(TInterfacedObject, IDataValue, IDataTupleValue)
TImplDataTupleValue1 = class(TInterfacedObject, IDataValue, IDataTupleValue)
private
FItem0: IDataValue;
function GetDataType: IDataType;
@@ -71,7 +71,7 @@ type
end;
// Optimized implementation for a tuple with 2 elements.
TDataTupleValue2 = class(TInterfacedObject, IDataValue, IDataTupleValue)
TImplDataTupleValue2 = class(TInterfacedObject, IDataValue, IDataTupleValue)
private
FItem0, FItem1: IDataValue;
function GetDataType: IDataType;
@@ -84,7 +84,7 @@ type
end;
// Optimized implementation for a tuple with 3 elements.
TDataTupleValue3 = class(TInterfacedObject, IDataValue, IDataTupleValue)
TImplDataTupleValue3 = class(TInterfacedObject, IDataValue, IDataTupleValue)
private
FItem0, FItem1, FItem2: IDataValue;
function GetDataType: IDataType;
@@ -97,7 +97,7 @@ type
end;
// Optimized implementation for a tuple with 4 elements.
TDataTupleValue4 = class(TInterfacedObject, IDataValue, IDataTupleValue)
TImplDataTupleValue4 = class(TInterfacedObject, IDataValue, IDataTupleValue)
private
FItem0, FItem1, FItem2, FItem3: IDataValue;
function GetDataType: IDataType;
@@ -110,7 +110,7 @@ type
end;
// Optimized implementation for a tuple with 5 elements.
TDataTupleValue5 = class(TInterfacedObject, IDataValue, IDataTupleValue)
TImplDataTupleValue5 = class(TInterfacedObject, IDataValue, IDataTupleValue)
private
FItem0, FItem1, FItem2, FItem3, FItem4: IDataValue;
function GetDataType: IDataType;
@@ -122,9 +122,9 @@ type
constructor Create(const AItems: array of IDataValue);
end;
{ TDataTupleValue (generic implementation for N > 5 elements) }
{ TImplDataTupleValue (generic implementation for N > 5 elements) }
constructor TDataTupleValue.Create(const AItems: array of IDataValue);
constructor TImplDataTupleValue.Create(const AItems: array of IDataValue);
var
i: Integer;
begin
@@ -134,12 +134,12 @@ begin
FItems[i] := AItems[i];
end;
function TDataTupleValue.GetDataType: IDataType;
function TImplDataTupleValue.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
Result := TImplDataTupleType.Singleton;
end;
function TDataTupleValue.GetAsString: string;
function TImplDataTupleValue.GetAsString: string;
var
sb: TStringBuilder;
i: Integer;
@@ -160,7 +160,7 @@ begin
end;
end;
function TDataTupleValue.AsTValue: TValue;
function TImplDataTupleValue.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
i: Integer;
@@ -171,66 +171,66 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataTupleValue.GetItem(Idx: Integer): IDataValue;
function TImplDataTupleValue.GetItem(Idx: Integer): IDataValue;
begin
Result := FItems[Idx];
end;
function TDataTupleValue.GetItemCount: Integer;
function TImplDataTupleValue.GetItemCount: Integer;
begin
Result := Length(FItems);
end;
{ TDataTupleValue0 }
{ TImplDataTupleValue0 }
class constructor TDataTupleValue0.CreateClass;
class constructor TImplDataTupleValue0.CreateClass;
var
emptyArray: TArray<TValue>;
begin
FSingleton := TDataTupleValue0.Create;
FSingleton := TImplDataTupleValue0.Create;
SetLength(emptyArray, 0);
FEmptyTValue := TValue.From<TArray<TValue>>(emptyArray);
end;
function TDataTupleValue0.GetAsString: string;
function TImplDataTupleValue0.GetAsString: string;
begin
Result := '()';
end;
function TDataTupleValue0.AsTValue: TValue;
function TImplDataTupleValue0.AsTValue: TValue;
begin
Result := FEmptyTValue;
end;
function TDataTupleValue0.GetDataType: IDataType;
function TImplDataTupleValue0.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
Result := TImplDataTupleType.Singleton;
end;
function TDataTupleValue0.GetItem(Idx: Integer): IDataValue;
function TImplDataTupleValue0.GetItem(Idx: Integer): IDataValue;
begin
raise EArgumentException.Create('Index out of bounds');
end;
function TDataTupleValue0.GetItemCount: Integer;
function TImplDataTupleValue0.GetItemCount: Integer;
begin
Result := 0;
end;
{ TDataTupleValue1 }
{ TImplDataTupleValue1 }
constructor TDataTupleValue1.Create(const AItems: array of IDataValue);
constructor TImplDataTupleValue1.Create(const AItems: array of IDataValue);
begin
inherited Create;
FItem0 := AItems[0];
end;
function TDataTupleValue1.GetAsString: string;
function TImplDataTupleValue1.GetAsString: string;
begin
Result := '(' + FItem0.AsString + ')';
end;
function TDataTupleValue1.AsTValue: TValue;
function TImplDataTupleValue1.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
@@ -239,12 +239,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataTupleValue1.GetDataType: IDataType;
function TImplDataTupleValue1.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
Result := TImplDataTupleType.Singleton;
end;
function TDataTupleValue1.GetItem(Idx: Integer): IDataValue;
function TImplDataTupleValue1.GetItem(Idx: Integer): IDataValue;
begin
case Idx of
0: Result := FItem0;
@@ -253,26 +253,26 @@ begin
end;
end;
function TDataTupleValue1.GetItemCount: Integer;
function TImplDataTupleValue1.GetItemCount: Integer;
begin
Result := 1;
end;
{ TDataTupleValue2 }
{ TImplDataTupleValue2 }
constructor TDataTupleValue2.Create(const AItems: array of IDataValue);
constructor TImplDataTupleValue2.Create(const AItems: array of IDataValue);
begin
inherited Create;
FItem0 := AItems[0];
FItem1 := AItems[1];
end;
function TDataTupleValue2.GetAsString: string;
function TImplDataTupleValue2.GetAsString: string;
begin
Result := '(' + FItem0.AsString + ', ' + FItem1.AsString + ')';
end;
function TDataTupleValue2.AsTValue: TValue;
function TImplDataTupleValue2.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
@@ -282,12 +282,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataTupleValue2.GetDataType: IDataType;
function TImplDataTupleValue2.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
Result := TImplDataTupleType.Singleton;
end;
function TDataTupleValue2.GetItem(Idx: Integer): IDataValue;
function TImplDataTupleValue2.GetItem(Idx: Integer): IDataValue;
begin
case Idx of
0: Result := FItem0;
@@ -297,14 +297,14 @@ begin
end;
end;
function TDataTupleValue2.GetItemCount: Integer;
function TImplDataTupleValue2.GetItemCount: Integer;
begin
Result := 2;
end;
{ TDataTupleValue3 }
{ TImplDataTupleValue3 }
constructor TDataTupleValue3.Create(const AItems: array of IDataValue);
constructor TImplDataTupleValue3.Create(const AItems: array of IDataValue);
begin
inherited Create;
FItem0 := AItems[0];
@@ -312,7 +312,7 @@ begin
FItem2 := AItems[2];
end;
function TDataTupleValue3.GetAsString: string;
function TImplDataTupleValue3.GetAsString: string;
var
sb: TStringBuilder;
begin
@@ -331,7 +331,7 @@ begin
end;
end;
function TDataTupleValue3.AsTValue: TValue;
function TImplDataTupleValue3.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
@@ -342,12 +342,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataTupleValue3.GetDataType: IDataType;
function TImplDataTupleValue3.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
Result := TImplDataTupleType.Singleton;
end;
function TDataTupleValue3.GetItem(Idx: Integer): IDataValue;
function TImplDataTupleValue3.GetItem(Idx: Integer): IDataValue;
begin
case Idx of
0: Result := FItem0;
@@ -358,14 +358,14 @@ begin
end;
end;
function TDataTupleValue3.GetItemCount: Integer;
function TImplDataTupleValue3.GetItemCount: Integer;
begin
Result := 3;
end;
{ TDataTupleValue4 }
{ TImplDataTupleValue4 }
constructor TDataTupleValue4.Create(const AItems: array of IDataValue);
constructor TImplDataTupleValue4.Create(const AItems: array of IDataValue);
begin
inherited Create;
FItem0 := AItems[0];
@@ -374,7 +374,7 @@ begin
FItem3 := AItems[3];
end;
function TDataTupleValue4.GetAsString: string;
function TImplDataTupleValue4.GetAsString: string;
var
sb: TStringBuilder;
begin
@@ -395,7 +395,7 @@ begin
end;
end;
function TDataTupleValue4.AsTValue: TValue;
function TImplDataTupleValue4.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
@@ -407,12 +407,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataTupleValue4.GetDataType: IDataType;
function TImplDataTupleValue4.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
Result := TImplDataTupleType.Singleton;
end;
function TDataTupleValue4.GetItem(Idx: Integer): IDataValue;
function TImplDataTupleValue4.GetItem(Idx: Integer): IDataValue;
begin
case Idx of
0: Result := FItem0;
@@ -424,14 +424,14 @@ begin
end;
end;
function TDataTupleValue4.GetItemCount: Integer;
function TImplDataTupleValue4.GetItemCount: Integer;
begin
Result := 4;
end;
{ TDataTupleValue5 }
{ TImplDataTupleValue5 }
constructor TDataTupleValue5.Create(const AItems: array of IDataValue);
constructor TImplDataTupleValue5.Create(const AItems: array of IDataValue);
begin
inherited Create;
FItem0 := AItems[0];
@@ -441,7 +441,7 @@ begin
FItem4 := AItems[4];
end;
function TDataTupleValue5.GetAsString: string;
function TImplDataTupleValue5.GetAsString: string;
var
sb: TStringBuilder;
begin
@@ -464,7 +464,7 @@ begin
end;
end;
function TDataTupleValue5.AsTValue: TValue;
function TImplDataTupleValue5.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
@@ -477,12 +477,12 @@ begin
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataTupleValue5.GetDataType: IDataType;
function TImplDataTupleValue5.GetDataType: IDataType;
begin
Result := TDataTupleType.Singleton;
Result := TImplDataTupleType.Singleton;
end;
function TDataTupleValue5.GetItem(Idx: Integer): IDataValue;
function TImplDataTupleValue5.GetItem(Idx: Integer): IDataValue;
begin
case Idx of
0: Result := FItem0;
@@ -495,40 +495,40 @@ begin
end;
end;
function TDataTupleValue5.GetItemCount: Integer;
function TImplDataTupleValue5.GetItemCount: Integer;
begin
Result := 5;
end;
{ TDataTupleType }
{ TImplDataTupleType }
class constructor TDataTupleType.CreateClass;
class constructor TImplDataTupleType.CreateClass;
begin
FSingleton := TDataTupleType.Create;
FSingleton := TImplDataTupleType.Create;
end;
function TDataTupleType.CreateValue(const AItems: array of IDataValue): IDataTupleValue;
function TImplDataTupleType.CreateValue(const AItems: array of IDataValue): IDataTupleValue;
begin
// Use optimized implementations for tuples with 0 to 5 elements.
case Length(AItems) of
0: Result := TDataTupleValue0.Singleton;
1: Result := TDataTupleValue1.Create(AItems);
2: Result := TDataTupleValue2.Create(AItems);
3: Result := TDataTupleValue3.Create(AItems);
4: Result := TDataTupleValue4.Create(AItems);
5: Result := TDataTupleValue5.Create(AItems);
0: Result := TImplDataTupleValue0.Singleton;
1: Result := TImplDataTupleValue1.Create(AItems);
2: Result := TImplDataTupleValue2.Create(AItems);
3: Result := TImplDataTupleValue3.Create(AItems);
4: Result := TImplDataTupleValue4.Create(AItems);
5: Result := TImplDataTupleValue5.Create(AItems);
else
// Use the generic implementation for tuples with more than 5 elements.
Result := TDataTupleValue.Create(AItems);
Result := TImplDataTupleValue.Create(AItems);
end;
end;
function TDataTupleType.GetName: String;
function TImplDataTupleType.GetName: String;
begin
Result := 'Tuple';
end;
function TDataTupleType.GetKind: TDataKind;
function TImplDataTupleType.GetKind: TDataKind;
begin
Result := dkTuple;
end;
Src/Data/Myc.Data.Types.pas
+922 -121
View File
File diff suppressed because it is too large Load Diff
Src/Data/TestDataTypes.pas
+151 -139
View File
@@ -51,12 +51,12 @@ uses
procedure TMyTestObject.TestRecords;
var
intType: IDataType;
floatType: IDataType;
personType1, personType2, otherType: IDataRecordType;
personValue: IDataValue;
idValue: IDataOrdinalValue;
floatValue: IDataFloatValue;
intType: TDataOrdinalType;
floatType: TDataFloatType;
personType1, personType2, otherType: TDataRecordType;
personValue: TDataRecordValue;
idValue: TDataOrdinalValue;
floatValue: TDataFloatValue;
begin
// This test covers the optimized implementation for 2 fields.
// --- 1. Setup: Define base types and a record structure ---
@@ -67,38 +67,38 @@ begin
personType1 := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Value', floatType)]);
// Assertions for the created type
Assert.IsNotNull(personType1, 'RecordType should be created');
Assert.IsNotNull(IDataRecordType(personType1), 'RecordType should be created');
Assert.AreEqual(2, personType1.FieldCount, 'FieldCount should be 2');
Assert.AreEqual('ID', personType1.Fields[0].Name, 'First field name should be ID');
Assert.AreSame(intType, personType1.Fields[0].DataType, 'First field type should be Integer');
Assert.AreSame(IDataType(intType), personType1.Fields[0].DataType, 'First field type should be Integer');
Assert.AreEqual('Value', personType1.Fields[1].Name, 'Second field name should be Value');
Assert.AreSame(floatType, personType1.Fields[1].DataType, 'Second field type should be Float');
Assert.AreSame(IDataType(floatType), personType1.Fields[1].DataType, 'Second field type should be Float');
Assert.AreEqual(0, personType1.IndexOf('ID'), 'IndexOf ID should be 0');
Assert.AreEqual(1, personType1.IndexOf('Value'), 'IndexOf Value should be 1');
Assert.AreEqual('Record<ID: Integer, Value: Float>', personType1.Name, 'Type name should match expected format');
Assert.AreEqual('Record<ID: Integer, Value: Float>', TDataType(personType1).Name, 'Type name should match expected format');
// Test if the same definition returns the same cached instance
personType2 := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Value', floatType)]);
Assert.AreSame(personType1, personType2, 'Types should be cached and return the same instance');
Assert.AreSame(IDataRecordType(personType1), IDataRecordType(personType2), 'Types should be cached and return the same instance');
// Test if a different definition returns a new instance
otherType := TDataType.RecordOf([TRecordField.Create('ID', intType), TRecordField.Create('Data', floatType)]);
Assert.AreNotSame(personType1, otherType, 'Different definitions should result in different types');
Assert.AreNotSame(IDataRecordType(personType1), IDataRecordType(otherType), 'Different definitions should result in different types');
// --- 3. Test Value Creation and Access ---
personValue := personType1.CreateValue([TDataValue.FromOrdinal(123), TDataValue.FromFloat(45.67)]);
Assert.IsNotNull(TDataValue(personValue).AsRecord, 'RecordValue should be created');
Assert.AreSame(personType1, TDataValue(personValue).DataType, 'Value should have the correct data type');
Assert.IsNotNull(IDataRecordValue(personValue), 'RecordValue should be created');
Assert.AreSame(IDataRecordType(personType1), IDataRecordValue(personValue).DataType, 'Value should have the correct data type');
// Access by index
idValue := TDataValue(TDataValue(personValue).AsRecord.Items[0]).AsOrdinal;
idValue := TDataValue(personValue.Items[0]).AsOrdinal;
Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect');
floatValue := TDataValue(TDataValue(personValue).AsRecord.Items[1]).AsFloat;
floatValue := TDataValue(personValue.Items[1]).AsFloat;
Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect');
// Access by name
floatValue := TDataValue(TDataValue(personValue).AsRecord.Items[personType1.IndexOf('Value')]).AsFloat;
floatValue := TDataValue(personValue.Items[personType1.IndexOf('Value')]).AsFloat;
Assert.AreEqual(45.67, floatValue.Value, 'Value accessed by name is incorrect');
// --- 4. Test Validation and Error Handling ---
@@ -130,8 +130,8 @@ end;
procedure TMyTestObject.TestRecords_Generic;
var
dataType: IDataRecordType;
dataValue: IDataRecordValue;
dataType: TDataRecordType;
dataValue: TDataRecordValue;
begin
// Test the generic implementation for records with > 2 fields.
dataType :=
@@ -144,20 +144,20 @@ begin
);
dataValue := dataType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('two'), TDataValue.FromFloat(3.0)]);
Assert.IsNotNull(dataValue, 'Generic record value should be created');
Assert.IsNotNull(IDataRecordValue(dataValue), 'Generic record value should be created');
Assert.AreEqual(3, dataType.FieldCount, 'Generic record should have 3 fields');
Assert.AreEqual(Int64(1), TDataValue(dataValue.Items[0]).AsOrdinal.Value, 'Field A is incorrect');
Assert.AreEqual('two', TDataValue(dataValue.Items[1]).AsText.Value, 'Field B is incorrect');
Assert.AreEqual(3.0, TDataValue(dataValue.Items[2]).AsFloat.Value, 'Field C is incorrect');
Assert.AreEqual('<A: 1, B: two, C: 3>', dataValue.AsString, 'Generic record AsString is incorrect');
Assert.AreEqual('<A: 1, B: two, C: 3>', IDataRecordValue(dataValue).AsString, 'Generic record AsString is incorrect');
end;
procedure TMyTestObject.TestTuples;
var
intValue: IDataValue;
floatValue: IDataValue;
tuple1, tuple2, tuple3: IDataTupleValue;
type1, type2, type3: IDataType;
intValue: TDataOrdinalValue;
floatValue: TDataFloatValue;
tuple1, tuple2, tuple3: TDataTupleValue;
type1, type2, type3: IDataType; // Keep as interface to test AreSame on the raw interface pointer
begin
// This test covers optimized implementations for 1 and 2 elements.
// --- 1. Setup: Create some values ---
@@ -167,10 +167,10 @@ begin
// --- 2. Test Value Creation and basic properties ---
tuple1 := TDataValue.FromTuple([intValue, floatValue]);
Assert.IsNotNull(tuple1, 'Tuple value should be created');
Assert.AreEqual(2, TDataValue(tuple1).AsTuple.ItemCount, 'ItemCount should be on the value');
Assert.AreSame(intValue, TDataValue(tuple1).AsTuple.Items[0], 'Item at index 0 is incorrect');
Assert.AreSame(floatValue, TDataValue(tuple1).AsTuple.Items[1], 'Item at index 1 is incorrect');
Assert.IsNotNull(IDataTupleValue(tuple1), 'Tuple value should be created');
Assert.AreEqual(2, tuple1.ItemCount, 'ItemCount should be on the value');
Assert.AreSame(IDataValue(intValue), tuple1.Items[0], 'Item at index 0 is incorrect');
Assert.AreSame(IDataValue(floatValue), tuple1.Items[1], 'Item at index 1 is incorrect');
// --- 3. Test Singleton Type Behavior ---
// Create more tuples with different structures
@@ -178,9 +178,9 @@ begin
tuple3 := TDataValue.FromTuple([intValue]);
// Access the DataType via the underlying interface
type1 := tuple1.DataType;
type2 := tuple2.DataType;
type3 := tuple3.DataType;
type1 := IDataValue(tuple1).DataType;
type2 := IDataValue(tuple2).DataType;
type3 := IDataValue(tuple3).DataType;
Assert.IsNotNull(type1, 'DataType interface should be accessible');
Assert.AreEqual('Tuple', type1.Name, 'The type name for all tuples should be Tuple');
@@ -192,7 +192,7 @@ end;
procedure TMyTestObject.TestTuples_Generic;
var
tupleValue: IDataTupleValue;
tupleValue: TDataTupleValue;
begin
// Test the generic implementation for tuples with > 5 elements.
tupleValue :=
@@ -207,19 +207,20 @@ begin
]
);
Assert.IsNotNull(tupleValue, 'Generic tuple value should be created');
Assert.IsNotNull(IDataTupleValue(tupleValue), 'Generic tuple value should be created');
Assert.AreEqual(6, tupleValue.ItemCount, 'Generic tuple should have 6 items');
Assert.AreEqual(Int64(6), TDataValue(tupleValue.Items[5]).AsOrdinal.Value, 'Last item is incorrect');
Assert.AreEqual('(1, 2, 3, 4, 5, 6)', tupleValue.AsString, 'Generic tuple AsString is incorrect');
Assert.AreEqual('(1, 2, 3, 4, 5, 6)', IDataTupleValue(tupleValue).AsString, 'Generic tuple AsString is incorrect');
end;
procedure TMyTestObject.TestArrays;
var
intType: IDataType;
floatType: IDataType;
intArrayType1, intArrayType2, floatArrayType: IDataArrayType;
arrayValue: IDataArrayValue;
v1, v2: IDataValue;
intType: TDataOrdinalType;
floatType: TDataFloatType;
intArrayType1, intArrayType2: TDataArrayType;
floatArrayType: TDataArrayType;
arrayValue: TDataArrayValue;
v1, v2: TDataOrdinalValue;
begin
// --- 1. Setup ---
intType := TDataType.Ordinal;
@@ -228,30 +229,34 @@ begin
// --- 2. Test Type Creation and Caching ---
intArrayType1 := TDataType.ArrayOf(intType);
Assert.IsNotNull(intArrayType1, 'ArrayType should be created');
Assert.AreSame(intType, intArrayType1.ElementType, 'ElementType should be Integer');
Assert.AreEqual('Array<Integer>', intArrayType1.Name, 'Type name should be Array<Integer>');
Assert.IsNotNull(IDataArrayType(intArrayType1), 'ArrayType should be created');
Assert.AreSame(IDataType(intType), intArrayType1.ElementType, 'ElementType should be Integer');
Assert.AreEqual('Array<Integer>', TDataType(intArrayType1).Name, 'Type name should be Array<Integer>');
// Test caching
intArrayType2 := TDataType.ArrayOf(intType);
Assert.AreSame(intArrayType1, intArrayType2, 'Array types should be cached');
Assert.AreSame(IDataArrayType(intArrayType1), IDataArrayType(intArrayType2), 'Array types should be cached');
// Test uniqueness
floatArrayType := TDataType.ArrayOf(floatType);
Assert.AreNotSame(intArrayType1, floatArrayType, 'Different element types should result in different array types');
Assert.AreEqual('Array<Float>', floatArrayType.Name, 'Type name should be Array<Float>');
Assert.AreNotSame(
IDataArrayType(intArrayType1),
IDataArrayType(floatArrayType),
'Different element types should result in different array types'
);
Assert.AreEqual('Array<Float>', TDataType(floatArrayType).Name, 'Type name should be Array<Float>');
// --- 3. Test Value Creation and Access ---
v1 := TDataValue.FromOrdinal(10);
v2 := TDataValue.FromOrdinal(20);
arrayValue := intArrayType1.CreateValue([v1, v2]);
Assert.IsNotNull(arrayValue, 'ArrayValue should be created');
Assert.AreEqual(2, TDataValue(arrayValue).AsArray.ElementCount, 'ElementCount should be 2');
Assert.IsNotNull(IDataArrayValue(arrayValue), 'ArrayValue should be created');
Assert.AreEqual(2, arrayValue.ElementCount, 'ElementCount should be 2');
// Access items and check values
Assert.AreEqual(Int64(10), TDataValue(TDataValue(arrayValue).AsArray.Items[0]).AsOrdinal.Value, 'Item at index 0 is incorrect');
Assert.AreEqual(Int64(20), TDataValue(TDataValue(arrayValue).AsArray.Items[1]).AsOrdinal.Value, 'Item at index 1 is incorrect');
Assert.AreEqual(Int64(10), TDataValue(arrayValue.Items[0]).AsOrdinal.Value, 'Item at index 0 is incorrect');
Assert.AreEqual(Int64(20), TDataValue(arrayValue.Items[1]).AsOrdinal.Value, 'Item at index 1 is incorrect');
// --- 4. Test Validation and Error Handling ---
// Test creating an array with a nil element type
@@ -271,51 +276,51 @@ end;
procedure TMyTestObject.TestArrays_OptimizedAndGeneric;
var
arrayType: IDataArrayType;
empty1, empty2, single, generic: IDataArrayValue;
arrayType: TDataArrayType;
empty1, empty2, single, generic: TDataArrayValue;
begin
arrayType := TDataType.ArrayOf(TDataType.Ordinal);
// Test optimized path for 0 elements (cached singleton per type)
empty1 := arrayType.CreateValue([]);
empty2 := arrayType.CreateValue([]);
Assert.IsNotNull(empty1, 'Empty array value should be created');
Assert.AreSame(empty1, empty2, 'Empty array value should be cached and reused');
Assert.IsNotNull(IDataArrayValue(empty1), 'Empty array value should be created');
Assert.AreSame(IDataArrayValue(empty1), IDataArrayValue(empty2), 'Empty array value should be cached and reused');
Assert.AreEqual(0, empty1.ElementCount, 'Empty array should have 0 elements');
Assert.AreEqual('[]', empty1.AsString, 'Empty array AsString is incorrect');
Assert.AreEqual('[]', IDataArrayValue(empty1).AsString, 'Empty array AsString is incorrect');
// Test optimized path for 1 element
single := arrayType.CreateValue([TDataValue.FromOrdinal(42)]);
Assert.IsNotNull(single, 'Single element array should be created');
Assert.IsNotNull(IDataArrayValue(single), 'Single element array should be created');
Assert.AreEqual(1, single.ElementCount, 'Single element array should have 1 element');
Assert.AreEqual(Int64(42), TDataValue(single.Items[0]).AsOrdinal.Value, 'Single element value is incorrect');
Assert.AreEqual('[42]', single.AsString, 'Single element array AsString is incorrect');
Assert.AreEqual('[42]', IDataArrayValue(single).AsString, 'Single element array AsString is incorrect');
// Test generic path for > 1 elements
generic := arrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2), TDataValue.FromOrdinal(3)]);
Assert.IsNotNull(generic, 'Generic array should be created');
Assert.IsNotNull(IDataArrayValue(generic), 'Generic array should be created');
Assert.AreEqual(3, generic.ElementCount, 'Generic array should have 3 elements');
Assert.AreEqual('[1, 2, 3]', generic.AsString, 'Generic array AsString is incorrect');
Assert.AreEqual('[1, 2, 3]', IDataArrayValue(generic).AsString, 'Generic array AsString is incorrect');
end;
procedure TMyTestObject.TestTexts;
var
textType: IDataTextType;
textValue1, textValue2: IDataTextValue;
textType: TDataTextType;
textValue1, textValue2: TDataTextValue;
dataValue: IDataValue;
begin
// --- 1. Test Type Creation ---
textType := TDataType.Text;
Assert.IsNotNull(textType, 'TextType should be created');
Assert.AreEqual('Text', textType.Name, 'Type name should be Text');
Assert.AreEqual(dkText, textType.Kind, 'Type kind should be dkText');
Assert.IsNotNull(IDataTextType(textType), 'TextType should be created');
Assert.AreEqual('Text', TDataType(textType).Name, 'Type name should be Text');
Assert.AreEqual(dkText, TDataType(textType).Kind, 'Type kind should be dkText');
// --- 2. Test Value Creation and Access ---
textValue1 := TDataValue.FromText('Hello World');
Assert.IsNotNull(textValue1, 'TextValue should be created');
Assert.AreSame(textType, textValue1.DataType, 'Value should have the correct data type');
Assert.IsNotNull(IDataTextValue(textValue1), 'TextValue should be created');
Assert.AreSame(IDataType(textType), IDataTextValue(textValue1).DataType, 'Value should have the correct data type');
Assert.AreEqual('Hello World', textValue1.Value, 'Value should be ''Hello World''');
// Test another text value
@@ -334,65 +339,65 @@ end;
procedure TMyTestObject.TestTexts_OptimizedEmpty;
var
empty1, empty2: IDataTextValue;
empty1, empty2: TDataTextValue;
begin
// Test the singleton implementation for the empty string.
empty1 := TDataValue.FromText('');
empty2 := TDataValue.FromText('');
Assert.IsNotNull(empty1, 'Empty text value should be created');
Assert.AreSame(empty1, empty2, 'Empty text value should be a singleton');
Assert.IsNotNull(IDataTextValue(empty1), 'Empty text value should be created');
Assert.AreSame(IDataTextValue(empty1), IDataTextValue(empty2), 'Empty text value should be a singleton');
Assert.AreEqual('', empty1.Value, 'Value of empty text should be empty');
Assert.AreEqual('', empty1.AsString, 'AsString of empty text should be empty');
Assert.AreEqual('', IDataTextValue(empty1).AsString, 'AsString of empty text should be empty');
end;
procedure TMyTestObject.TestFloats_OptimizedAndGeneric;
var
zero1, zero2, nan1, nan2, generic: IDataFloatValue;
zero1, zero2, nan1, nan2, generic: TDataFloatValue;
begin
// Test singleton for 0.0
zero1 := TDataValue.FromFloat(0.0);
zero2 := TDataValue.FromFloat(0.0);
Assert.IsNotNull(zero1, 'Zero float should be created');
Assert.AreSame(zero1, zero2, 'Zero float should be a singleton');
Assert.IsNotNull(IDataFloatValue(zero1), 'Zero float should be created');
Assert.AreSame(IDataFloatValue(zero1), IDataFloatValue(zero2), 'Zero float should be a singleton');
Assert.AreEqual(0.0, zero1.Value, 'Value of zero float is incorrect');
// Test singleton for NaN
nan1 := TDataValue.FromFloat(NaN);
nan2 := TDataValue.FromFloat(NaN);
Assert.IsNotNull(nan1, 'NaN float should be created');
Assert.AreSame(nan1, nan2, 'NaN float should be a singleton');
Assert.IsNotNull(IDataFloatValue(nan1), 'NaN float should be created');
Assert.AreSame(IDataFloatValue(nan1), IDataFloatValue(nan2), 'NaN float should be a singleton');
Assert.IsTrue(IsNaN(nan1.Value), 'Value of NaN float should be NaN');
Assert.AreEqual('NaN', nan1.AsString, 'NaN AsString is incorrect');
Assert.AreEqual('NaN', IDataFloatValue(nan1).AsString, 'NaN AsString is incorrect');
// Test generic path
generic := TDataValue.FromFloat(123.45);
Assert.IsNotNull(generic, 'Generic float should be created');
Assert.AreNotSame(zero1, generic, 'Generic float should not be the zero singleton');
Assert.AreNotSame(nan1, generic, 'Generic float should not be the NaN singleton');
Assert.IsNotNull(IDataFloatValue(generic), 'Generic float should be created');
Assert.AreNotSame(IDataFloatValue(zero1), IDataFloatValue(generic), 'Generic float should not be the zero singleton');
Assert.AreNotSame(IDataFloatValue(nan1), IDataFloatValue(generic), 'Generic float should not be the NaN singleton');
Assert.AreEqual(123.45, generic.Value, 'Value of generic float is incorrect');
end;
procedure TMyTestObject.TestTimestamps;
var
tsType: IDataTimestampType;
tsValue1, tsValue2: IDataTimestampValue;
tsType: TDataTimestampType;
tsValue1, tsValue2: TDataTimestampValue;
dataValue: IDataValue;
now: TDateTime;
begin
// --- 1. Test Type Creation ---
tsType := TDataType.Timestamp;
Assert.IsNotNull(tsType, 'TimestampType should be created');
Assert.AreEqual('Timestamp', tsType.Name, 'Type name should be Timestamp');
Assert.AreEqual(dkTimestamp, tsType.Kind, 'Type kind should be dkTimestamp');
Assert.IsNotNull(IDataTimestampType(tsType), 'TimestampType should be created');
Assert.AreEqual('Timestamp', TDataType(tsType).Name, 'Type name should be Timestamp');
Assert.AreEqual(dkTimestamp, TDataType(tsType).Kind, 'Type kind should be dkTimestamp');
// --- 2. Test Value Creation and Access ---
now := System.Sysutils.Now;
tsValue1 := TDataValue.FromTimestamp(now);
Assert.IsNotNull(tsValue1, 'TimestampValue should be created');
Assert.AreSame(tsType, tsValue1.DataType, 'Value should have the correct data type');
Assert.IsNotNull(IDataTimestampValue(tsValue1), 'TimestampValue should be created');
Assert.AreSame(IDataType(tsType), IDataTimestampValue(tsValue1).DataType, 'Value should have the correct data type');
Assert.AreEqual(now, tsValue1.Value, 'Value should be the same');
// Test another text value
@@ -414,15 +419,15 @@ end;
procedure TMyTestObject.TestEnums;
var
colorType: IDataEnumType;
red, green, blue: IDataEnumValue;
colorType: TDataEnumType;
red, green, blue: TDataEnumValue;
begin
// --- 1. Test Type Creation ---
colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']);
Assert.IsNotNull(colorType, 'EnumType should be created');
Assert.AreEqual('Color', colorType.Name, 'Name should be Color');
Assert.AreEqual(dkEnum, colorType.Kind, 'Kind should be dkEnum');
Assert.IsNotNull(IDataEnumType(colorType), 'EnumType should be created');
Assert.AreEqual('Color', TDataType(colorType).Name, 'Name should be Color');
Assert.AreEqual(dkEnum, TDataType(colorType).Kind, 'Kind should be dkEnum');
Assert.AreEqual(3, colorType.IdentifierCount, 'IdentifierCount should be 3');
Assert.AreEqual('Red', colorType.Identifiers[0], 'Identifier at index 0 should be Red');
Assert.AreEqual('Green', colorType.Identifiers[1], 'Identifier at index 1 should be Green');
@@ -433,17 +438,17 @@ begin
// --- 2. Test Value Creation and Access ---
red := colorType.CreateValue(0);
green := colorType.CreateValue('Green');
blue := TDataValue(colorType.CreateValue(2)).AsEnum;
blue := colorType.CreateValue(2);
Assert.IsNotNull(red, 'EnumValue from index should be created');
Assert.AreSame(colorType, red.DataType, 'Red should have the correct data type');
Assert.IsNotNull(IDataEnumValue(red), 'EnumValue from index should be created');
Assert.AreSame(IDataType(colorType), IDataEnumValue(red).DataType, 'Red should have the correct data type');
Assert.AreEqual(0, red.Value, 'Value of Red should be 0');
Assert.AreEqual('Red', red.AsString, 'AsText of Red should be Red');
Assert.AreEqual('Red', IDataEnumValue(red).AsString, 'AsText of Red should be Red');
Assert.IsNotNull(green, 'EnumValue from identifier should be created');
Assert.AreSame(colorType, green.DataType, 'Green should have the correct data type');
Assert.IsNotNull(IDataEnumValue(green), 'EnumValue from identifier should be created');
Assert.AreSame(IDataType(colorType), IDataEnumValue(green).DataType, 'Green should have the correct data type');
Assert.AreEqual(1, green.Value, 'Value of Green should be 1');
Assert.AreEqual('Green', green.AsString, 'AsText of Green should be Green');
Assert.AreEqual('Green', IDataEnumValue(green).AsString, 'AsText of Green should be Green');
Assert.AreEqual(2, blue.Value, 'Value of Blue should be 2');
@@ -469,64 +474,64 @@ end;
procedure TMyTestObject.TestAsString;
var
ordinalValue: IDataOrdinalValue;
floatValue: IDataFloatValue;
textValue: IDataTextValue;
tsValue: IDataTimestampValue;
enumValue: IDataEnumValue;
arrayValue: IDataArrayValue;
recordValue: IDataRecordValue;
tupleValue: IDataTupleValue;
colorType: IDataEnumType;
personType: IDataRecordType;
intArrayType: IDataArrayType;
ordinalValue: TDataOrdinalValue;
floatValue: TDataFloatValue;
textValue: TDataTextValue;
tsValue: TDataTimestampValue;
enumValue: TDataEnumValue;
arrayValue: TDataArrayValue;
recordValue: TDataRecordValue;
tupleValue: TDataTupleValue;
colorType: TDataEnumType;
personType: TDataRecordType;
intArrayType: TDataArrayType;
now: TDateTime;
begin
// Ordinal
ordinalValue := TDataValue.FromOrdinal(123);
Assert.AreEqual('123', ordinalValue.AsString, 'Ordinal AsString incorrect');
Assert.AreEqual('123', IDataOrdinalValue(ordinalValue).AsString, 'Ordinal AsString incorrect');
// Float
floatValue := TDataValue.FromFloat(45.67);
Assert.AreEqual(FloatToStr(45.67), floatValue.AsString, 'Float AsString incorrect');
Assert.AreEqual(FloatToStr(45.67), IDataFloatValue(floatValue).AsString, 'Float AsString incorrect');
// Text
textValue := TDataValue.FromText('Hello');
Assert.AreEqual('Hello', textValue.AsString, 'Text AsString incorrect');
Assert.AreEqual('Hello', IDataTextValue(textValue).AsString, 'Text AsString incorrect');
// Timestamp
now := System.Sysutils.Now;
tsValue := TDataValue.FromTimestamp(now);
Assert.AreEqual(DateTimeToStr(now), tsValue.AsString, 'Timestamp AsString incorrect');
Assert.AreEqual(DateTimeToStr(now), IDataTimestampValue(tsValue).AsString, 'Timestamp AsString incorrect');
// Enum
colorType := TDataType.EnumOf('Color', ['Red', 'Green', 'Blue']);
enumValue := colorType.CreateValue('Green');
Assert.AreEqual('Green', enumValue.AsString, 'Enum AsString incorrect');
Assert.AreEqual('Green', IDataEnumValue(enumValue).AsString, 'Enum AsString incorrect');
// Array
intArrayType := TDataType.ArrayOf(TDataType.Ordinal);
arrayValue := intArrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2)]);
Assert.AreEqual('[1, 2]', arrayValue.AsString, 'Array AsString incorrect');
Assert.AreEqual('[1, 2]', IDataArrayValue(arrayValue).AsString, 'Array AsString incorrect');
// Record
personType := TDataType.RecordOf([TRecordField.Create('ID', TDataType.Ordinal), TRecordField.Create('Name', TDataType.Text)]);
recordValue := personType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('Bob')]);
Assert.AreEqual('<ID: 1, Name: Bob>', recordValue.AsString, 'Record AsString incorrect');
Assert.AreEqual('<ID: 1, Name: Bob>', IDataRecordValue(recordValue).AsString, 'Record AsString incorrect');
// Tuple
tupleValue := TDataValue.FromTuple([TDataValue.FromOrdinal(10), TDataValue.FromText('Tuple')]);
Assert.AreEqual('(10, Tuple)', tupleValue.AsString, 'Tuple AsString incorrect');
Assert.AreEqual('(10, Tuple)', IDataTupleValue(tupleValue).AsString, 'Tuple AsString incorrect');
end;
procedure TMyTestObject.TestAsTValue;
var
dataValue: IDataValue;
dataValue: IDataValue; // Keep as generic interface to test AsTValue
tv, element: TValue;
now: TDateTime;
colorType: IDataEnumType;
intArrayType: IDataArrayType;
personType: IDataRecordType;
colorType: TDataEnumType;
intArrayType: TDataArrayType;
personType: TDataRecordType;
begin
// --- Ordinal ---
dataValue := TDataValue.FromOrdinal(123);
@@ -612,11 +617,13 @@ end;
procedure TMyTestObject.TestMethods;
var
ordinalType, textType: IDataType;
methodType1, methodType2, otherMethodType: IDataMethodType;
ordinalType: TDataOrdinalType;
textType: TDataTextType;
methodType1, methodType2, otherMethodType: TDataMethodType;
myFunc: TMethodProc;
methodValue: IDataMethodValue;
inputValue, resultValue: IDataValue;
methodValue: TDataMethodValue;
inputValue: TDataOrdinalValue;
resultValue: IDataValue;
tv: TValue;
begin
// --- 1. Setup: Define base types ---
@@ -627,27 +634,32 @@ begin
methodType1 := TDataType.MethodOf(ordinalType, textType);
// Assertions for the created type
Assert.IsNotNull(methodType1, 'MethodType should be created');
Assert.AreEqual(dkMethod, methodType1.Kind, 'Kind should be dkMethod');
Assert.AreSame(ordinalType, methodType1.ArgType, 'ArgType should be Ordinal');
Assert.AreSame(textType, methodType1.ResultType, 'ResultType should be Text');
Assert.AreEqual('Method<Integer -> Text>', methodType1.Name, 'Type name should match expected format');
Assert.IsNotNull(IDataMethodType(methodType1), 'MethodType should be created');
Assert.AreEqual(dkMethod, TDataType(methodType1).Kind, 'Kind should be dkMethod');
Assert.AreSame(IDataType(ordinalType), methodType1.ArgType, 'ArgType should be Ordinal');
Assert.AreSame(IDataType(textType), methodType1.ResultType, 'ResultType should be Text');
Assert.AreEqual('Method<Integer -> Text>', TDataType(methodType1).Name, 'Type name should match expected format');
// Test if the same definition returns the same cached instance
methodType2 := TDataType.MethodOf(ordinalType, textType);
Assert.AreSame(methodType1, methodType2, 'Method types should be cached and return the same instance');
Assert
.AreSame(IDataMethodType(methodType1), IDataMethodType(methodType2), 'Method types should be cached and return the same instance');
// Test if a different definition returns a new instance
otherMethodType := TDataType.MethodOf(textType, ordinalType);
Assert.AreNotSame(methodType1, otherMethodType, 'Different signatures should result in different types');
Assert.AreEqual('Method<Text -> Integer>', otherMethodType.Name, 'Name of other method type is incorrect');
Assert.AreNotSame(
IDataMethodType(methodType1),
IDataMethodType(otherMethodType),
'Different signatures should result in different types'
);
Assert.AreEqual('Method<Text -> Integer>', TDataType(otherMethodType).Name, 'Name of other method type is incorrect');
// --- 3. Test Value Creation ---
// Define a function that matches the signature Ordinal -> Text
myFunc :=
function(const AValue: IDataValue): IDataValue
var
ordinalValue: IDataOrdinalValue;
ordinalValue: TDataOrdinalValue;
val: Int64;
begin
ordinalValue := TDataValue(AValue).AsOrdinal;
@@ -656,8 +668,8 @@ begin
end;
methodValue := TDataValue.FromMethod(methodType1, myFunc);
Assert.IsNotNull(methodValue, 'MethodValue should be created');
Assert.AreSame(methodType1, methodValue.DataType, 'Value should have the correct data type');
Assert.IsNotNull(IDataMethodValue(methodValue), 'MethodValue should be created');
Assert.AreSame(IDataType(methodType1), IDataMethodValue(methodValue).DataType, 'Value should have the correct data type');
// --- 4. Test Execution (Simulated) ---
inputValue := TDataValue.FromOrdinal(42);
@@ -665,13 +677,13 @@ begin
resultValue := methodValue.Value(inputValue);
Assert.IsNotNull(resultValue, 'Execution result should not be nil');
Assert.AreSame(textType, resultValue.DataType, 'Result value should have Text type');
Assert.AreSame(IDataType(textType), resultValue.DataType, 'Result value should have Text type');
Assert.AreEqual('42', TDataValue(resultValue).AsText.Value, 'Result value content is incorrect');
// --- 5. Test AsString and AsTValue ---
Assert.AreEqual('<METHOD>', methodValue.AsString, 'Method AsString is incorrect');
Assert.AreEqual('<METHOD>', IDataMethodValue(methodValue).AsString, 'Method AsString is incorrect');
tv := methodValue.AsTValue;
tv := IDataMethodValue(methodValue).AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Method TValue should not be empty');
Assert.AreEqual(tkInterface, tv.Kind, 'TValue kind for a TMethodProc should be tkInterface, as it is a reference-to-function');
Assert.IsTrue(TypeInfo(TMethodProc) = tv.TypeInfo, 'TValue should hold TMethodProc type info');
Src/Myc.Trade.Indicators.Common.pas
+25 -25
View File
@@ -21,7 +21,7 @@ type
TSMA = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -39,7 +39,7 @@ type
class function CreateSMA(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('EMA', 'Exponential Moving Average')]
@@ -47,7 +47,7 @@ type
TEMA = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -64,7 +64,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateEMA(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('WMA', 'Weighted Moving Average')]
@@ -72,7 +72,7 @@ type
TWMA = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -89,7 +89,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateWMA(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('HMA', 'Hull Moving Average')]
@@ -97,7 +97,7 @@ type
THMA = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -114,7 +114,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateHMA(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('RSI', 'Relative Strength Index')]
@@ -122,7 +122,7 @@ type
TRSI = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -139,7 +139,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateRSI(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('MACD', 'Moving Average Convergence Divergence')]
@@ -147,7 +147,7 @@ type
TMACD = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -173,7 +173,7 @@ type
EmaSignal: TConvertFunc<Double, Double>
): TConvertFunc<Double, TMACD.TResult>; overload; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('Stoch', 'Stochastic Oscillator')]
@@ -181,7 +181,7 @@ type
TStochastic = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -205,7 +205,7 @@ type
const SmaD: TConvertFunc<Double, Double>
): TConvertFunc<TOhlcItem, TStochastic.TResult>; overload; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('StdDev', 'Standard Deviation')]
@@ -213,7 +213,7 @@ type
TStdDev = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -230,7 +230,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateStdDev(Period: Integer): TConvertFunc<Double, Double>; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('BB', 'Bollinger Bands')]
@@ -238,7 +238,7 @@ type
TBollingerBands = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -258,7 +258,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateBollingerBands(Period: Integer; Multiplier: Double): TConvertFunc<Double, TResult>; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('ATR', 'Average True Range')]
@@ -266,7 +266,7 @@ type
TATR = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -284,7 +284,7 @@ type
class function CreateATR(Period: Integer): TConvertFunc<TOhlcItem, Double>; overload; static;
class function CreateATR(const MovAvgTR: TConvertFunc<Double, Double>): TConvertFunc<TOhlcItem, Double>; overload; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('KC', 'Keltner Channels')]
@@ -292,7 +292,7 @@ type
TKeltnerChannels = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -317,7 +317,7 @@ type
Multiplier: Double
): TConvertFunc<TOhlcItem, TKeltnerChannels.TResult>; overload; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
[IndicatorName('Mean', 'Mean Value')]
@@ -325,7 +325,7 @@ type
TMean = class
strict private
class var
FFactory: IDataMethodValue;
FFactory: TDataMethodValue;
class constructor CreateClass;
public
type
@@ -341,7 +341,7 @@ type
class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
class function CreateMean: TConvertFunc<TArray<Double>, Double>; static;
// Provides the factory method for this indicator as a data value.
class property Factory: IDataMethodValue read FFactory;
class property Factory: TDataMethodValue read FFactory;
end;
implementation
@@ -350,7 +350,7 @@ implementation
class constructor TSMA.CreateClass;
begin
{ var params := TDataType.RecordOf( [TRecordField.Create( 'Period', TDataType.Ordinal )] );
{ var params := TDataType.RecordOf( [TRecordField.Create( 'Period', TDataType.Ordinal )] );
var args := TDataType.RecordOf( [TRecordField.Create( 'Value', TDataType.Float )] );
var results := TDataType.RecordOf( [TRecordField.Create( 'SMA', TDataType.Float )] );
Src/Myc.Trade.Indicators_v2.pas
+37 -34
View File
@@ -68,23 +68,23 @@ type
public
Identifier: String;
// Use the custom type system instead of PTypeInfo.
DataType: IDataType;
DataType: TDataType;
end;
TFieldLayout = TArray<TFieldDef>;
// Interface for creating an indicator instance. Only contains functional aspects.
IIndicatorFactory = interface
function GetParamType: IDataType;
function GetArgType: IDataType;
function GetResultType: IDataType;
function GetParamType: TDataType;
function GetArgType: TDataType;
function GetResultType: TDataType;
function CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>;
function CreateIndicator(const Params: TDataValue): TConvertFunc<TDataValue, TDataValue>;
// Provides direct access to the type information of parameters, arguments, and results.
property ParamType: IDataType read GetParamType;
property ArgType: IDataType read GetArgType;
property ResultType: IDataType read GetResultType;
property ParamType: TDataType read GetParamType;
property ArgType: TDataType read GetArgType;
property ResultType: TDataType read GetResultType;
end;
TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
@@ -93,22 +93,22 @@ type
FName: String;
FShortName: String;
FHint: String;
FParamType: IDataType;
FArgType: IDataType;
FResultType: IDataType;
FParamType: TDataType;
FArgType: TDataType;
FResultType: TDataType;
public
constructor Create(
const AFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
const AShortName, AName, AHint: String;
const AParamType, AArgType, AResultType: IDataType
const AParamType, AArgType, AResultType: TDataType
);
// IIndicatorFactory
function GetParamType: IDataType;
function GetArgType: IDataType;
function GetResultType: IDataType;
function CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>; overload;
function GetParamType: TDataType;
function GetArgType: TDataType;
function GetResultType: TDataType;
function CreateIndicator(const Params: TDataValue): TConvertFunc<TDataValue, TDataValue>; overload;
class function CreateFromTemplate<T>: TGenericIndicatorFactory;
@@ -163,7 +163,7 @@ type
var
IndicatorRegistry: TIndicatorRegistry;
function DataValueFromTValue(const aValue: TValue): IDataValue;
function DataValueFromTValue(const aValue: TValue): TDataValue;
function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDataType;
implementation
@@ -180,7 +180,7 @@ function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDa
begin
if not Assigned(rttiType) then
begin
Result := nil;
Result := TDataType.Create(nil);
exit;
end;
@@ -207,13 +207,13 @@ begin
end;
// Converts a TValue into an IDataValue. This is the bridge from RTTI to the custom type system.
function DataValueFromTValue(const aValue: TValue): IDataValue;
function DataValueFromTValue(const aValue: TValue): TDataValue;
var
ctx: TRttiContext;
begin
if aValue.IsEmpty then
begin
Result := nil;
Result := TDataValue.Create(nil);
exit;
end;
@@ -261,7 +261,7 @@ end;
constructor TGenericIndicatorFactory.Create(
const AFactoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
const AShortName, AName, AHint: String;
const AParamType, AArgType, AResultType: IDataType
const AParamType, AArgType, AResultType: TDataType
);
begin
inherited Create;
@@ -278,7 +278,7 @@ class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicator
var
Ctx: TRttiContext;
rttiType: TRttiType;
paramsDataType, argsDataType, resultDataType: IDataType;
paramsDataType, argsDataType, resultDataType: TDataType;
templateFactoryMethod: TRttiMethod;
factoryProc: TIndicatorFactoryProc<IDataValue, IDataValue, IDataValue>;
shortName, name, hint: string;
@@ -345,7 +345,7 @@ begin
[templateFactoryMethod.ToString, E.Message]);
end;
// Convert RTTI types to IDataType from our custom type system.
// Convert RTTI types to TDataType from our custom type system.
paramsDataType := DataTypeFromRttiType(Ctx, factoryInvoke.GetParameters[0].ParamType);
argsDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.GetParameters[0].ParamType);
resultDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.ReturnType);
@@ -423,24 +423,27 @@ begin
Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsDataType, argsDataType, resultDataType);
end;
function TGenericIndicatorFactory.GetParamType: IDataType;
function TGenericIndicatorFactory.GetParamType: TDataType;
begin
Result := FParamType;
end;
function TGenericIndicatorFactory.GetArgType: IDataType;
function TGenericIndicatorFactory.GetArgType: TDataType;
begin
Result := FArgType;
end;
function TGenericIndicatorFactory.GetResultType: IDataType;
function TGenericIndicatorFactory.GetResultType: TDataType;
begin
Result := FResultType;
end;
function TGenericIndicatorFactory.CreateIndicator(const Params: IDataValue): TConvertFunc<IDataValue, IDataValue>;
function TGenericIndicatorFactory.CreateIndicator(const Params: TDataValue): TConvertFunc<TDataValue, TDataValue>;
var
internalProc: TConvertFunc<IDataValue, IDataValue>;
begin
Result := FFactoryProc(Params);
internalProc := FFactoryProc(Params);
Result := function(const Args: TDataValue): TDataValue begin Result := internalProc(Args); end;
end;
function TGenericIndicatorFactory.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
@@ -455,7 +458,7 @@ begin
var argsAsTValue := TValue.From<TArgs>(Args);
var argsAsDataValue := DataValueFromTValue(argsAsTValue);
var resultAsDataValue := cIndicator(argsAsDataValue);
var resultAsTValue := resultAsDataValue.AsTValue;
var resultAsTValue := IDataValue(resultAsDataValue).AsTValue;
Result := resultAsTValue.AsType<TResult>;
end;
end;
@@ -485,7 +488,7 @@ begin
var argsAsTValue := TValue.From<TArgs>(Args);
var argsAsDataValue := DataValueFromTValue(argsAsTValue);
var resultAsDataValue := cIndicator(argsAsDataValue);
var resultAsTValue := resultAsDataValue.AsTValue;
var resultAsTValue := IDataValue(resultAsDataValue).AsTValue;
Result := resultAsTValue.AsType<TResult>;
end;
end;
@@ -526,17 +529,17 @@ var
item: TItem;
// Generates a field layout from a data type.
function LayoutFromDataType(DataType: IDataType): TFieldLayout;
function LayoutFromDataType(DataType: TDataType): TFieldLayout;
var
recordType: IDataRecordType;
recordType: TDataRecordType;
begin
if (not Assigned(DataType)) or (DataType.Kind <> TDataKind.dkRecord) then
if DataType.Kind <> TDataKind.dkRecord then
begin
SetLength(Result, 0);
exit;
end;
recordType := TDataType.Create(DataType).AsRecord;
recordType := DataType.AsRecord;
SetLength(Result, recordType.FieldCount);
for var i := 0 to recordType.FieldCount - 1 do
begin
Test/MycTests.dpr
-1
View File
@@ -24,7 +24,6 @@ uses
Myc.Test.Signals.Latch in '..\Src\Myc.Test.Signals.Latch.pas',
Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas',
Test.Core.Mutable in 'Test.Core.Mutable.pas',
TestDataRecord in 'TestDataRecord.pas',
TestDataArray in 'TestDataArray.pas',
Myc.Data.Types in '..\Src\Myc.Data.Types.pas',
Myc.Data.Types.Ordinal in 'Myc.Data.Types.Ordinal.pas',
Test/MycTests.dproj
-1
View File
@@ -125,7 +125,6 @@ $(PreBuildEvent)]]></PreBuildEvent>
<DCCReference Include="..\Src\Myc.Test.Signals.Latch.pas"/>
<DCCReference Include="..\Src\Myc.Test.Signals.Dirty.pas"/>
<DCCReference Include="Test.Core.Mutable.pas"/>
<DCCReference Include="TestDataRecord.pas"/>
<DCCReference Include="TestDataArray.pas"/>
<DCCReference Include="..\Src\Myc.Data.Types.pas"/>
<DCCReference Include="Myc.Data.Types.Ordinal.pas"/>