MycLib/Src/Data/Myc.Data.Value.pas

unit Myc.Data.Value;

interface

uses
    System.SysUtils,
    System.SyncObjs,
    Myc.Utils,
    Myc.Data.Scalar,
    Myc.Data.Series,
    Myc.Data.Keyword;

type
    TDataValueKind = (
        vkVoid,
        vkScalar,
        vkText,
        vkKeyword,
        vkSeries,
        vkRecordSeries,
        vkRecord,
        vkManagedObject,
        vkMethod,
        vkInterface,
        vkPointer,
        vkGeneric
    );

    TDataValue = record
        type
            TFunc = reference to function(const ArgNodes: TArray<TDataValue>): TDataValue;

    private
        type
            TVal<T> = class(TInterfacedObject)
                Value: T;
{$ifdef DEBUG}
                TypeHandle: Pointer;
{$endif}
                constructor Create(const AValue: T);
            end;

            TObjVal = class(TVal<TObject>)
                destructor Destroy; override;
            end;

        var
            FKind: TDataValueKind;
            FScalar: TScalar;
            FInterface: IInterface;

        function GetIsVoid: Boolean; inline;

    public
        class operator Initialize(out Dest: TDataValue);
        class function Void: TDataValue; inline; static;

        class operator Implicit(const AValue: Int64): TDataValue; overload; inline;
        class operator Implicit(const AValue: Double): TDataValue; overload; inline;
        class operator Implicit(const AValue: TScalar): TDataValue; overload; inline;
        class operator Implicit(const AValue: TDataValue): TScalar; overload; inline;
        class operator Implicit(const AValue: String): TDataValue; overload; inline;
        class operator Implicit(const AValue: IKeyword): TDataValue; overload; inline;
        class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline;
        class operator Implicit(const AValue: TObject): TDataValue; overload; inline;

        // atomic operations
        function CompareAndSet(const Expected, NewValue: TDataValue): Boolean;
        function Reset(const NewValue: TDataValue): TDataValue;

        class function FromIntf<T: IInterface>(const AValue: T): TDataValue; static;
        function AsIntf<T: IInterface>: T; inline;

        class function FromGeneric<T>(const [ref] AValue: T): TDataValue; static; inline;
        function AsGeneric<T>: T; inline;

        class function FromPtr(const AValue: Pointer): TDataValue; static; inline;
        function AsPtr: Pointer; inline;

        class function Map(const SourceSeries: ISeries; const MapperFunc: TFunc): ISeries; static;

        class function FromRecordSeries(const AValue: IRecordSeries): TDataValue; static; inline;
        class function FromRecord(const [ref] AValue: TScalarRecord): TDataValue; static; inline;
        class function FromSeries(const AValue: ISeries): TDataValue; static; inline;
        class function FromKeyword(const AValue: IKeyword): TDataValue; static; inline;

        function AsScalar: TScalar; inline;
        function AsMethod: TFunc; inline;
        function AsText: String; inline;
        function AsKeyword: IKeyword; inline;
        function AsRecordSeries: IRecordSeries; inline;
        function AsRecord: TScalarRecord; inline;
        function AsSeries: ISeries; inline;
        function AsObject: TObject; overload; inline;

        function ToString: String;
        property IsVoid: Boolean read GetIsVoid;
        property Kind: TDataValueKind read FKind;
    end;

    TDataValueKindHelper = record helper for TDataValueKind
    public
        function ToString: string;
    end;

implementation

uses
    System.TypInfo;

type
    TMapSeries = class(TInterfacedObject, ISeries)
    private
        FSourceSeries: ISeries;
        FMapperFunc: TDataValue.TFunc;
        // ISeries
        function GetCount: Int64;
        function GetTotalCount: Int64;
        function GetItems(Idx: Integer): TScalar;
    public
        constructor Create(const ASourceSeries: ISeries; const AMapperFunc: TDataValue.TFunc);
    end;

{ TDataValue.TVal<T> }

constructor TDataValue.TVal<T>.Create(const AValue: T);
begin
    inherited Create;
    Value := AValue;
{$ifdef DEBUG}
    TypeHandle := TypeInfo(T);
{$endif}
end;

{ TDataValue }

class operator TDataValue.Initialize(out Dest: TDataValue);
begin
    Dest.FKind := vkVoid;
    Dest.FInterface := nil;
end;

function TDataValue.AsSeries: ISeries;
begin
    if (FKind <> vkSeries) then
        raise EInvalidCast.Create('Cannot read value as MemberSeries.');
    Result := ISeries(FInterface);
end;

function TDataValue.AsMethod: TFunc;
begin
    if (FKind <> vkMethod) then
        raise EInvalidCast.Create('Cannot read value as a method.');
    Result := TFunc(FInterface);
end;

function TDataValue.AsGeneric<T>: T;
begin
    if FKind <> vkGeneric then
        raise EInvalidCast.Create('Cannot read value as generic of ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
{$ifdef DEBUG}
    var val := TVal<T>(FInterface);
    if val.TypeHandle <> TypeInfo(T) then
        raise EInvalidCast.Create('Generic type is not a ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
{$endif}
    Result := TVal<T>(FInterface).Value;
end;

function TDataValue.AsIntf<T>: T;
begin
    if FKind <> vkInterface then
        raise EInvalidCast.Create('Cannot read value as interface.');
    Result := T(FInterface);
end;

function TDataValue.AsObject: TObject;
begin
    if (FKind <> vkManagedObject) then
        raise EInvalidCast.Create('Cannot read value as object.');
    Result := (FInterface as TObjVal).Value;
end;

function TDataValue.AsPtr: Pointer;
begin
    if (FKind <> vkPointer) then
        raise EInvalidCast.Create('Cannot read value as pointer.');
    Result := Pointer(FScalar.Value.AsInt64);
end;

function TDataValue.AsKeyword: IKeyword;
begin
    if (FKind <> vkKeyword) then
        raise EInvalidCast.Create('Cannot read value as Keyword.');
    Result := IKeyword(FInterface);
end;

function TDataValue.AsRecord: TScalarRecord;
begin
    if (FKind <> vkRecord) then
        raise EInvalidCast.Create('Cannot read value as Record.');
    Result := (FInterface as TVal<TScalarRecord>).Value;
end;

function TDataValue.AsRecordSeries: IRecordSeries;
begin
    if (FKind <> vkRecordSeries) then
        raise EInvalidCast.Create('Cannot read value as RecordSeries.');
    Result := IRecordSeries(FInterface);
end;

function TDataValue.AsScalar: TScalar;
begin
    if (FKind <> vkScalar) then
        raise EInvalidCast.Create('Cannot read value as a Scalar.');
    Result := FScalar;
end;

function TDataValue.AsText: String;
begin
    if (FKind <> vkText) then
        raise EInvalidCast.Create('Cannot read value as Text.');
    Result := (FInterface as TVal<String>).Value;
end;

function TDataValue.CompareAndSet(const Expected, NewValue: TDataValue): Boolean;

    function IntfCompareExchange(var VTarget: IInterface; const AValue, Compare: IInterface): IInterface; inline;
    begin
        if AValue <> nil then
            AValue._AddRef;

        Result := IInterface(TInterlocked.CompareExchange(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));

        if (AValue <> nil) and (Pointer(Result) <> Pointer(Compare)) then
            AValue._Release;
    end;

begin
    Result := false;
    if FKind <> Expected.Kind then
        exit;
    if FKind <> NewValue.Kind then
        raise EArgumentException.Create('Value kinds have to match');

    if FKind = vkVoid then
        raise EArgumentException.Create('Value is void');

    case FKind of
        vkScalar:
            case FScalar.Kind of
                TScalar.TKind.Ordinal:
                    Result :=
                        TInterlocked
                                .CompareExchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64, Expected.AsScalar.Value.AsInt64)
                            = Expected.AsScalar.Value.AsInt64;
                TScalar.TKind.Float:
                    Result :=
                        TInterlocked
                                .CompareExchange(FScalar.Value.AsDouble, NewValue.AsScalar.Value.AsDouble, Expected.AsScalar.Value.AsDouble)
                            = Expected.AsScalar.Value.AsDouble;
            end;
        vkPointer:
            Result :=
                TInterlocked.CompareExchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64, Expected.AsScalar.Value.AsInt64)
                    = Expected.AsScalar.Value.AsInt64;

        vkText, vkKeyword, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric:
            Result := IntfCompareExchange(FInterface, NewValue.FInterface, Expected.FInterface) = Expected.FInterface;
    end;
end;

class function TDataValue.FromIntf<T>(const AValue: T): TDataValue;
begin
    Result.FKind := vkInterface;
    Result.FInterface := IInterface(AValue);
end;

class function TDataValue.FromGeneric<T>(const [ref] AValue: T): TDataValue;
begin
    Result.FKind := vkGeneric;
    Result.FInterface := TVal<T>.Create(AValue);
end;

class function TDataValue.FromKeyword(const AValue: IKeyword): TDataValue;
begin
    Result.FKind := vkKeyword;
    Result.FInterface := AValue;
end;

class function TDataValue.FromPtr(const AValue: Pointer): TDataValue;
begin
    Assert(sizeof(Pointer) <= sizeof(Int64));
    Result.FKind := vkPointer;
    Result.FScalar.FromInt64(Int64(AValue));
end;

class function TDataValue.FromSeries(const AValue: ISeries): TDataValue;
begin
    Result.FKind := vkSeries;
    Result.FInterface := AValue;
end;

class function TDataValue.FromRecord(const [ref] AValue: TScalarRecord): TDataValue;
begin
    Result.FKind := vkRecord;
    Result.FInterface := TVal<TScalarRecord>.Create(AValue);
end;

class function TDataValue.FromRecordSeries(const AValue: IRecordSeries): TDataValue;
begin
    Result.FKind := vkRecordSeries;
    Result.FInterface := AValue;
end;

class operator TDataValue.Implicit(const AValue: TScalar): TDataValue;
begin
    Result.FKind := vkScalar;
    Result.FScalar := AValue;
    Result.FInterface := nil;
end;

class operator TDataValue.Implicit(const AValue: String): TDataValue;
begin
    Result.FKind := vkText;
    Result.FInterface := TVal<String>.Create(AValue);
end;

class operator TDataValue.Implicit(const AValue: IKeyword): TDataValue;
begin
    Result.FKind := vkKeyword;
    Result.FInterface := AValue;
end;

function TDataValue.GetIsVoid: Boolean;
begin
    Result := FKind = vkVoid;
end;

class function TDataValue.Map(const SourceSeries: ISeries; const MapperFunc: TFunc): ISeries;
begin
    Result := TMapSeries.Create(SourceSeries, MapperFunc);
end;

function TDataValue.Reset(const NewValue: TDataValue): TDataValue;

    function IntfExchange(var VTarget: IInterface; const AValue: IInterface): IInterface; inline;
    begin
        if AValue <> nil then
            AValue._AddRef;

        Result := IInterface(TInterlocked.Exchange(Pointer(VTarget), Pointer(AValue)));

        if AValue <> nil then
            AValue._Release;
    end;

begin
    if FKind <> NewValue.Kind then
        raise EArgumentException.Create('Value kinds have to match');

    if FKind = vkVoid then
        raise EArgumentException.Create('Value is void');

    case FKind of
        vkScalar:
            case FScalar.Kind of
                TScalar.TKind.Ordinal: Result := TInterlocked.Exchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64);
                TScalar.TKind.Float: Result := TInterlocked.Exchange(FScalar.Value.AsDouble, NewValue.AsScalar.Value.AsDouble);
            end;
        vkPointer: Result := TInterlocked.Exchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64);

        vkText, vkKeyword, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric:
        begin
            Result.FKind := FKind;
            Result.FInterface := IntfExchange(FInterface, NewValue.FInterface);
        end;
    end;
end;

function TDataValue.ToString: String;
var
    sb: TStringBuilder;
    field: TScalarRecordField;
    first: Boolean;
begin
    case FKind of
        vkScalar: Result := FScalar.ToString;
        vkText: Result := '"' + AsText + '"';
        vkKeyword: Result := ':' + AsKeyword.Name;
        vkSeries:
        begin
            var series := AsSeries;
            // Add type and count for series
            Result := Format('<series[%d]>', [series.Count]);
        end;
        vkRecordSeries:
        begin
            var series := AsRecordSeries;
            sb := TStringBuilder.Create;
            try
                sb.Append('{');
                first := True;
                for field in series.Def.Fields do
                begin
                    if not first then
                        sb.Append(',');
                    sb.Append(field.Key.Name);
                    first := False;
                end;
                sb.Append('}');
                // Add field names and count for record series
                Result := Format('<record_series%s[%d]>', [sb.ToString, series.Count]);
            finally
                sb.Free;
            end;
        end;
        vkRecord:
        begin
            var rec := AsRecord;
            sb := TStringBuilder.Create;
            try
                sb.Append('{');
                first := True;
                for field in rec.Def.Fields do
                begin
                    if not first then
                        sb.Append(',');
                    sb.Append(field.Key.Name);
                    first := False;
                end;
                sb.Append('}');
                // Add field names for records
                Result := Format('<record%s>', [sb.ToString]);
            finally
                sb.Free;
            end;
        end;
        vkVoid: Result := '<void>';
        vkMethod: Result := '<method>';
        vkGeneric:
            // Getting meaningful type information for vkGeneric is not easily possible
            // without storing additional RTTI, as the specific type of T in TVal<T> is lost.
            Result := '<generic>';
    else
        Result := '[Unknown DataValue]';
    end;
end;

class function TDataValue.Void: TDataValue;
begin
    Result := Default(TDataValue);
end;

class operator TDataValue.Implicit(const AValue: TDataValue.TFunc): TDataValue;
begin
    Result.FKind := vkMethod;
    TFunc(Result.FInterface) := AValue;
end;

class operator TDataValue.Implicit(const AValue: TObject): TDataValue;
begin
    Result.FKind := vkManagedObject;
    Result.FInterface := TObjVal.Create(AValue);
end;

class operator TDataValue.Implicit(const AValue: TDataValue): TScalar;
begin
    Result := AValue.AsScalar;
end;

class operator TDataValue.Implicit(const AValue: Int64): TDataValue;
begin
    Result.FKind := vkScalar;
    Result.FScalar := TScalar.FromInt64(AValue);
    Result.FInterface := nil;
end;

class operator TDataValue.Implicit(const AValue: Double): TDataValue;
begin
    Result.FKind := vkScalar;
    Result.FScalar := TScalar.FromDouble(AValue);
    Result.FInterface := nil;
end;

{ TDataValueKindHelper }

function TDataValueKindHelper.ToString: string;
begin
    case Self of
        vkVoid: Result := 'Void';
        vkScalar: Result := 'Scalar';
        vkText: Result := 'Text';
        vkKeyword: Result := 'Keyword';
        vkSeries: Result := 'Series';
        vkRecordSeries: Result := 'RecordSeries';
        vkRecord: Result := 'Record';
        vkMethod: Result := 'Method';
    else
        Result := 'unknown';
    end;
end;

{ TMapSeries }

constructor TMapSeries.Create(const ASourceSeries: ISeries; const AMapperFunc: TDataValue.TFunc);
begin
    inherited Create;
    FSourceSeries := ASourceSeries;
    FMapperFunc := AMapperFunc;
end;

function TMapSeries.GetCount: Int64;
begin
    Result := FSourceSeries.Count;
end;

function TMapSeries.GetTotalCount: Int64;
begin
    Result := FSourceSeries.TotalCount;
end;

function TMapSeries.GetItems(Idx: Integer): TScalar;
var
    sourceValue: TScalar;
    argArray: TArray<TDataValue>;
    mappedValue: TDataValue;
begin
    // Get the original item, apply the mapper function, and return the result.
    sourceValue := FSourceSeries.Items[Idx];
    argArray := [TDataValue(sourceValue)];
    mappedValue := FMapperFunc(argArray);

    if mappedValue.Kind <> vkScalar then
        raise EInvalidCast.Create('Map function did not return a scalar value.');

    Result := mappedValue.AsScalar;
end;

destructor TDataValue.TObjVal.Destroy;
begin
    Value.Free;
    inherited;
end;

end.