Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Preparing for atomic data values

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-30 11:34:35 +02:00
parent 4de6bf9bcd
commit 9010bb1890
1 changed files with 43 additions and 162 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Data/Myc.Data.Value.pas
+43 -162
View File
@@ -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<T: IInterface>(const AValue: T): TDataValue; static;
function AsIntf<T: IInterface>: 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<T> }
constructor TDataValue.TVal<T>.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>: T;
begin
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsGeneric<T>);
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<T>(FInterface).TypeHandle <> TypeInfo(T) then
@@ -233,155 +150,115 @@ end;
function TDataValue.AsIntf<T>: T;
begin
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsGeneric<T>);
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<TScalarRecord>).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<String>).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>): 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<T>(const AValue: T): TDataValue;
begin
Result.FKind := Ord(vkInterface);
Result.FKind := vkInterface;
Result.FInterface := IInterface(AValue);
end;
class function TDataValue.FromGeneric<T>(const [ref] AValue: T): TDataValue;
begin
Result.FKind := Ord(vkGeneric);
Result.FKind := vkGeneric;
Result.FInterface := TVal<T>.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<TScalarRecord>.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<String>.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[%d]>', [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 := '<void>';
Ord(vkMethod): Result := '<method>';
Ord(vkGeneric):
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>';
Ord(vkLazy): Result := Format('<lazy[%s]>', [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;