RTL and Data value refactoring and defered values
This commit is contained in:
@@ -25,8 +25,8 @@ type
|
||||
class operator LessThan(const A, B: TDecimal): Boolean; inline;
|
||||
class operator LessThanOrEqual(const A, B: TDecimal): Boolean; inline;
|
||||
class operator Negative(const A: TDecimal): TDecimal; inline;
|
||||
class operator Round(const A: TDecimal): TDecimal;
|
||||
class operator Trunc(const A: TDecimal): TDecimal;
|
||||
class operator Round(const A: TDecimal): Int64;
|
||||
class operator Trunc(const A: TDecimal): Int64;
|
||||
|
||||
class operator Implicit(const A: Int64): TDecimal; inline;
|
||||
class operator Explicit(const A: TDecimal): Double;
|
||||
@@ -34,6 +34,9 @@ type
|
||||
class function MinValue(AScale: TScale): TDecimal; static;
|
||||
class function MaxValue(AScale: TScale): TDecimal; static;
|
||||
|
||||
function Sign: Integer; inline;
|
||||
function Abs: TDecimal; inline;
|
||||
|
||||
function GetValue: Int64;
|
||||
function GetScale: TScale;
|
||||
function GetRawValue: Int64; inline;
|
||||
@@ -119,6 +122,14 @@ begin
|
||||
FValue := (Int64(AScale) shl VALUE_BITS) or (intValue and RAW_VALUE_MASK);
|
||||
end;
|
||||
|
||||
function TDecimal.Abs: TDecimal;
|
||||
begin
|
||||
if GetValue < 0 then
|
||||
Result := -Self
|
||||
else
|
||||
Result := Self;
|
||||
end;
|
||||
|
||||
class operator TDecimal.Add(const A, B: TDecimal): TDecimal;
|
||||
begin
|
||||
var aScale := A.GetScale;
|
||||
@@ -302,24 +313,22 @@ begin
|
||||
Result := TDecimal.Create(-A.GetValue, A.GetScale);
|
||||
end;
|
||||
|
||||
class operator TDecimal.Round(const A: TDecimal): TDecimal;
|
||||
class operator TDecimal.Round(const A: TDecimal): Int64;
|
||||
var
|
||||
value: Int64;
|
||||
divisor: Int64;
|
||||
begin
|
||||
// Rounds to the nearest whole number (scale 0) using arithmetic rounding.
|
||||
value := A.GetValue;
|
||||
divisor := PowersOf10[A.GetScale];
|
||||
if value >= 0 then
|
||||
Result := TDecimal.Create((value + divisor div 2) div divisor, 0)
|
||||
Result := (value + divisor div 2) div divisor
|
||||
else
|
||||
Result := TDecimal.Create((value - divisor div 2) div divisor, 0);
|
||||
Result := (value - divisor div 2) div divisor;
|
||||
end;
|
||||
|
||||
class operator TDecimal.Trunc(const A: TDecimal): TDecimal;
|
||||
class operator TDecimal.Trunc(const A: TDecimal): Int64;
|
||||
begin
|
||||
// Truncates the fractional part, resulting in a decimal with scale 0
|
||||
Result := TDecimal.Create(A.GetValue div PowersOf10[A.GetScale], 0);
|
||||
Result := A.GetValue div PowersOf10[A.GetScale];
|
||||
end;
|
||||
|
||||
class operator TDecimal.Implicit(const A: Int64): TDecimal;
|
||||
@@ -365,4 +374,14 @@ begin
|
||||
Result := FValue;
|
||||
end;
|
||||
|
||||
function TDecimal.Sign: Integer;
|
||||
begin
|
||||
var val := GetValue;
|
||||
if val < 0 then
|
||||
exit(-1);
|
||||
if val > 0 then
|
||||
exit(-1);
|
||||
exit(0);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
+154
-178
@@ -173,70 +173,89 @@ type
|
||||
FFields: TArray<TScalarValue>;
|
||||
end;
|
||||
|
||||
// A time series of scalar values of the same kind.
|
||||
TScalarSeries = record
|
||||
private
|
||||
FKind: TScalarKind;
|
||||
FItems: TSeries<TScalarValue>;
|
||||
public
|
||||
// Creates a new scalar series.
|
||||
constructor Create(AKind: TScalarKind; const AItems: TSeries<TScalarValue>);
|
||||
|
||||
property Kind: TScalarKind read FKind;
|
||||
property Items: TSeries<TScalarValue> read FItems;
|
||||
end;
|
||||
|
||||
TScalarMemberSeries = record
|
||||
private
|
||||
FArray: TChunkArray<TScalarValue>;
|
||||
FElementIdx: Integer;
|
||||
FKind: TScalarKind;
|
||||
FElemCount: Integer;
|
||||
ISeries = interface
|
||||
{$region 'private'}
|
||||
function GetCount: Int64;
|
||||
function GetItems(Idx: Integer): TScalar;
|
||||
public
|
||||
constructor Create(AKind: TScalarKind; const AArray: TChunkArray<TScalarValue>; AElementIdx, AElemCount: Integer);
|
||||
function GetKind: TScalarKind;
|
||||
function GetTotalCount: Int64;
|
||||
{$endregion}
|
||||
property Count: Int64 read GetCount;
|
||||
property Items[Idx: Integer]: TScalar read GetItems; default;
|
||||
property Kind: TScalarKind read FKind;
|
||||
property Kind: TScalarKind read GetKind;
|
||||
property TotalCount: Int64 read GetTotalCount;
|
||||
end;
|
||||
|
||||
// A time series of scalar tuples, optimized for memory and access speed.
|
||||
TScalarTupleSeries = record
|
||||
private
|
||||
FDef: TArray<TScalarKind>;
|
||||
FArray: TChunkArray<TScalarValue>;
|
||||
FTotalCount: Int64;
|
||||
function GetCount: Int64;
|
||||
function GetItems(Idx: Integer): TScalarTuple;
|
||||
public
|
||||
constructor Create(const ADef: TArray<TScalarKind>);
|
||||
procedure Add(const Item: TScalarTuple; Lookback: Int64 = -1);
|
||||
function CreateMemberSeries(Idx: Integer): TScalarMemberSeries;
|
||||
property Count: Int64 read GetCount;
|
||||
property Def: TArray<TScalarKind> read FDef;
|
||||
property Items[Idx: Integer]: TScalarTuple read GetItems; default;
|
||||
property TotalCount: Int64 read FTotalCount;
|
||||
IWriteableSeries = interface(ISeries)
|
||||
procedure Add(const Item: TScalarValue; Lookback: Int64 = -1);
|
||||
end;
|
||||
|
||||
// A time series of scalar records, optimized for memory and access speed.
|
||||
TScalarRecordSeries = record
|
||||
TScalarSeries = class(TInterfacedObject, ISeries, IWriteableSeries)
|
||||
private
|
||||
FKind: TScalarKind;
|
||||
FArray: TChunkArray<TScalarValue>;
|
||||
FTotalCount: Int64;
|
||||
|
||||
function GetKind: TScalarKind; inline;
|
||||
function GetCount: Int64; inline;
|
||||
function GetItems(Idx: Integer): TScalar; inline;
|
||||
function GetTotalCount: Int64; inline;
|
||||
|
||||
public
|
||||
constructor Create(AKind: TScalarKind);
|
||||
procedure Add(const Item: TScalarValue; Lookback: Int64 = -1);
|
||||
end;
|
||||
|
||||
IRecordSeries = interface
|
||||
{$region 'private'}
|
||||
function GetCount: Int64;
|
||||
function GetDef: TScalarRecordDefinition;
|
||||
function GetItems(Idx: Integer): TScalarRecord;
|
||||
function GetTotalCount: Int64;
|
||||
{$endregion}
|
||||
procedure Add(const Item: TScalarRecord; Lookback: Int64 = -1);
|
||||
function CreateMemberSeries(const Field: String): ISeries;
|
||||
property Count: Int64 read GetCount;
|
||||
property Def: TScalarRecordDefinition read GetDef;
|
||||
property Items[Idx: Integer]: TScalarRecord read GetItems; default;
|
||||
property TotalCount: Int64 read GetTotalCount;
|
||||
end;
|
||||
|
||||
// A time series of scalar records, optimized for memory and access speed.
|
||||
TScalarRecordSeries = class(TInterfacedObject, IRecordSeries)
|
||||
type
|
||||
TMemberSeries = class(TInterfacedObject, ISeries)
|
||||
private
|
||||
FRecordSeries: TScalarRecordSeries;
|
||||
FKind: TScalarKind;
|
||||
FOffset: Integer;
|
||||
function GetCount: Int64;
|
||||
function GetItems(Idx: Integer): TScalar;
|
||||
function GetKind: TScalarKind;
|
||||
function GetTotalCount: Int64;
|
||||
public
|
||||
constructor Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer);
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
private
|
||||
FDef: TScalarRecordDefinition;
|
||||
FArray: TChunkArray<TScalarValue>;
|
||||
FTotalCount: Int64;
|
||||
function GetCount: Int64;
|
||||
function GetCount: Int64; inline;
|
||||
function GetDef: TScalarRecordDefinition; inline;
|
||||
function GetItems(Idx: Integer): TScalarRecord;
|
||||
function GetItems(Idx: Integer): TScalarRecord; inline;
|
||||
function GetTotalCount: Int64; inline;
|
||||
function GetItemRef(Idx: Integer): TChunkArray<TScalarValue>.PT; inline;
|
||||
public
|
||||
constructor Create(const ADef: TScalarRecordDefinition);
|
||||
procedure Add(const Item: TScalarRecord; Lookback: Int64 = -1);
|
||||
function AsTupleSeries: TScalarTupleSeries;
|
||||
function CreateMemberSeries(const Field: String): TScalarMemberSeries;
|
||||
function CreateMemberSeries(const Field: String): ISeries;
|
||||
property Count: Int64 read GetCount;
|
||||
property Def: TScalarRecordDefinition read GetDef;
|
||||
property Items[Idx: Integer]: TScalarRecord read GetItems; default;
|
||||
property TotalCount: Int64 read FTotalCount;
|
||||
property TotalCount: Int64 read GetTotalCount;
|
||||
end;
|
||||
|
||||
TBinaryOperatorHelper = record helper for TBinaryOperator
|
||||
@@ -1347,116 +1366,6 @@ begin
|
||||
Result.Create(FDef.Fields[idx].Kind, FFields[idx]);
|
||||
end;
|
||||
|
||||
{ TScalarSeries }
|
||||
|
||||
constructor TScalarSeries.Create(AKind: TScalarKind; const AItems: TSeries<TScalarValue>);
|
||||
begin
|
||||
FKind := AKind;
|
||||
FItems := AItems;
|
||||
end;
|
||||
|
||||
{ TScalarTupleSeries }
|
||||
|
||||
constructor TScalarTupleSeries.Create(const ADef: TArray<TScalarKind>);
|
||||
begin
|
||||
// Implements a time series of scalar tuples using a chunk array for efficient storage.
|
||||
Assert(Length(ADef) > 0, 'Tuple definition cannot be empty.');
|
||||
FDef := ADef;
|
||||
FTotalCount := 0;
|
||||
end;
|
||||
|
||||
procedure TScalarTupleSeries.Add(const Item: TScalarTuple; Lookback: Int64 = -1);
|
||||
var
|
||||
values: TArray<TScalarValue>;
|
||||
i: Integer;
|
||||
tupleSize: Integer;
|
||||
maxCount: Integer;
|
||||
begin
|
||||
tupleSize := Length(FDef);
|
||||
Assert(Length(Item) = tupleSize, 'Tuple does not match series definition.');
|
||||
|
||||
// Extract TScalarValue from TScalarTuple.
|
||||
SetLength(values, tupleSize);
|
||||
for i := 0 to tupleSize - 1 do
|
||||
begin
|
||||
Assert(Item[i].Kind = FDef[i], 'Tuple element kind mismatch.');
|
||||
values[i] := Item[i].Value;
|
||||
end;
|
||||
|
||||
if Lookback < 0 then
|
||||
maxCount := -1
|
||||
else
|
||||
maxCount := tupleSize * Lookback;
|
||||
|
||||
FArray.Add(values, maxCount);
|
||||
inc(FTotalCount);
|
||||
end;
|
||||
|
||||
function TScalarTupleSeries.CreateMemberSeries(Idx: Integer): TScalarMemberSeries;
|
||||
var
|
||||
tupleSize: Integer;
|
||||
begin
|
||||
tupleSize := Length(FDef);
|
||||
if (Idx < 0) or (Idx >= tupleSize) then
|
||||
raise EArgumentException.CreateFmt('Index %d is out of bounds for a tuple of size %d.', [Idx, tupleSize]);
|
||||
|
||||
// Creates a series view for a specific member of the tuple.
|
||||
Result := TScalarMemberSeries.Create(FDef[Idx], FArray, Idx, tupleSize);
|
||||
end;
|
||||
|
||||
function TScalarTupleSeries.GetCount: Int64;
|
||||
begin
|
||||
if Length(FDef) = 0 then
|
||||
exit(0);
|
||||
Result := FArray.Count div Length(FDef);
|
||||
end;
|
||||
|
||||
function TScalarTupleSeries.GetItems(Idx: Integer): TScalarTuple;
|
||||
var
|
||||
values: TArray<TScalarValue>;
|
||||
tupleSize, i: Integer;
|
||||
begin
|
||||
tupleSize := Length(FDef);
|
||||
Assert(tupleSize > 0);
|
||||
Assert((Idx >= 0) and (Idx < (FArray.Count div tupleSize)));
|
||||
|
||||
// Create a temporary array to hold the values for one tuple.
|
||||
SetLength(values, tupleSize);
|
||||
// Copy the tuple data from the chunk array (latest item is at the end).
|
||||
Move(FArray.ItemRef[(FArray.Count - tupleSize) - (Idx * tupleSize)]^, values[0], sizeof(TScalarValue) * tupleSize);
|
||||
|
||||
// Reconstruct the TScalarTuple from the values and the definition.
|
||||
SetLength(Result, tupleSize);
|
||||
for i := 0 to tupleSize - 1 do
|
||||
Result[i] := TScalar.Create(FDef[i], values[i]);
|
||||
end;
|
||||
|
||||
{ TScalarMemberSeries }
|
||||
|
||||
constructor TScalarMemberSeries.Create(AKind: TScalarKind; const AArray: TChunkArray<TScalarValue>; AElementIdx, AElemCount: Integer);
|
||||
begin
|
||||
Assert(AArray.Count mod AElemCount = 0);
|
||||
Assert(AElementIdx >= 0);
|
||||
Assert(AElementIdx < AElemCount);
|
||||
|
||||
FKind := AKind;
|
||||
FArray := AArray;
|
||||
FElementIdx := AElementIdx;
|
||||
FElemCount := AElemCount;
|
||||
end;
|
||||
|
||||
function TScalarMemberSeries.GetCount: Int64;
|
||||
begin
|
||||
if FElemCount = 0 then
|
||||
exit(0);
|
||||
Result := FArray.Count div FElemCount;
|
||||
end;
|
||||
|
||||
function TScalarMemberSeries.GetItems(Idx: Integer): TScalar;
|
||||
begin
|
||||
Result.Create(FKind, FArray.Items[(FArray.Count - FElemCount) - (Idx * FElemCount) + FElementIdx]);
|
||||
end;
|
||||
|
||||
{ TScalarRecordDefinition }
|
||||
|
||||
constructor TScalarRecordDefinition.Create(const AFields: TArray<TScalarRecordField>);
|
||||
@@ -1494,31 +1403,13 @@ begin
|
||||
inc(FTotalCount);
|
||||
end;
|
||||
|
||||
function TScalarRecordSeries.AsTupleSeries: TScalarTupleSeries;
|
||||
var
|
||||
tupleDef: TArray<TScalarKind>;
|
||||
i: Integer;
|
||||
begin
|
||||
// Extract the kinds from the record definition to create a tuple definition.
|
||||
SetLength(tupleDef, Length(FDef.Fields));
|
||||
for i := 0 to High(FDef.Fields) do
|
||||
tupleDef[i] := FDef.Fields[i].Kind;
|
||||
|
||||
// Create the tuple series with the new definition.
|
||||
Result := TScalarTupleSeries.Create(tupleDef);
|
||||
|
||||
// The underlying data is compatible, so we can share it.
|
||||
Result.FArray := FArray;
|
||||
Result.FTotalCount := FTotalCount;
|
||||
end;
|
||||
|
||||
function TScalarRecordSeries.CreateMemberSeries(const Field: String): TScalarMemberSeries;
|
||||
function TScalarRecordSeries.CreateMemberSeries(const Field: String): ISeries;
|
||||
begin
|
||||
var elem := FDef.IndexOf(Field);
|
||||
if elem < 0 then
|
||||
raise EArgumentException.CreateFmt('Field "%s" not found in record definition.', [Field]);
|
||||
|
||||
Result := TScalarMemberSeries.Create(FDef.Fields[elem].Kind, FArray, elem, Length(FDef.Fields));
|
||||
Result := TMemberSeries.Create(Self, elem);
|
||||
end;
|
||||
|
||||
function TScalarRecordSeries.GetCount: Int64;
|
||||
@@ -1531,17 +1422,26 @@ begin
|
||||
Result := FDef;
|
||||
end;
|
||||
|
||||
function TScalarRecordSeries.GetItemRef(Idx: Integer): TChunkArray<TScalarValue>.PT;
|
||||
begin
|
||||
var len := Length(FDef.Fields);
|
||||
Result := FArray.ItemRef[(FArray.Count - len) - (Idx * len)];
|
||||
end;
|
||||
|
||||
function TScalarRecordSeries.GetItems(Idx: Integer): TScalarRecord;
|
||||
var
|
||||
values: TArray<TScalarValue>;
|
||||
fieldCount: Integer;
|
||||
begin
|
||||
fieldCount := Length(FDef.Fields);
|
||||
SetLength(values, fieldCount);
|
||||
Move(FArray.ItemRef[(FArray.Count - fieldCount) - (Idx * fieldCount)]^, values[0], sizeof(TScalarValue) * fieldCount);
|
||||
SetLength(values, Length(FDef.Fields));
|
||||
Move(GetItemRef(Idx)^, values[0], sizeof(TScalarValue) * Length(values));
|
||||
Result.Create(FDef, values);
|
||||
end;
|
||||
|
||||
function TScalarRecordSeries.GetTotalCount: Int64;
|
||||
begin
|
||||
Result := FTotalCount;
|
||||
end;
|
||||
|
||||
function TScalarKindHelper.ToString: string;
|
||||
begin
|
||||
case Self of
|
||||
@@ -1595,6 +1495,82 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TScalarRecordSeries.TMemberSeries.Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
FRecordSeries := ARecordSeries;
|
||||
FRecordSeries._AddRef;
|
||||
FKind := FRecordSeries.FDef.FFields[AElementIdx].Kind;
|
||||
FOffset := sizeof(TScalarValue) * AElementIdx;
|
||||
end;
|
||||
|
||||
destructor TScalarRecordSeries.TMemberSeries.Destroy;
|
||||
begin
|
||||
FRecordSeries._Release;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TScalarRecordSeries.TMemberSeries.GetCount: Int64;
|
||||
begin
|
||||
Result := FRecordSeries.Count;
|
||||
end;
|
||||
|
||||
function TScalarRecordSeries.TMemberSeries.GetItems(Idx: Integer): TScalar;
|
||||
var
|
||||
P: TChunkArray<TScalarValue>.PT;
|
||||
begin
|
||||
P := FRecordSeries.GetItemRef(Idx);
|
||||
inc(PByte(P), FOffset);
|
||||
Result.Create(FKind, P^);
|
||||
end;
|
||||
|
||||
function TScalarRecordSeries.TMemberSeries.GetKind: TScalarKind;
|
||||
begin
|
||||
Result := FKind;
|
||||
end;
|
||||
|
||||
function TScalarRecordSeries.TMemberSeries.GetTotalCount: Int64;
|
||||
begin
|
||||
Result := FRecordSeries.TotalCount;
|
||||
end;
|
||||
|
||||
{ TScalarSeries }
|
||||
|
||||
// Implements a time series of scalar records using a chunk array for efficient storage.
|
||||
// Each record's fields are stored sequentially in the TChunkArray.
|
||||
|
||||
constructor TScalarSeries.Create(AKind: TScalarKind);
|
||||
begin
|
||||
FKind := AKind;
|
||||
FTotalCount := 0;
|
||||
end;
|
||||
|
||||
procedure TScalarSeries.Add(const Item: TScalarValue; Lookback: Int64 = -1);
|
||||
begin
|
||||
FArray.Add(Item, Lookback);
|
||||
inc(FTotalCount);
|
||||
end;
|
||||
|
||||
function TScalarSeries.GetCount: Int64;
|
||||
begin
|
||||
Result := FArray.Count;
|
||||
end;
|
||||
|
||||
function TScalarSeries.GetItems(Idx: Integer): TScalar;
|
||||
begin
|
||||
Result.Create(FKind, FArray[FArray.Count - Idx - 1]);
|
||||
end;
|
||||
|
||||
function TScalarSeries.GetKind: TScalarKind;
|
||||
begin
|
||||
Result := FKind;
|
||||
end;
|
||||
|
||||
function TScalarSeries.GetTotalCount: Int64;
|
||||
begin
|
||||
Result := FTotalCount;
|
||||
end;
|
||||
|
||||
initialization
|
||||
Assert(sizeof(TScalarValue) = 8);
|
||||
|
||||
|
||||
+250
-91
@@ -8,25 +8,48 @@ uses
|
||||
Myc.Data.Series;
|
||||
|
||||
type
|
||||
TDataValueKind = (vkVoid, vkScalar, vkInterface, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries, vkGeneric, vkMethod);
|
||||
TDataValueKind = (vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries, vkMethod, vkGeneric);
|
||||
|
||||
TDataValue = record
|
||||
public
|
||||
type
|
||||
TVal<T> = class(TInterfacedObject)
|
||||
Value: T;
|
||||
constructor Create(const AValue: T);
|
||||
end;
|
||||
|
||||
TFunc = reference to function(const ArgNodes: TArray<TDataValue>): TDataValue;
|
||||
|
||||
private
|
||||
type
|
||||
IVal = interface
|
||||
{$ifdef DEBUG}
|
||||
function GetTypeHandle: Pointer;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
TVal<T> = class(TInterfacedObject, IVal)
|
||||
Value: T;
|
||||
{$ifdef DEBUG}
|
||||
TypeHandle: Pointer;
|
||||
function GetTypeHandle: Pointer;
|
||||
{$endif}
|
||||
constructor Create(const AValue: T);
|
||||
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: TDataValueKind;
|
||||
FKind: TInternalKindOrdinal;
|
||||
FScalar: TScalar;
|
||||
FInterface: IInterface;
|
||||
|
||||
function AsLazy: ILazy; inline;
|
||||
function GetKind: TDataValueKind; inline;
|
||||
function GetIsVoid: Boolean; inline;
|
||||
|
||||
public
|
||||
class operator Initialize(out Dest: TDataValue);
|
||||
class function Void: TDataValue; inline; static;
|
||||
@@ -35,178 +58,292 @@ type
|
||||
class operator Implicit(const AValue: String): TDataValue; overload; inline;
|
||||
class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline;
|
||||
|
||||
class function From<T: record>(const [ref] AValue: T): TDataValue; static; inline;
|
||||
function AsVal<T: record>: TVal<T>; inline;
|
||||
class function FromGeneric<T>(const [ref] AValue: T): TDataValue; static; inline;
|
||||
function AsGeneric<T>: T; inline;
|
||||
|
||||
class function FromSeries(const [ref] AValue: TScalarSeries): TDataValue; static; inline;
|
||||
class function FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TDataValue; static; inline;
|
||||
class function Defer(const Value: TDataValue; const Calc: TFunc): TDataValue; overload; static;
|
||||
|
||||
class function FromSeries(const AValue: IWriteableSeries): TDataValue; static; inline;
|
||||
class function FromRecordSeries(const AValue: IRecordSeries): TDataValue; static; inline;
|
||||
class function FromRecord(const [ref] AValue: TScalarRecord): TDataValue; static; inline;
|
||||
class function FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TDataValue; static; inline;
|
||||
class function FromInterface(const [ref] AValue: IInterface): TDataValue; static; inline;
|
||||
class function FromMemberSeries(const AValue: ISeries): TDataValue; static; inline;
|
||||
|
||||
function AsScalar: TScalar; inline;
|
||||
function AsInterface: IInterface; inline;
|
||||
function AsMethod: TFunc; inline;
|
||||
function AsText: String; inline;
|
||||
function AsRecordSeries: TVal<TScalarRecordSeries>; inline;
|
||||
function AsRecord: TVal<TScalarRecord>; inline;
|
||||
function AsMemberSeries: TVal<TScalarMemberSeries>; inline;
|
||||
function AsSeries: TVal<TScalarSeries>; inline;
|
||||
|
||||
procedure SetVoid;
|
||||
function AsRecordSeries: IRecordSeries; inline;
|
||||
function AsRecord: TScalarRecord; inline;
|
||||
function AsMemberSeries: ISeries; inline;
|
||||
function AsSeries: IWriteableSeries; inline;
|
||||
|
||||
function ToString: String;
|
||||
property IsVoid: Boolean read GetIsVoid;
|
||||
property Kind: TDataValueKind read GetKind;
|
||||
end;
|
||||
|
||||
type
|
||||
TDataValueKindHelper = record helper for TDataValueKind
|
||||
public
|
||||
function ToString: string;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
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;
|
||||
|
||||
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);
|
||||
begin
|
||||
inherited Create;
|
||||
Value := AValue;
|
||||
{$ifdef DEBUG}
|
||||
TypeHandle := TypeInfo(T);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{$ifdef DEBUG}
|
||||
function TDataValue.TVal<T>.GetTypeHandle: Pointer;
|
||||
begin
|
||||
Result := TypeHandle;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
function TDataValue.AsLazy: ILazy;
|
||||
begin
|
||||
Assert(FKind = Ord(vkLazy));
|
||||
Result := ILazy(FInterface);
|
||||
end;
|
||||
|
||||
{ TDataValue }
|
||||
|
||||
class operator TDataValue.Initialize(out Dest: TDataValue);
|
||||
begin
|
||||
Dest.FKind := vkVoid;
|
||||
Dest.FKind := Ord(vkVoid);
|
||||
Dest.FInterface := nil;
|
||||
end;
|
||||
|
||||
function TDataValue.AsInterface: IInterface;
|
||||
function TDataValue.AsMemberSeries: ISeries;
|
||||
begin
|
||||
if (FKind <> vkInterface) then
|
||||
raise EInvalidCast.Create('Cannot read value as an Interface.');
|
||||
Result := FInterface;
|
||||
end;
|
||||
|
||||
function TDataValue.AsMemberSeries: TVal<TScalarMemberSeries>;
|
||||
begin
|
||||
if (FKind <> vkMemberSeries) then
|
||||
if FKind = Ord(vkLazy) then
|
||||
exit(AsLazy.Value.AsMemberSeries);
|
||||
if (FKind <> Ord(vkMemberSeries)) then
|
||||
raise EInvalidCast.Create('Cannot read value as MemberSeries.');
|
||||
Result := TVal<TScalarMemberSeries>(FInterface);
|
||||
Result := ISeries(FInterface);
|
||||
end;
|
||||
|
||||
function TDataValue.AsMethod: TFunc;
|
||||
begin
|
||||
if (FKind <> vkMethod) then
|
||||
if FKind = Ord(vkLazy) then
|
||||
exit(AsLazy.Value.AsMethod);
|
||||
if (FKind <> Ord(vkMethod)) then
|
||||
raise EInvalidCast.Create('Cannot read value as a method.');
|
||||
Result := TFunc(FInterface);
|
||||
end;
|
||||
|
||||
function TDataValue.AsVal<T>: TVal<T>;
|
||||
function TDataValue.AsGeneric<T>: T;
|
||||
begin
|
||||
if (FKind <> vkGeneric) then
|
||||
raise EInvalidCast.Create('Cannot read value as ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
|
||||
Result := TVal<T>(FInterface);
|
||||
if FKind = Ord(vkLazy) then
|
||||
exit(AsLazy.Value.AsGeneric<T>);
|
||||
if FKind <> Ord(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
|
||||
raise EInvalidCast.Create('Generic type is not a ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
|
||||
{$endif}
|
||||
Result := TVal<T>(FInterface).Value;
|
||||
end;
|
||||
|
||||
function TDataValue.AsRecord: TVal<TScalarRecord>;
|
||||
function TDataValue.AsRecord: TScalarRecord;
|
||||
begin
|
||||
if (FKind <> vkRecord) then
|
||||
if FKind = Ord(vkLazy) then
|
||||
exit(AsLazy.Value.AsRecord);
|
||||
if (FKind <> Ord(vkRecord)) then
|
||||
raise EInvalidCast.Create('Cannot read value as Record.');
|
||||
Result := (FInterface as TVal<TScalarRecord>);
|
||||
Result := (FInterface as TVal<TScalarRecord>).Value;
|
||||
end;
|
||||
|
||||
function TDataValue.AsRecordSeries: TVal<TScalarRecordSeries>;
|
||||
function TDataValue.AsRecordSeries: IRecordSeries;
|
||||
begin
|
||||
if (FKind <> vkRecordSeries) then
|
||||
if FKind = Ord(vkLazy) then
|
||||
exit(AsLazy.Value.AsRecordSeries);
|
||||
if (FKind <> Ord(vkRecordSeries)) then
|
||||
raise EInvalidCast.Create('Cannot read value as RecordSeries.');
|
||||
Result := TVal<TScalarRecordSeries>(FInterface);
|
||||
Result := IRecordSeries(FInterface);
|
||||
end;
|
||||
|
||||
function TDataValue.AsScalar: TScalar;
|
||||
begin
|
||||
if (FKind <> vkScalar) then
|
||||
if FKind = Ord(vkLazy) then
|
||||
exit(AsLazy.Value.AsScalar);
|
||||
if (FKind <> Ord(vkScalar)) then
|
||||
raise EInvalidCast.Create('Cannot read value as a Scalar.');
|
||||
Result := FScalar;
|
||||
end;
|
||||
|
||||
function TDataValue.AsSeries: TVal<TScalarSeries>;
|
||||
function TDataValue.AsSeries: IWriteableSeries;
|
||||
begin
|
||||
if (FKind <> vkSeries) then
|
||||
if FKind = Ord(vkLazy) then
|
||||
exit(AsLazy.Value.AsSeries);
|
||||
if (FKind <> Ord(vkSeries)) then
|
||||
raise EInvalidCast.Create('Cannot read value as Series.');
|
||||
Result := TVal<TScalarSeries>(FInterface);
|
||||
Result := IWriteableSeries(FInterface);
|
||||
end;
|
||||
|
||||
function TDataValue.AsText: String;
|
||||
begin
|
||||
if (FKind <> vkText) then
|
||||
if FKind = Ord(vkLazy) then
|
||||
exit(AsLazy.Value.AsText);
|
||||
if (FKind <> Ord(vkText)) then
|
||||
raise EInvalidCast.Create('Cannot read value as Text.');
|
||||
Result := (FInterface as TVal<String>).Value;
|
||||
end;
|
||||
|
||||
class function TDataValue.From<T>(const [ref] AValue: T): TDataValue;
|
||||
class function TDataValue.Defer(const Value: TDataValue; const Calc: TFunc): TDataValue;
|
||||
begin
|
||||
Result.FKind := vkGeneric;
|
||||
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;
|
||||
end;
|
||||
|
||||
class function TDataValue.FromGeneric<T>(const [ref] AValue: T): TDataValue;
|
||||
begin
|
||||
Result.FKind := Ord(vkGeneric);
|
||||
Result.FInterface := TVal<T>.Create(AValue);
|
||||
end;
|
||||
|
||||
class function TDataValue.FromInterface(const [ref] AValue: IInterface): TDataValue;
|
||||
class function TDataValue.FromMemberSeries(const AValue: ISeries): TDataValue;
|
||||
begin
|
||||
Result.FKind := vkInterface;
|
||||
Result.FKind := Ord(vkMemberSeries);
|
||||
Result.FInterface := AValue;
|
||||
end;
|
||||
|
||||
class function TDataValue.FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TDataValue;
|
||||
begin
|
||||
Result.FKind := vkMemberSeries;
|
||||
Result.FInterface := TVal<TScalarMemberSeries>.Create(AValue);
|
||||
end;
|
||||
|
||||
class function TDataValue.FromRecord(const [ref] AValue: TScalarRecord): TDataValue;
|
||||
begin
|
||||
Result.FKind := vkRecord;
|
||||
Result.FKind := Ord(vkRecord);
|
||||
Result.FInterface := TVal<TScalarRecord>.Create(AValue);
|
||||
end;
|
||||
|
||||
class function TDataValue.FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TDataValue;
|
||||
class function TDataValue.FromRecordSeries(const AValue: IRecordSeries): TDataValue;
|
||||
begin
|
||||
Result.FKind := vkRecordSeries;
|
||||
Result.FInterface := TVal<TScalarRecordSeries>.Create(AValue);
|
||||
Result.FKind := Ord(vkRecordSeries);
|
||||
Result.FInterface := AValue;
|
||||
end;
|
||||
|
||||
class function TDataValue.FromSeries(const [ref] AValue: TScalarSeries): TDataValue;
|
||||
class function TDataValue.FromSeries(const AValue: IWriteableSeries): TDataValue;
|
||||
begin
|
||||
Result.FKind := vkSeries;
|
||||
Result.FInterface := TVal<TScalarSeries>.Create(AValue);
|
||||
Result.FKind := Ord(vkSeries);
|
||||
Result.FInterface := AValue;
|
||||
end;
|
||||
|
||||
class operator TDataValue.Implicit(const AValue: TScalar): TDataValue;
|
||||
begin
|
||||
Result.FKind := vkScalar;
|
||||
Result.FKind := Ord(vkScalar);
|
||||
Result.FScalar := AValue;
|
||||
Result.FInterface := nil;
|
||||
end;
|
||||
|
||||
class operator TDataValue.Implicit(const AValue: String): TDataValue;
|
||||
begin
|
||||
Result.FKind := vkText;
|
||||
Result.FKind := Ord(vkText);
|
||||
Result.FInterface := TVal<String>.Create(AValue);
|
||||
end;
|
||||
|
||||
function TDataValue.GetIsVoid: Boolean;
|
||||
begin
|
||||
Result := FKind = vkVoid;
|
||||
Result := FKind = Ord(vkVoid);
|
||||
end;
|
||||
|
||||
function TDataValue.GetKind: TDataValueKind;
|
||||
begin
|
||||
Result := FKind;
|
||||
end;
|
||||
|
||||
procedure TDataValue.SetVoid;
|
||||
begin
|
||||
FKind := vkVoid;
|
||||
FInterface := nil;
|
||||
if FKind = Ord(vkLazy) then
|
||||
exit(AsLazy.Kind);
|
||||
Result := TDataValueKind(FKind);
|
||||
end;
|
||||
|
||||
function TDataValue.ToString: String;
|
||||
@@ -216,18 +353,17 @@ var
|
||||
first: Boolean;
|
||||
begin
|
||||
case FKind of
|
||||
vkScalar: Result := FScalar.ToString;
|
||||
vkInterface: Result := '<interface>';
|
||||
vkText: Result := '"' + AsText + '"';
|
||||
vkSeries:
|
||||
Ord(vkScalar): Result := FScalar.ToString;
|
||||
Ord(vkText): Result := '"' + AsText + '"';
|
||||
Ord(vkSeries):
|
||||
begin
|
||||
var series := AsSeries.Value;
|
||||
var series := AsSeries;
|
||||
// Add type and count for series
|
||||
Result := Format('<series<%s>[%d]>', [series.Kind.ToString, series.Items.Count]);
|
||||
Result := Format('<series<%s>[%d]>', [series.Kind.ToString, series.Count]);
|
||||
end;
|
||||
vkRecordSeries:
|
||||
Ord(vkRecordSeries):
|
||||
begin
|
||||
var series := AsRecordSeries.Value;
|
||||
var series := AsRecordSeries;
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
sb.Append('{');
|
||||
@@ -246,9 +382,9 @@ begin
|
||||
sb.Free;
|
||||
end;
|
||||
end;
|
||||
vkRecord:
|
||||
Ord(vkRecord):
|
||||
begin
|
||||
var rec := AsRecord.Value;
|
||||
var rec := AsRecord;
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
sb.Append('{');
|
||||
@@ -267,18 +403,23 @@ begin
|
||||
sb.Free;
|
||||
end;
|
||||
end;
|
||||
vkMemberSeries:
|
||||
Ord(vkMemberSeries):
|
||||
begin
|
||||
var series := AsMemberSeries.Value;
|
||||
var series := AsMemberSeries;
|
||||
// Add type and count for member series
|
||||
Result := Format('<member_series<%s>[%d]>', [series.Kind.ToString, series.Count]);
|
||||
end;
|
||||
vkVoid: Result := '<void>';
|
||||
vkMethod: Result := '<method>';
|
||||
vkGeneric:
|
||||
Ord(vkVoid): Result := '<void>';
|
||||
Ord(vkMethod): Result := '<method>';
|
||||
Ord(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.
|
||||
{$ifdef DEBUG}
|
||||
Result := '<' + String(PTypeInfo(TDataValue.IVal(FInterface).GetTypeHandle).Name) + '>';
|
||||
{$else}
|
||||
Result := '<generic>';
|
||||
{$endif}
|
||||
Ord(vkLazy): Result := Format('<lazy[%s]>', [AsLazy.Kind.ToString]);
|
||||
else
|
||||
Result := '[Unknown DataValue]';
|
||||
end;
|
||||
@@ -291,8 +432,26 @@ end;
|
||||
|
||||
class operator TDataValue.Implicit(const AValue: TDataValue.TFunc): TDataValue;
|
||||
begin
|
||||
Result.FKind := vkMethod;
|
||||
Result.FKind := Ord(vkMethod);
|
||||
TFunc(Result.FInterface) := AValue;
|
||||
end;
|
||||
|
||||
{ TDataValueKindHelper }
|
||||
|
||||
function TDataValueKindHelper.ToString: string;
|
||||
begin
|
||||
case Self of
|
||||
vkVoid: Result := 'Void';
|
||||
vkScalar: Result := 'Scalar';
|
||||
vkText: Result := 'Text';
|
||||
vkSeries: Result := 'Series';
|
||||
vkRecordSeries: Result := 'RecordSeries';
|
||||
vkRecord: Result := 'Record';
|
||||
vkMemberSeries: Result := 'MemberSeries';
|
||||
vkMethod: Result := 'Method';
|
||||
else
|
||||
Result := 'unknown';
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user