Michael Schimmel
1058 lines
34 KiB
ObjectPascal
1058 lines
34 KiB
ObjectPascal
unit Myc.Data.Scalar;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Generics.Collections,
|
|
System.Generics.Defaults,
|
|
System.Math,
|
|
System.DateUtils,
|
|
Myc.Utils,
|
|
Myc.Data.Decimal,
|
|
Myc.Data.Series,
|
|
Myc.Data.Keyword;
|
|
|
|
{$SCOPEDENUMS ON}
|
|
|
|
type
|
|
// A scalar value with a type identifier.
|
|
TScalar = record
|
|
public
|
|
type
|
|
// Defines the underlying storage kinds for scalar values
|
|
TKind = (Ordinal, Float, Keyword, Boolean, DateTime);
|
|
|
|
// The 8-byte storage for the scalar value
|
|
PValue = ^TValue;
|
|
TValue = record
|
|
case TKind of
|
|
TKind.Ordinal, TKind.Keyword, TKind.Boolean: (AsInt64: Int64);
|
|
TKind.Float, TKind.DateTime: (AsDouble: Double);
|
|
end;
|
|
|
|
TBinaryOp = (
|
|
Add,
|
|
Subtract,
|
|
Multiply,
|
|
Divide,
|
|
IntDivide,
|
|
Modulus,
|
|
Equal,
|
|
NotEqual,
|
|
Less,
|
|
Greater,
|
|
LessOrEqual,
|
|
GreaterOrEqual,
|
|
BitwiseAnd,
|
|
BitwiseOr,
|
|
BitwiseXor,
|
|
LeftShift,
|
|
RightShift
|
|
);
|
|
|
|
TUnaryOp = (Negate, Positive, &Not);
|
|
|
|
TKindHelper = record helper for TKind
|
|
public
|
|
function ToString: string;
|
|
end;
|
|
|
|
TBinaryOpHelper = record helper for TScalar.TBinaryOp
|
|
function ToString: string;
|
|
end;
|
|
|
|
TUnaryOpHelper = record helper for TScalar.TUnaryOp
|
|
function ToString: string;
|
|
end;
|
|
|
|
public
|
|
Kind: TKind;
|
|
Value: TValue;
|
|
|
|
// Creates a new scalar from a kind and a value.
|
|
constructor Create(AKind: TKind; const AValue: TValue);
|
|
|
|
// Factory methods for core types.
|
|
class function FromInt64(AValue: Int64): TScalar; static; inline;
|
|
class function FromDouble(AValue: Double): TScalar; static; inline;
|
|
class function FromKeyword(const AValue: IKeyword): TScalar; static; inline;
|
|
class function FromBoolean(AValue: Boolean): TScalar; static; inline;
|
|
class function FromDateTime(AValue: TDateTime): TScalar; static; inline;
|
|
|
|
// Implicit casts for core types.
|
|
class operator Implicit(AValue: Int64): TScalar; overload; inline;
|
|
class operator Implicit(AValue: Double): TScalar; overload; inline;
|
|
class operator Implicit(const AValue: IKeyword): TScalar; overload; inline;
|
|
class operator Implicit(AValue: Boolean): TScalar; overload; inline;
|
|
|
|
class operator Implicit(const A: TScalar): Double; overload; inline;
|
|
class operator Implicit(const A: TScalar): Int64; overload; inline;
|
|
class operator Implicit(const A: TScalar): Boolean; overload; inline;
|
|
class operator Implicit(const A: TScalar): TDateTime; overload; inline;
|
|
|
|
class function StringToKind(const AName: string): TKind; static;
|
|
function ToString: String;
|
|
|
|
class function IsBinaryOperatorSupported(Op: TBinaryOp; A, B: TKind): Boolean; static;
|
|
class function IsUnaryOperatorSupported(Op: TUnaryOp; A: TKind): Boolean; static;
|
|
|
|
class function TryBinaryOperation(Op: TBinaryOp; const A, B: TScalar; out Res: TScalar): Boolean; static;
|
|
class function TryUnaryOperation(Op: TUnaryOp; const A: TScalar; out Res: TScalar): Boolean; static;
|
|
|
|
// Operators
|
|
class operator Add(const A, B: TScalar): TScalar; inline;
|
|
class operator Subtract(const A, B: TScalar): TScalar; inline;
|
|
class operator Multiply(const A, B: TScalar): TScalar; inline;
|
|
class operator Divide(const A, B: TScalar): TScalar; inline;
|
|
|
|
class operator IntDivide(const A, B: TScalar): TScalar; inline;
|
|
class operator Modulus(const A, B: TScalar): TScalar; inline;
|
|
class operator Positive(const A: TScalar): TScalar; inline;
|
|
|
|
class operator Equal(const A, B: TScalar): Boolean; inline;
|
|
class operator NotEqual(const A, B: TScalar): Boolean; inline;
|
|
class operator GreaterThan(const A, B: TScalar): Boolean; inline;
|
|
class operator GreaterThanOrEqual(const A, B: TScalar): Boolean; inline;
|
|
class operator LessThan(const A, B: TScalar): Boolean; inline;
|
|
class operator LessThanOrEqual(const A, B: TScalar): Boolean; inline;
|
|
|
|
class operator BitwiseAnd(const A, B: TScalar): TScalar; inline;
|
|
class operator BitwiseOr(const A, B: TScalar): TScalar; inline;
|
|
class operator BitwiseXor(const A, B: TScalar): TScalar; inline;
|
|
class operator LeftShift(const A, B: TScalar): TScalar; inline;
|
|
class operator RightShift(const A, B: TScalar): TScalar; inline;
|
|
|
|
class operator LogicalNot(const A: TScalar): TScalar; inline;
|
|
class operator Negative(const A: TScalar): TScalar; inline;
|
|
|
|
class operator Round(const A: TScalar): TScalar; inline;
|
|
class operator Trunc(const A: TScalar): TScalar; inline;
|
|
end;
|
|
|
|
// An array of scalar values of the same kind.
|
|
TScalarArray = record
|
|
public
|
|
Kind: TScalar.TKind;
|
|
Items: TArray<TScalar.TValue>;
|
|
constructor Create(AKind: TScalar.TKind; const AItems: TArray<TScalar.TValue>);
|
|
end;
|
|
|
|
TScalarTuple = TArray<TScalar>;
|
|
|
|
// A field definition for a scalar record.
|
|
TScalarRecordField = TPair<IKeyword, TScalar.TKind>;
|
|
IScalarRecordDefinition = IKeywordMapping<TScalar.TKind>;
|
|
IScalarRecord = IKeywordMapping<TScalar>;
|
|
|
|
TScalarRecord = class(TInterfacedObject, IScalarRecord)
|
|
type
|
|
TRegistry = TKeywordMappingRegistry<TScalar.TKind>;
|
|
private
|
|
FDef: IScalarRecordDefinition;
|
|
FData: TArray<TScalar.TValue>;
|
|
|
|
function IndexOf(const Key: IKeyword): Integer;
|
|
function GetCount: Integer;
|
|
function GetItems(Idx: Integer): TPair<IKeyword, TScalar>;
|
|
function GetFields(const Key: IKeyword): TScalar;
|
|
public
|
|
constructor Create(const ADef: IScalarRecordDefinition; const AData: TArray<TScalar.TValue>);
|
|
end;
|
|
|
|
ISeries = interface
|
|
{$region 'private'}
|
|
function GetCount: Int64;
|
|
function GetItems(Idx: Integer): TScalar;
|
|
function GetTotalCount: Int64;
|
|
{$endregion}
|
|
property Count: Int64 read GetCount;
|
|
property Items[Idx: Integer]: TScalar read GetItems; default;
|
|
property TotalCount: Int64 read GetTotalCount;
|
|
end;
|
|
|
|
IWriteableSeries = interface(ISeries)
|
|
procedure Add(const Item: TScalar.TValue; Lookback: Int64 = -1);
|
|
end;
|
|
|
|
// A series of scalar records, optimized for memory and access speed.
|
|
TScalarSeries = class(TInterfacedObject, ISeries, IWriteableSeries)
|
|
private
|
|
FKind: TScalar.TKind;
|
|
FArray: TChunkArray<TScalar.TValue>;
|
|
FTotalCount: Int64;
|
|
function GetCount: Int64; inline;
|
|
function GetItems(Idx: Integer): TScalar; inline;
|
|
function GetTotalCount: Int64; inline;
|
|
public
|
|
constructor Create(AKind: TScalar.TKind);
|
|
procedure Add(const Item: TScalar.TValue; Lookback: Int64 = -1);
|
|
end;
|
|
|
|
IRecordSeries = interface
|
|
{$region 'private'}
|
|
function GetCount: Int64;
|
|
function GetDef: IScalarRecordDefinition;
|
|
function GetTotalCount: Int64;
|
|
function GetFields(const Key: IKeyword): ISeries;
|
|
{$endregion}
|
|
procedure Add(const Item: IScalarRecord; Lookback: Int64 = -1);
|
|
procedure AddRaw(const Data; Lookback: Int64 = -1);
|
|
property Count: Int64 read GetCount;
|
|
property Def: IScalarRecordDefinition read GetDef;
|
|
property Fields[const Key: IKeyword]: ISeries read GetFields; default;
|
|
property TotalCount: Int64 read GetTotalCount;
|
|
end;
|
|
|
|
// A series of scalar records, optimized for memory and access speed.
|
|
TScalarRecordSeries = class(TInterfacedObject, IRecordSeries)
|
|
type
|
|
TMemberSeries = class(TGenericContainedObject<TScalarRecordSeries>, ISeries)
|
|
private
|
|
FKind: TScalar.TKind;
|
|
FOffset: Integer;
|
|
function GetCount: Int64;
|
|
function GetItems(Idx: Integer): TScalar;
|
|
function GetRecordSeries: TScalarRecordSeries; inline;
|
|
function GetTotalCount: Int64;
|
|
public
|
|
constructor Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer);
|
|
property RecordSeries: TScalarRecordSeries read GetRecordSeries;
|
|
end;
|
|
private
|
|
FDef: IScalarRecordDefinition;
|
|
FArray: TChunkArray<TScalar.TValue>;
|
|
FFields: TArray<TMemberSeries>;
|
|
FTotalCount: Int64;
|
|
function GetCount: Int64; inline;
|
|
function GetFields(const Key: IKeyword): ISeries;
|
|
function GetDef: IScalarRecordDefinition; inline;
|
|
function GetTotalCount: Int64; inline;
|
|
function GetItemRef(Idx: Integer): TChunkArray<TScalar.TValue>.PT; inline;
|
|
public
|
|
constructor Create(const ADef: IScalarRecordDefinition);
|
|
destructor Destroy; override;
|
|
procedure Add(const Item: IScalarRecord; Lookback: Int64 = -1);
|
|
|
|
// Copies data directly from the Data reference (zero-copy wrapper)
|
|
procedure AddRaw(const Data; Lookback: Int64 = -1);
|
|
|
|
property Count: Int64 read GetCount;
|
|
property Fields[const Key: IKeyword]: ISeries read GetFields; default;
|
|
property Def: IScalarRecordDefinition read GetDef;
|
|
property TotalCount: Int64 read GetTotalCount;
|
|
end;
|
|
|
|
TIndexSeries = class(TInterfacedObject, ISeries)
|
|
private
|
|
FIndexArray: TArray<Integer>;
|
|
function GetCount: Int64;
|
|
function GetTotalCount: Int64;
|
|
function GetItems(Idx: Integer): TScalar;
|
|
public
|
|
constructor Create(const AIndexArray: TArray<Integer>);
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TScalar }
|
|
|
|
constructor TScalar.Create(AKind: TKind; const AValue: TValue);
|
|
begin
|
|
Kind := AKind;
|
|
Value := AValue;
|
|
end;
|
|
|
|
class function TScalar.FromDouble(AValue: Double): TScalar;
|
|
begin
|
|
Result.Kind := TKind.Float;
|
|
Result.Value.AsDouble := AValue;
|
|
end;
|
|
|
|
class function TScalar.FromInt64(AValue: Int64): TScalar;
|
|
begin
|
|
Result.Kind := TKind.Ordinal;
|
|
Result.Value.AsInt64 := AValue;
|
|
end;
|
|
|
|
class function TScalar.FromKeyword(const AValue: IKeyword): TScalar;
|
|
begin
|
|
Result.Kind := TKind.Keyword;
|
|
if not Assigned(AValue) then
|
|
raise EArgumentException.Create('Keyword must not be nil.');
|
|
Result.Value.AsInt64 := AValue.Idx
|
|
end;
|
|
|
|
class function TScalar.FromBoolean(AValue: Boolean): TScalar;
|
|
begin
|
|
Result.Kind := TKind.Boolean;
|
|
Result.Value.AsInt64 := Ord(AValue);
|
|
end;
|
|
|
|
class function TScalar.FromDateTime(AValue: TDateTime): TScalar;
|
|
begin
|
|
Result.Kind := TKind.DateTime;
|
|
Result.Value.AsDouble := AValue;
|
|
end;
|
|
|
|
// --- Implicit Conversions ---
|
|
|
|
class operator TScalar.Implicit(AValue: Double): TScalar;
|
|
begin
|
|
Result.Kind := TKind.Float;
|
|
Result.Value.AsDouble := AValue;
|
|
end;
|
|
|
|
class operator TScalar.Implicit(AValue: Int64): TScalar;
|
|
begin
|
|
Result.Kind := TKind.Ordinal;
|
|
Result.Value.AsInt64 := AValue;
|
|
end;
|
|
|
|
class operator TScalar.Implicit(const AValue: IKeyword): TScalar;
|
|
begin
|
|
Result.Kind := TKind.Keyword;
|
|
if not Assigned(AValue) then
|
|
raise EArgumentException.Create('Keyword must not be nil.');
|
|
Result.Value.AsInt64 := AValue.Idx
|
|
end;
|
|
|
|
class operator TScalar.Implicit(AValue: Boolean): TScalar;
|
|
begin
|
|
Result.Kind := TKind.Boolean;
|
|
Result.Value.AsInt64 := Ord(AValue);
|
|
end;
|
|
|
|
class operator TScalar.Implicit(const A: TScalar): Double;
|
|
begin
|
|
case A.Kind of
|
|
TKind.Ordinal: Result := A.Value.AsInt64;
|
|
TKind.Float: Result := A.Value.AsDouble;
|
|
TKind.DateTime: Result := A.Value.AsDouble;
|
|
else
|
|
raise EInvalidCast.CreateFmt('Cannot implicitly convert %s to Double', [A.Kind.ToString]);
|
|
end;
|
|
end;
|
|
|
|
class operator TScalar.Implicit(const A: TScalar): Int64;
|
|
begin
|
|
case A.Kind of
|
|
TKind.Ordinal: Result := A.Value.AsInt64;
|
|
TKind.Boolean: Result := A.Value.AsInt64;
|
|
else
|
|
raise EInvalidCast.CreateFmt('Cannot implicitly convert %s to Int64', [A.Kind.ToString]);
|
|
end;
|
|
end;
|
|
|
|
class operator TScalar.Implicit(const A: TScalar): Boolean;
|
|
begin
|
|
case A.Kind of
|
|
TKind.Boolean, TKind.Ordinal: Result := A.Value.AsInt64 <> 0;
|
|
else
|
|
raise EInvalidCast.CreateFmt('Cannot implicitly convert %s to Boolean', [A.Kind.ToString]);
|
|
end;
|
|
end;
|
|
|
|
class operator TScalar.Implicit(const A: TScalar): TDateTime;
|
|
begin
|
|
case A.Kind of
|
|
TKind.DateTime: Result := A.Value.AsDouble;
|
|
else
|
|
raise EInvalidCast.CreateFmt('Cannot implicitly convert %s to TDateTime', [A.Kind.ToString]);
|
|
end;
|
|
end;
|
|
|
|
// --- Support Checks ---
|
|
|
|
class function TScalar.IsBinaryOperatorSupported(Op: TBinaryOp; A, B: TKind): Boolean;
|
|
begin
|
|
// Keyword logic
|
|
if (A = TKind.Keyword) or (B = TKind.Keyword) then
|
|
begin
|
|
Result := (Op in [TBinaryOp.Equal, TBinaryOp.NotEqual]);
|
|
exit;
|
|
end;
|
|
|
|
// DateTime logic
|
|
if (A = TKind.DateTime) or (B = TKind.DateTime) then
|
|
begin
|
|
case Op of
|
|
TBinaryOp.Add:
|
|
// Date + Num or Num + Date
|
|
Result :=
|
|
(A in [TKind.DateTime, TKind.Ordinal, TKind.Float])
|
|
and (B in [TKind.DateTime, TKind.Ordinal, TKind.Float])
|
|
and not ((A = TKind.DateTime) and (B = TKind.DateTime));
|
|
|
|
TBinaryOp.Subtract:
|
|
// Date - Num or Date - Date
|
|
Result := (A = TKind.DateTime) and (B in [TKind.DateTime, TKind.Ordinal, TKind.Float]);
|
|
|
|
TBinaryOp.Equal, TBinaryOp.NotEqual, TBinaryOp.Less, TBinaryOp.Greater, TBinaryOp.LessOrEqual, TBinaryOp.GreaterOrEqual:
|
|
Result := True;
|
|
|
|
else
|
|
Result := False;
|
|
end;
|
|
exit;
|
|
end;
|
|
|
|
// Boolean Logic
|
|
if (A = TKind.Boolean) or (B = TKind.Boolean) then
|
|
begin
|
|
if (A = TKind.Boolean) and (B = TKind.Boolean) then
|
|
begin
|
|
Result := Op in [TBinaryOp.Equal, TBinaryOp.NotEqual, TBinaryOp.BitwiseAnd, TBinaryOp.BitwiseOr, TBinaryOp.BitwiseXor];
|
|
exit;
|
|
end;
|
|
Result := Op in [TBinaryOp.Equal, TBinaryOp.NotEqual];
|
|
exit;
|
|
end;
|
|
|
|
// Bitwise/Int Math requires Ordinals
|
|
if Op
|
|
in [
|
|
TBinaryOp.IntDivide,
|
|
TBinaryOp.Modulus,
|
|
TBinaryOp.BitwiseAnd,
|
|
TBinaryOp.BitwiseOr,
|
|
TBinaryOp.BitwiseXor,
|
|
TBinaryOp.LeftShift,
|
|
TBinaryOp.RightShift] then
|
|
begin
|
|
Result := (A = TKind.Ordinal) and (B = TKind.Ordinal);
|
|
exit;
|
|
end;
|
|
|
|
// Default Numeric
|
|
Result := True;
|
|
end;
|
|
|
|
class function TScalar.IsUnaryOperatorSupported(Op: TUnaryOp; A: TKind): Boolean;
|
|
begin
|
|
if A = TKind.Keyword then
|
|
exit(False);
|
|
|
|
if A = TKind.Boolean then
|
|
begin
|
|
Result := (Op = TUnaryOp.Not);
|
|
exit;
|
|
end;
|
|
|
|
if A = TKind.DateTime then
|
|
exit(False);
|
|
|
|
if (Op = TUnaryOp.Not) and (A <> TKind.Ordinal) then
|
|
exit(False);
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
class function TScalar.StringToKind(const AName: string): TKind;
|
|
begin
|
|
if SameText(AName, 'Ordinal') then
|
|
Result := TKind.Ordinal
|
|
else if SameText(AName, 'Float') then
|
|
Result := TKind.Float
|
|
else if SameText(AName, 'Keyword') then
|
|
Result := TKind.Keyword
|
|
else if SameText(AName, 'Boolean') then
|
|
Result := TKind.Boolean
|
|
else if SameText(AName, 'DateTime') then
|
|
Result := TKind.DateTime
|
|
else
|
|
raise EArgumentException.CreateFmt('Unknown scalar type name: "%s"', [AName]);
|
|
end;
|
|
|
|
function TScalar.ToString: String;
|
|
begin
|
|
case Kind of
|
|
TKind.Ordinal: Result := IntToStr(Value.AsInt64);
|
|
TKind.Float: Result := FloatToStr(Value.AsDouble);
|
|
TKind.Keyword: Result := ':' + TKeywordRegistry.GetName(Value.AsInt64);
|
|
TKind.Boolean: Result := BoolToStr(Value.AsInt64 <> 0, True);
|
|
TKind.DateTime: Result := DateToISO8601(Value.AsDouble, True);
|
|
else
|
|
Result := '[Unknown Scalar]';
|
|
end;
|
|
end;
|
|
|
|
class function TScalar.TryBinaryOperation(Op: TBinaryOp; const A, B: TScalar; out Res: TScalar): Boolean;
|
|
begin
|
|
if not IsBinaryOperatorSupported(Op, A.Kind, B.Kind) then
|
|
exit(False);
|
|
try
|
|
case Op of
|
|
TBinaryOp.Add: Res := A + B;
|
|
TBinaryOp.Subtract: Res := A - B;
|
|
TBinaryOp.Multiply: Res := A * B;
|
|
TBinaryOp.Divide: Res := A / B;
|
|
TBinaryOp.IntDivide: Res := A div B;
|
|
TBinaryOp.Modulus: Res := A mod B;
|
|
TBinaryOp.Equal: Res := TScalar.FromBoolean(A = B);
|
|
TBinaryOp.NotEqual: Res := TScalar.FromBoolean(A <> B);
|
|
TBinaryOp.Less: Res := TScalar.FromBoolean(A < B);
|
|
TBinaryOp.Greater: Res := TScalar.FromBoolean(A > B);
|
|
TBinaryOp.LessOrEqual: Res := TScalar.FromBoolean(A <= B);
|
|
TBinaryOp.GreaterOrEqual: Res := TScalar.FromBoolean(A >= B);
|
|
TBinaryOp.BitwiseAnd: Res := A and B;
|
|
TBinaryOp.BitwiseOr: Res := A or B;
|
|
TBinaryOp.BitwiseXor: Res := A xor B;
|
|
TBinaryOp.LeftShift: Res := A shl B;
|
|
TBinaryOp.RightShift: Res := A shr B;
|
|
else
|
|
exit(False);
|
|
end;
|
|
Result := True;
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
class function TScalar.TryUnaryOperation(Op: TUnaryOp; const A: TScalar; out Res: TScalar): Boolean;
|
|
begin
|
|
if not IsUnaryOperatorSupported(Op, A.Kind) then
|
|
exit(False);
|
|
try
|
|
case Op of
|
|
TUnaryOp.Negate: Res := -A;
|
|
TUnaryOp.Positive: Res := +A;
|
|
TUnaryOp.Not: Res := not A;
|
|
else
|
|
exit(False);
|
|
end;
|
|
Result := True;
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
// --- Operators ---
|
|
|
|
class operator TScalar.Add(const A, B: TScalar): TScalar;
|
|
begin
|
|
// Date Math
|
|
if (A.Kind = TKind.DateTime) or (B.Kind = TKind.DateTime) then
|
|
begin
|
|
if (A.Kind = TKind.DateTime) and (B.Kind = TKind.DateTime) then
|
|
raise EArgumentException.Create('Cannot add two DateTimes.');
|
|
|
|
var dateVal: Double;
|
|
var numVal: Double;
|
|
|
|
if A.Kind = TKind.DateTime then
|
|
begin
|
|
dateVal := A.Value.AsDouble;
|
|
numVal := Double(B);
|
|
end
|
|
else
|
|
begin
|
|
dateVal := B.Value.AsDouble;
|
|
numVal := Double(A);
|
|
end;
|
|
|
|
Result.Kind := TKind.DateTime;
|
|
Result.Value.AsDouble := dateVal + numVal;
|
|
exit;
|
|
end;
|
|
|
|
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
|
|
Result := A.Value.AsInt64 + B.Value.AsInt64
|
|
else if (A.Kind in [TKind.Ordinal, TKind.Float]) and (B.Kind in [TKind.Ordinal, TKind.Float]) then
|
|
begin
|
|
var valA: Double := A;
|
|
var valB: Double := B;
|
|
Result := valA + valB;
|
|
end
|
|
else
|
|
raise EArgumentException.CreateFmt('Operator Add not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
|
|
end;
|
|
|
|
class operator TScalar.Subtract(const A, B: TScalar): TScalar;
|
|
begin
|
|
// Date Math
|
|
if A.Kind = TKind.DateTime then
|
|
begin
|
|
var dateA := A.Value.AsDouble;
|
|
if B.Kind = TKind.DateTime then
|
|
begin
|
|
Result.Kind := TKind.Float;
|
|
Result.Value.AsDouble := dateA - B.Value.AsDouble;
|
|
end
|
|
else if B.Kind in [TKind.Ordinal, TKind.Float] then
|
|
begin
|
|
Result.Kind := TKind.DateTime;
|
|
Result.Value.AsDouble := dateA - Double(B);
|
|
end
|
|
else
|
|
raise EArgumentException.Create('Invalid operand for Date subtraction.');
|
|
exit;
|
|
end;
|
|
|
|
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
|
|
Result := A.Value.AsInt64 - B.Value.AsInt64
|
|
else if (A.Kind in [TKind.Ordinal, TKind.Float]) and (B.Kind in [TKind.Ordinal, TKind.Float]) then
|
|
begin
|
|
var valA: Double := A;
|
|
var valB: Double := B;
|
|
Result := valA - valB;
|
|
end
|
|
else
|
|
raise EArgumentException.CreateFmt('Operator Subtract not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
|
|
end;
|
|
|
|
class operator TScalar.Multiply(const A, B: TScalar): TScalar;
|
|
begin
|
|
if (A.Kind in [TKind.DateTime, TKind.Keyword, TKind.Boolean]) or (B.Kind in [TKind.DateTime, TKind.Keyword, TKind.Boolean]) then
|
|
raise EArgumentException.CreateFmt('Operator Multiply not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
|
|
|
|
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
|
|
Result := A.Value.AsInt64 * B.Value.AsInt64
|
|
else
|
|
begin
|
|
var valA: Double := A;
|
|
var valB: Double := B;
|
|
Result := valA * valB;
|
|
end;
|
|
end;
|
|
|
|
class operator TScalar.Divide(const A, B: TScalar): TScalar;
|
|
begin
|
|
if (A.Kind in [TKind.DateTime, TKind.Keyword, TKind.Boolean]) or (B.Kind in [TKind.DateTime, TKind.Keyword, TKind.Boolean]) then
|
|
raise EArgumentException.CreateFmt('Operator Divide not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
|
|
|
|
var valB: Double := B;
|
|
if valB = 0.0 then
|
|
raise EDivByZero.Create('Division by zero');
|
|
|
|
var valA: Double := A;
|
|
Result := valA / valB;
|
|
end;
|
|
|
|
class operator TScalar.IntDivide(const A, B: TScalar): TScalar;
|
|
begin
|
|
if (A.Kind <> TKind.Ordinal) or (B.Kind <> TKind.Ordinal) then
|
|
raise EArgumentException.Create('Operator div requires Ordinal arguments.');
|
|
|
|
if B.Value.AsInt64 = 0 then
|
|
raise EDivByZero.Create('Division by zero');
|
|
|
|
Result.Kind := TKind.Ordinal;
|
|
Result.Value.AsInt64 := A.Value.AsInt64 div B.Value.AsInt64;
|
|
end;
|
|
|
|
class operator TScalar.Modulus(const A, B: TScalar): TScalar;
|
|
begin
|
|
if (A.Kind <> TKind.Ordinal) or (B.Kind <> TKind.Ordinal) then
|
|
raise EArgumentException.Create('Operator mod requires Ordinal arguments.');
|
|
|
|
if B.Value.AsInt64 = 0 then
|
|
raise EDivByZero.Create('Division by zero');
|
|
|
|
Result.Kind := TKind.Ordinal;
|
|
Result.Value.AsInt64 := A.Value.AsInt64 mod B.Value.AsInt64;
|
|
end;
|
|
|
|
class operator TScalar.Equal(const A, B: TScalar): Boolean;
|
|
begin
|
|
if A.Kind = B.Kind then
|
|
begin
|
|
case A.Kind of
|
|
TKind.Ordinal, TKind.Keyword, TKind.Boolean: Result := A.Value.AsInt64 = B.Value.AsInt64;
|
|
TKind.Float, TKind.DateTime: Result := SameValue(A.Value.AsDouble, B.Value.AsDouble);
|
|
else
|
|
Result := False;
|
|
end;
|
|
end
|
|
else if (A.Kind in [TKind.Ordinal, TKind.Float]) and (B.Kind in [TKind.Ordinal, TKind.Float]) then
|
|
Result := SameValue(Double(A), Double(B))
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
class operator TScalar.NotEqual(const A, B: TScalar): Boolean;
|
|
begin
|
|
Result := not (A = B);
|
|
end;
|
|
|
|
class operator TScalar.LessThan(const A, B: TScalar): Boolean;
|
|
begin
|
|
if (A.Kind = TKind.Keyword) or (B.Kind = TKind.Keyword) or (A.Kind = TKind.Boolean) or (B.Kind = TKind.Boolean) then
|
|
raise EArgumentException.Create('Order comparison not supported for Keyword/Boolean.');
|
|
|
|
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
|
|
Result := A.Value.AsInt64 < B.Value.AsInt64
|
|
else
|
|
Result := Double(A) < Double(B);
|
|
end;
|
|
|
|
class operator TScalar.LessThanOrEqual(const A, B: TScalar): Boolean;
|
|
begin
|
|
Result := not (A > B);
|
|
end;
|
|
|
|
class operator TScalar.GreaterThan(const A, B: TScalar): Boolean;
|
|
begin
|
|
if (A.Kind = TKind.Keyword) or (B.Kind = TKind.Keyword) or (A.Kind = TKind.Boolean) or (B.Kind = TKind.Boolean) then
|
|
raise EArgumentException.Create('Order comparison not supported for Keyword/Boolean.');
|
|
|
|
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
|
|
Result := A.Value.AsInt64 > B.Value.AsInt64
|
|
else
|
|
Result := Double(A) > Double(B);
|
|
end;
|
|
|
|
class operator TScalar.GreaterThanOrEqual(const A, B: TScalar): Boolean;
|
|
begin
|
|
Result := not (A < B);
|
|
end;
|
|
|
|
class operator TScalar.BitwiseAnd(const A, B: TScalar): TScalar;
|
|
begin
|
|
if (A.Kind = TKind.Boolean) and (B.Kind = TKind.Boolean) then
|
|
Result := FromBoolean((A.Value.AsInt64 <> 0) and (B.Value.AsInt64 <> 0))
|
|
else if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
|
|
Result := FromInt64(A.Value.AsInt64 and B.Value.AsInt64)
|
|
else
|
|
raise EArgumentException.Create('Operator "and" requires Ordinal or Boolean arguments.');
|
|
end;
|
|
|
|
class operator TScalar.BitwiseOr(const A, B: TScalar): TScalar;
|
|
begin
|
|
if (A.Kind = TKind.Boolean) and (B.Kind = TKind.Boolean) then
|
|
Result := FromBoolean((A.Value.AsInt64 <> 0) or (B.Value.AsInt64 <> 0))
|
|
else if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
|
|
Result := FromInt64(A.Value.AsInt64 or B.Value.AsInt64)
|
|
else
|
|
raise EArgumentException.Create('Operator "or" requires Ordinal or Boolean arguments.');
|
|
end;
|
|
|
|
class operator TScalar.BitwiseXor(const A, B: TScalar): TScalar;
|
|
begin
|
|
if (A.Kind = TKind.Boolean) and (B.Kind = TKind.Boolean) then
|
|
Result := FromBoolean((A.Value.AsInt64 <> 0) xor (B.Value.AsInt64 <> 0))
|
|
else if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
|
|
Result := FromInt64(A.Value.AsInt64 xor B.Value.AsInt64)
|
|
else
|
|
raise EArgumentException.Create('Operator "xor" requires Ordinal or Boolean arguments.');
|
|
end;
|
|
|
|
class operator TScalar.LeftShift(const A, B: TScalar): TScalar;
|
|
begin
|
|
if (A.Kind <> TKind.Ordinal) or (B.Kind <> TKind.Ordinal) then
|
|
raise EArgumentException.Create('Operator shl requires Ordinal arguments.');
|
|
Result := FromInt64(A.Value.AsInt64 shl B.Value.AsInt64);
|
|
end;
|
|
|
|
class operator TScalar.RightShift(const A, B: TScalar): TScalar;
|
|
begin
|
|
if (A.Kind <> TKind.Ordinal) or (B.Kind <> TKind.Ordinal) then
|
|
raise EArgumentException.Create('Operator shr requires Ordinal arguments.');
|
|
Result := FromInt64(A.Value.AsInt64 shr B.Value.AsInt64);
|
|
end;
|
|
|
|
class operator TScalar.LogicalNot(const A: TScalar): TScalar;
|
|
begin
|
|
if A.Kind = TKind.Boolean then
|
|
Result := FromBoolean(A.Value.AsInt64 = 0)
|
|
else if A.Kind = TKind.Ordinal then
|
|
Result := FromBoolean(A.Value.AsInt64 = 0)
|
|
else
|
|
raise EArgumentException.CreateFmt('Operator Not not supported for type %s', [A.Kind.ToString]);
|
|
end;
|
|
|
|
class operator TScalar.Negative(const A: TScalar): TScalar;
|
|
begin
|
|
Result.Kind := A.Kind;
|
|
case A.Kind of
|
|
TKind.Ordinal: Result.Value.AsInt64 := -A.Value.AsInt64;
|
|
TKind.Float: Result.Value.AsDouble := -A.Value.AsDouble;
|
|
else
|
|
raise EArgumentException.CreateFmt('Operator Negative not supported for type %s', [A.Kind.ToString]);
|
|
end;
|
|
end;
|
|
|
|
class operator TScalar.Positive(const A: TScalar): TScalar;
|
|
begin
|
|
if A.Kind in [TKind.Ordinal, TKind.Float] then
|
|
Result := A
|
|
else
|
|
raise EArgumentException.CreateFmt('Operator Positive not supported for type %s', [A.Kind.ToString]);
|
|
end;
|
|
|
|
class operator TScalar.Round(const A: TScalar): TScalar;
|
|
begin
|
|
var val: Double := A;
|
|
Result := FromInt64(System.Round(val));
|
|
end;
|
|
|
|
class operator TScalar.Trunc(const A: TScalar): TScalar;
|
|
begin
|
|
var val: Double := A;
|
|
Result := FromInt64(System.Trunc(val));
|
|
end;
|
|
|
|
{ TScalarArray }
|
|
|
|
constructor TScalarArray.Create(AKind: TScalar.TKind; const AItems: TArray<TScalar.TValue>);
|
|
begin
|
|
Kind := AKind;
|
|
Items := AItems;
|
|
end;
|
|
|
|
{ TScalarRecordSeries }
|
|
|
|
constructor TScalarRecordSeries.Create(const ADef: IScalarRecordDefinition);
|
|
begin
|
|
Assert(ADef.Count > 0);
|
|
FDef := ADef;
|
|
FTotalCount := 0;
|
|
SetLength(FFields, FDef.Count);
|
|
for var i := 0 to High(FFields) do
|
|
FFields[i] := TMemberSeries.Create(Self, i);
|
|
end;
|
|
|
|
destructor TScalarRecordSeries.Destroy;
|
|
begin
|
|
for var i := High(FFields) downto 0 do
|
|
FFields[i].Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TScalarRecordSeries.Add(const Item: IScalarRecord; Lookback: Int64 = -1);
|
|
begin
|
|
var lb := FDef.Count * Integer(Lookback);
|
|
for var i := 0 to FDef.Count - 1 do
|
|
FArray.Add(Item[i].Value.Value, lb);
|
|
inc(FTotalCount);
|
|
end;
|
|
|
|
procedure TScalarRecordSeries.AddRaw(const Data; Lookback: Int64 = -1);
|
|
begin
|
|
var lb := FDef.Count * Integer(Lookback);
|
|
var P: TScalar.PValue := @Data;
|
|
for var i := 0 to FDef.Count - 1 do
|
|
begin
|
|
FArray.Add(P^, lb);
|
|
inc(P);
|
|
end;
|
|
inc(FTotalCount);
|
|
end;
|
|
|
|
function TScalarRecordSeries.GetFields(const Key: IKeyword): ISeries;
|
|
begin
|
|
var elem := FDef.IndexOf(Key);
|
|
if elem < 0 then
|
|
raise EArgumentException.CreateFmt('Field ":%s" not found in record definition.', [Key.Name]);
|
|
|
|
Result := FFields[elem];
|
|
end;
|
|
|
|
function TScalarRecordSeries.GetCount: Int64;
|
|
begin
|
|
Result := FArray.Count div FDef.Count;
|
|
end;
|
|
|
|
function TScalarRecordSeries.GetDef: IScalarRecordDefinition;
|
|
begin
|
|
Result := FDef;
|
|
end;
|
|
|
|
function TScalarRecordSeries.GetItemRef(Idx: Integer): TChunkArray<TScalar.TValue>.PT;
|
|
begin
|
|
var len := FDef.Count;
|
|
Result := FArray.ItemRef[(FArray.Count - len) - (Idx * len)];
|
|
end;
|
|
|
|
function TScalarRecordSeries.GetTotalCount: Int64;
|
|
begin
|
|
Result := FTotalCount;
|
|
end;
|
|
|
|
{ TScalar.TKindHelper }
|
|
|
|
function TScalar.TKindHelper.ToString: string;
|
|
begin
|
|
case Self of
|
|
TScalar.TKind.Ordinal: Result := 'Ordinal';
|
|
TScalar.TKind.Float: Result := 'Float';
|
|
TScalar.TKind.Keyword: Result := 'Keyword';
|
|
TScalar.TKind.Boolean: Result := 'Boolean';
|
|
TScalar.TKind.DateTime: Result := 'DateTime';
|
|
else
|
|
Result := 'unknown';
|
|
end;
|
|
end;
|
|
|
|
{ TScalar.TBinaryOpHelper }
|
|
|
|
function TScalar.TBinaryOpHelper.ToString: string;
|
|
begin
|
|
case Self of
|
|
TScalar.TBinaryOp.Add: Result := '+';
|
|
TScalar.TBinaryOp.Subtract: Result := '-';
|
|
TScalar.TBinaryOp.Multiply: Result := '*';
|
|
TScalar.TBinaryOp.Divide: Result := '/';
|
|
TScalar.TBinaryOp.IntDivide: Result := 'div';
|
|
TScalar.TBinaryOp.Modulus: Result := 'mod';
|
|
TScalar.TBinaryOp.Equal: Result := '=';
|
|
TScalar.TBinaryOp.NotEqual: Result := '<>';
|
|
TScalar.TBinaryOp.Less: Result := '<';
|
|
TScalar.TBinaryOp.Greater: Result := '>';
|
|
TScalar.TBinaryOp.LessOrEqual: Result := '<=';
|
|
TScalar.TBinaryOp.GreaterOrEqual: Result := '>=';
|
|
TScalar.TBinaryOp.BitwiseAnd: Result := 'and';
|
|
TScalar.TBinaryOp.BitwiseOr: Result := 'or';
|
|
TScalar.TBinaryOp.BitwiseXor: Result := 'xor';
|
|
TScalar.TBinaryOp.LeftShift: Result := 'shl';
|
|
TScalar.TBinaryOp.RightShift: Result := 'shr';
|
|
else
|
|
Result := '?';
|
|
end;
|
|
end;
|
|
|
|
{ TScalar.TUnaryOpHelper }
|
|
|
|
function TScalar.TUnaryOpHelper.ToString: string;
|
|
begin
|
|
case Self of
|
|
TScalar.TUnaryOp.Negate: Result := '-';
|
|
TScalar.TUnaryOp.Positive: Result := '+';
|
|
TScalar.TUnaryOp.Not: Result := 'not';
|
|
else
|
|
Result := '?';
|
|
end;
|
|
end;
|
|
|
|
{ TScalarRecordSeries.TMemberSeries }
|
|
|
|
constructor TScalarRecordSeries.TMemberSeries.Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer);
|
|
begin
|
|
inherited Create(ARecordSeries);
|
|
FKind := ARecordSeries.FDef[AElementIdx].Value;
|
|
FOffset := sizeof(TScalar.TValue) * AElementIdx;
|
|
end;
|
|
|
|
function TScalarRecordSeries.TMemberSeries.GetCount: Int64;
|
|
begin
|
|
Result := RecordSeries.Count;
|
|
end;
|
|
|
|
function TScalarRecordSeries.TMemberSeries.GetItems(Idx: Integer): TScalar;
|
|
var
|
|
P: TChunkArray<TScalar.TValue>.PT;
|
|
begin
|
|
P := RecordSeries.GetItemRef(Idx);
|
|
inc(PByte(P), FOffset);
|
|
Result.Create(FKind, P^);
|
|
end;
|
|
|
|
function TScalarRecordSeries.TMemberSeries.GetRecordSeries: TScalarRecordSeries;
|
|
begin
|
|
Result := TScalarRecordSeries(Controller);
|
|
end;
|
|
|
|
function TScalarRecordSeries.TMemberSeries.GetTotalCount: Int64;
|
|
begin
|
|
Result := RecordSeries.TotalCount;
|
|
end;
|
|
|
|
{ TScalarSeries }
|
|
|
|
constructor TScalarSeries.Create(AKind: TScalar.TKind);
|
|
begin
|
|
FKind := AKind;
|
|
FTotalCount := 0;
|
|
end;
|
|
|
|
procedure TScalarSeries.Add(const Item: TScalar.TValue; 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.GetTotalCount: Int64;
|
|
begin
|
|
Result := FTotalCount;
|
|
end;
|
|
|
|
{ TIndexSeries }
|
|
|
|
constructor TIndexSeries.Create(const AIndexArray: TArray<Integer>);
|
|
begin
|
|
inherited Create;
|
|
FIndexArray := AIndexArray;
|
|
end;
|
|
|
|
function TIndexSeries.GetCount: Int64;
|
|
begin
|
|
Result := Length(FIndexArray);
|
|
end;
|
|
|
|
function TIndexSeries.GetTotalCount: Int64;
|
|
begin
|
|
Result := GetCount;
|
|
end;
|
|
|
|
function TIndexSeries.GetItems(Idx: Integer): TScalar;
|
|
var
|
|
sourceIndex: Integer;
|
|
begin
|
|
sourceIndex := FIndexArray[GetCount - 1 - Idx];
|
|
Result := TScalar.FromInt64(sourceIndex);
|
|
end;
|
|
|
|
{ TScalarRecord }
|
|
|
|
constructor TScalarRecord.Create(const ADef: IScalarRecordDefinition; const AData: TArray<TScalar.TValue>);
|
|
begin
|
|
inherited Create;
|
|
FDef := ADef;
|
|
FData := AData;
|
|
end;
|
|
|
|
function TScalarRecord.GetCount: Integer;
|
|
begin
|
|
Result := FDef.Count;
|
|
end;
|
|
|
|
function TScalarRecord.GetFields(const Key: IKeyword): TScalar;
|
|
var
|
|
idx: Integer;
|
|
begin
|
|
idx := FDef.IndexOf(Key);
|
|
if idx < 0 then
|
|
exit(Default(TScalar));
|
|
|
|
// Return the raw TValue at the offset
|
|
Result.Kind := FDef[idx].Value;
|
|
Result.Value := FData[idx];
|
|
end;
|
|
|
|
function TScalarRecord.GetItems(Idx: Integer): TPair<IKeyword, TScalar>;
|
|
begin
|
|
Result.Key := FDef[Idx].Key;
|
|
Result.Value.Kind := FDef[idx].Value;
|
|
Result.Value.Value := FData[idx];
|
|
end;
|
|
|
|
function TScalarRecord.IndexOf(const Key: IKeyword): Integer;
|
|
begin
|
|
Result := FDef.IndexOf(Key);
|
|
end;
|
|
|
|
initialization
|
|
Assert(sizeof(TScalar.TValue) = 8);
|
|
|
|
end.
|