From 9010bb18904b1065dacb5dcbbf4c3a46199d6bd6 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Tue, 30 Sep 2025 11:34:35 +0200 Subject: [PATCH] Preparing for atomic data values --- Src/Data/Myc.Data.Value.pas | 205 ++++++++---------------------------- 1 file changed, 43 insertions(+), 162 deletions(-) diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas index 453930a..e93613c 100644 --- a/Src/Data/Myc.Data.Value.pas +++ b/Src/Data/Myc.Data.Value.pas @@ -30,22 +30,11 @@ type destructor Destroy; override; end; - ILazy = interface - function GetKind: TDataValueKind; - function GetValue: TDataValue; - property Kind: TDataValueKind read GetKind; - property Value: TDataValue read GetValue; - end; - - TInternalKind = (vkLazy = Ord(High(TDataValueKind)) + 1); - TInternalKindOrdinal = 0..Ord(High(TInternalKind)); - var - FKind: TInternalKindOrdinal; + FKind: TDataValueKind; FScalar: TScalar; FInterface: IInterface; - function AsLazy: ILazy; inline; function GetKind: TDataValueKind; inline; function GetIsVoid: Boolean; inline; @@ -61,6 +50,9 @@ type class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline; class operator Implicit(const AValue: TObject): TDataValue; overload; inline; + class function CompareAndSet(var Target: TDataValue; const Expected, NewValue: TDataValue): Boolean; static; + class function Reset(var Target: TDataValue; const NewValue: TDataValue): TDataValue; static; + class function FromIntf(const AValue: T): TDataValue; static; function AsIntf: T; inline; @@ -70,8 +62,6 @@ type class function FromPtr(const AValue: Pointer): TDataValue; static; inline; function AsPtr: Pointer; inline; - class function Defer(const Value: TDataValue; const Calc: TFunc): TDataValue; overload; static; - class function Map(const SourceSeries: ISeries; const MapperFunc: TFunc): ISeries; static; class function FromRecordSeries(const AValue: IRecordSeries): TDataValue; static; inline; @@ -102,27 +92,6 @@ uses TypInfo; type - TManagedLazy = class(TInterfacedObject, TDataValue.ILazy) - private - FKind: TDataValueKind; - FVal: IInterface; - FCalc: TDataValue.TFunc; - function GetValue: TDataValue; - function GetKind: TDataValueKind; - public - constructor Create(AKind: TDataValueKind; const AVal: IInterface; const ACalc: TDataValue.TFunc); - end; - - TScalarLazy = class(TInterfacedObject, TDataValue.ILazy) - private - FVal: TScalar; - FCalc: TDataValue.TFunc; - function GetKind: TDataValueKind; - function GetValue: TDataValue; - public - constructor Create(const AVal: TScalar; const ACalc: TDataValue.TFunc); - end; - TMapSeries = class(TInterfacedObject, ISeries) private FSourceSeries: ISeries; @@ -135,46 +104,6 @@ type constructor Create(const ASourceSeries: ISeries; const AMapperFunc: TDataValue.TFunc); end; -constructor TManagedLazy.Create(AKind: TDataValueKind; const AVal: IInterface; const ACalc: TDataValue.TFunc); -begin - inherited Create; - FKind := AKind; - Assert(FKind <> vkVoid); - FVal := AVal; - FCalc := ACalc; -end; - -function TManagedLazy.GetKind: TDataValueKind; -begin - Result := FKind; -end; - -function TManagedLazy.GetValue: TDataValue; -var - dv: TDataValue; -begin - dv.FKind := Ord(FKind); - dv.FInterface := FVal; - Result := FCalc([dv]); -end; - -constructor TScalarLazy.Create(const AVal: TScalar; const ACalc: TDataValue.TFunc); -begin - inherited Create; - FVal := AVal; - FCalc := ACalc; -end; - -function TScalarLazy.GetKind: TDataValueKind; -begin - Result := vkScalar; -end; - -function TScalarLazy.GetValue: TDataValue; -begin - Result := FCalc([FVal]); -end; - { TDataValue.TVal } constructor TDataValue.TVal.Create(const AValue: T); @@ -186,43 +115,31 @@ begin {$endif} end; -function TDataValue.AsLazy: ILazy; -begin - Assert(FKind = Ord(vkLazy)); - Result := ILazy(FInterface); -end; - { TDataValue } class operator TDataValue.Initialize(out Dest: TDataValue); begin - Dest.FKind := Ord(vkVoid); + Dest.FKind := vkVoid; Dest.FInterface := nil; end; function TDataValue.AsSeries: ISeries; begin - if FKind = Ord(vkLazy) then - exit(AsLazy.Value.AsSeries); - if (FKind <> Ord(vkSeries)) then + if (FKind <> vkSeries) then raise EInvalidCast.Create('Cannot read value as MemberSeries.'); Result := ISeries(FInterface); end; function TDataValue.AsMethod: TFunc; begin - if FKind = Ord(vkLazy) then - exit(AsLazy.Value.AsMethod); - if (FKind <> Ord(vkMethod)) then + if (FKind <> vkMethod) then raise EInvalidCast.Create('Cannot read value as a method.'); Result := TFunc(FInterface); end; function TDataValue.AsGeneric: T; begin - if FKind = Ord(vkLazy) then - exit(AsLazy.Value.AsGeneric); - if FKind <> Ord(vkGeneric) then + if FKind <> vkGeneric then raise EInvalidCast.Create('Cannot read value as generic of ' + String(PTypeInfo(TypeInfo(T)).Name) + '.'); {$ifdef DEBUG} if TVal(FInterface).TypeHandle <> TypeInfo(T) then @@ -233,155 +150,115 @@ end; function TDataValue.AsIntf: T; begin - if FKind = Ord(vkLazy) then - exit(AsLazy.Value.AsGeneric); - if FKind <> Ord(vkInterface) then + if FKind <> vkInterface then raise EInvalidCast.Create('Cannot read value as interface.'); Result := T(FInterface); end; function TDataValue.AsObject: TObject; begin - if FKind = Ord(vkLazy) then - exit(AsLazy.Value.AsObject); - if (FKind <> Ord(vkManagedObject)) then + 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 = Ord(vkLazy) then - exit(AsLazy.Value.AsPtr); - if (FKind <> Ord(vkPointer)) then + if (FKind <> vkPointer) then raise EInvalidCast.Create('Cannot read value as pointer.'); Result := Pointer(FScalar.Value.AsInt64); end; function TDataValue.AsRecord: TScalarRecord; begin - if FKind = Ord(vkLazy) then - exit(AsLazy.Value.AsRecord); - if (FKind <> Ord(vkRecord)) then + if (FKind <> vkRecord) then raise EInvalidCast.Create('Cannot read value as Record.'); Result := (FInterface as TVal).Value; end; function TDataValue.AsRecordSeries: IRecordSeries; begin - if FKind = Ord(vkLazy) then - exit(AsLazy.Value.AsRecordSeries); - if (FKind <> Ord(vkRecordSeries)) then + if (FKind <> vkRecordSeries) then raise EInvalidCast.Create('Cannot read value as RecordSeries.'); Result := IRecordSeries(FInterface); end; function TDataValue.AsScalar: TScalar; begin - if FKind = Ord(vkLazy) then - exit(AsLazy.Value.AsScalar); - if (FKind <> Ord(vkScalar)) then + if (FKind <> vkScalar) then raise EInvalidCast.Create('Cannot read value as a Scalar.'); Result := FScalar; end; function TDataValue.AsText: String; begin - if FKind = Ord(vkLazy) then - exit(AsLazy.Value.AsText); - if (FKind <> Ord(vkText)) then + if (FKind <> vkText) then raise EInvalidCast.Create('Cannot read value as Text.'); Result := (FInterface as TVal).Value; end; -class function TDataValue.Defer(const Value: TDataValue; const Calc: TFunc): TDataValue; +class function TDataValue.CompareAndSet(var Target: TDataValue; const Expected, NewValue: TDataValue): Boolean; begin - Result.FKind := Ord(vkLazy); - case Value.FKind of - Ord(vkScalar): Result.FInterface := TScalarLazy.Create(Value.AsScalar, Calc); - Ord(vkLazy): - begin - // Create a new lazy object that wraps the existing one, passing the original - // kind and the inner lazy interface. - var cCalc: TFunc := Calc; - Result.FInterface := - TManagedLazy.Create( - Value.AsLazy.Kind, - Value.FInterface, - function(const ArgNodes: TArray): TDataValue - begin - // Chain lazy computations. The new calculation function will first evaluate - // the inner lazy value and then pass the result to the new calculation. - // The reconstructed TDataValue in ArgNodes[0] contains the inner ILazy interface. - Assert(Length(ArgNodes) = 1, 'Expected 1 argument in lazy computation chain'); - Result := cCalc([ILazy(ArgNodes[0].FInterface).Value]); - end - ); - end; - else - Result.FInterface := TManagedLazy.Create(Value.Kind, Value.FInterface, Calc); - end; + // Result := ; end; class function TDataValue.FromIntf(const AValue: T): TDataValue; begin - Result.FKind := Ord(vkInterface); + Result.FKind := vkInterface; Result.FInterface := IInterface(AValue); end; class function TDataValue.FromGeneric(const [ref] AValue: T): TDataValue; begin - Result.FKind := Ord(vkGeneric); + Result.FKind := vkGeneric; Result.FInterface := TVal.Create(AValue); end; class function TDataValue.FromPtr(const AValue: Pointer): TDataValue; begin Assert(sizeof(Pointer) <= sizeof(Int64)); - Result.FKind := Ord(vkPointer); + Result.FKind := vkPointer; Result.FScalar.FromInt64(Int64(AValue)); end; class function TDataValue.FromSeries(const AValue: ISeries): TDataValue; begin - Result.FKind := Ord(vkSeries); + Result.FKind := vkSeries; Result.FInterface := AValue; end; class function TDataValue.FromRecord(const [ref] AValue: TScalarRecord): TDataValue; begin - Result.FKind := Ord(vkRecord); + Result.FKind := vkRecord; Result.FInterface := TVal.Create(AValue); end; class function TDataValue.FromRecordSeries(const AValue: IRecordSeries): TDataValue; begin - Result.FKind := Ord(vkRecordSeries); + Result.FKind := vkRecordSeries; Result.FInterface := AValue; end; class operator TDataValue.Implicit(const AValue: TScalar): TDataValue; begin - Result.FKind := Ord(vkScalar); + Result.FKind := vkScalar; Result.FScalar := AValue; Result.FInterface := nil; end; class operator TDataValue.Implicit(const AValue: String): TDataValue; begin - Result.FKind := Ord(vkText); + Result.FKind := vkText; Result.FInterface := TVal.Create(AValue); end; function TDataValue.GetIsVoid: Boolean; begin - Result := FKind = Ord(vkVoid); + Result := FKind = vkVoid; end; function TDataValue.GetKind: TDataValueKind; begin - if FKind = Ord(vkLazy) then - exit(AsLazy.Kind); Result := TDataValueKind(FKind); end; @@ -390,6 +267,11 @@ begin Result := TMapSeries.Create(SourceSeries, MapperFunc); end; +class function TDataValue.Reset(var Target: TDataValue; const NewValue: TDataValue): TDataValue; +begin + // Result := ; +end; + function TDataValue.ToString: String; var sb: TStringBuilder; @@ -397,15 +279,15 @@ var first: Boolean; begin case FKind of - Ord(vkScalar): Result := FScalar.ToString; - Ord(vkText): Result := '"' + AsText + '"'; - Ord(vkSeries): + vkScalar: Result := FScalar.ToString; + vkText: Result := '"' + AsText + '"'; + vkSeries: begin var series := AsSeries; // Add type and count for series Result := Format('', [series.Count]); end; - Ord(vkRecordSeries): + vkRecordSeries: begin var series := AsRecordSeries; sb := TStringBuilder.Create; @@ -426,7 +308,7 @@ begin sb.Free; end; end; - Ord(vkRecord): + vkRecord: begin var rec := AsRecord; sb := TStringBuilder.Create; @@ -447,13 +329,12 @@ begin sb.Free; end; end; - Ord(vkVoid): Result := ''; - Ord(vkMethod): Result := ''; - Ord(vkGeneric): + vkVoid: Result := ''; + vkMethod: Result := ''; + vkGeneric: // Getting meaningful type information for vkGeneric is not easily possible // without storing additional RTTI, as the specific type of T in TVal is lost. Result := ''; - Ord(vkLazy): Result := Format('', [AsLazy.Kind.ToString]); else Result := '[Unknown DataValue]'; end; @@ -466,13 +347,13 @@ end; class operator TDataValue.Implicit(const AValue: TDataValue.TFunc): TDataValue; begin - Result.FKind := Ord(vkMethod); + Result.FKind := vkMethod; TFunc(Result.FInterface) := AValue; end; class operator TDataValue.Implicit(const AValue: TObject): TDataValue; begin - Result.FKind := Ord(vkManagedObject); + Result.FKind := vkManagedObject; Result.FInterface := TObjVal.Create(AValue); end; @@ -483,14 +364,14 @@ end; class operator TDataValue.Implicit(const AValue: Int64): TDataValue; begin - Result.FKind := Ord(vkScalar); + Result.FKind := vkScalar; Result.FScalar := TScalar.FromInt64(AValue); Result.FInterface := nil; end; class operator TDataValue.Implicit(const AValue: Double): TDataValue; begin - Result.FKind := Ord(vkScalar); + Result.FKind := vkScalar; Result.FScalar := TScalar.FromDouble(AValue); Result.FInterface := nil; end;