Michael Schimmel
853 lines
29 KiB
ObjectPascal
853 lines
29 KiB
ObjectPascal
unit Myc.Ast.RTL.Core;
|
|
|
|
interface
|
|
|
|
uses
|
|
Myc.Utils,
|
|
Myc.Data.Scalar,
|
|
Myc.Data.Value,
|
|
Myc.Ast.RTL;
|
|
|
|
type
|
|
// Contains the "pure" native implementations.
|
|
TRtlFunctions = record
|
|
public
|
|
// (* --- Dynamic Fallbacks --- *)
|
|
[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('=')]
|
|
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;
|
|
|
|
[TRtlExport('not')]
|
|
class function LogicalNot(const Args: TArray<TDataValue>): TDataValue; static;
|
|
|
|
// (* Dynamic fallbacks for TScalar input *)
|
|
[TRtlExport('Abs')]
|
|
class function Abs(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;
|
|
|
|
// (* 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 (for Monomorphization) --- *)
|
|
// (* Schema: FunctionName_Arg1_ArgN_Return *)
|
|
|
|
// 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;
|
|
|
|
// 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 (NOT pure due to DivByZero)
|
|
[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;
|
|
|
|
// Comparisons (Return Ordinal)
|
|
[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;
|
|
|
|
// 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('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.SysUtils,
|
|
System.Generics.Collections,
|
|
System.Math,
|
|
Myc.Data.Decimal;
|
|
|
|
{ TRtlFunctions - Operator Implementations }
|
|
|
|
class function TRtlFunctions.Add(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator + requires 2 arguments.');
|
|
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Add, Args[0], Args[1], res) then
|
|
raise EArgumentException.Create('Invalid arguments for operator +.');
|
|
Result := res;
|
|
end;
|
|
|
|
class function TRtlFunctions.Subtract(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) = 1 then // Unary negation
|
|
begin
|
|
if not TScalar.TryUnaryOperation(TScalar.TUnaryOp.Negate, Args[0], res) then
|
|
raise EArgumentException.Create('Invalid argument for unary operator -.');
|
|
end
|
|
else if Length(Args) = 2 then // Binary subtraction
|
|
begin
|
|
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Subtract, Args[0], Args[1], res) then
|
|
raise EArgumentException.Create('Invalid arguments for binary operator -.');
|
|
end
|
|
else
|
|
raise EArgumentException.Create('Operator - requires 1 or 2 arguments.');
|
|
Result := res;
|
|
end;
|
|
|
|
class function TRtlFunctions.Multiply(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator * requires 2 arguments.');
|
|
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Multiply, Args[0], Args[1], res) then
|
|
raise EArgumentException.Create('Invalid arguments for operator *.');
|
|
Result := res;
|
|
end;
|
|
|
|
class function TRtlFunctions.Divide(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator / requires 2 arguments.');
|
|
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Divide, Args[0], Args[1], res) then
|
|
raise EArgumentException.Create('Invalid arguments for operator /.');
|
|
Result := res;
|
|
end;
|
|
|
|
class function TRtlFunctions.Equal(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator = requires 2 arguments.');
|
|
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Equal, Args[0], Args[1], res) then
|
|
raise EArgumentException.Create('Invalid arguments for operator =.');
|
|
Result := res;
|
|
end;
|
|
|
|
class function TRtlFunctions.NotEqual(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator <> requires 2 arguments.');
|
|
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.NotEqual, Args[0], Args[1], res) then
|
|
raise EArgumentException.Create('Invalid arguments for operator <>.');
|
|
Result := res;
|
|
end;
|
|
|
|
class function TRtlFunctions.LessThan(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator < requires 2 arguments.');
|
|
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Less, Args[0], Args[1], res) then
|
|
raise EArgumentException.Create('Invalid arguments for operator <.');
|
|
Result := res;
|
|
end;
|
|
|
|
class function TRtlFunctions.LessThanOrEqual(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator <= requires 2 arguments.');
|
|
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.LessOrEqual, Args[0], Args[1], res) then
|
|
raise EArgumentException.Create('Invalid arguments for operator <=.');
|
|
Result := res;
|
|
end;
|
|
|
|
class function TRtlFunctions.GreaterThan(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator > requires 2 arguments.');
|
|
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Greater, Args[0], Args[1], res) then
|
|
raise EArgumentException.Create('Invalid arguments for operator >.');
|
|
Result := res;
|
|
end;
|
|
|
|
class function TRtlFunctions.GreaterThanOrEqual(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) <> 2 then
|
|
raise EArgumentException.Create('Operator >= requires 2 arguments.');
|
|
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.GreaterOrEqual, Args[0], Args[1], res) then
|
|
raise EArgumentException.Create('Invalid arguments for operator >=.');
|
|
Result := res;
|
|
end;
|
|
|
|
class function TRtlFunctions.LogicalNot(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
res: TScalar;
|
|
begin
|
|
if Length(Args) <> 1 then
|
|
raise EArgumentException.Create('Operator not requires 1 argument.');
|
|
if not TScalar.TryUnaryOperation(TScalar.TUnaryOp.Not, Args[0], res) then
|
|
raise EArgumentException.Create('Invalid argument for operator not.');
|
|
Result := res;
|
|
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: Result := TScalar.FromDouble(System.Abs(Arg.Value.AsDouble));
|
|
else
|
|
raise EArgumentException.Create('Abs requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
class function TRtlFunctions.Trunc(const Arg: TScalar): TScalar;
|
|
begin
|
|
case Arg.Kind of
|
|
TScalar.TKind.Ordinal: Result := Arg; // Trunc on an integer is a no-op
|
|
TScalar.TKind.Float: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsDouble));
|
|
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; // Ceil on an integer is a no-op
|
|
TScalar.TKind.Float: 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; // Floor on an integer is a no-op
|
|
TScalar.TKind.Float: 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: Result := TScalar.FromInt64(System.Math.Sign(Arg.Value.AsDouble));
|
|
else
|
|
raise EArgumentException.Create('Sign requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
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.');
|
|
|
|
// create a managed dictionary
|
|
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)]);
|
|
if (predicateResult.Kind = vkScalar)
|
|
and (predicateResult.AsScalar.Kind = TScalar.TKind.Ordinal)
|
|
and (predicateResult.AsScalar.Value.AsInt64 <> 0) 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 (predicateResult.AsScalar.Kind = TScalar.TKind.Ordinal)
|
|
and (predicateResult.AsScalar.Value.AsInt64 <> 0) then
|
|
begin
|
|
Result := TScalar.FromInt64(1);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
Result := TScalar.FromInt64(0);
|
|
end;
|
|
|
|
{ TRtlFunctions - 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;
|
|
|
|
// --- Comparisons ---
|
|
(* Delphi bools: 0=False, 1=True. We return Int64 (0 or 1) *)
|
|
|
|
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(A = B); // Note: Standard float comparison
|
|
end;
|
|
|
|
class function TRtlFunctions.Equal_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
|
|
begin
|
|
Result := Ord(A = B);
|
|
end;
|
|
|
|
class function TRtlFunctions.Equal_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
|
|
begin
|
|
Result := Ord(A = B);
|
|
end;
|
|
|
|
class function TRtlFunctions.Equal_Keyword_Keyword_Ordinal(A, B: Int64): Int64;
|
|
begin
|
|
// Keywords are passed as their Int64 index
|
|
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(A <> B);
|
|
end;
|
|
|
|
class function TRtlFunctions.NotEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
|
|
begin
|
|
Result := Ord(A <> B);
|
|
end;
|
|
|
|
class function TRtlFunctions.NotEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
|
|
begin
|
|
Result := Ord(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;
|
|
|
|
// --- 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
|
|
// Lisp-style 'not': 0 -> 1, everything else -> 0
|
|
Result := Ord(A = 0);
|
|
end;
|
|
|
|
// --- Standard functions ---
|
|
|
|
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.Trunc_Ordinal_Ordinal(A: Int64): Int64;
|
|
begin
|
|
Result := A; // No-op
|
|
end;
|
|
|
|
class function TRtlFunctions.Trunc_Float_Ordinal(A: Double): Int64;
|
|
begin
|
|
Result := System.Trunc(A);
|
|
end;
|
|
|
|
end.
|