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.
    // These functions work with Delphi-native types (like TScalar) instead of TDataValue,
    // making them type-safe and easier to test.
    // The registration mechanism below will automatically create the required high-performance
    // wrappers to make them available to the script interpreter.
    TRtlFunctions = record
    public
        [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;

        // NOTE: Higher-order and complex functions can keep the TDataValue signature for now.
        // The registry is smart enough to handle both native types and the TDataValue signature directly.
        [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;

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 := 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 := cCache.AsObject as TDictionary<Int64, TDataValue>;

            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.