Files
MycLib/Src/AST/Myc.Ast.RTL.Core.pas
T
Michael Schimmel 51d0b8d9b7 Fix in RTL-Core
2026-01-06 16:50:48 +01:00

985 lines
35 KiB
ObjectPascal

unit Myc.Ast.RTL.Core;
interface
uses
System.SysUtils,
Myc.Utils,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.RTL,
Myc.Ast.Attributes;
type
// Contains the "pure" native implementations.
TRtlFunctions = record
public
// Arithmetic
[TRtlExport('+', Pure)]
[AstDoc('Adds two numbers or concatenates two strings.')]
class function Add(const Args: TArray<TDataValue>): TDataValue; overload; static;
[TRtlExport('-', Pure)]
[AstDoc('Subtracts B from A, or negates A if called with one argument.')]
class function Subtract(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('*', Pure)]
[AstDoc('Multiplies two numbers.')]
class function Multiply(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('/', Pure)]
[AstDoc('Divides A by B. Returns a Float.')]
class function Divide(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('div', Pure)]
[AstDoc('Integer division.')]
class function IntDivide(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('mod', Pure)]
[AstDoc('Remainder of integer division.')]
class function Modulus(const Args: TArray<TDataValue>): TDataValue; static;
// Comparison
[TRtlExport('=', Pure)]
[AstDoc('Returns true if A equals B.')]
class function Equal(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('<>', Pure)]
[AstDoc('Returns true if A is not equal to B.')]
class function NotEqual(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('<', Pure)]
[AstDoc('Returns true if A is less than B.')]
class function LessThan(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('<=', Pure)]
[AstDoc('Returns true if A is less than or equal to B.')]
class function LessThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('>', Pure)]
[AstDoc('Returns true if A is greater than B.')]
class function GreaterThan(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('>=', Pure)]
[AstDoc('Returns true if A is greater than or equal to B.')]
class function GreaterThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;
// Logic / Bitwise
[TRtlExport('not', Pure)]
[AstDoc('Logical or bitwise NOT.')]
class function LogicalNot(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('and', Pure)]
[AstDoc('Logical or bitwise AND.')]
class function BitwiseAnd(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('or', Pure)]
[AstDoc('Logical or bitwise OR.')]
class function BitwiseOr(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('xor', Pure)]
[AstDoc('Logical or bitwise XOR.')]
class function BitwiseXor(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('shl', Pure)]
[AstDoc('Bitwise shift left.')]
class function LeftShift(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('shr', Pure)]
[AstDoc('Bitwise shift right.')]
class function RightShift(const Args: TArray<TDataValue>): TDataValue; static;
// Math Functions
[TRtlExport('Abs', Pure)]
[AstDoc('Returns the absolute value.')]
class function Abs(const Arg: TScalar): TScalar; static;
[TRtlExport('Round', Pure)]
[AstDoc('Rounds a float to the nearest integer.')]
class function Round(const Arg: TScalar): TScalar; static;
[TRtlExport('Trunc', Pure)]
[AstDoc('Truncates a float to an integer.')]
class function Trunc(const Arg: TScalar): TScalar; static;
[TRtlExport('Ceil', Pure)]
[AstDoc('Returns the smallest integer greater than or equal to the argument.')]
class function Ceil(const Arg: TScalar): TScalar; static;
[TRtlExport('Floor', Pure)]
[AstDoc('Returns the largest integer less than or equal to the argument.')]
class function Floor(const Arg: TScalar): TScalar; static;
[TRtlExport('Sign', Pure)]
[AstDoc('Returns -1 for negative numbers, 1 for positive numbers, and 0 for zero.')]
class function Sign(const Arg: TScalar): TScalar; static;
// DateTime
[TRtlExport('Now', Impure)]
[AstDoc('Returns the current system date and time.')]
class function Now(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Date', Impure)]
[AstDoc('Returns the current date or constructs a date from (Year, Month, Day).')]
class function Date(const Args: TArray<TDataValue>): TDataValue; static;
// High-Order / Series
[TRtlExport('Memoize', Pure)]
[AstDoc('Returns a memoized version of the provided function.')]
class function Memoize(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Map', Pure)]
[AstDoc('Maps a function over a series.')]
class function Map(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Reduce', Pure)]
[AstDoc('Reduces a series using a combining function and an accumulator.')]
class function Reduce(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Where', Pure)]
[AstDoc('Filters a series using a predicate function.')]
class function Where(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Any', Pure)]
[AstDoc('Returns true if any element in the series satisfies the predicate.')]
class function Any(const Args: TArray<TDataValue>): TDataValue; static;
// --- Static Specializations (Picked up by TRtlRegistry via attributes) ---
[TRtlExport('+', Pure)]
class function Add_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('+', Pure)]
class function Add_Float_Float_Float(A, B: Double): Double; static;
[TRtlExport('+', Pure)]
class function Add_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
[TRtlExport('+', Pure)]
class function Add_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
[TRtlExport('+', Pure)]
class function Add_Text_Text_Text(const A: String; const B: String): String; static;
[TRtlExport('-', Pure)]
class function Subtract_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('-', Pure)]
class function Subtract_Float_Float_Float(A, B: Double): Double; static;
[TRtlExport('-', Pure)]
class function Subtract_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
[TRtlExport('-', Pure)]
class function Subtract_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
[TRtlExport('*', Pure)]
class function Multiply_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('*', Pure)]
class function Multiply_Float_Float_Float(A, B: Double): Double; static;
[TRtlExport('*', Pure)]
class function Multiply_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
[TRtlExport('*', Pure)]
class function Multiply_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
[TRtlExport('/', Pure)]
class function Divide_Ordinal_Ordinal_Float(A, B: Int64): Double; static;
[TRtlExport('/', Pure)]
class function Divide_Float_Float_Float(A, B: Double): Double; static;
[TRtlExport('/', Pure)]
class function Divide_Ordinal_Float_Float(A: Int64; B: Double): Double; static;
[TRtlExport('/', Pure)]
class function Divide_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
[TRtlExport('div', Pure)]
class function Div_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('mod', Pure)]
class function Mod_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('=', Pure)]
class function Equal_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('=', Pure)]
class function Equal_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('=', Pure)]
class function Equal_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('=', Pure)]
class function Equal_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('=', Pure)]
class function Equal_Keyword_Keyword_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('<>', Pure)]
class function NotEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('<>', Pure)]
class function NotEqual_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('<>', Pure)]
class function NotEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('<>', Pure)]
class function NotEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('<>', Pure)]
class function NotEqual_Keyword_Keyword_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('<', Pure)]
class function Less_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('<', Pure)]
class function Less_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('<', Pure)]
class function Less_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('<', Pure)]
class function Less_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('<=', Pure)]
class function LessOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('<=', Pure)]
class function LessOrEqual_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('<=', Pure)]
class function LessOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('<=', Pure)]
class function LessOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('>', Pure)]
class function Greater_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('>', Pure)]
class function Greater_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('>', Pure)]
class function Greater_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('>', Pure)]
class function Greater_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('>=', Pure)]
class function GreaterOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('>=', Pure)]
class function GreaterOrEqual_Float_Float_Ordinal(A, B: Double): Int64; static;
[TRtlExport('>=', Pure)]
class function GreaterOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static;
[TRtlExport('>=', Pure)]
class function GreaterOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
[TRtlExport('and', Pure)]
class function And_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('or', Pure)]
class function Or_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('xor', Pure)]
class function Xor_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('shl', Pure)]
class function Shl_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('shr', Pure)]
class function Shr_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('-', Pure)]
class function Negate_Ordinal_Ordinal(A: Int64): Int64; static;
[TRtlExport('-', Pure)]
class function Negate_Float_Float(A: Double): Double; static;
[TRtlExport('not', Pure)]
class function Not_Ordinal_Ordinal(A: Int64): Int64; static;
[TRtlExport('Abs', Pure)]
class function Abs_Ordinal_Ordinal(A: Int64): Int64; static;
[TRtlExport('Abs', Pure)]
class function Abs_Float_Float(A: Double): Double; static;
[TRtlExport('Round', Pure)]
class function Round_Ordinal_Ordinal(A: Int64): Int64; static;
[TRtlExport('Round', Pure)]
class function Round_Float_Ordinal(A: Double): Int64; static;
[TRtlExport('Trunc', Pure)]
class function Trunc_Ordinal_Ordinal(A: Int64): Int64; static;
[TRtlExport('Trunc', Pure)]
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.');
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.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;
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)]);
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;
Result := TDataValue.Map(indexSeries, mapperFunc);
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;
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;
// 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.