MycLib/Src/AST/Myc.Ast.RTL.Core.pas

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
        [TRtlFunction('+')]
        class function Add(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('-')]
        class function Subtract(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('*')]
        class function Multiply(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('/')]
        class function Divide(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('=')]
        class function Equal(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('<>')]
        class function NotEqual(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('<')]
        class function LessThan(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('<=')]
        class function LessThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('>')]
        class function GreaterThan(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('>=')]
        class function GreaterThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('not')]
        class function LogicalNot(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('Abs')]
        class function Abs(const Arg: TScalar): TScalar; static;

        [TRtlFunction('Trunc')]
        class function Trunc(const Arg: TScalar): TScalar; static;

        [TRtlFunction('Ceil')]
        class function Ceil(const Arg: TScalar): TScalar; static;

        [TRtlFunction('Floor')]
        class function Floor(const Arg: TScalar): TScalar; static;

        [TRtlFunction('Sign')]
        class function Sign(const Arg: TScalar): TScalar; static;

        [TRtlFunction('Memoize')]
        class function Memoize(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('Map')]
        class function Map(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('Reduce')]
        class function Reduce(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('Where')]
        class function Where(const Args: TArray<TDataValue>): TDataValue; static;

        [TRtlFunction('Any')]
        class function Any(const Args: TArray<TDataValue>): TDataValue; 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;

end.