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