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.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;