Files
MycLib/Src/Data/Myc.Data.Types.Arrays.pas
T
Michael Schimmel 947060566d Data Types
2025-08-25 18:00:15 +02:00

268 lines
7.0 KiB
ObjectPascal

unit Myc.Data.Types.Arrays;
interface
uses
System.Generics.Collections,
System.SysUtils,
Myc.Data.Types;
type
// Implements the array data type.
TDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType)
private
FElementType: IDataType;
FEmptyValue: IDataArrayValue; // Cached empty array value for this type
function GetElementType: IDataType;
function GetName: String;
function GetKind: TDataKind;
public
constructor Create(const AElementType: IDataType);
function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
end;
implementation
uses
System.SyncObjs,
System.Rtti;
type
// Implements the array data value.
TDataArrayValue = class(TInterfacedObject, IDataValue, IDataArrayValue)
private
FArrayType: IDataArrayType;
FItems: TArray<IDataValue>;
function GetDataType: IDataType;
function GetAsString: string;
function AsTValue: TValue;
function GetElementCount: Integer;
function GetItem(Idx: Integer): IDataValue;
public
constructor Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
end;
// Optimized implementation for an array with 0 elements.
TDataArrayValue0 = class(TInterfacedObject, IDataValue, IDataArrayValue)
strict private
class var
FEmptyTValue: TValue; // Singleton TValue for an empty array
class constructor CreateClass;
private
FArrayType: IDataArrayType;
function GetDataType: IDataType;
function GetAsString: string;
function AsTValue: TValue;
function GetElementCount: Integer;
function GetItem(Idx: Integer): IDataValue;
public
constructor Create(const AArrayType: IDataArrayType);
end;
// Optimized implementation for an array with 1 element.
TDataArrayValue1 = class(TInterfacedObject, IDataValue, IDataArrayValue)
private
FArrayType: IDataArrayType;
FItem0: IDataValue;
function GetDataType: IDataType;
function GetAsString: string;
function AsTValue: TValue;
function GetElementCount: Integer;
function GetItem(Idx: Integer): IDataValue;
public
constructor Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
end;
{ TDataArrayValue (generic implementation for N > 1 elements) }
constructor TDataArrayValue.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 TDataArrayValue.GetDataType: IDataType;
begin
Result := FArrayType;
end;
function TDataArrayValue.GetAsString: string;
var
sb: TStringBuilder;
i: Integer;
begin
sb := TStringBuilder.Create;
try
sb.Append('[');
for i := 0 to High(FItems) do
begin
sb.Append(FItems[i].AsString);
if (i < High(FItems)) then
sb.Append(', ');
end;
sb.Append(']');
Result := sb.ToString;
finally
sb.Free;
end;
end;
function TDataArrayValue.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
i: Integer;
begin
SetLength(tvalueArray, Length(FItems));
for i := 0 to High(FItems) do
tvalueArray[i] := FItems[i].AsTValue;
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataArrayValue.GetElementCount: Integer;
begin
Result := Length(FItems);
end;
function TDataArrayValue.GetItem(Idx: Integer): IDataValue;
begin
Result := FItems[Idx];
end;
{ TDataArrayValue0 }
class constructor TDataArrayValue0.CreateClass;
begin
// Create a singleton TValue representing an empty dynamic array.
FEmptyTValue := TValue.From<TArray<TValue>>([]);
end;
constructor TDataArrayValue0.Create(const AArrayType: IDataArrayType);
begin
inherited Create;
FArrayType := AArrayType;
end;
function TDataArrayValue0.GetAsString: string;
begin
Result := '[]';
end;
function TDataArrayValue0.AsTValue: TValue;
begin
Result := FEmptyTValue;
end;
function TDataArrayValue0.GetDataType: IDataType;
begin
Result := FArrayType;
end;
function TDataArrayValue0.GetElementCount: Integer;
begin
Result := 0;
end;
function TDataArrayValue0.GetItem(Idx: Integer): IDataValue;
begin
raise EArgumentException.Create('Index out of bounds');
end;
{ TDataArrayValue1 }
constructor TDataArrayValue1.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
begin
inherited Create;
FArrayType := AArrayType;
FItem0 := AItems[0];
end;
function TDataArrayValue1.GetAsString: string;
begin
Result := '[' + FItem0.AsString + ']';
end;
function TDataArrayValue1.AsTValue: TValue;
var
tvalueArray: TArray<TValue>;
begin
SetLength(tvalueArray, 1);
tvalueArray[0] := FItem0.AsTValue;
Result := TValue.From<TArray<TValue>>(tvalueArray);
end;
function TDataArrayValue1.GetDataType: IDataType;
begin
Result := FArrayType;
end;
function TDataArrayValue1.GetElementCount: Integer;
begin
Result := 1;
end;
function TDataArrayValue1.GetItem(Idx: Integer): IDataValue;
begin
case Idx of
0: Result := FItem0;
else
raise EArgumentException.Create('Index out of bounds');
end;
end;
{ TDataArrayType }
constructor TDataArrayType.Create(const AElementType: IDataType);
begin
inherited Create;
FElementType := AElementType;
FEmptyValue := TDataArrayValue0.Create(Self);
end;
function TDataArrayType.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;
// Use optimized implementations for arrays with 0 or 1 elements.
case Length(AItems) of
0: Result := FEmptyValue;
1: Result := TDataArrayValue1.Create(Self, AItems);
else
// Use the generic implementation for arrays with more than 1 element.
Result := TDataArrayValue.Create(Self, AItems);
end;
end;
function TDataArrayType.GetElementType: IDataType;
begin
Result := FElementType;
end;
function TDataArrayType.GetName: String;
begin
Result := Format('Array<%s>', [FElementType.Name]);
end;
function TDataArrayType.GetKind: TDataKind;
begin
Result := dkArray;
end;
end.