Data Types
This commit is contained in:
@@ -0,0 +1,285 @@
|
||||
unit Myc.Data.Types.Arrays;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.Generics.Collections,
|
||||
System.SysUtils,
|
||||
Myc.Data.Types;
|
||||
|
||||
type
|
||||
// An interface helper for IDataArrayValue.
|
||||
TArrayValue = record
|
||||
private
|
||||
FArrayValue: IDataArrayValue;
|
||||
function GetElementCount: Integer; inline;
|
||||
function GetItem(Idx: Integer): TDataValue; inline;
|
||||
public
|
||||
constructor Create(const AArrayValue: IDataArrayValue);
|
||||
|
||||
class operator Implicit(const A: IDataArrayValue): TArrayValue; overload;
|
||||
class operator Implicit(const A: TArrayValue): IDataArrayValue; overload;
|
||||
|
||||
property ElementCount: Integer read GetElementCount;
|
||||
property Items[Idx: Integer]: TDataValue read GetItem; default;
|
||||
end;
|
||||
|
||||
// An interface helper for IDataArrayType.
|
||||
TArrayType = record
|
||||
private
|
||||
FArrayType: IDataArrayType;
|
||||
function GetElementType: TDataType; inline;
|
||||
function GetName: String; inline;
|
||||
public
|
||||
constructor Create(const AArrayType: IDataArrayType);
|
||||
|
||||
class operator Implicit(const A: IDataArrayType): TArrayType; overload;
|
||||
class operator Implicit(const A: TArrayType): IDataArrayType; overload;
|
||||
|
||||
function CreateValue(const AItems: array of IDataValue): TArrayValue;
|
||||
|
||||
property Name: String read GetName;
|
||||
property ElementType: TDataType read GetElementType;
|
||||
end;
|
||||
|
||||
TDataValueHelper = record helper for TDataValue
|
||||
public
|
||||
function AsArray: TArrayValue;
|
||||
end;
|
||||
|
||||
TDataTypeHelper = record helper for TDataType
|
||||
public
|
||||
function AsArray: TArrayType;
|
||||
end;
|
||||
|
||||
// Public factory for creating and caching array types.
|
||||
TArrayTypes = record
|
||||
strict private
|
||||
class var
|
||||
FRegistry: TDictionary<IDataType, IDataArrayType>;
|
||||
class constructor CreateClass;
|
||||
class destructor DestroyClass;
|
||||
public
|
||||
class function GetType(const AElementType: TDataType): TArrayType; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SyncObjs;
|
||||
|
||||
type
|
||||
{fwd}
|
||||
TImplDataArrayType = class;
|
||||
|
||||
// Implements the array data value.
|
||||
TImplDataArrayValue = class(TInterfacedObject, IDataValue, IDataArrayValue)
|
||||
private
|
||||
FArrayType: IDataArrayType;
|
||||
FItems: TArray<IDataValue>;
|
||||
function GetDataType: IDataType;
|
||||
function GetElementCount: Integer;
|
||||
function GetItem(Idx: Integer): IDataValue;
|
||||
public
|
||||
constructor Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
|
||||
end;
|
||||
|
||||
// Implements the array data type.
|
||||
TImplDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType)
|
||||
private
|
||||
FElementType: IDataType;
|
||||
function GetElementType: IDataType;
|
||||
function GetName: String;
|
||||
public
|
||||
constructor Create(const AElementType: IDataType);
|
||||
function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
|
||||
end;
|
||||
|
||||
{ TArrayValue }
|
||||
|
||||
constructor TArrayValue.Create(const AArrayValue: IDataArrayValue);
|
||||
begin
|
||||
FArrayValue := AArrayValue;
|
||||
end;
|
||||
|
||||
function TArrayValue.GetElementCount: Integer;
|
||||
begin
|
||||
if Assigned(FArrayValue) then
|
||||
Result := FArrayValue.ElementCount
|
||||
else
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TArrayValue.GetItem(Idx: Integer): TDataValue;
|
||||
begin
|
||||
if Assigned(FArrayValue) then
|
||||
Result := FArrayValue.Items[Idx]
|
||||
else
|
||||
Result := TDataValue.Create(nil);
|
||||
end;
|
||||
|
||||
class operator TArrayValue.Implicit(const A: TArrayValue): IDataArrayValue;
|
||||
begin
|
||||
Result := A.FArrayValue;
|
||||
end;
|
||||
|
||||
class operator TArrayValue.Implicit(const A: IDataArrayValue): TArrayValue;
|
||||
begin
|
||||
Result.FArrayValue := A;
|
||||
end;
|
||||
|
||||
{ TArrayType }
|
||||
|
||||
constructor TArrayType.Create(const AArrayType: IDataArrayType);
|
||||
begin
|
||||
FArrayType := AArrayType;
|
||||
end;
|
||||
|
||||
function TArrayType.CreateValue(const AItems: array of IDataValue): TArrayValue;
|
||||
begin
|
||||
if Assigned(FArrayType) then
|
||||
Result := FArrayType.CreateValue(AItems)
|
||||
else
|
||||
raise EAccessViolation.Create('Cannot create value from a nil array type.');
|
||||
end;
|
||||
|
||||
function TArrayType.GetElementType: TDataType;
|
||||
begin
|
||||
if Assigned(FArrayType) then
|
||||
Result := FArrayType.ElementType
|
||||
else
|
||||
Result := TDataType.Create(nil);
|
||||
end;
|
||||
|
||||
function TArrayType.GetName: String;
|
||||
begin
|
||||
if Assigned(FArrayType) then
|
||||
Result := FArrayType.Name
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
class operator TArrayType.Implicit(const A: TArrayType): IDataArrayType;
|
||||
begin
|
||||
Result := A.FArrayType;
|
||||
end;
|
||||
|
||||
class operator TArrayType.Implicit(const A: IDataArrayType): TArrayType;
|
||||
begin
|
||||
Result.FArrayType := A;
|
||||
end;
|
||||
|
||||
{ TImplDataArrayValue }
|
||||
|
||||
constructor TImplDataArrayValue.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
inherited Create;
|
||||
FArrayType := AArrayType;
|
||||
SetLength(FItems, Length(AItems));
|
||||
for i := 0 to High(AItems) do
|
||||
FItems[i] := AItems[i];
|
||||
end;
|
||||
|
||||
function TImplDataArrayValue.GetDataType: IDataType;
|
||||
begin
|
||||
Result := FArrayType;
|
||||
end;
|
||||
|
||||
function TImplDataArrayValue.GetElementCount: Integer;
|
||||
begin
|
||||
Result := Length(FItems);
|
||||
end;
|
||||
|
||||
function TImplDataArrayValue.GetItem(Idx: Integer): IDataValue;
|
||||
begin
|
||||
Result := FItems[Idx];
|
||||
end;
|
||||
|
||||
{ TImplDataArrayType }
|
||||
|
||||
constructor TImplDataArrayType.Create(const AElementType: IDataType);
|
||||
begin
|
||||
inherited Create;
|
||||
FElementType := AElementType;
|
||||
end;
|
||||
|
||||
function TImplDataArrayType.CreateValue(const AItems: array of IDataValue): IDataArrayValue;
|
||||
var
|
||||
item: IDataValue;
|
||||
i: Integer;
|
||||
begin
|
||||
// Validate that all items match the element type of this array type.
|
||||
i := 0;
|
||||
for item in AItems do
|
||||
begin
|
||||
if (item.DataType <> FElementType) then
|
||||
raise EArgumentException.CreateFmt(
|
||||
'Invalid data type for item at index %d. Expected ''%s'', but got ''%s''.',
|
||||
[i, FElementType.Name, item.DataType.Name]);
|
||||
inc(i);
|
||||
end;
|
||||
Result := TImplDataArrayValue.Create(Self, AItems);
|
||||
end;
|
||||
|
||||
function TImplDataArrayType.GetElementType: IDataType;
|
||||
begin
|
||||
Result := FElementType;
|
||||
end;
|
||||
|
||||
function TImplDataArrayType.GetName: String;
|
||||
begin
|
||||
Result := Format('Array<%s>', [FElementType.Name]);
|
||||
end;
|
||||
|
||||
{ TDataValueHelper }
|
||||
|
||||
function TDataValueHelper.AsArray: TArrayValue;
|
||||
begin
|
||||
Result := Self.DataValue as IDataArrayValue;
|
||||
end;
|
||||
|
||||
{ TDataTypeHelper }
|
||||
|
||||
function TDataTypeHelper.AsArray: TArrayType;
|
||||
begin
|
||||
Result := Self.DataType as IDataArrayType;
|
||||
end;
|
||||
|
||||
{ TArrayTypes }
|
||||
|
||||
class constructor TArrayTypes.CreateClass;
|
||||
begin
|
||||
// IDataType interface keys work out-of-the-box with the default comparer.
|
||||
FRegistry := TDictionary<IDataType, IDataArrayType>.Create;
|
||||
end;
|
||||
|
||||
class destructor TArrayTypes.DestroyClass;
|
||||
begin
|
||||
FRegistry.Free;
|
||||
end;
|
||||
|
||||
class function TArrayTypes.GetType(const AElementType: TDataType): TArrayType;
|
||||
var
|
||||
arrayTypeItf: IDataArrayType;
|
||||
elementTypeItf: IDataType;
|
||||
begin
|
||||
elementTypeItf := AElementType.DataType; // Get underlying interface from helper
|
||||
if not Assigned(elementTypeItf) then
|
||||
raise EArgumentException.Create('Cannot create an array type with a nil element type.');
|
||||
|
||||
TMonitor.Enter(FRegistry);
|
||||
try
|
||||
if not FRegistry.TryGetValue(elementTypeItf, arrayTypeItf) then
|
||||
begin
|
||||
arrayTypeItf := TImplDataArrayType.Create(elementTypeItf);
|
||||
FRegistry.Add(elementTypeItf, arrayTypeItf);
|
||||
end;
|
||||
finally
|
||||
TMonitor.Exit(FRegistry);
|
||||
end;
|
||||
Result := arrayTypeItf;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,113 @@
|
||||
unit Myc.Data.Types.Float;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Myc.Data.Types;
|
||||
|
||||
type
|
||||
TDataValueHelper = record helper for TDataValue
|
||||
public
|
||||
function AsFloat: IDataFloatValue;
|
||||
end;
|
||||
|
||||
TDataTypeHelper = record helper for TDataType
|
||||
public
|
||||
function AsFloat: IDataFloatType;
|
||||
end;
|
||||
|
||||
// Public factory for creating float values.
|
||||
TFloatType = record
|
||||
public
|
||||
class function CreateValue(Init: Double): IDataFloatValue; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils;
|
||||
|
||||
type
|
||||
// Implements the float data value.
|
||||
TImplDataFloatValue = class(TInterfacedObject, IDataValue, IDataFloatValue)
|
||||
private
|
||||
FValue: Double;
|
||||
public
|
||||
constructor Create(const AValue: Double);
|
||||
|
||||
// IDataValue
|
||||
function GetDataType: IDataType;
|
||||
|
||||
// IDataFloatValue
|
||||
function GetValue: Double;
|
||||
end;
|
||||
|
||||
// Implements the float data type.
|
||||
TImplDataFloatType = class(TInterfacedObject, IDataType, IDataFloatType)
|
||||
strict private
|
||||
class var
|
||||
FSingleton: IDataFloatType;
|
||||
class constructor CreateClass;
|
||||
public
|
||||
function GetName: String;
|
||||
function CreateValue(Init: Double): IDataFloatValue;
|
||||
class property Singleton: IDataFloatType read FSingleton;
|
||||
end;
|
||||
|
||||
{ TImplDataFloatValue }
|
||||
|
||||
constructor TImplDataFloatValue.Create(const AValue: Double);
|
||||
begin
|
||||
inherited Create;
|
||||
FValue := AValue;
|
||||
end;
|
||||
|
||||
function TImplDataFloatValue.GetDataType: IDataType;
|
||||
begin
|
||||
Result := TImplDataFloatType.Singleton;
|
||||
end;
|
||||
|
||||
function TImplDataFloatValue.GetValue: Double;
|
||||
begin
|
||||
Result := FValue;
|
||||
end;
|
||||
|
||||
{ TImplDataFloatType }
|
||||
|
||||
class constructor TImplDataFloatType.CreateClass;
|
||||
begin
|
||||
FSingleton := TImplDataFloatType.Create;
|
||||
end;
|
||||
|
||||
function TImplDataFloatType.GetName: String;
|
||||
begin
|
||||
Result := 'Float';
|
||||
end;
|
||||
|
||||
function TImplDataFloatType.CreateValue(Init: Double): IDataFloatValue;
|
||||
begin
|
||||
Result := TImplDataFloatValue.Create(Init);
|
||||
end;
|
||||
|
||||
{ TFloatType }
|
||||
|
||||
class function TFloatType.CreateValue(Init: Double): IDataFloatValue;
|
||||
begin
|
||||
Result := TImplDataFloatType.Singleton.CreateValue(Init);
|
||||
end;
|
||||
|
||||
{ TDataValueHelper }
|
||||
|
||||
function TDataValueHelper.AsFloat: IDataFloatValue;
|
||||
begin
|
||||
Result := Self.DataValue as IDataFloatValue;
|
||||
end;
|
||||
|
||||
{ TDataTypeHelper }
|
||||
|
||||
function TDataTypeHelper.AsFloat: IDataFloatType;
|
||||
begin
|
||||
Result := Self.DataType as IDataFloatType;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,111 @@
|
||||
unit Myc.Data.Types.Ordinal;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Myc.Data.Types;
|
||||
|
||||
type
|
||||
TDataValueOrdinalHelper = record helper for TDataValue
|
||||
public
|
||||
function AsOrdinal: IDataOrdinalValue;
|
||||
end;
|
||||
|
||||
TDataTypeHelper = record helper for TDataType
|
||||
public
|
||||
function AsOrdinal: IDataOrdinalType;
|
||||
end;
|
||||
|
||||
TOrdinalType = record
|
||||
class function CreateValue(Init: Int64): IDataOrdinalValue; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils;
|
||||
|
||||
type
|
||||
// Implements the ordinal data value.
|
||||
TImplDataOrdinalValue = class(TInterfacedObject, IDataValue, IDataOrdinalValue)
|
||||
private
|
||||
FValue: Int64;
|
||||
public
|
||||
constructor Create(const AValue: Int64);
|
||||
|
||||
// IDataValue
|
||||
function GetDataType: IDataType;
|
||||
|
||||
// IDataOrdinalValue
|
||||
function GetValue: Int64;
|
||||
end;
|
||||
|
||||
// Implements the ordinal data type.
|
||||
TImplDataOrdinalType = class(TInterfacedObject, IDataType, IDataOrdinalType)
|
||||
strict private
|
||||
class var
|
||||
FSingleton: IDataOrdinalType;
|
||||
class constructor CreateClass;
|
||||
public
|
||||
function GetName: String;
|
||||
function CreateValue(Init: Int64): IDataOrdinalValue;
|
||||
class property Singleton: IDataOrdinalType read FSingleton;
|
||||
end;
|
||||
|
||||
{ TImplDataOrdinalValue }
|
||||
|
||||
constructor TImplDataOrdinalValue.Create(const AValue: Int64);
|
||||
begin
|
||||
inherited Create;
|
||||
FValue := AValue;
|
||||
end;
|
||||
|
||||
function TImplDataOrdinalValue.GetDataType: IDataType;
|
||||
begin
|
||||
Result := TImplDataOrdinalType.Singleton;
|
||||
end;
|
||||
|
||||
function TImplDataOrdinalValue.GetValue: Int64;
|
||||
begin
|
||||
Result := FValue;
|
||||
end;
|
||||
|
||||
{ TImplDataOrdinalType }
|
||||
|
||||
class constructor TImplDataOrdinalType.CreateClass;
|
||||
begin
|
||||
FSingleton := TImplDataOrdinalType.Create;
|
||||
end;
|
||||
|
||||
function TImplDataOrdinalType.GetName: String;
|
||||
begin
|
||||
Result := 'Integer';
|
||||
end;
|
||||
|
||||
function TImplDataOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue;
|
||||
begin
|
||||
Result := TImplDataOrdinalValue.Create(Init);
|
||||
end;
|
||||
|
||||
{ TDataTypeHelper }
|
||||
|
||||
function TDataTypeHelper.AsOrdinal: IDataOrdinalType;
|
||||
begin
|
||||
Result := DataType as IDataOrdinalType;
|
||||
end;
|
||||
|
||||
{ TDataValueOrdinalHelper }
|
||||
|
||||
function TDataValueOrdinalHelper.AsOrdinal: IDataOrdinalValue;
|
||||
begin
|
||||
Result := DataValue as IDataOrdinalValue;
|
||||
end;
|
||||
|
||||
{ TOrdinalType }
|
||||
|
||||
class function TOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue;
|
||||
begin
|
||||
Result := TImplDataOrdinalType.Singleton.CreateValue(Init);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,399 @@
|
||||
unit Myc.Data.Types.Records;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.Generics.Collections,
|
||||
System.SysUtils,
|
||||
Myc.Data.Types;
|
||||
|
||||
type
|
||||
// An interface helper for IDataRecordType.
|
||||
TRecordType = record
|
||||
private
|
||||
FRecordType: IDataRecordType;
|
||||
function GetFieldCount: Integer; inline;
|
||||
function GetField(Idx: Integer): TRecordField; inline;
|
||||
function GetName: String; inline;
|
||||
public
|
||||
constructor Create(const ARecordType: IDataRecordType);
|
||||
|
||||
class operator Implicit(const A: IDataRecordType): TRecordType; overload;
|
||||
class operator Implicit(const A: TRecordType): IDataRecordType; overload;
|
||||
|
||||
function CreateValue(const AItems: array of IDataValue): TDataValue;
|
||||
|
||||
function IndexOf(const AName: string): Integer; inline;
|
||||
|
||||
class operator Equal(const A, B: TRecordType): Boolean;
|
||||
|
||||
property Name: String read GetName;
|
||||
property FieldCount: Integer read GetFieldCount;
|
||||
property Fields[Idx: Integer]: TRecordField read GetField; default;
|
||||
end;
|
||||
|
||||
// An interface helper for IDataRecordValue.
|
||||
TRecordValue = record
|
||||
private
|
||||
FRecordValue: IDataRecordValue;
|
||||
function GetDataType: TRecordType; inline;
|
||||
function GetItem(Idx: Integer): TDataValue; inline;
|
||||
public
|
||||
constructor Create(const ARecordValue: IDataRecordValue);
|
||||
|
||||
function CreateValue(const AItems: array of IDataValue): TDataValue;
|
||||
|
||||
class operator Implicit(const A: IDataRecordValue): TRecordValue; overload;
|
||||
class operator Implicit(const A: TRecordValue): IDataRecordValue; overload;
|
||||
|
||||
property DataType: TRecordType read GetDataType;
|
||||
property Items[Idx: Integer]: TDataValue read GetItem; default;
|
||||
end;
|
||||
|
||||
TDataValueRecordHelper = record helper for TDataValue
|
||||
public
|
||||
function AsRecord: TRecordValue;
|
||||
end;
|
||||
|
||||
TDataTypeHelper = record helper for TDataType
|
||||
public
|
||||
function AsRecord: TRecordType;
|
||||
end;
|
||||
|
||||
// Public factory for creating record types.
|
||||
TRecordTypes = record
|
||||
strict private
|
||||
class var
|
||||
FRegistry: TDictionary<TArray<TRecordField>, IDataRecordType>;
|
||||
class constructor CreateClass;
|
||||
class destructor DestroyClass;
|
||||
public
|
||||
class function GetType(const AFields: TArray<TRecordField>): TRecordType; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Generics.Defaults,
|
||||
System.Hash,
|
||||
System.SyncObjs;
|
||||
|
||||
type
|
||||
{fwd}
|
||||
TImplDataRecordType = class;
|
||||
|
||||
// Custom comparer for TArray<TRecordField> to be used as a dictionary key.
|
||||
TRecordFieldComparer = class(TInterfacedObject, IEqualityComparer<TArray<TRecordField>>)
|
||||
public
|
||||
function Equals(const Left, Right: TArray<TRecordField>): Boolean; reintroduce;
|
||||
function GetHashCode(const Value: TArray<TRecordField>): Integer; reintroduce;
|
||||
end;
|
||||
|
||||
// Implements the record data value.
|
||||
TImplDataRecordValue = class(TInterfacedObject, IDataValue, IDataRecordValue)
|
||||
private
|
||||
FDataType: IDataRecordType;
|
||||
FItems: TArray<IDataValue>;
|
||||
function GetDataType: IDataType;
|
||||
function GetItem(Idx: Integer): IDataValue;
|
||||
public
|
||||
constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
|
||||
end;
|
||||
|
||||
// Implements the record data type.
|
||||
TImplDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType)
|
||||
private
|
||||
FFields: TArray<TRecordField>;
|
||||
FFieldMap: TDictionary<string, Integer>; // For fast lookups by name
|
||||
function GetName: String;
|
||||
function GetFieldCount: Integer;
|
||||
function GetField(Idx: Integer): TRecordField;
|
||||
function IndexOf(const AName: string): Integer;
|
||||
public
|
||||
constructor Create(const AFields: array of TRecordField);
|
||||
destructor Destroy; override;
|
||||
function CreateValue(const AItems: array of IDataValue): IDataRecordValue;
|
||||
end;
|
||||
|
||||
{ TRecordValue }
|
||||
|
||||
constructor TRecordValue.Create(const ARecordValue: IDataRecordValue);
|
||||
begin
|
||||
FRecordValue := ARecordValue;
|
||||
end;
|
||||
|
||||
function TRecordValue.CreateValue(const AItems: array of IDataValue): TDataValue;
|
||||
var
|
||||
recordTypeItf: IDataRecordType;
|
||||
begin
|
||||
recordTypeItf := Self.DataType;
|
||||
if not Assigned(recordTypeItf) then
|
||||
raise EAccessViolation.Create('Cannot create value from a nil record type.');
|
||||
Result := recordTypeItf.CreateValue(AItems);
|
||||
end;
|
||||
|
||||
function TRecordValue.GetDataType: TRecordType;
|
||||
begin
|
||||
if Assigned(FRecordValue) then
|
||||
Result := FRecordValue.DataType as IDataRecordType
|
||||
else
|
||||
Result := TRecordType.Create(nil);
|
||||
end;
|
||||
|
||||
function TRecordValue.GetItem(Idx: Integer): TDataValue;
|
||||
begin
|
||||
if Assigned(FRecordValue) then
|
||||
Result := FRecordValue.Items[Idx]
|
||||
else
|
||||
Result := TDataValue.Create(nil);
|
||||
end;
|
||||
|
||||
class operator TRecordValue.Implicit(const A: TRecordValue): IDataRecordValue;
|
||||
begin
|
||||
Result := A.FRecordValue;
|
||||
end;
|
||||
|
||||
class operator TRecordValue.Implicit(const A: IDataRecordValue): TRecordValue;
|
||||
begin
|
||||
Result.FRecordValue := A;
|
||||
end;
|
||||
|
||||
{ TRecordType }
|
||||
|
||||
constructor TRecordType.Create(const ARecordType: IDataRecordType);
|
||||
begin
|
||||
FRecordType := ARecordType;
|
||||
end;
|
||||
|
||||
function TRecordType.CreateValue(const AItems: array of IDataValue): TDataValue;
|
||||
begin
|
||||
if Assigned(FRecordType) then
|
||||
Result := FRecordType.CreateValue(AItems)
|
||||
else
|
||||
raise EAccessViolation.Create('Cannot create value from a nil record type.');
|
||||
end;
|
||||
|
||||
function TRecordType.GetField(Idx: Integer): TRecordField;
|
||||
begin
|
||||
if Assigned(FRecordType) then
|
||||
Result := FRecordType.Fields[Idx]
|
||||
else
|
||||
Result := Default(TRecordField);
|
||||
end;
|
||||
|
||||
function TRecordType.GetFieldCount: Integer;
|
||||
begin
|
||||
if Assigned(FRecordType) then
|
||||
Result := FRecordType.FieldCount
|
||||
else
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TRecordType.GetName: String;
|
||||
begin
|
||||
if Assigned(FRecordType) then
|
||||
Result := FRecordType.Name
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TRecordType.IndexOf(const AName: string): Integer;
|
||||
begin
|
||||
if Assigned(FRecordType) then
|
||||
Result := FRecordType.IndexOf(AName)
|
||||
else
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
class operator TRecordType.Equal(const A, B: TRecordType): Boolean;
|
||||
begin
|
||||
Result := A.FRecordType = B.FRecordType;
|
||||
end;
|
||||
|
||||
class operator TRecordType.Implicit(const A: TRecordType): IDataRecordType;
|
||||
begin
|
||||
Result := A.FRecordType;
|
||||
end;
|
||||
|
||||
class operator TRecordType.Implicit(const A: IDataRecordType): TRecordType;
|
||||
begin
|
||||
Result.FRecordType := A;
|
||||
end;
|
||||
|
||||
{ TRecordFieldComparer }
|
||||
|
||||
function TRecordFieldComparer.Equals(const Left, Right: TArray<TRecordField>): Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if (Length(Left) <> Length(Right)) then
|
||||
exit(False);
|
||||
|
||||
for i := 0 to High(Left) do
|
||||
begin
|
||||
if (CompareStr(Left[i].Name, Right[i].Name) <> 0) or (Left[i].DataType <> Right[i].DataType) then
|
||||
exit(False);
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TRecordFieldComparer.GetHashCode(const Value: TArray<TRecordField>): Integer;
|
||||
var
|
||||
field: TRecordField;
|
||||
begin
|
||||
Result := 0;
|
||||
for field in Value do
|
||||
begin
|
||||
Result := THashBobJenkins.GetHashValue(field.Name) xor THashFNV1a32.GetHashValue(field.DataType, SizeOf(IDataType)) xor Result;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TImplDataRecordValue }
|
||||
|
||||
constructor TImplDataRecordValue.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
inherited Create;
|
||||
FDataType := ADataType;
|
||||
SetLength(FItems, Length(AItems));
|
||||
for i := 0 to High(AItems) do
|
||||
FItems[i] := AItems[i];
|
||||
end;
|
||||
|
||||
function TImplDataRecordValue.GetDataType: IDataType;
|
||||
begin
|
||||
Result := FDataType;
|
||||
end;
|
||||
|
||||
function TImplDataRecordValue.GetItem(Idx: Integer): IDataValue;
|
||||
begin
|
||||
Result := FItems[Idx];
|
||||
end;
|
||||
|
||||
{ TImplDataRecordType }
|
||||
|
||||
constructor TImplDataRecordType.Create(const AFields: array of TRecordField);
|
||||
var
|
||||
i: Integer;
|
||||
field: TRecordField;
|
||||
begin
|
||||
inherited Create;
|
||||
FFieldMap := TDictionary<string, Integer>.Create;
|
||||
SetLength(FFields, Length(AFields));
|
||||
for i := 0 to High(AFields) do
|
||||
begin
|
||||
field := AFields[i];
|
||||
if FFieldMap.ContainsKey(field.Name) then
|
||||
raise EArgumentException.CreateFmt('Duplicate field name: ''%s''', [field.Name]);
|
||||
FFields[i] := field;
|
||||
FFieldMap.Add(field.Name, i);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TImplDataRecordType.Destroy;
|
||||
begin
|
||||
FFieldMap.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TImplDataRecordType.CreateValue(const AItems: array of IDataValue): IDataRecordValue;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if (Length(AItems) <> Length(FFields)) then
|
||||
raise EArgumentException
|
||||
.CreateFmt('Invalid number of items for this record type. Expected %d, but got %d.', [Length(FFields), Length(AItems)]);
|
||||
|
||||
for i := 0 to High(AItems) do
|
||||
if (AItems[i].DataType <> FFields[i].DataType) then
|
||||
raise EArgumentException.CreateFmt(
|
||||
'Invalid data type for field ''%s'' at index %d. Expected ''%s'', but got ''%s''.',
|
||||
[FFields[i].Name, i, FFields[i].DataType.Name, AItems[i].DataType.Name]);
|
||||
|
||||
Result := TImplDataRecordValue.Create(Self, AItems);
|
||||
end;
|
||||
|
||||
function TImplDataRecordType.GetField(Idx: Integer): TRecordField;
|
||||
begin
|
||||
Result := FFields[Idx];
|
||||
end;
|
||||
|
||||
function TImplDataRecordType.GetFieldCount: Integer;
|
||||
begin
|
||||
Result := Length(FFields);
|
||||
end;
|
||||
|
||||
function TImplDataRecordType.GetName: String;
|
||||
var
|
||||
i: Integer;
|
||||
sb: TStringBuilder;
|
||||
begin
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
sb.Append('Record<');
|
||||
for i := 0 to High(FFields) do
|
||||
begin
|
||||
sb.Append(FFields[i].Name);
|
||||
sb.Append(': ');
|
||||
sb.Append(FFields[i].DataType.Name);
|
||||
if (i < High(FFields)) then
|
||||
sb.Append(', ');
|
||||
end;
|
||||
sb.Append('>');
|
||||
Result := sb.ToString;
|
||||
finally
|
||||
sb.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TImplDataRecordType.IndexOf(const AName: string): Integer;
|
||||
begin
|
||||
if not FFieldMap.TryGetValue(AName, Result) then
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
{ TDataValueRecordHelper }
|
||||
|
||||
function TDataValueRecordHelper.AsRecord: TRecordValue;
|
||||
begin
|
||||
Result := Self.DataValue as IDataRecordValue;
|
||||
end;
|
||||
|
||||
{ TDataTypeHelper }
|
||||
|
||||
function TDataTypeHelper.AsRecord: TRecordType;
|
||||
begin
|
||||
Result := Self.DataType as IDataRecordType;
|
||||
end;
|
||||
|
||||
{ TRecordTypes }
|
||||
|
||||
class constructor TRecordTypes.CreateClass;
|
||||
begin
|
||||
FRegistry := TDictionary<TArray<TRecordField>, IDataRecordType>.Create(TRecordFieldComparer.Create);
|
||||
end;
|
||||
|
||||
class destructor TRecordTypes.DestroyClass;
|
||||
begin
|
||||
FRegistry.Free;
|
||||
end;
|
||||
|
||||
class function TRecordTypes.GetType(const AFields: TArray<TRecordField>): TRecordType;
|
||||
var
|
||||
recordTypeItf: IDataRecordType;
|
||||
begin
|
||||
TMonitor.Enter(FRegistry);
|
||||
try
|
||||
if not FRegistry.TryGetValue(AFields, recordTypeItf) then
|
||||
begin
|
||||
recordTypeItf := TImplDataRecordType.Create(AFields);
|
||||
FRegistry.Add(AFields, recordTypeItf);
|
||||
end;
|
||||
finally
|
||||
TMonitor.Exit(FRegistry);
|
||||
end;
|
||||
Result := recordTypeItf;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,200 @@
|
||||
unit Myc.Data.Types.Tuple;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
Myc.Data.Types;
|
||||
|
||||
type
|
||||
// An interface helper for the singleton IDataTupleType.
|
||||
TTupleType = record
|
||||
private
|
||||
FTupleType: IDataTupleType;
|
||||
function GetName: String; inline;
|
||||
public
|
||||
constructor Create(const ATupleType: IDataTupleType);
|
||||
class operator Implicit(const A: IDataTupleType): TTupleType; overload;
|
||||
class operator Implicit(const A: TTupleType): IDataTupleType; overload;
|
||||
property Name: String read GetName;
|
||||
end;
|
||||
|
||||
// An interface helper for IDataTupleValue.
|
||||
TTupleValue = record
|
||||
private
|
||||
FTupleValue: IDataTupleValue;
|
||||
function GetItem(Idx: Integer): TDataValue; inline;
|
||||
function GetItemCount: Integer; inline;
|
||||
public
|
||||
constructor Create(const ATupleValue: IDataTupleValue);
|
||||
|
||||
class operator Implicit(const A: IDataTupleValue): TTupleValue; overload;
|
||||
class operator Implicit(const A: TTupleValue): IDataTupleValue; overload;
|
||||
|
||||
property ItemCount: Integer read GetItemCount;
|
||||
property Items[Idx: Integer]: TDataValue read GetItem; default;
|
||||
end;
|
||||
|
||||
TDataValueHelper = record helper for TDataValue
|
||||
public
|
||||
function AsTuple: TTupleValue;
|
||||
end;
|
||||
|
||||
TDataTypeHelper = record helper for TDataType
|
||||
public
|
||||
function AsTuple: TTupleType;
|
||||
end;
|
||||
|
||||
// Public factory for creating simple, non-cached tuple values.
|
||||
TTuple = record
|
||||
public
|
||||
class function Create(const AItems: array of IDataValue): IDataTupleValue; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
// Implements the simple tuple data value.
|
||||
TImplDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue)
|
||||
private
|
||||
FItems: TArray<IDataValue>;
|
||||
function GetDataType: IDataType;
|
||||
function GetItemCount: Integer;
|
||||
function GetItem(Idx: Integer): IDataValue;
|
||||
public
|
||||
constructor Create(const AItems: array of IDataValue);
|
||||
end;
|
||||
|
||||
// Implements the singleton tuple data type.
|
||||
TImplDataTupleType = class(TInterfacedObject, IDataType, IDataTupleType)
|
||||
strict private
|
||||
class var
|
||||
FSingleton: IDataTupleType;
|
||||
class constructor CreateClass;
|
||||
private
|
||||
function GetName: String;
|
||||
public
|
||||
class property Singleton: IDataTupleType read FSingleton;
|
||||
end;
|
||||
|
||||
{ TTupleValue }
|
||||
|
||||
constructor TTupleValue.Create(const ATupleValue: IDataTupleValue);
|
||||
begin
|
||||
FTupleValue := ATupleValue;
|
||||
end;
|
||||
|
||||
function TTupleValue.GetItem(Idx: Integer): TDataValue;
|
||||
begin
|
||||
if Assigned(FTupleValue) then
|
||||
Result := FTupleValue.Items[Idx]
|
||||
else
|
||||
Result := TDataValue.Create(nil);
|
||||
end;
|
||||
|
||||
function TTupleValue.GetItemCount: Integer;
|
||||
begin
|
||||
if Assigned(FTupleValue) then
|
||||
Result := FTupleValue.ItemCount
|
||||
else
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
class operator TTupleValue.Implicit(const A: TTupleValue): IDataTupleValue;
|
||||
begin
|
||||
Result := A.FTupleValue;
|
||||
end;
|
||||
|
||||
class operator TTupleValue.Implicit(const A: IDataTupleValue): TTupleValue;
|
||||
begin
|
||||
Result.FTupleValue := A;
|
||||
end;
|
||||
|
||||
{ TTupleType }
|
||||
|
||||
constructor TTupleType.Create(const ATupleType: IDataTupleType);
|
||||
begin
|
||||
FTupleType := ATupleType;
|
||||
end;
|
||||
|
||||
function TTupleType.GetName: String;
|
||||
begin
|
||||
if Assigned(FTupleType) then
|
||||
Result := FTupleType.Name
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
class operator TTupleType.Implicit(const A: TTupleType): IDataTupleType;
|
||||
begin
|
||||
Result := A.FTupleType;
|
||||
end;
|
||||
|
||||
class operator TTupleType.Implicit(const A: IDataTupleType): TTupleType;
|
||||
begin
|
||||
Result.FTupleType := A;
|
||||
end;
|
||||
|
||||
{ TImplDataTupleValue }
|
||||
|
||||
constructor TImplDataTupleValue.Create(const AItems: array of IDataValue);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
inherited Create;
|
||||
SetLength(FItems, Length(AItems));
|
||||
for i := 0 to High(AItems) do
|
||||
FItems[i] := AItems[i];
|
||||
end;
|
||||
|
||||
function TImplDataTupleValue.GetDataType: IDataType;
|
||||
begin
|
||||
Result := TImplDataTupleType.Singleton;
|
||||
end;
|
||||
|
||||
function TImplDataTupleValue.GetItem(Idx: Integer): IDataValue;
|
||||
begin
|
||||
Result := FItems[Idx];
|
||||
end;
|
||||
|
||||
function TImplDataTupleValue.GetItemCount: Integer;
|
||||
begin
|
||||
Result := Length(FItems);
|
||||
end;
|
||||
|
||||
{ TImplDataTupleType }
|
||||
|
||||
class constructor TImplDataTupleType.CreateClass;
|
||||
begin
|
||||
FSingleton := TImplDataTupleType.Create;
|
||||
end;
|
||||
|
||||
function TImplDataTupleType.GetName: String;
|
||||
begin
|
||||
Result := 'Tuple';
|
||||
end;
|
||||
|
||||
{ TDataValueHelper }
|
||||
|
||||
function TDataValueHelper.AsTuple: TTupleValue;
|
||||
begin
|
||||
Result := Self.DataValue as IDataTupleValue;
|
||||
end;
|
||||
|
||||
{ TDataTypeHelper }
|
||||
|
||||
function TDataTypeHelper.AsTuple: TTupleType;
|
||||
begin
|
||||
Result := Self.DataType as IDataTupleType;
|
||||
end;
|
||||
|
||||
{ TTuple }
|
||||
|
||||
class function TTuple.Create(const AItems: array of IDataValue): IDataTupleValue;
|
||||
begin
|
||||
// Create a new value instance. The instance itself knows its item count
|
||||
// and will report the singleton "Tuple" type via its DataType property.
|
||||
Result := TImplDataTupleValue.Create(AItems);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,176 @@
|
||||
unit Myc.Data.Types;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
IDataType = interface
|
||||
function GetName: String;
|
||||
property Name: String read GetName;
|
||||
end;
|
||||
|
||||
IDataValue = interface
|
||||
function GetDataType: IDataType;
|
||||
property DataType: IDataType read GetDataType;
|
||||
end;
|
||||
|
||||
IDataOrdinalValue = interface(IDataValue)
|
||||
['{DF512FD0-D513-4B96-9687-C80624E475A4}']
|
||||
function GetValue: Int64;
|
||||
property Value: Int64 read GetValue;
|
||||
end;
|
||||
|
||||
IDataOrdinalType = interface(IDataType)
|
||||
['{BE97F145-3634-4F56-9783-FD2C3DD485CA}']
|
||||
function CreateValue(Init: Int64): IDataOrdinalValue;
|
||||
end;
|
||||
|
||||
IDataFloatValue = interface(IDataValue)
|
||||
['{A6E1E8B5-B8E5-4F4B-9B2E-8E8E9F8F8B8E}']
|
||||
function GetValue: Double;
|
||||
property Value: Double read GetValue;
|
||||
end;
|
||||
|
||||
IDataFloatType = interface(IDataType)
|
||||
['{B7E2E9B6-B9E6-4F5B-9C3E-9E9E0F9F9C9F}']
|
||||
function CreateValue(Init: Double): IDataFloatValue;
|
||||
end;
|
||||
|
||||
IDataRecordValue = interface(IDataValue)
|
||||
['{53B63A49-720D-4E3E-8EE5-3EA45BA93E58}']
|
||||
function GetItem(Idx: Integer): IDataValue;
|
||||
property Items[Idx: Integer]: IDataValue read GetItem; default;
|
||||
end;
|
||||
|
||||
TRecordField = record
|
||||
Name: string;
|
||||
DataType: IDataType;
|
||||
public
|
||||
constructor Create(const AName: string; const ADataType: IDataType);
|
||||
end;
|
||||
|
||||
IDataRecordType = interface(IDataType)
|
||||
['{7A266BA0-B1AF-416B-941F-A730D6EDA333}']
|
||||
function GetFieldCount: Integer;
|
||||
function GetField(Idx: Integer): TRecordField;
|
||||
function IndexOf(const AName: string): Integer;
|
||||
function CreateValue(const AItems: array of IDataValue): IDataRecordValue;
|
||||
property FieldCount: Integer read GetFieldCount;
|
||||
property Fields[Idx: Integer]: TRecordField read GetField; default;
|
||||
end;
|
||||
|
||||
IDataTupleValue = interface(IDataValue)
|
||||
['{E1D5B0D1-8A1C-4B7E-9F2D-3A4B5C6D7E8F}']
|
||||
function GetItemCount: Integer;
|
||||
function GetItem(Idx: Integer): IDataValue;
|
||||
property ItemCount: Integer read GetItemCount;
|
||||
property Items[Idx: Integer]: IDataValue read GetItem; default;
|
||||
end;
|
||||
|
||||
IDataTupleType = interface(IDataType)
|
||||
['{9442043E-99AC-4464-99E4-75F1BE1F3118}']
|
||||
end;
|
||||
|
||||
IDataArrayValue = interface(IDataValue)
|
||||
['{1F3A4B5C-6D7E-4F1A-8B9C-0D1E2F3A4B5C}']
|
||||
function GetElementCount: Integer;
|
||||
function GetItem(Idx: Integer): IDataValue;
|
||||
property ElementCount: Integer read GetElementCount;
|
||||
property Items[Idx: Integer]: IDataValue read GetItem; default;
|
||||
end;
|
||||
|
||||
IDataArrayType = interface(IDataType)
|
||||
['{7E8F9A0B-C1D2-4E3F-A4B5-C6D7E8F9A0B1}']
|
||||
function GetElementType: IDataType;
|
||||
function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
|
||||
property ElementType: IDataType read GetElementType;
|
||||
end;
|
||||
|
||||
TDataType = record
|
||||
private
|
||||
FDataType: IDataType;
|
||||
function GetName: String; inline;
|
||||
public
|
||||
constructor Create(const ADataType: IDataType);
|
||||
|
||||
class operator Implicit(const A: IDataType): TDataType; overload;
|
||||
class operator Implicit(const A: TDataType): IDataType; overload;
|
||||
|
||||
property DataType: IDataType read FDataType;
|
||||
property Name: String read GetName;
|
||||
end;
|
||||
|
||||
TDataValue = record
|
||||
private
|
||||
FDataValue: IDataValue;
|
||||
function GetDataType: IDataType; inline;
|
||||
public
|
||||
constructor Create(const ADataValue: IDataValue);
|
||||
|
||||
class operator Implicit(const A: IDataValue): TDataValue; overload;
|
||||
class operator Implicit(const A: TDataValue): IDataValue; overload;
|
||||
|
||||
property DataValue: IDataValue read FDataValue;
|
||||
property DataType: IDataType read GetDataType;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TRecordField }
|
||||
|
||||
constructor TRecordField.Create(const AName: string; const ADataType: IDataType);
|
||||
begin
|
||||
Name := AName;
|
||||
DataType := ADataType;
|
||||
end;
|
||||
|
||||
{ TDataType }
|
||||
|
||||
constructor TDataType.Create(const ADataType: IDataType);
|
||||
begin
|
||||
FDataType := ADataType;
|
||||
end;
|
||||
|
||||
function TDataType.GetName: String;
|
||||
begin
|
||||
if Assigned(FDataType) then
|
||||
Result := FDataType.Name
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
class operator TDataType.Implicit(const A: TDataType): IDataType;
|
||||
begin
|
||||
Result := A.FDataType;
|
||||
end;
|
||||
|
||||
class operator TDataType.Implicit(const A: IDataType): TDataType;
|
||||
begin
|
||||
Result.FDataType := A;
|
||||
end;
|
||||
|
||||
{ TDataValue }
|
||||
|
||||
constructor TDataValue.Create(const ADataValue: IDataValue);
|
||||
begin
|
||||
FDataValue := ADataValue;
|
||||
end;
|
||||
|
||||
function TDataValue.GetDataType: IDataType;
|
||||
begin
|
||||
if Assigned(FDataValue) then
|
||||
Result := FDataValue.DataType
|
||||
else
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
class operator TDataValue.Implicit(const A: TDataValue): IDataValue;
|
||||
begin
|
||||
Result := A.FDataValue;
|
||||
end;
|
||||
|
||||
class operator TDataValue.Implicit(const A: IDataValue): TDataValue;
|
||||
begin
|
||||
Result.FDataValue := A;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,219 @@
|
||||
# Zweck und Ziele
|
||||
|
||||
* Unterstütze mich bei der Entwicklung unter Embarcadero Delphi.
|
||||
* Ich bin ein sehr erfahrener Softwareentwickler. Fasse dich kurz und nutze Fachsprache.
|
||||
* Wir nutzen immer die neueste Delphi-Version, aktuell ist das Delphi 12.3 Athens.
|
||||
|
||||
|
||||
|
||||
# Allgemeine Regeln
|
||||
|
||||
* Sprache im Code und in den Kommentaren: Englisch
|
||||
* Sprache im Chat: Deutsch
|
||||
|
||||
* Ändere niemals den Code, den ich poste - es sei denn, ich fordere dich ausdrücklich dazu auf. Wenn ich Code poste, dann analysiere ihn zunächst und weise mich gegebenenfalls auf Unstimmigkeiten hin.
|
||||
|
||||
* Von mir geposteter Code ersetzt grundsätzlich die ältere Versionen des selben Codes.
|
||||
|
||||
* Bei der Code-Analyse zählt nur die tatsächliche Implementierung. Kommentare können veraltet sein. Weise mich auf Differenzen zwischen Implementierung und Kommentaren hin.
|
||||
|
||||
* Finde Schlüsselstellen im Code und zeige mir durch eine kurze Erklärung, dass du sie verstanden hast.
|
||||
|
||||
* Effizienz ist mir sehr wichtig. Wenn dir etwas auffällt, das die Performance negativ beeinflussen kann, dann weise mich darauf hin.
|
||||
|
||||
* Schlage gegebenenfalls Korrekturen vor. Warte auf meine Zustimmung, bevor die sie vornimmst.
|
||||
|
||||
* Erkläre niemals grundlegende Syntax, es sei denn ich frage ausdrücklich danach.
|
||||
|
||||
* Fasse dich kurz. Behalte den Kontext während der gesamten Konversation bei. Alle Ideen und Antworten sollen mit der vorherigen Diskussion in Verbindung stehen. Schweife nicht ab.
|
||||
|
||||
* Wenn ich unvollständigen Code poste, erstelle einen Plan, wie die Implementierung aussehen könnte und präsentiere ihn kurz und prägnant.
|
||||
|
||||
# TODO
|
||||
|
||||
* Wenn ich Code poste, der einen TODO-Eintrag enthält, dann implementiere die dort spezifizierten Anforderungen.
|
||||
|
||||
* Ändere *nicht* den umliegenden Code. Nutze den vorhandenen Kontext um die Anforderung zu erledigen.
|
||||
|
||||
* Dokumentiere die Änderung knapp direkt im Code.
|
||||
|
||||
* Gib mir als Ergebnis den vollständigen Codeblock zurück.
|
||||
|
||||
# Code-Generierung
|
||||
|
||||
* Befolge die gängigen Delphi-Formatierungsstandards mit folgenden Ausnahmen:
|
||||
|
||||
- Einrückung mit 4 Leerzeichen anstelle von 2. Auch bei Kommentaren.
|
||||
- Das Code-Format ist UTF-8. Nur ASCII, keine Sonderzeichen erlaubt (insb. kein No-Break-Space!)
|
||||
- Folgende Schlüsselwörter müssen klein geschrieben werden:
|
||||
and, or, not, mod, div, in, as, is, array of, sizeof(), inc(), dec(), exit, inc, dec, shl, shr
|
||||
- Compiler-Direktiven (z.B. $region) sollen immer klein geschrieben werden.
|
||||
|
||||
* Ändere niemals vorhandene Bezeichner im vom Benutzer bereitgestellten Code, es sei denn du wirst dazu aufgefordert.
|
||||
|
||||
* Bei verketteten Vergleichen innerhalb von if-Anweisungen müssen immer runde Klammern verwendet werden, um Teilausdrücke klar zu gruppieren:
|
||||
"if (a > b) and (c < d) then"
|
||||
|
||||
* Funktions- und Prozedurparameter dürfen keinen Präfix haben. Sie sollten großgeschrieben werden:
|
||||
"procedure ProcessData(InputArray: TIntegerArray; const Count: Integer)"
|
||||
|
||||
* Ausnahme: Parameter von Konstruktoren haben "A" als Präfix:
|
||||
"constructor Create(const AValue: Integer)"
|
||||
|
||||
* Lokale Variablen sollten mit einem kleinen Buchstaben beginnen (camel case) (z.B. tempValue: Integer;). Wenn ich von dieser Regel abweiche, ist das in Ordnung.
|
||||
|
||||
* Achte beim Erstellen von Format-Strings (z. B. mit Format()), darauf, dass die Anzahl der Parameter genau der Anzahl der Format-Tags (z. B. %s, %d) entspricht. Überprüfe die Typkompatibilität.
|
||||
|
||||
* Denke daran, dass Delphi nicht zwischen Groß- und Kleinschreibung unterscheidet. Bezeichner müssen sich immer von Schlüsselwörtern unterscheiden.
|
||||
|
||||
* Interfaces benötigen keine GUIDs. Füge keine GUIDs in Interfaces ein und schlagen Sie dies auch nicht vor. Wenn ein gegebenes Interface keine GUID hat, ist das so gewollt. GUIDs werden ausschließlich von mir vergeben. Füge niemals selbst eine GUID hinzu.
|
||||
|
||||
* TThread ist in System.Classes definiert.
|
||||
* TInterlocked ist in System.SyncObjs definiert.
|
||||
|
||||
* Statement-Blöcke werden mit begin..end eingekapselt. (Niemals mit Klammern!)
|
||||
* begin und end stehen am Anfang einer neuen Zeile. then steht nie am Anfang einer neuen Zeile.
|
||||
* RECORDs, die einen Initialize-Operator haben, sind Managed Records. Sie benötigen also kein explizites Create.
|
||||
|
||||
# In Unit-Tests
|
||||
|
||||
* Verwende nur statische Strings für Log-Einträge und Asserts. Keine Format(), ToString usw. (Das verursacht Speicherlecks außerhalb des Test-Gültigkeitsbereichs, sodass ein Leak vom Memory Manager gemeldet wird.)
|
||||
|
||||
* Verwende das Attribut für parametrische Tests, um verschiedene Szenarien durchzuspielen. Z. B. [TestCase('TestName', 'Parameter1,Parameter2,...')]
|
||||
|
||||
|
||||
# Kommentare im Code
|
||||
|
||||
* Vermeide jegliche Kommentare, die Änderungen am Code beschreiben. Z.B. `// hier wurde was geändert`. Das mag ich gar nicht.
|
||||
|
||||
* Kommentare sind immer englisch.
|
||||
|
||||
* Benutze keine HTML-Tags (`<summary>`, etc.)!
|
||||
* Benutze `//` oder `(* *)` und fasse dich extrem kurz. Meistens genügen Einzeiler vor den Deklarationen.
|
||||
|
||||
* Kommentare in der interface-Sektion einer Unit sollen die Schnittstelle dokumentieren. Dokumentiere ausschließlich Elemente, die auch von außen zugänglich sind, und beziehe dich auch nur auf Elemente, die von außen zugänglich sind. Im Interface wird beschrieben, **was** eine Funktion macht. Es wird nicht beschrieben **wie** sie es macht!
|
||||
|
||||
* Kommentare im Implementation-Teil sollten sehr sparsam eingesetzt werden. Sie sind nur nötig, wenn etwas wirklich kompliziertes Beschrieben werden muss und auch nur, wenn sich die Funktion nicht aus dem Quelltext ergibt.
|
||||
|
||||
* Jede Klassen-, Record-, oder Interface-Definition sollte einen sinnvollen Einzeiler haben.
|
||||
|
||||
# Refactoring
|
||||
|
||||
* Umschließe alle Reader- und Writer-Properties innerhalb einer Interface-Definition mit eine Region 'private'. So zum Beispiel:
|
||||
|
||||
```
|
||||
IConverter = interface(IMycProcessor<S>)
|
||||
{$region 'private'}
|
||||
function GetSender: TDataProvider<T>.IDataProvider;
|
||||
{$endregion}
|
||||
property Sender: TDataProvider<T>.IDataProvider read GetSender;
|
||||
end;
|
||||
```
|
||||
|
||||
# Projektplan
|
||||
|
||||
* **Wenn ich dich darum bitte**, erzeuge eine Zusammenfassung der Ergebnisse unserer Unterhaltung. Diese möchte ich in einen externen Projektplan kopieren.
|
||||
|
||||
- Formatiere in Markdown. Gib als Antwort nur den Projektplan aus (damit ich ihn direkt kopieren kann).
|
||||
- Füge Datum und Uhrzeit hinzu.
|
||||
- Gliedere in der Reihenfolge: Motivation - Ziel - Ergebnis
|
||||
- Fass dich kurz
|
||||
|
||||
* Füge eine kurze Todo-Liste an, welche die nächsten Schritte skizziert.
|
||||
|
||||
# Interface helper
|
||||
|
||||
**Interface helper** sind ein Konzept, dass *nicht* explizit in Delphi/Pascal verankert ist. Es werden stattdessen managed records benutzt um ein Interface zu kapseln und die zugrundeliegende Implementierung vollständig zu verbergen.
|
||||
|
||||
- Ein "interface helper" ist ein managed record, das immer nur **genau ein** Interface referenziert.
|
||||
|
||||
- Die Definition des Interface findet sich meist im Scope des helpers (ganz am Anfang mit Default-Visibility).
|
||||
|
||||
- Es verbirgt die verschiedenen Implementierungen des Interface und fungiert als generische "Instanz" des interface.
|
||||
|
||||
- interface helper unterstützen das **null object pattern**. Der Sinn dieses Patterns ist es, nil-Prüfungen überflüssig zu machen und stattdessen ein Null-Objekt mit definiertem "leerem" Verhalten zu haben.
|
||||
|
||||
- Die Implementierungen des Interfaces finden sich oft in "Core"-Klassen, oder im implementation-Teil der Unit. Diese Implementierungen sollen von Benutzern nicht direkt eingebunden werden (außer zum Testen.)
|
||||
|
||||
* Wenn ich dich dazu auffordere sollst du ihn so weit wie möglich selbst erzeugen, oder einen unvollständigen helper ergänzen. Auf jeden Fall enthält ein interface helper:
|
||||
- einen Konstruktor
|
||||
- zwei implicit-operatoren, die vom helper zum interface casten (und umgekehrt)
|
||||
- Wrapper für die Methoden und Properties des Interface.
|
||||
- ein class property "Null".
|
||||
|
||||
* Direkte Wrapper auf Interface-Methoden sind *inline*.
|
||||
|
||||
* Immer wenn ein interface helper für ein interface vorhanden wird, soll er auch benutzt werden. Greife nicht direkt auf die Implementierung zu, lasse den helper das erledigen. Beispiel:
|
||||
|
||||
```
|
||||
type
|
||||
TFuture<T> = record
|
||||
type
|
||||
IFuture = interface
|
||||
function GetValue: T;
|
||||
function GetDone: TState;
|
||||
end;
|
||||
|
||||
strict private
|
||||
class var
|
||||
FNull: IFuture;
|
||||
|
||||
class constructor CreateClass;
|
||||
|
||||
private
|
||||
FFuture: IFuture;
|
||||
function GetDone: TState; inline;
|
||||
function GetValue: T; inline;
|
||||
|
||||
public
|
||||
constructor Create(const AFuture: IFuture);
|
||||
|
||||
class operator Initialize(out Dest: TFuture<T>);
|
||||
class operator Implicit(const A: IFuture): TFuture<T>; overload;
|
||||
class operator Implicit(const A: TFuture<T>): IFuture; overload;
|
||||
|
||||
class property Null: IFuture read FNull;
|
||||
|
||||
// Wrapper methods for IFuture
|
||||
property Done: TState read GetDone;
|
||||
property Value: T read GetValue;
|
||||
end;
|
||||
|
||||
constructor TFuture<T>.Create(const AFuture: IFuture);
|
||||
begin
|
||||
FFuture := AFuture;
|
||||
if not Assigned(FFuture) then
|
||||
FFuture := FNull;
|
||||
end;
|
||||
|
||||
class constructor TFuture<T>.CreateClass;
|
||||
begin
|
||||
FNull := TNullFuture.Create;
|
||||
end;
|
||||
|
||||
class operator TFuture<T>.Implicit(const A: IFuture): TFuture<T>;
|
||||
begin
|
||||
Result.FFuture := A;
|
||||
end;
|
||||
|
||||
class operator TFuture<T>.Implicit(const A: TFuture<T>): IFuture;
|
||||
begin
|
||||
Result := A.FFuture;
|
||||
end;
|
||||
|
||||
class operator TFuture<T>.Initialize(out Dest: TFuture<T>);
|
||||
begin
|
||||
Dest.FFuture := FNull;
|
||||
end;
|
||||
|
||||
function TFuture<T>.GetDone: TState;
|
||||
begin
|
||||
Result := FFuture.Done;
|
||||
end;
|
||||
|
||||
function TFuture<T>.GetValue: T;
|
||||
begin
|
||||
Result := FFuture.Value;
|
||||
end;
|
||||
```
|
||||
|
||||
@@ -0,0 +1,16 @@
|
||||
unit Myc.Data.Component;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Myc.Signals,
|
||||
Myc.Data.Pipeline;
|
||||
|
||||
type
|
||||
IDataType = interface
|
||||
|
||||
end;
|
||||
|
||||
IDataTypeRegistry = interface
|
||||
procedure RegisterType(end; IDataComponentParameter = interface property end; implementation end.
|
||||
|
||||
@@ -193,8 +193,12 @@ type
|
||||
function Consume(const Value: T): TState; override; final;
|
||||
end;
|
||||
|
||||
// Endpoint that collects data into a series.
|
||||
TMycDataJoin<T> = class(TInterfacedObject, IProducer<TArray<T>>)
|
||||
IDataJoin<T> = interface(IProducer<TArray<T>>)
|
||||
function GetConsumers(Idx: Integer): IConsumer<T>;
|
||||
property Consumers[Idx: Integer]: IConsumer<T> read GetConsumers;
|
||||
end;
|
||||
|
||||
TMycDataJoinAll<T> = class(TInterfacedObject, IProducer<TArray<T>>, IDataJoin<T>)
|
||||
private
|
||||
FConsumers: array of record
|
||||
Consumer: TMycGenericConsumer<T>;
|
||||
@@ -214,6 +218,25 @@ type
|
||||
property Consumers[Idx: Integer]: IConsumer<T> read GetConsumers;
|
||||
end;
|
||||
|
||||
TMycDataJoinAny<T> = class(TInterfacedObject, IProducer<TArray<T>>, IDataJoin<T>)
|
||||
private
|
||||
FConsumers: array of TMycGenericConsumer<T>;
|
||||
FValues: TArray<T>;
|
||||
FInit: TArray<Boolean>;
|
||||
FInitCount: Integer;
|
||||
|
||||
FContainedProvider: TMycContainedProducer<TArray<T>>;
|
||||
FLock: TSpinLock;
|
||||
function Consume(Idx: Integer; const Value: T): TState;
|
||||
function GetConsumers(Idx: Integer): IConsumer<T>;
|
||||
function Link(const Consumer: IConsumer<TArray<T>>): TTag;
|
||||
procedure Unlink(Tag: TTag);
|
||||
public
|
||||
constructor Create(ACount: Integer);
|
||||
destructor Destroy; override;
|
||||
property Consumers[Idx: Integer]: IConsumer<T> read GetConsumers;
|
||||
end;
|
||||
|
||||
TMycComposedConverter<S, T> = class(TInterfacedObject, IConverter<S, T>)
|
||||
private
|
||||
FConsumer: IConsumer<S>;
|
||||
@@ -589,9 +612,9 @@ begin
|
||||
FQueue := Result;
|
||||
end;
|
||||
|
||||
{ TMycDataJoin<T> }
|
||||
{ TMycDataJoinAll<T> }
|
||||
|
||||
constructor TMycDataJoin<T>.Create(ACount: Integer);
|
||||
constructor TMycDataJoinAll<T>.Create(ACount: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
@@ -616,7 +639,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TMycDataJoin<T>.Destroy;
|
||||
destructor TMycDataJoinAll<T>.Destroy;
|
||||
begin
|
||||
for var i := High(FConsumers) downto 0 do
|
||||
with FConsumers[i] do
|
||||
@@ -629,17 +652,17 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMycDataJoin<T>.Link(const Consumer: IConsumer<TArray<T>>): TTag;
|
||||
function TMycDataJoinAll<T>.Link(const Consumer: IConsumer<TArray<T>>): TTag;
|
||||
begin
|
||||
Result := FContainedProvider.Link(Consumer);
|
||||
end;
|
||||
|
||||
procedure TMycDataJoin<T>.Unlink(Tag: TTag);
|
||||
procedure TMycDataJoinAll<T>.Unlink(Tag: TTag);
|
||||
begin
|
||||
FContainedProvider.Unlink(Tag);
|
||||
end;
|
||||
|
||||
function TMycDataJoin<T>.Consume(Idx: Integer; const Value: T): TState;
|
||||
function TMycDataJoinAll<T>.Consume(Idx: Integer; const Value: T): TState;
|
||||
begin
|
||||
var Arr: TArray<T>;
|
||||
|
||||
@@ -671,7 +694,7 @@ begin
|
||||
FContainedProvider.Broadcast(Arr);
|
||||
end;
|
||||
|
||||
function TMycDataJoin<T>.GetConsumers(Idx: Integer): IConsumer<T>;
|
||||
function TMycDataJoinAll<T>.GetConsumers(Idx: Integer): IConsumer<T>;
|
||||
begin
|
||||
Result := FConsumers[Idx].Consumer;
|
||||
end;
|
||||
@@ -797,4 +820,75 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
{ TMycDataJoinAny<T> }
|
||||
|
||||
constructor TMycDataJoinAny<T>.Create(ACount: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
SetLength(FConsumers, ACount);
|
||||
SetLength(FValues, ACount);
|
||||
SetLength(FInit, ACount);
|
||||
FInitCount := ACount;
|
||||
|
||||
FLock := TSpinLock.Create(false);
|
||||
|
||||
FContainedProvider := TMycContainedProducer<TArray<T>>.Create(Self);
|
||||
|
||||
var cFunc :=
|
||||
function(Idx: Integer): TConvertFunc<T, TState>
|
||||
begin
|
||||
Result := function(const Value: T): TState begin Result := Consume(Idx, Value); end
|
||||
end;
|
||||
|
||||
for var i := 0 to High(FConsumers) do
|
||||
begin
|
||||
FValues[i] := Default(T);
|
||||
FInit[i] := false;
|
||||
FConsumers[i] := TMycGenericConsumer<T>.Create(Self, cFunc(i));
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TMycDataJoinAny<T>.Destroy;
|
||||
begin
|
||||
for var i := High(FConsumers) downto 0 do
|
||||
FConsumers[i].Free;
|
||||
|
||||
FContainedProvider.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMycDataJoinAny<T>.Link(const Consumer: IConsumer<TArray<T>>): TTag;
|
||||
begin
|
||||
Result := FContainedProvider.Link(Consumer);
|
||||
end;
|
||||
|
||||
procedure TMycDataJoinAny<T>.Unlink(Tag: TTag);
|
||||
begin
|
||||
FContainedProvider.Unlink(Tag);
|
||||
end;
|
||||
|
||||
function TMycDataJoinAny<T>.Consume(Idx: Integer; const Value: T): TState;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
FValues[Idx] := Value;
|
||||
if not FInit[Idx] then
|
||||
begin
|
||||
FInit[Idx] := true;
|
||||
dec(FInitCount);
|
||||
end;
|
||||
|
||||
if FInitCount = 0 then
|
||||
FContainedProvider.Broadcast(FValues);
|
||||
finally
|
||||
FLock.Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMycDataJoinAny<T>.GetConsumers(Idx: Integer): IConsumer<T>;
|
||||
begin
|
||||
Result := FConsumers[Idx];
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -118,7 +118,10 @@ type
|
||||
|
||||
class function CreateEndpoint<T>(Lookback: Int64; out Series: TLazy<TSeries<T>>): IConsumer<T>; static;
|
||||
|
||||
class function Join<T>(const Producers: TArray<TProducer<T>>): TProducer<TArray<T>>; static;
|
||||
type
|
||||
TJoinMode = (jmAll, jmAny);
|
||||
|
||||
class function Join<T>(Mode: TJoinMode; const Producers: TArray<TProducer<T>>): TProducer<TArray<T>>; static;
|
||||
|
||||
type
|
||||
TRecordMapping = record
|
||||
@@ -344,11 +347,16 @@ begin
|
||||
);
|
||||
end;
|
||||
|
||||
class function TConverter.Join<T>(const Producers: TArray<TProducer<T>>): TProducer<TArray<T>>;
|
||||
class function TConverter.Join<T>(Mode: TJoinMode; const Producers: TArray<TProducer<T>>): TProducer<TArray<T>>;
|
||||
var
|
||||
joiner: TMycDataJoin<T>;
|
||||
joiner: IDataJoin<T>;
|
||||
begin
|
||||
joiner := TMycDataJoin<T>.Create(Length(Producers));
|
||||
case Mode of
|
||||
jmAll: joiner := TMycDataJoinAll<T>.Create(Length(Producers));
|
||||
jmAny: joiner := TMycDataJoinAny<T>.Create(Length(Producers));
|
||||
else
|
||||
Assert(false);
|
||||
end;
|
||||
Result := joiner;
|
||||
|
||||
for var i := 0 to High(Producers) do
|
||||
@@ -361,7 +369,7 @@ class function TConverter.JoinRecords(
|
||||
const Producers: TArray<TProducer<TDataRecord>>
|
||||
): TConverter<TArray<TDataRecord>, TDataRecord>;
|
||||
begin
|
||||
var RecProvider := Join<TDataRecord>(Producers);
|
||||
var RecProvider := Join<TDataRecord>(jmAll, Producers);
|
||||
|
||||
Result := DataMapping(Mapping, TargetLayout);
|
||||
|
||||
@@ -395,7 +403,7 @@ function TDataRecordHelper.JoinRecords(
|
||||
begin
|
||||
var map := TConverter.DataMapping(Mapping, TargetLayout);
|
||||
|
||||
TConverter.Join<TDataRecord>(Self).Chain(map.Consumer);
|
||||
TConverter.Join<TDataRecord>(jmAll, Self).Chain(map.Consumer);
|
||||
|
||||
Result := map.Producer;
|
||||
end;
|
||||
|
||||
@@ -0,0 +1,208 @@
|
||||
unit Myc.Data.Records.Types;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.TypInfo,
|
||||
System.Generics.Collections;
|
||||
|
||||
type
|
||||
TDataType = class abstract
|
||||
strict private
|
||||
class var
|
||||
FRegistry: TObjectDictionary<String, TDataType>;
|
||||
class constructor CreateClass;
|
||||
class destructor DestroyClass;
|
||||
private
|
||||
FTypeName: string;
|
||||
class function GetItems(const Name: String): TDataType; static;
|
||||
class procedure SetItems(const Name: String; const Value: TDataType); static;
|
||||
protected
|
||||
function GetHandle: PTypeInfo; virtual; abstract;
|
||||
function GetSize: Integer; virtual; abstract;
|
||||
public
|
||||
constructor Create(const ATypeName: string);
|
||||
procedure Init(P: Pointer); virtual;
|
||||
procedure Assign(P, Q: Pointer); virtual; abstract;
|
||||
procedure Finalize(P: Pointer); virtual;
|
||||
|
||||
class procedure RegisterType(DataType: TDataType);
|
||||
class property Items[const Name: String]: TDataType read GetItems write SetItems; default;
|
||||
|
||||
property TypeName: string read FTypeName;
|
||||
|
||||
property Handle: PTypeInfo read GetHandle;
|
||||
property Size: Integer read GetSize;
|
||||
end;
|
||||
|
||||
TFloatType = class(TDataType)
|
||||
type
|
||||
TFltType = (fSingle, fDouble);
|
||||
private
|
||||
FHandle: PTypeInfo;
|
||||
FSize: Integer;
|
||||
FFloatType: TFltType;
|
||||
protected
|
||||
function GetHandle: PTypeInfo; override;
|
||||
function GetSize: Integer; override;
|
||||
public
|
||||
constructor Create(const ATypeName: string);
|
||||
procedure Init(P: Pointer); override;
|
||||
procedure Assign(P, Q: Pointer); override;
|
||||
procedure Finalize(P: Pointer); override;
|
||||
end;
|
||||
|
||||
TIntegerType = class(TDataType)
|
||||
private
|
||||
FKind: TTypeKind;
|
||||
public
|
||||
constructor Create(const ATypeName: string; AHandle: PTypeInfo; ASize: Integer);
|
||||
procedure Init(P: Pointer); override;
|
||||
procedure Assign(P, Q: Pointer); override;
|
||||
procedure Finalize(P: Pointer); override;
|
||||
end;
|
||||
|
||||
TStringType = class(TDataType)
|
||||
public
|
||||
constructor Create(const ATypeName: string; AHandle: PTypeInfo; ASize: Integer);
|
||||
procedure Init(P: Pointer); override;
|
||||
procedure Assign(P, Q: Pointer); override;
|
||||
procedure Finalize(P: Pointer); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TDataType }
|
||||
|
||||
constructor TDataType.Create(const ATypeName: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FTypeName := ATypeName;
|
||||
end;
|
||||
|
||||
class constructor TDataType.CreateClass;
|
||||
begin
|
||||
FRegistry := TObjectDictionary<String, TDataType>.Create([doOwnsValues]);
|
||||
end;
|
||||
|
||||
class destructor TDataType.DestroyClass;
|
||||
begin
|
||||
FRegistry.Free;
|
||||
end;
|
||||
|
||||
procedure TDataType.Finalize(P: Pointer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
class function TDataType.GetItems(const Name: String): TDataType;
|
||||
begin
|
||||
if not FRegistry.TryGetValue(Name, Result) then
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TDataType.Init(P: Pointer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
class procedure TDataType.RegisterType(DataType: TDataType);
|
||||
begin
|
||||
FRegistry.Add(DataType.TypeName, DataType);
|
||||
end;
|
||||
|
||||
class procedure TDataType.SetItems(const Name: String; const Value: TDataType);
|
||||
begin
|
||||
// TODO -cMM: TDataType.SetItems default body inserted
|
||||
end;
|
||||
|
||||
{ TFloatType }
|
||||
|
||||
constructor TFloatType.Create(const ATypeName: string);
|
||||
begin
|
||||
inherited;
|
||||
FFloatType := GetTypeData(AHandle).FloatType;
|
||||
Assert(FFloatType in [ftSingle, ftDouble]);
|
||||
end;
|
||||
|
||||
procedure TFloatType.Assign(P, Q: Pointer);
|
||||
begin
|
||||
case FFloatType of
|
||||
ftSingle: PSingle(Q)^ := PSingle(P)^;
|
||||
ftDouble: PDouble(Q)^ := PDouble(P)^;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFloatType.Finalize(P: Pointer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function TFloatType.GetHandle: PTypeInfo;
|
||||
begin
|
||||
Result := FHandle;
|
||||
end;
|
||||
|
||||
function TFloatType.GetSize: Integer;
|
||||
begin
|
||||
Result := FSize;
|
||||
end;
|
||||
|
||||
procedure TFloatType.Init(P: Pointer);
|
||||
begin
|
||||
end;
|
||||
|
||||
{ TIntegerType }
|
||||
|
||||
constructor TIntegerType.Create(const ATypeName: string; AHandle: PTypeInfo; ASize: Integer);
|
||||
begin
|
||||
inherited;
|
||||
FKind := AHandle.Kind;
|
||||
Assert(FKind in [tkInteger, tkInt64]);
|
||||
end;
|
||||
|
||||
procedure TIntegerType.Assign(P, Q: Pointer);
|
||||
begin
|
||||
case FKind of
|
||||
tkInteger: PInteger(Q)^ := PInteger(P)^;
|
||||
tkInt64: PInt64(Q)^ := PInt64(P)^;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIntegerType.Finalize(P: Pointer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TIntegerType.Init(P: Pointer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ TStringType }
|
||||
|
||||
constructor TStringType.Create(const ATypeName: string; AHandle: PTypeInfo; ASize: Integer);
|
||||
begin
|
||||
inherited;
|
||||
Assert(AHandle.Kind in [tkString, tkUString]);
|
||||
end;
|
||||
|
||||
procedure TStringType.Assign(P, Q: Pointer);
|
||||
begin
|
||||
PString(Q)^ := PString(P)^;
|
||||
end;
|
||||
|
||||
procedure TStringType.Finalize(P: Pointer);
|
||||
begin
|
||||
System.Finalize(PString(P)^);
|
||||
end;
|
||||
|
||||
procedure TStringType.Init(P: Pointer);
|
||||
begin
|
||||
System.Initialize(PString(P)^);
|
||||
end;
|
||||
|
||||
initialization
|
||||
TDataType.RegisterType(TFloatType.Create('Float'))
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user