MycLib/Src/Data/Myc.Data.Types.Tuple.pas

unit Myc.Data.Types.Tuple;

interface

uses
    System.Generics.Collections,
    System.SysUtils,
    System.Generics.Defaults,
    System.Hash,
    Myc.Data.Types;

type
    // Custom comparer for TArray<IDataType> to be used as a dictionary key.
    TDataTupleTypeComparer = class(TInterfacedObject, IEqualityComparer<TArray<IDataType>>)
    public
        function Equals(const Left, Right: TArray<IDataType>): Boolean; reintroduce;
        function GetHashCode(const Value: TArray<IDataType>): Integer; reintroduce;
    end;

    // Implements the tuple data type.
    TImplDataTupleType = class(TInterfacedObject, IDataType, IDataTupleType)
    strict private
        // Class-level registry to cache and reuse tuple type definitions.
        class var
            FTupleTypeRegistry: TDictionary<TArray<IDataType>, IDataTupleType>;
    private
        FItemTypes: TArray<IDataType>;
        FEmptyValue: IDataTupleValue; // Cached instance for zero-field tuples
        function GetName: String;
        function GetKind: TDataKind;
        function CreateValue(const AItems: array of IDataValue): IDataTupleValue;
        function GetItemCount: Integer;
        function GetItemType(Idx: Integer): IDataType;
    public
        constructor Create(const AItemTypes: TArray<IDataType>);
        destructor Destroy; override;

        class constructor CreateClass;
        class destructor DestroyClass;

        class function GetInstance(const AItemTypes: array of IDataType): IDataTupleType; static;
    end;

implementation

uses
    System.SyncObjs,
    System.Rtti;

type
    // Implements the tuple data value.
    TImplDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue)
    private
        FDataType: IDataTupleType;
        FItems: TArray<IDataValue>;
        function GetDataType: IDataType;
        function GetAsString: string;
        function GetItemCount: Integer;
        function GetItem(Idx: Integer): IDataValue;
    public
        constructor Create(const ADataType: IDataTupleType; const AItems: array of IDataValue);
    end;

    // Optimized implementation for a tuple with 0 fields.
    TImplDataTupleValue0 = class(TInterfacedObject, IDataValue, IDataTupleValue)
    private
        FDataType: IDataTupleType;
        function GetDataType: IDataType;
        function GetAsString: string;
        function GetItemCount: Integer;
        function GetItem(Idx: Integer): IDataValue;
    public
        constructor Create(const ADataType: IDataTupleType);
    end;

    // Optimized implementation for a tuple with 1 field.
    TImplDataTupleValue1 = class(TInterfacedObject, IDataValue, IDataTupleValue)
    private
        FDataType: IDataTupleType;
        FItem0: IDataValue;
        function GetDataType: IDataType;
        function GetAsString: string;
        function GetItemCount: Integer;
        function GetItem(Idx: Integer): IDataValue;
    public
        constructor Create(const ADataType: IDataTupleType; const AItems: array of IDataValue);
    end;

    // Optimized implementation for a tuple with 2 fields.
    TImplDataTupleValue2 = class(TInterfacedObject, IDataValue, IDataTupleValue)
    private
        FDataType: IDataTupleType;
        FItem0, FItem1: IDataValue;
        function GetDataType: IDataType;
        function GetAsString: string;
        function GetItemCount: Integer;
        function GetItem(Idx: Integer): IDataValue;
    public
        constructor Create(const ADataType: IDataTupleType; const AItems: array of IDataValue);
    end;

    // Optimized implementation for a tuple with 3 fields.
    TImplDataTupleValue3 = class(TInterfacedObject, IDataValue, IDataTupleValue)
    private
        FDataType: IDataTupleType;
        FItem0, FItem1, FItem2: IDataValue;
        function GetDataType: IDataType;
        function GetAsString: string;
        function GetItemCount: Integer;
        function GetItem(Idx: Integer): IDataValue;
    public
        constructor Create(const ADataType: IDataTupleType; const AItems: array of IDataValue);
    end;

    // Optimized implementation for a tuple with 4 fields.
    TImplDataTupleValue4 = class(TInterfacedObject, IDataValue, IDataTupleValue)
    private
        FDataType: IDataTupleType;
        FItem0, FItem1, FItem2, FItem3: IDataValue;
        function GetDataType: IDataType;
        function GetAsString: string;
        function GetItemCount: Integer;
        function GetItem(Idx: Integer): IDataValue;
    public
        constructor Create(const ADataType: IDataTupleType; const AItems: array of IDataValue);
    end;

{ TDataTupleTypeComparer }

function TDataTupleTypeComparer.Equals(const Left, Right: TArray<IDataType>): Boolean;
var
    i: Integer;
begin
    if (Length(Left) <> Length(Right)) then
        exit(False);

    for i := 0 to High(Left) do
    begin
        // Compare by interface reference.
        // It's safe because all IDataType instances are managed by GetInstance singletons.
        if (Left[i] <> Right[i]) then
            exit(False);
    end;
    Result := True;
end;

function TDataTupleTypeComparer.GetHashCode(const Value: TArray<IDataType>): Integer;
var
    dataType: IDataType;
begin
    Result := 0;
    for dataType in Value do
    begin
        // Use the hash of the interface's memory address.
        // This is safe and fast due to the singleton pattern for types.
        Result := Integer(PPointer(@dataType)^) xor Result;
    end;
end;

{ TImplDataTupleType }

class constructor TImplDataTupleType.CreateClass;
begin
    // Initialize the global registry for tuple types.
    FTupleTypeRegistry := TDictionary<TArray<IDataType>, IDataTupleType>.Create(TDataTupleTypeComparer.Create);
end;

class destructor TImplDataTupleType.DestroyClass;
begin
    FTupleTypeRegistry.Free;
    FTupleTypeRegistry := nil;
end;

constructor TImplDataTupleType.Create(const AItemTypes: TArray<IDataType>);
begin
    inherited Create;
    FItemTypes := AItemTypes;

    // Pre-create the singleton value instance if this is a zero-field tuple.
    if (Length(FItemTypes) = 0) then
        FEmptyValue := TImplDataTupleValue0.Create(Self);
end;

destructor TImplDataTupleType.Destroy;
begin
    inherited;
end;

function TImplDataTupleType.CreateValue(const AItems: array of IDataValue): IDataTupleValue;
var
    i: Integer;
begin
    if (Length(AItems) <> Length(FItemTypes)) then
        raise EArgumentException
            .CreateFmt('Invalid number of items for this tuple type. Expected %d, but got %d.', [Length(FItemTypes), Length(AItems)]);

    for i := 0 to High(AItems) do
        if not Assigned(AItems[i]) or (AItems[i].DataType <> FItemTypes[i]) then
            raise EArgumentException.CreateFmt(
                'Invalid data type for item at index %d. Expected %s, but got %s.',
                [i, FItemTypes[i].Name, AItems[i].DataType.Name]);

    // Use optimized implementations for tuples with 0, 1, 2, 3, or 4 fields.
    case Length(FItemTypes) of
        0: Result := FEmptyValue; // Return the pre-cached instance.
        1: Result := TImplDataTupleValue1.Create(Self, AItems);
        2: Result := TImplDataTupleValue2.Create(Self, AItems);
        3: Result := TImplDataTupleValue3.Create(Self, AItems);
        4: Result := TImplDataTupleValue4.Create(Self, AItems);
    else
        // Use the generic implementation for tuples with more than 4 fields.
        Result := TImplDataTupleValue.Create(Self, AItems);
    end;
end;

class function TImplDataTupleType.GetInstance(const AItemTypes: array of IDataType): IDataTupleType;
var
    tItems: TArray<IDataType>;
    i: Integer;
    res: IDataTupleType;
begin
    SetLength(tItems, Length(AItemTypes));
    for i := 0 to High(AItemTypes) do
        tItems[i] := AItemTypes[i];

    TMonitor.Enter(FTupleTypeRegistry);
    try
        if not FTupleTypeRegistry.TryGetValue(tItems, res) then
        begin
            res := TImplDataTupleType.Create(tItems);
            FTupleTypeRegistry.Add(tItems, res);
        end;
    finally
        TMonitor.Exit(FTupleTypeRegistry);
    end;
    Result := res;
end;

function TImplDataTupleType.GetItemCount: Integer;
begin
    Result := Length(FItemTypes);
end;

function TImplDataTupleType.GetItemType(Idx: Integer): IDataType;
begin
    Result := FItemTypes[Idx];
end;

function TImplDataTupleType.GetName: String;
var
    i: Integer;
    sb: TStringBuilder;
begin
    sb := TStringBuilder.Create;
    try
        sb.Append('Tuple<');
        for i := 0 to High(FItemTypes) do
        begin
            sb.Append(FItemTypes[i].Name);
            if (i < High(FItemTypes)) then
                sb.Append(', ');
        end;
        sb.Append('>');
        Result := sb.ToString;
    finally
        sb.Free;
    end;
end;

function TImplDataTupleType.GetKind: TDataKind;
begin
    Result := dkTuple;
end;

{ TImplDataTupleValue (generic implementation for N > 4 fields) }

constructor TImplDataTupleValue.Create(const ADataType: IDataTupleType; const AItems: array of IDataValue);
var
    i: Integer;
begin
    inherited Create;
    FDataType := ADataType;
    SetLength(FItems, Length(AItems));
    for i := 0 to High(AItems) do
        FItems[i] := AItems[i];
end;

function TImplDataTupleValue.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TImplDataTupleValue.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 TImplDataTupleValue.GetItem(Idx: Integer): IDataValue;
begin
    Result := FItems[Idx];
end;

function TImplDataTupleValue.GetItemCount: Integer;
begin
    Result := Length(FItems);
end;

{ TImplDataTupleValue0 }

constructor TImplDataTupleValue0.Create(const ADataType: IDataTupleType);
begin
    inherited Create;
    FDataType := ADataType;
end;

function TImplDataTupleValue0.GetAsString: string;
begin
    Result := '()';
end;

function TImplDataTupleValue0.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TImplDataTupleValue0.GetItem(Idx: Integer): IDataValue;
begin
    raise EArgumentException.Create('Index out of bounds');
end;

function TImplDataTupleValue0.GetItemCount: Integer;
begin
    Result := 0;
end;

{ TImplDataTupleValue1 }

constructor TImplDataTupleValue1.Create(const ADataType: IDataTupleType; const AItems: array of IDataValue);
begin
    inherited Create;
    FDataType := ADataType;
    FItem0 := AItems[0];
end;

function TImplDataTupleValue1.GetAsString: string;
begin
    Result := Format('(%s)', [FItem0.AsString]);
end;

function TImplDataTupleValue1.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TImplDataTupleValue1.GetItem(Idx: Integer): IDataValue;
begin
    case Idx of
        0: Result := FItem0;
    else
        raise EArgumentException.Create('Index out of bounds');
    end;
end;

function TImplDataTupleValue1.GetItemCount: Integer;
begin
    Result := 1;
end;

{ TImplDataTupleValue2 }

constructor TImplDataTupleValue2.Create(const ADataType: IDataTupleType; const AItems: array of IDataValue);
begin
    inherited Create;
    FDataType := ADataType;
    FItem0 := AItems[0];
    FItem1 := AItems[1];
end;

function TImplDataTupleValue2.GetAsString: string;
var
    sb: TStringBuilder;
begin
    sb := TStringBuilder.Create;
    try
        sb.Append('(');
        sb.Append(FItem0.AsString);
        sb.Append(', ');
        sb.Append(FItem1.AsString);
        sb.Append(')');
        Result := sb.ToString;
    finally
        sb.Free;
    end;
end;

function TImplDataTupleValue2.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TImplDataTupleValue2.GetItem(Idx: Integer): IDataValue;
begin
    case Idx of
        0: Result := FItem0;
        1: Result := FItem1;
    else
        raise EArgumentException.Create('Index out of bounds');
    end;
end;

function TImplDataTupleValue2.GetItemCount: Integer;
begin
    Result := 2;
end;

{ TImplDataTupleValue3 }

constructor TImplDataTupleValue3.Create(const ADataType: IDataTupleType; const AItems: array of IDataValue);
begin
    inherited Create;
    FDataType := ADataType;
    FItem0 := AItems[0];
    FItem1 := AItems[1];
    FItem2 := AItems[2];
end;

function TImplDataTupleValue3.GetAsString: string;
var
    sb: TStringBuilder;
begin
    sb := TStringBuilder.Create;
    try
        sb.Append('(');
        sb.Append(FItem0.AsString);
        sb.Append(', ');
        sb.Append(FItem1.AsString);
        sb.Append(', ');
        sb.Append(FItem2.AsString);
        sb.Append(')');
        Result := sb.ToString;
    finally
        sb.Free;
    end;
end;

function TImplDataTupleValue3.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TImplDataTupleValue3.GetItem(Idx: Integer): IDataValue;
begin
    case Idx of
        0: Result := FItem0;
        1: Result := FItem1;
        2: Result := FItem2;
    else
        raise EArgumentException.Create('Index out of bounds');
    end;
end;

function TImplDataTupleValue3.GetItemCount: Integer;
begin
    Result := 3;
end;

{ TImplDataTupleValue4 }

constructor TImplDataTupleValue4.Create(const ADataType: IDataTupleType; const AItems: array of IDataValue);
begin
    inherited Create;
    FDataType := ADataType;
    FItem0 := AItems[0];
    FItem1 := AItems[1];
    FItem2 := AItems[2];
    FItem3 := AItems[3];
end;

function TImplDataTupleValue4.GetAsString: string;
var
    sb: TStringBuilder;
begin
    sb := TStringBuilder.Create;
    try
        sb.Append('(');
        sb.Append(FItem0.AsString);
        sb.Append(', ');
        sb.Append(FItem1.AsString);
        sb.Append(', ');
        sb.Append(FItem2.AsString);
        sb.Append(', ');
        sb.Append(FItem3.AsString);
        sb.Append(')');
        Result := sb.ToString;
    finally
        sb.Free;
    end;
end;

function TImplDataTupleValue4.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TImplDataTupleValue4.GetItem(Idx: Integer): IDataValue;
begin
    case Idx of
        0: Result := FItem0;
        1: Result := FItem1;
        2: Result := FItem2;
        3: Result := FItem3;
    else
        raise EArgumentException.Create('Index out of bounds');
    end;
end;

function TImplDataTupleValue4.GetItemCount: Integer;
begin
    Result := 4;
end;

end.