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

New type system

Browse Source
This commit is contained in:
Michael Schimmel
2025-08-26 14:57:35 +02:00
parent 8e8f139785
commit e9608a746a
5 changed files with 199 additions and 132 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Data/Myc.Data.Types.Arrays.pas
+42
View File
@@ -10,6 +10,10 @@ uses
type
// Implements the array data type.
TImplDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType)
strict private
// Class-level registry to cache and reuse array type definitions.
class var
FArrayTypeRegistry: TDictionary<IDataType, IDataArrayType>;
private
FElementType: IDataType;
FEmptyValue: IDataArrayValue; // Cached empty array value for this type
@@ -18,6 +22,12 @@ type
function GetKind: TDataKind;
public
constructor Create(const AElementType: IDataType);
class constructor CreateClass;
class destructor DestroyClass;
// Factory method to get a cached or new array type instance.
class function GetInstance(const AElementType: IDataType): IDataArrayType; static;
function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
end;
@@ -216,6 +226,38 @@ end;
{ TImplDataArrayType }
class constructor TImplDataArrayType.CreateClass;
begin
// Initialize the global registry for array types.
FArrayTypeRegistry := TDictionary<IDataType, IDataArrayType>.Create;
end;
class destructor TImplDataArrayType.DestroyClass;
begin
FArrayTypeRegistry.Free;
FArrayTypeRegistry := nil;
end;
class function TImplDataArrayType.GetInstance(const AElementType: IDataType): IDataArrayType;
var
res: IDataArrayType;
begin
if not Assigned(AElementType) then
raise EArgumentException.Create('Cannot create an array type with a nil element type.');
TMonitor.Enter(FArrayTypeRegistry);
try
if not FArrayTypeRegistry.TryGetValue(AElementType, res) then
begin
res := TImplDataArrayType.Create(AElementType);
FArrayTypeRegistry.Add(AElementType, res);
end;
finally
TMonitor.Exit(FArrayTypeRegistry);
end;
Result := res;
end;
constructor TImplDataArrayType.Create(const AElementType: IDataType);
begin
inherited Create;
Src/Data/Myc.Data.Types.Decimal.pas
+32
View File
@@ -10,9 +10,19 @@ type
TImplDataDecimalType = class(TInterfacedObject, IDataDecimalType)
private
FScale: Integer;
strict private
class var
// Pre-cached instances for scales 0-18.
FDecimalTypes: TArray<IDataDecimalType>;
public
constructor Create(const AScale: Integer);
class constructor CreateClass;
class destructor DestroyClass;
// Returns a cached instance for the specified scale.
class function GetInstance(const AScale: Integer): IDataDecimalType; static;
// IDataType
function GetName: String;
function GetKind: TDataKind;
@@ -54,6 +64,28 @@ begin
FScale := AScale;
end;
class constructor TImplDataDecimalType.CreateClass;
var
i: Integer;
begin
// Create and cache singleton instances for each supported scale.
SetLength(FDecimalTypes, 19);
for i := 0 to High(FDecimalTypes) do
FDecimalTypes[i] := TImplDataDecimalType.Create(i);
end;
class destructor TImplDataDecimalType.DestroyClass;
begin
FDecimalTypes := nil;
end;
class function TImplDataDecimalType.GetInstance(const AScale: Integer): IDataDecimalType;
begin
if (AScale < 0) or (AScale > High(FDecimalTypes)) then
raise EArgumentException.CreateFmt('Scale for decimal must be between 0 and %d.', [High(FDecimalTypes)]);
Result := FDecimalTypes[AScale];
end;
function TImplDataDecimalType.CreateValue(const AValue: Int64): IDataDecimalValue;
begin
Result := TDataDecimalValue.Create(AValue, Self);
Src/Data/Myc.Data.Types.Method.pas
+62 -1
View File
@@ -5,11 +5,16 @@ interface
uses
System.SysUtils,
System.Rtti,
System.Generics.Collections,
Myc.Data.Types;
type
// Implements the IDataMethodType interface.
TImplDataMethodType = class(TInterfacedObject, IDataMethodType)
strict private
// Class-level registry to cache and reuse method type definitions.
class var
FMethodTypeRegistry: TDictionary<TPair<IDataType, IDataType>, IDataMethodType>;
private
FArgType: IDataType;
FResultType: IDataType;
@@ -20,12 +25,19 @@ type
function CreateValue(const AValue: TDataMethodProc): IDataMethodValue;
public
constructor Create(const AArgType, AResultType: IDataType);
class constructor CreateClass;
class destructor DestroyClass;
// Factory method to get a cached or new method type instance.
class function GetInstance(const AArgType, AResultType: IDataType): IDataMethodType; static;
end;
implementation
uses
System.Classes;
System.Classes,
System.SyncObjs,
System.Generics.Defaults;
type
// Implements the IDataMethodValue interface.
@@ -43,6 +55,55 @@ type
{ TImplDataMethodType }
class constructor TImplDataMethodType.CreateClass;
begin
// Initialize the global registry for method types using a custom comparer for the TPair key.
FMethodTypeRegistry :=
TDictionary<TPair<IDataType, IDataType>, IDataMethodType>.Create(
TEqualityComparer<TPair<IDataType, IDataType>>.Construct(
function(const Left, Right: TPair<IDataType, IDataType>): Boolean
begin
// Compare interface pointers.
Result := (Left.Key = Right.Key) and (Left.Value = Right.Value);
end,
function(const Value: TPair<IDataType, IDataType>): Integer
var
hash1, hash2: NativeInt;
begin
// Combine hashes of interface pointers.
hash1 := NativeInt(Value.Key);
hash2 := NativeInt(Value.Value);
Result := Integer(hash1 xor hash2);
end
)
);
end;
class destructor TImplDataMethodType.DestroyClass;
begin
FMethodTypeRegistry.Free;
FMethodTypeRegistry := nil;
end;
class function TImplDataMethodType.GetInstance(const AArgType, AResultType: IDataType): IDataMethodType;
var
key: TPair<IDataType, IDataType>;
res: IDataMethodType;
begin
key := TPair<IDataType, IDataType>.Create(AArgType, AResultType);
TMonitor.Enter(FMethodTypeRegistry);
try
if not FMethodTypeRegistry.TryGetValue(key, res) then
begin
res := TImplDataMethodType.Create(AArgType, AResultType);
FMethodTypeRegistry.Add(key, res);
end;
finally
TMonitor.Exit(FMethodTypeRegistry);
end;
Result := res;
end;
constructor TImplDataMethodType.Create(const AArgType, AResultType: IDataType);
begin
inherited Create;
Src/Data/Myc.Data.Types.Records.pas
+51
View File
@@ -19,6 +19,10 @@ type
// Implements the record data type.
TImplDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType)
strict private
// Class-level registry to cache and reuse record type definitions.
class var
FRecordTypeRegistry: TDictionary<TArray<TDataRecordField>, IDataRecordType>;
private
FFields: TArray<TDataRecordField>;
FFieldMap: TDictionary<string, Integer>; // For fast lookups by name
@@ -31,6 +35,13 @@ type
public
constructor Create(const AFields: array of TDataRecordField);
destructor Destroy; override;
class constructor CreateClass;
class destructor DestroyClass;
// Factory method to get a cached or new record type instance.
class function GetInstance(const AFields: TArray<TDataRecordField>): IDataRecordType; overload; static;
class function GetInstance(const AFields: array of TDataRecordField): IDataRecordType; overload; static;
function CreateValue(const AItems: array of IDataValue): IDataRecordValue;
end;
@@ -319,6 +330,46 @@ end;
{ TImplDataRecordType }
class constructor TImplDataRecordType.CreateClass;
begin
// Initialize the global registry for record types.
FRecordTypeRegistry := TDictionary<TArray<TDataRecordField>, IDataRecordType>.Create(TDataRecordFieldComparer.Create);
end;
class destructor TImplDataRecordType.DestroyClass;
begin
FRecordTypeRegistry.Free;
FRecordTypeRegistry := nil;
end;
class function TImplDataRecordType.GetInstance(const AFields: TArray<TDataRecordField>): IDataRecordType;
var
res: IDataRecordType;
begin
TMonitor.Enter(FRecordTypeRegistry);
try
if not FRecordTypeRegistry.TryGetValue(AFields, res) then
begin
res := TImplDataRecordType.Create(AFields);
FRecordTypeRegistry.Add(AFields, res);
end;
finally
TMonitor.Exit(FRecordTypeRegistry);
end;
Result := res;
end;
class function TImplDataRecordType.GetInstance(const AFields: array of TDataRecordField): IDataRecordType;
var
tFields: TArray<TDataRecordField>;
i: Integer;
begin
SetLength(tFields, Length(AFields));
for i := 0 to High(AFields) do
tFields[i] := AFields[i];
Result := GetInstance(tFields);
end;
constructor TImplDataRecordType.Create(const AFields: array of TDataRecordField);
var
i: Integer;
Src/Data/Myc.Data.Types.pas
+12 -131
View File
@@ -3,7 +3,6 @@ unit Myc.Data.Types;
interface
uses
System.Generics.Collections,
System.SysUtils,
System.RTTI;
@@ -515,11 +514,6 @@ type
FDataType: IDataType;
function GetName: String; inline;
function GetKind: TDataKind; inline;
class var
FArrayTypeRegistry: TDictionary<IDataType, IDataArrayType>;
FRecordTypeRegistry: TDictionary<TArray<TDataRecordField>, IDataRecordType>;
FMethodTypeRegistry: TDictionary<TPair<IDataType, IDataType>, IDataMethodType>;
FDecimalTypes: TArray<IDataDecimalType>;
class constructor CreateClass;
class destructor DestroyClass;
public
@@ -573,8 +567,6 @@ implementation
uses
System.Math, // Added for Power function
System.SyncObjs,
System.Generics.Defaults,
Myc.Data.Types.Void,
Myc.Data.Types.Ordinal,
Myc.Data.Types.Float,
@@ -587,44 +579,6 @@ uses
Myc.Data.Types.Enum,
Myc.Data.Types.Method;
type
TDataRecordFieldComparer = class(TEqualityComparer<TArray<TDataRecordField>>)
public
function Equals(const Left, Right: TArray<TDataRecordField>): Boolean; override;
function GetHashCode(const Value: TArray<TDataRecordField>): Integer; override;
end;
{ TDataRecordFieldComparer }
function TDataRecordFieldComparer.Equals(const Left, Right: TArray<TDataRecordField>): Boolean;
var
i: Integer;
begin
if Length(Left) <> Length(Right) then
Exit(False);
for i := 0 to High(Left) do
begin
// Compare field names (case-insensitive) and data types (pointer comparison)
if (not SameText(Left[i].Name, Right[i].Name)) or (Left[i].DataType <> Right[i].DataType) then
Exit(False);
end;
Result := True;
end;
function TDataRecordFieldComparer.GetHashCode(const Value: TArray<TDataRecordField>): Integer;
var
field: TDataRecordField;
begin
Result := 0;
for field in Value do
begin
// Combine hash codes of field name (case-insensitive) and data type pointer
Result := Result xor TEqualityComparer<string>.Default.GetHashCode(field.Name.ToUpper) xor Integer(NativeInt(field.DataType));
end;
end;
{ TDataRecordField }
constructor TDataRecordField.Create(const AName: string; const ADataType: IDataType);
@@ -1321,69 +1275,25 @@ begin
end;
class constructor TDataType.CreateClass;
var
i: Integer;
begin
FArrayTypeRegistry := TDictionary<IDataType, IDataArrayType>.Create;
FRecordTypeRegistry := TDictionary<TArray<TDataRecordField>, IDataRecordType>.Create(TDataRecordFieldComparer.Create);
SetLength(FDecimalTypes, 19);
for i := 0 to 18 do
FDecimalTypes[i] := TImplDataDecimalType.Create(i);
FMethodTypeRegistry :=
TDictionary<TPair<IDataType, IDataType>, IDataMethodType>.Create(
TEqualityComparer<TPair<IDataType, IDataType>>.Construct(
function(const Left, Right: TPair<IDataType, IDataType>): Boolean
begin
Result := (Left.Key = Right.Key) and (Left.Value = Right.Value);
end,
function(const Value: TPair<IDataType, IDataType>): Integer
var
hash1, hash2: NativeInt;
begin
hash1 := NativeInt(Value.Key);
hash2 := NativeInt(Value.Value);
// Simple XOR combination for pointer hashes
Result := Integer(hash1 xor hash2);
end
)
);
// Registries are now managed by their respective implementation units.
end;
class destructor TDataType.DestroyClass;
begin
FArrayTypeRegistry.Free;
FRecordTypeRegistry.Free;
FDecimalTypes := nil;
FMethodTypeRegistry.Free;
// Registries are now managed by their respective implementation units.
end;
class function TDataType.ArrayOf(const AElementType: IDataType): TDataType.TArray;
var
res: IDataArrayType;
begin
if not Assigned(AElementType) then
raise EArgumentException.Create('Cannot create an array type with a nil element type.');
TMonitor.Enter(FArrayTypeRegistry);
try
if not FArrayTypeRegistry.TryGetValue(AElementType, res) then
begin
res := TImplDataArrayType.Create(AElementType);
FArrayTypeRegistry.Add(AElementType, res);
end;
finally
TMonitor.Exit(FArrayTypeRegistry);
end;
Result.Create(res);
// The TImplDataArrayType now manages its own instances.
Result.Create(TImplDataArrayType.GetInstance(AElementType));
end;
class function TDataType.DecimalOf(const AScale: Integer): TDataType.TDecimal;
begin
if (AScale < 0) or (AScale > 18) then
raise EArgumentException.Create('Scale for decimal must be between 0 and 18.');
Result.Create(FDecimalTypes[AScale]);
// The TImplDataDecimalType now manages its own instances.
Result.Create(TImplDataDecimalType.GetInstance(AScale));
end;
class function TDataType.EnumOf(const AName: string; const AIdentifiers: array of string): TDataType.TEnum;
@@ -1410,22 +1320,9 @@ begin
end;
class function TDataType.MethodOf(const AArgType, AResultType: IDataType): TDataType.TMethod;
var
key: TPair<IDataType, IDataType>;
res: IDataMethodType;
begin
key := TPair<IDataType, IDataType>.Create(AArgType, AResultType);
TMonitor.Enter(FMethodTypeRegistry);
try
if not FMethodTypeRegistry.TryGetValue(key, res) then
begin
res := TImplDataMethodType.Create(AArgType, AResultType);
FMethodTypeRegistry.Add(key, res);
end;
finally
TMonitor.Exit(FMethodTypeRegistry);
end;
Result.Create(res);
// The TImplDataMethodType now manages its own instances.
Result.Create(TImplDataMethodType.GetInstance(AArgType, AResultType));
end;
class function TDataType.Ordinal: TDataType.TOrdinal;
@@ -1434,31 +1331,15 @@ begin
end;
class function TDataType.RecordOf(const Fields: TArray<TDataRecordField>): TDataType.TRecord;
var
res: IDataRecordType;
begin
TMonitor.Enter(FRecordTypeRegistry);
try
if not FRecordTypeRegistry.TryGetValue(Fields, res) then
begin
res := TImplDataRecordType.Create(Fields);
FRecordTypeRegistry.Add(Fields, res);
end;
finally
TMonitor.Exit(FRecordTypeRegistry);
end;
Result.Create(res);
// The TImplDataRecordType now manages its own instances.
Result.Create(TImplDataRecordType.GetInstance(Fields));
end;
class function TDataType.RecordOf(const Fields: array of TDataRecordField): TDataType.TRecord;
var
tFields: TArray<TDataRecordField>;
i: Integer;
begin
SetLength(tFields, Length(Fields));
for i := 0 to High(Fields) do
tFields[i] := Fields[i];
Result := RecordOf(tFields);
// The TImplDataRecordType now manages its own instances.
Result.Create(TImplDataRecordType.GetInstance(Fields));
end;
class function TDataType.Text: TDataType.TText;