From e9608a746a8c3207d1fb4fb059b3f21fb4d4dfa1 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Tue, 26 Aug 2025 14:57:35 +0200 Subject: [PATCH] New type system --- Src/Data/Myc.Data.Types.Arrays.pas | 42 ++++++++ Src/Data/Myc.Data.Types.Decimal.pas | 32 +++++++ Src/Data/Myc.Data.Types.Method.pas | 63 +++++++++++- Src/Data/Myc.Data.Types.Records.pas | 51 ++++++++++ Src/Data/Myc.Data.Types.pas | 143 +++------------------------- 5 files changed, 199 insertions(+), 132 deletions(-) diff --git a/Src/Data/Myc.Data.Types.Arrays.pas b/Src/Data/Myc.Data.Types.Arrays.pas index a9dcbc6..9c33835 100644 --- a/Src/Data/Myc.Data.Types.Arrays.pas +++ b/Src/Data/Myc.Data.Types.Arrays.pas @@ -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; 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.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; diff --git a/Src/Data/Myc.Data.Types.Decimal.pas b/Src/Data/Myc.Data.Types.Decimal.pas index 2f6a275..30ffdf8 100644 --- a/Src/Data/Myc.Data.Types.Decimal.pas +++ b/Src/Data/Myc.Data.Types.Decimal.pas @@ -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; 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); diff --git a/Src/Data/Myc.Data.Types.Method.pas b/Src/Data/Myc.Data.Types.Method.pas index b67c086..71a38f9 100644 --- a/Src/Data/Myc.Data.Types.Method.pas +++ b/Src/Data/Myc.Data.Types.Method.pas @@ -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, 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, IDataMethodType>.Create( + TEqualityComparer>.Construct( + function(const Left, Right: TPair): Boolean + begin + // Compare interface pointers. + Result := (Left.Key = Right.Key) and (Left.Value = Right.Value); + end, + function(const Value: TPair): 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; + res: IDataMethodType; +begin + key := TPair.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; diff --git a/Src/Data/Myc.Data.Types.Records.pas b/Src/Data/Myc.Data.Types.Records.pas index 0832074..933899a 100644 --- a/Src/Data/Myc.Data.Types.Records.pas +++ b/Src/Data/Myc.Data.Types.Records.pas @@ -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, IDataRecordType>; private FFields: TArray; FFieldMap: TDictionary; // 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): 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, IDataRecordType>.Create(TDataRecordFieldComparer.Create); +end; + +class destructor TImplDataRecordType.DestroyClass; +begin + FRecordTypeRegistry.Free; + FRecordTypeRegistry := nil; +end; + +class function TImplDataRecordType.GetInstance(const AFields: TArray): 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; + 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; diff --git a/Src/Data/Myc.Data.Types.pas b/Src/Data/Myc.Data.Types.pas index 1b6c12b..b648274 100644 --- a/Src/Data/Myc.Data.Types.pas +++ b/Src/Data/Myc.Data.Types.pas @@ -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; - FRecordTypeRegistry: TDictionary, IDataRecordType>; - FMethodTypeRegistry: TDictionary, IDataMethodType>; - FDecimalTypes: TArray; 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>) - public - function Equals(const Left, Right: TArray): Boolean; override; - function GetHashCode(const Value: TArray): Integer; override; - end; - -{ TDataRecordFieldComparer } - -function TDataRecordFieldComparer.Equals(const Left, Right: TArray): 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): 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.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.Create; - FRecordTypeRegistry := TDictionary, IDataRecordType>.Create(TDataRecordFieldComparer.Create); - - SetLength(FDecimalTypes, 19); - for i := 0 to 18 do - FDecimalTypes[i] := TImplDataDecimalType.Create(i); - - FMethodTypeRegistry := - TDictionary, IDataMethodType>.Create( - TEqualityComparer>.Construct( - function(const Left, Right: TPair): Boolean - begin - Result := (Left.Key = Right.Key) and (Left.Value = Right.Value); - end, - function(const Value: TPair): 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; - res: IDataMethodType; begin - key := TPair.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): 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; - 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;