Michael Schimmel
947 lines
34 KiB
ObjectPascal
947 lines
34 KiB
ObjectPascal
unit Myc.Ast.RTL.Core;
|
|
|
|
interface
|
|
|
|
uses
|
|
system.sysutils,
|
|
Myc.Utils,
|
|
Myc.Data.Scalar,
|
|
Myc.Data.Value,
|
|
Myc.Ast.RTL;
|
|
|
|
type
|
|
// Contains the "pure" native implementations.
|
|
TRtlFunctions = record
|
|
public
|
|
// (* --- Dynamic Fallbacks (Interpreter) --- *)
|
|
|
|
// Arithmetic
|
|
[TRtlExport('+')]
|
|
class function Add(const Args: TArray<TDataValue>): TDataValue; overload; static;
|
|
[TRtlExport('-')]
|
|
class function Subtract(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('*')]
|
|
class function Multiply(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('/')]
|
|
class function Divide(const Args: TArray<TDataValue>): TDataValue; static;
|
|
|
|
[TRtlExport('div')]
|
|
class function IntDivide(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('mod')]
|
|
class function Modulus(const Args: TArray<TDataValue>): TDataValue; static;
|
|
|
|
// Comparison
|
|
[TRtlExport('=')]
|
|
class function Equal(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('<>')]
|
|
class function NotEqual(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('<')]
|
|
class function LessThan(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('<=')]
|
|
class function LessThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('>')]
|
|
class function GreaterThan(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('>=')]
|
|
class function GreaterThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;
|
|
|
|
// Logic / Bitwise
|
|
[TRtlExport('not')]
|
|
class function LogicalNot(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('and')]
|
|
class function BitwiseAnd(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('or')]
|
|
class function BitwiseOr(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('xor')]
|
|
class function BitwiseXor(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('shl')]
|
|
class function LeftShift(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('shr')]
|
|
class function RightShift(const Args: TArray<TDataValue>): TDataValue; static;
|
|
|
|
// (* Dynamic fallbacks for TScalar input *)
|
|
[TRtlExport('Abs')]
|
|
class function Abs(const Arg: TScalar): TScalar; static;
|
|
[TRtlExport('Round')]
|
|
class function Round(const Arg: TScalar): TScalar; static;
|
|
[TRtlExport('Trunc')]
|
|
class function Trunc(const Arg: TScalar): TScalar; static;
|
|
[TRtlExport('Ceil')]
|
|
class function Ceil(const Arg: TScalar): TScalar; static;
|
|
[TRtlExport('Floor')]
|
|
class function Floor(const Arg: TScalar): TScalar; static;
|
|
[TRtlExport('Sign')]
|
|
class function Sign(const Arg: TScalar): TScalar; static;
|
|
|
|
// (* DateTime Constructors *)
|
|
[TRtlExport('Now', False)]
|
|
class function Now(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('Date')]
|
|
class function Date(const Args: TArray<TDataValue>): TDataValue; static;
|
|
|
|
// (* Other dynamic functions *)
|
|
[TRtlExport('Memoize')]
|
|
class function Memoize(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('Map')]
|
|
class function Map(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('Reduce')]
|
|
class function Reduce(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('Where')]
|
|
class function Where(const Args: TArray<TDataValue>): TDataValue; static;
|
|
[TRtlExport('Any')]
|
|
class function Any(const Args: TArray<TDataValue>): TDataValue; static;
|
|
|
|
// (* --- Static Specializations (Monomorphization Targets) --- *)
|
|
|
|
// Add
|
|
[TRtlExport('+', True)]
|
|
class function Add_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('+', True)]
|
|
class function Add_Float_Float_Float(A, B: Double): Double; static;
|
|
[TRtlExport('+', True)]
|
|
class function Add_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
|
|
[TRtlExport('+', True)]
|
|
class function Add_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
|
|
[TRtlExport('+', True)]
|
|
class function Add_Text_Text_Text(const A: String; const B: String): String; static;
|
|
|
|
// Subtract
|
|
[TRtlExport('-', True)]
|
|
class function Subtract_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('-', True)]
|
|
class function Subtract_Float_Float_Float(A, B: Double): Double; static;
|
|
[TRtlExport('-', True)]
|
|
class function Subtract_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
|
|
[TRtlExport('-', True)]
|
|
class function Subtract_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
|
|
|
|
// Multiply
|
|
[TRtlExport('*', True)]
|
|
class function Multiply_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('*', True)]
|
|
class function Multiply_Float_Float_Float(A, B: Double): Double; static;
|
|
[TRtlExport('*', True)]
|
|
class function Multiply_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
|
|
[TRtlExport('*', True)]
|
|
class function Multiply_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
|
|
|
|
// Divide (Impure due to EDivByZero potential)
|
|
[TRtlExport('/')]
|
|
class function Divide_Ordinal_Ordinal_Float(A, B: Int64): Double; static;
|
|
[TRtlExport('/')]
|
|
class function Divide_Float_Float_Float(A, B: Double): Double; static;
|
|
[TRtlExport('/')]
|
|
class function Divide_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
|
|
[TRtlExport('/')]
|
|
class function Divide_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
|
|
|
|
// Integer Math (Impure due to EDivByZero)
|
|
[TRtlExport('div')]
|
|
class function Div_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('mod')]
|
|
class function Mod_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
|
|
// Comparisons
|
|
[TRtlExport('=', True)]
|
|
class function Equal_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('=', True)]
|
|
class function Equal_Float_Float_Ordinal(A, B: Double): Int64; static;
|
|
[TRtlExport('=', True)]
|
|
class function Equal_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
|
|
[TRtlExport('=', True)]
|
|
class function Equal_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
|
|
[TRtlExport('=', True)]
|
|
class function Equal_Keyword_Keyword_Ordinal(A, B: Int64): Int64; static;
|
|
|
|
[TRtlExport('<>', True)]
|
|
class function NotEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('<>', True)]
|
|
class function NotEqual_Float_Float_Ordinal(A, B: Double): Int64; static;
|
|
[TRtlExport('<>', True)]
|
|
class function NotEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
|
|
[TRtlExport('<>', True)]
|
|
class function NotEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
|
|
[TRtlExport('<>', True)]
|
|
class function NotEqual_Keyword_Keyword_Ordinal(A, B: Int64): Int64; static;
|
|
|
|
[TRtlExport('<', True)]
|
|
class function Less_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('<', True)]
|
|
class function Less_Float_Float_Ordinal(A, B: Double): Int64; static;
|
|
[TRtlExport('<', True)]
|
|
class function Less_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
|
|
[TRtlExport('<', True)]
|
|
class function Less_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
|
|
|
|
[TRtlExport('<=', True)]
|
|
class function LessOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('<=', True)]
|
|
class function LessOrEqual_Float_Float_Ordinal(A, B: Double): Int64; static;
|
|
[TRtlExport('<=', True)]
|
|
class function LessOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
|
|
[TRtlExport('<=', True)]
|
|
class function LessOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
|
|
|
|
[TRtlExport('>', True)]
|
|
class function Greater_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('>', True)]
|
|
class function Greater_Float_Float_Ordinal(A, B: Double): Int64; static;
|
|
[TRtlExport('>', True)]
|
|
class function Greater_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
|
|
[TRtlExport('>', True)]
|
|
class function Greater_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
|
|
|
|
[TRtlExport('>=', True)]
|
|
class function GreaterOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('>=', True)]
|
|
class function GreaterOrEqual_Float_Float_Ordinal(A, B: Double): Int64; static;
|
|
[TRtlExport('>=', True)]
|
|
class function GreaterOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
|
|
[TRtlExport('>=', True)]
|
|
class function GreaterOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
|
|
|
|
// Bitwise Static
|
|
[TRtlExport('and', True)]
|
|
class function And_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('or', True)]
|
|
class function Or_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('xor', True)]
|
|
class function Xor_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('shl', True)]
|
|
class function Shl_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
[TRtlExport('shr', True)]
|
|
class function Shr_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
|
|
|
|
// Unary
|
|
[TRtlExport('-', True)]
|
|
class function Negate_Ordinal_Ordinal(A: Int64): Int64; static;
|
|
[TRtlExport('-', True)]
|
|
class function Negate_Float_Float(A: Double): Double; static;
|
|
|
|
[TRtlExport('not', True)]
|
|
class function Not_Ordinal_Ordinal(A: Int64): Int64; static;
|
|
|
|
// Standard functions
|
|
[TRtlExport('Abs', True)]
|
|
class function Abs_Ordinal_Ordinal(A: Int64): Int64; static;
|
|
[TRtlExport('Abs', True)]
|
|
class function Abs_Float_Float(A: Double): Double; static;
|
|
|
|
[TRtlExport('Round', True)]
|
|
class function Round_Ordinal_Ordinal(A: Int64): Int64; static;
|
|
[TRtlExport('Round', True)]
|
|
class function Round_Float_Ordinal(A: Double): Int64; static;
|
|
|
|
[TRtlExport('Trunc', True)]
|
|
class function Trunc_Ordinal_Ordinal(A: Int64): Int64; static;
|
|
[TRtlExport('Trunc', True)]
|
|
class function Trunc_Float_Ordinal(A: Double): Int64; static;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
system.generics.collections,
|
|
system.math,
|
|
system.dateutils,
|
|
Myc.Data.Decimal;
|
|
|
|
{ TRtlFunctions - Operator Implementations }
|
|
|
|
class function TRtlFunctions.Add(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator + requires 2 arguments.');
|
|
if (Args[0].Kind = vkText) and (Args[1].Kind = vkText) then
|
|
Result := Args[0].AsText + Args[1].AsText
|
|
else
|
|
Result := Args[0].AsScalar + Args[1].AsScalar;
|
|
end;
|
|
|
|
class function TRtlFunctions.Subtract(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) = 1 then
|
|
Result := -Args[0].AsScalar
|
|
else if Length(Args) = 2 then
|
|
Result := Args[0].AsScalar - Args[1].AsScalar
|
|
else
|
|
raise EArgumentException.Create('Operator - requires 1 or 2 arguments.');
|
|
end;
|
|
|
|
class function TRtlFunctions.Multiply(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator * requires 2 arguments.');
|
|
Result := Args[0].AsScalar * Args[1].AsScalar;
|
|
end;
|
|
|
|
class function TRtlFunctions.Divide(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator / requires 2 arguments.');
|
|
// Explicit check is handled in TScalar.Divide
|
|
Result := Args[0].AsScalar / Args[1].AsScalar;
|
|
end;
|
|
|
|
class function TRtlFunctions.IntDivide(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator div requires 2 arguments.');
|
|
Result := Args[0].AsScalar div Args[1].AsScalar;
|
|
end;
|
|
|
|
class function TRtlFunctions.Modulus(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator mod requires 2 arguments.');
|
|
Result := Args[0].AsScalar mod Args[1].AsScalar;
|
|
end;
|
|
|
|
class function TRtlFunctions.Equal(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator = requires 2 arguments.');
|
|
Result := TScalar.FromBoolean(Args[0].AsScalar = Args[1].AsScalar);
|
|
end;
|
|
|
|
class function TRtlFunctions.NotEqual(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator <> requires 2 arguments.');
|
|
Result := TScalar.FromBoolean(Args[0].AsScalar <> Args[1].AsScalar);
|
|
end;
|
|
|
|
class function TRtlFunctions.LessThan(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator < requires 2 arguments.');
|
|
Result := TScalar.FromBoolean(Args[0].AsScalar < Args[1].AsScalar);
|
|
end;
|
|
|
|
class function TRtlFunctions.LessThanOrEqual(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator <= requires 2 arguments.');
|
|
Result := TScalar.FromBoolean(Args[0].AsScalar <= Args[1].AsScalar);
|
|
end;
|
|
|
|
class function TRtlFunctions.GreaterThan(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator > requires 2 arguments.');
|
|
Result := TScalar.FromBoolean(Args[0].AsScalar > Args[1].AsScalar);
|
|
end;
|
|
|
|
class function TRtlFunctions.GreaterThanOrEqual(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator >= requires 2 arguments.');
|
|
Result := TScalar.FromBoolean(Args[0].AsScalar >= Args[1].AsScalar);
|
|
end;
|
|
|
|
// --- Logic / Bitwise ---
|
|
|
|
class function TRtlFunctions.LogicalNot(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 1 then
|
|
raise EArgumentException.Create('Operator not requires 1 argument.');
|
|
Result := not Args[0].AsScalar;
|
|
end;
|
|
|
|
class function TRtlFunctions.BitwiseAnd(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator and requires 2 arguments.');
|
|
Result := Args[0].AsScalar and Args[1].AsScalar;
|
|
end;
|
|
|
|
class function TRtlFunctions.BitwiseOr(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator or requires 2 arguments.');
|
|
Result := Args[0].AsScalar or Args[1].AsScalar;
|
|
end;
|
|
|
|
class function TRtlFunctions.BitwiseXor(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator xor requires 2 arguments.');
|
|
Result := Args[0].AsScalar xor Args[1].AsScalar;
|
|
end;
|
|
|
|
class function TRtlFunctions.LeftShift(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator shl requires 2 arguments.');
|
|
Result := Args[0].AsScalar shl Args[1].AsScalar;
|
|
end;
|
|
|
|
class function TRtlFunctions.RightShift(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator shr requires 2 arguments.');
|
|
Result := Args[0].AsScalar shr Args[1].AsScalar;
|
|
end;
|
|
|
|
{ TRtlFunctions - Standard Functions }
|
|
|
|
class function TRtlFunctions.Abs(const Arg: TScalar): TScalar;
|
|
begin
|
|
case Arg.Kind of
|
|
TScalar.TKind.Ordinal: Result := TScalar.FromInt64(System.Abs(Arg.Value.AsInt64));
|
|
TScalar.TKind.Float, TScalar.TKind.DateTime: Result := TScalar.FromDouble(System.Abs(Arg.Value.AsDouble));
|
|
else
|
|
raise EArgumentException.Create('Abs requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
class function TRtlFunctions.Round(const Arg: TScalar): TScalar;
|
|
begin
|
|
case Arg.Kind of
|
|
TScalar.TKind.Ordinal: Result := Arg;
|
|
TScalar.TKind.Float, TScalar.TKind.DateTime:
|
|
begin
|
|
var val: Double := Arg.Value.AsDouble;
|
|
Result := TScalar.FromInt64(System.Round(val));
|
|
end;
|
|
else
|
|
raise EArgumentException.Create('Round requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
class function TRtlFunctions.Trunc(const Arg: TScalar): TScalar;
|
|
begin
|
|
case Arg.Kind of
|
|
TScalar.TKind.Ordinal: Result := Arg;
|
|
TScalar.TKind.Float, TScalar.TKind.DateTime:
|
|
begin
|
|
var val: Double := Arg.Value.AsDouble;
|
|
Result := TScalar.FromInt64(System.Trunc(val));
|
|
end;
|
|
else
|
|
raise EArgumentException.Create('Trunc requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
class function TRtlFunctions.Ceil(const Arg: TScalar): TScalar;
|
|
begin
|
|
case Arg.Kind of
|
|
TScalar.TKind.Ordinal: Result := Arg;
|
|
TScalar.TKind.Float, TScalar.TKind.DateTime: Result := TScalar.FromInt64(System.Math.Ceil(Arg.Value.AsDouble));
|
|
else
|
|
raise EArgumentException.Create('Ceil requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
class function TRtlFunctions.Floor(const Arg: TScalar): TScalar;
|
|
begin
|
|
case Arg.Kind of
|
|
TScalar.TKind.Ordinal: Result := Arg;
|
|
TScalar.TKind.Float, TScalar.TKind.DateTime: Result := TScalar.FromInt64(System.Math.Floor(Arg.Value.AsDouble));
|
|
else
|
|
raise EArgumentException.Create('Floor requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
class function TRtlFunctions.Sign(const Arg: TScalar): TScalar;
|
|
begin
|
|
case Arg.Kind of
|
|
TScalar.TKind.Ordinal: Result := TScalar.FromInt64(System.Math.Sign(Arg.Value.AsInt64));
|
|
TScalar.TKind.Float, TScalar.TKind.DateTime: Result := TScalar.FromInt64(System.Math.Sign(Arg.Value.AsDouble));
|
|
else
|
|
raise EArgumentException.Create('Sign requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
// --- Date Constructors ---
|
|
|
|
class function TRtlFunctions.Now(const Args: TArray<TDataValue>): TDataValue;
|
|
begin
|
|
Result := TScalar.FromDateTime(System.SysUtils.Now);
|
|
end;
|
|
|
|
class function TRtlFunctions.Date(const Args: TArray<TDataValue>): TDataValue;
|
|
|
|
function GetInt(const V: TDataValue; ArgIndex: Integer): Word;
|
|
begin
|
|
if V.AsScalar.Kind <> TScalar.TKind.Ordinal then
|
|
raise EArgumentException.CreateFmt('Date argument %d must be an Integer.', [ArgIndex]);
|
|
Result := V.AsScalar.Value.AsInt64;
|
|
end;
|
|
|
|
begin
|
|
if Length(Args) = 3 then
|
|
begin
|
|
var y := GetInt(Args[0], 1);
|
|
var m := GetInt(Args[1], 2);
|
|
var d := GetInt(Args[2], 3);
|
|
Result := TScalar.FromDateTime(EncodeDate(y, m, d));
|
|
end
|
|
else if Length(Args) = 0 then
|
|
Result := TScalar.FromDateTime(System.SysUtils.Date)
|
|
else
|
|
raise EArgumentException.Create('Date expects 0 or 3 arguments (Year, Month, Day).');
|
|
end;
|
|
|
|
// --- High-Order / Series ---
|
|
|
|
class function TRtlFunctions.Memoize(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
funcToMemoize: TDataValue.TFunc;
|
|
memoizedFunc: TDataValue.TFunc;
|
|
begin
|
|
if Length(Args) <> 1 then
|
|
raise EArgumentException.Create('Memoize requires exactly one argument.');
|
|
if Args[0].Kind <> vkMethod then
|
|
raise EArgumentException.Create('The argument to Memoize must be a function.');
|
|
|
|
var cCache: TDataValue;
|
|
cCache.FromObj(TDictionary<Int64, TDataValue>.Create);
|
|
|
|
funcToMemoize := Args[0].AsMethod();
|
|
|
|
memoizedFunc :=
|
|
function(const AArgs: TArray<TDataValue>): TDataValue
|
|
var
|
|
argScalar: TScalar;
|
|
key: Int64;
|
|
begin
|
|
if (Length(AArgs) <> 1) or (AArgs[0].Kind <> vkScalar) then
|
|
raise EArgumentException.Create('This memoized function can only be called with a single scalar argument.');
|
|
|
|
argScalar := AArgs[0].AsScalar;
|
|
if argScalar.Kind <> TScalar.TKind.Ordinal then
|
|
raise EArgumentException.Create('This memoized function expects an ordinal argument for caching.');
|
|
|
|
key := argScalar.Value.AsInt64;
|
|
|
|
var cache := TDictionary<Int64, TDataValue>(cCache.AsObject);
|
|
|
|
if cache.TryGetValue(key, Result) then
|
|
exit;
|
|
|
|
Result := funcToMemoize(AArgs);
|
|
cache.Add(key, Result);
|
|
end;
|
|
|
|
Result := TDataValue(memoizedFunc);
|
|
end;
|
|
|
|
class function TRtlFunctions.Map(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
sourceArg: TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Map requires exactly two arguments: a series and a function.');
|
|
|
|
sourceArg := Args[0];
|
|
if not (sourceArg.Kind in [vkSeries]) then
|
|
raise EArgumentException.Create('The first argument to Map must be a series.');
|
|
|
|
if Args[1].Kind <> vkMethod then
|
|
raise EArgumentException.Create('The second argument to Map must be a function.');
|
|
|
|
Result := TDataValue.FromSeries(TDataValue.Map(sourceArg.AsSeries, Args[1].AsMethod()));
|
|
end;
|
|
|
|
class function TRtlFunctions.Reduce(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
sourceArg: TDataValue;
|
|
sourceSeries: ISeries;
|
|
accumulator: TDataValue;
|
|
reducerFunc: TDataValue.TFunc;
|
|
i: Integer;
|
|
currentItem: TScalar;
|
|
reducerArgs: TArray<TDataValue>;
|
|
begin
|
|
if Length(Args) <> 3 then
|
|
raise EArgumentException.Create('Reduce requires exactly three arguments: a series, an initial value, and a reducer function.');
|
|
|
|
sourceArg := Args[0];
|
|
if sourceArg.Kind <> vkSeries then
|
|
raise EArgumentException.Create('The first argument to Reduce must be a series.');
|
|
|
|
if Args[2].Kind <> vkMethod then
|
|
raise EArgumentException.Create('The third argument to Reduce must be a function.');
|
|
|
|
sourceSeries := sourceArg.AsSeries;
|
|
accumulator := Args[1];
|
|
reducerFunc := Args[2].AsMethod();
|
|
|
|
for i := sourceSeries.Count - 1 downto 0 do
|
|
begin
|
|
currentItem := sourceSeries.Items[i];
|
|
reducerArgs := [accumulator, TDataValue(currentItem)];
|
|
accumulator := reducerFunc(reducerArgs);
|
|
end;
|
|
|
|
Result := accumulator;
|
|
end;
|
|
|
|
class function TRtlFunctions.Where(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
sourceArg: TDataValue;
|
|
sourceSeries: ISeries;
|
|
predicateFunc: TDataValue.TFunc;
|
|
matchingIndices: TList<Integer>;
|
|
i: Integer;
|
|
item: TScalar;
|
|
predicateResult: TDataValue;
|
|
indexSeries: ISeries;
|
|
mapperFunc: TDataValue.TFunc;
|
|
finalSeries: ISeries;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Where requires exactly two arguments: a series and a predicate function.');
|
|
|
|
sourceArg := Args[0];
|
|
if sourceArg.Kind <> vkSeries then
|
|
raise EArgumentException.Create('The first argument to Where must be a series.');
|
|
|
|
if Args[1].Kind <> vkMethod then
|
|
raise EArgumentException.Create('The second argument to Where must be a function.');
|
|
|
|
sourceSeries := sourceArg.AsSeries;
|
|
predicateFunc := Args[1].AsMethod();
|
|
|
|
matchingIndices := TList<Integer>.Create;
|
|
try
|
|
for i := sourceSeries.Count - 1 downto 0 do
|
|
begin
|
|
item := sourceSeries.Items[i];
|
|
predicateResult := predicateFunc([TDataValue(item)]);
|
|
|
|
// Use the implicit Boolean operator of TScalar
|
|
if (predicateResult.Kind = vkScalar) and (Boolean(predicateResult.AsScalar)) then
|
|
matchingIndices.Add(i);
|
|
end;
|
|
|
|
indexSeries := TIndexSeries.Create(matchingIndices.ToArray);
|
|
finally
|
|
matchingIndices.Free;
|
|
end;
|
|
|
|
mapperFunc :=
|
|
function(const AArgs: TArray<TDataValue>): TDataValue
|
|
var
|
|
idx: Integer;
|
|
begin
|
|
idx := AArgs[0].AsScalar.Value.AsInt64;
|
|
Result := TDataValue(sourceSeries.Items[idx]);
|
|
end;
|
|
|
|
finalSeries := TDataValue.Map(indexSeries, mapperFunc);
|
|
Result := TDataValue.FromSeries(finalSeries);
|
|
end;
|
|
|
|
class function TRtlFunctions.Any(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
sourceArg: TDataValue;
|
|
sourceSeries: ISeries;
|
|
predicateFunc: TDataValue.TFunc;
|
|
i: Integer;
|
|
item: TScalar;
|
|
predicateResult: TDataValue;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Any requires exactly two arguments: a series and a predicate function.');
|
|
|
|
sourceArg := Args[0];
|
|
if sourceArg.Kind <> vkSeries then
|
|
raise EArgumentException.Create('The first argument to Any must be a series.');
|
|
|
|
if Args[1].Kind <> vkMethod then
|
|
raise EArgumentException.Create('The second argument to Any must be a function.');
|
|
|
|
sourceSeries := sourceArg.AsSeries;
|
|
predicateFunc := Args[1].AsMethod();
|
|
|
|
for i := 0 to sourceSeries.Count - 1 do
|
|
begin
|
|
item := sourceSeries.Items[i];
|
|
predicateResult := predicateFunc([TDataValue(item)]);
|
|
|
|
if (predicateResult.Kind = vkScalar) and (Boolean(predicateResult.AsScalar)) then
|
|
begin
|
|
Result := TScalar.FromBoolean(True);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
Result := TScalar.FromBoolean(False);
|
|
end;
|
|
|
|
// --- Static Specializations ---
|
|
|
|
// Add
|
|
class function TRtlFunctions.Add_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := A + B;
|
|
end;
|
|
class function TRtlFunctions.Add_Float_Float_Float(A, B: Double): Double;
|
|
begin
|
|
Result := A + B;
|
|
end;
|
|
class function TRtlFunctions.Add_Ordinal_Float_Float(A: Int64; B: Double): Double;
|
|
begin
|
|
Result := A + B;
|
|
end;
|
|
class function TRtlFunctions.Add_Float_Ordinal_Float(A: Double; B: Int64): Double;
|
|
begin
|
|
Result := A + B;
|
|
end;
|
|
|
|
// Subtract
|
|
class function TRtlFunctions.Subtract_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := A - B;
|
|
end;
|
|
class function TRtlFunctions.Subtract_Float_Float_Float(A, B: Double): Double;
|
|
begin
|
|
Result := A - B;
|
|
end;
|
|
class function TRtlFunctions.Subtract_Ordinal_Float_Float(A: Int64; B: Double): Double;
|
|
begin
|
|
Result := A - B;
|
|
end;
|
|
class function TRtlFunctions.Subtract_Float_Ordinal_Float(A: Double; B: Int64): Double;
|
|
begin
|
|
Result := A - B;
|
|
end;
|
|
|
|
// Multiply
|
|
class function TRtlFunctions.Multiply_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := A * B;
|
|
end;
|
|
class function TRtlFunctions.Multiply_Float_Float_Float(A, B: Double): Double;
|
|
begin
|
|
Result := A * B;
|
|
end;
|
|
class function TRtlFunctions.Multiply_Ordinal_Float_Float(A: Int64; B: Double): Double;
|
|
begin
|
|
Result := A * B;
|
|
end;
|
|
class function TRtlFunctions.Multiply_Float_Ordinal_Float(A: Double; B: Int64): Double;
|
|
begin
|
|
Result := A * B;
|
|
end;
|
|
|
|
// Divide
|
|
class function TRtlFunctions.Divide_Ordinal_Ordinal_Float(A, B: Int64): Double;
|
|
begin
|
|
if B = 0 then
|
|
raise EDivByZero.Create('Division by zero.');
|
|
Result := A / B;
|
|
end;
|
|
class function TRtlFunctions.Divide_Float_Float_Float(A, B: Double): Double;
|
|
begin
|
|
if B = 0.0 then
|
|
raise EDivByZero.Create('Division by zero.');
|
|
Result := A / B;
|
|
end;
|
|
class function TRtlFunctions.Divide_Ordinal_Float_Float(A: Int64; B: Double): Double;
|
|
begin
|
|
if B = 0.0 then
|
|
raise EDivByZero.Create('Division by zero.');
|
|
Result := A / B;
|
|
end;
|
|
class function TRtlFunctions.Divide_Float_Ordinal_Float(A: Double; B: Int64): Double;
|
|
begin
|
|
if B = 0 then
|
|
raise EDivByZero.Create('Division by zero.');
|
|
Result := A / B;
|
|
end;
|
|
|
|
// Integer Math
|
|
class function TRtlFunctions.Div_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := A div B;
|
|
end; // Delphi runtime handles EDivByZero for integers
|
|
class function TRtlFunctions.Mod_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := A mod B;
|
|
end;
|
|
|
|
// Comparisons
|
|
class function TRtlFunctions.Equal_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A = B);
|
|
end;
|
|
class function TRtlFunctions.Equal_Float_Float_Ordinal(A, B: Double): Int64;
|
|
begin
|
|
Result := Ord(SameValue(A, B));
|
|
end;
|
|
class function TRtlFunctions.Equal_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
|
|
begin
|
|
Result := Ord(SameValue(A, B));
|
|
end;
|
|
class function TRtlFunctions.Equal_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
|
|
begin
|
|
Result := Ord(SameValue(A, B));
|
|
end;
|
|
class function TRtlFunctions.Equal_Keyword_Keyword_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A = B);
|
|
end;
|
|
|
|
class function TRtlFunctions.NotEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A <> B);
|
|
end;
|
|
class function TRtlFunctions.NotEqual_Float_Float_Ordinal(A, B: Double): Int64;
|
|
begin
|
|
Result := Ord(not SameValue(A, B));
|
|
end;
|
|
class function TRtlFunctions.NotEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
|
|
begin
|
|
Result := Ord(not SameValue(A, B));
|
|
end;
|
|
class function TRtlFunctions.NotEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
|
|
begin
|
|
Result := Ord(not SameValue(A, B));
|
|
end;
|
|
class function TRtlFunctions.NotEqual_Keyword_Keyword_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A <> B);
|
|
end;
|
|
|
|
class function TRtlFunctions.Less_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A < B);
|
|
end;
|
|
class function TRtlFunctions.Less_Float_Float_Ordinal(A, B: Double): Int64;
|
|
begin
|
|
Result := Ord(A < B);
|
|
end;
|
|
class function TRtlFunctions.Less_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
|
|
begin
|
|
Result := Ord(A < B);
|
|
end;
|
|
class function TRtlFunctions.Less_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A < B);
|
|
end;
|
|
|
|
class function TRtlFunctions.LessOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A <= B);
|
|
end;
|
|
class function TRtlFunctions.LessOrEqual_Float_Float_Ordinal(A, B: Double): Int64;
|
|
begin
|
|
Result := Ord(A <= B);
|
|
end;
|
|
class function TRtlFunctions.LessOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
|
|
begin
|
|
Result := Ord(A <= B);
|
|
end;
|
|
class function TRtlFunctions.LessOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A <= B);
|
|
end;
|
|
|
|
class function TRtlFunctions.Greater_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A > B);
|
|
end;
|
|
class function TRtlFunctions.Greater_Float_Float_Ordinal(A, B: Double): Int64;
|
|
begin
|
|
Result := Ord(A > B);
|
|
end;
|
|
class function TRtlFunctions.Greater_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
|
|
begin
|
|
Result := Ord(A > B);
|
|
end;
|
|
class function TRtlFunctions.Greater_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A > B);
|
|
end;
|
|
|
|
class function TRtlFunctions.GreaterOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A >= B);
|
|
end;
|
|
class function TRtlFunctions.GreaterOrEqual_Float_Float_Ordinal(A, B: Double): Int64;
|
|
begin
|
|
Result := Ord(A >= B);
|
|
end;
|
|
class function TRtlFunctions.GreaterOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
|
|
begin
|
|
Result := Ord(A >= B);
|
|
end;
|
|
class function TRtlFunctions.GreaterOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A >= B);
|
|
end;
|
|
|
|
// Bitwise Static
|
|
class function TRtlFunctions.And_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := A and B;
|
|
end;
|
|
class function TRtlFunctions.Or_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := A or B;
|
|
end;
|
|
class function TRtlFunctions.Xor_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := A xor B;
|
|
end;
|
|
class function TRtlFunctions.Shl_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := A shl B;
|
|
end;
|
|
class function TRtlFunctions.Shr_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
Result := A shr B;
|
|
end;
|
|
|
|
// Unary
|
|
class function TRtlFunctions.Negate_Ordinal_Ordinal(A: Int64): Int64;
|
|
begin
|
|
Result := -A;
|
|
end;
|
|
class function TRtlFunctions.Negate_Float_Float(A: Double): Double;
|
|
begin
|
|
Result := -A;
|
|
end;
|
|
|
|
class function TRtlFunctions.Not_Ordinal_Ordinal(A: Int64): Int64;
|
|
begin
|
|
Result := Ord(A = 0);
|
|
end; // Logical NOT for Int64
|
|
|
|
// Standard
|
|
class function TRtlFunctions.Abs_Ordinal_Ordinal(A: Int64): Int64;
|
|
begin
|
|
Result := System.Abs(A);
|
|
end;
|
|
class function TRtlFunctions.Abs_Float_Float(A: Double): Double;
|
|
begin
|
|
Result := System.Abs(A);
|
|
end;
|
|
|
|
class function TRtlFunctions.Add_Text_Text_Text(const A: String; const B: String): String;
|
|
begin
|
|
Result := A + B;
|
|
end;
|
|
|
|
class function TRtlFunctions.Round_Ordinal_Ordinal(A: Int64): Int64;
|
|
begin
|
|
Result := A;
|
|
end;
|
|
class function TRtlFunctions.Round_Float_Ordinal(A: Double): Int64;
|
|
begin
|
|
Result := System.Round(A);
|
|
end;
|
|
|
|
class function TRtlFunctions.Trunc_Ordinal_Ordinal(A: Int64): Int64;
|
|
begin
|
|
Result := A;
|
|
end;
|
|
class function TRtlFunctions.Trunc_Float_Ordinal(A: Double): Int64;
|
|
begin
|
|
Result := System.Trunc(A);
|
|
end;
|
|
|
|
end.
|