RTL enhancements

2025-09-19 15:05:20 +02:00
parent abbce15362
commit c31985935c
6 changed files with 439 additions and 264 deletions
@@ -0,0 +1,306 @@
+unit Myc.Ast.RTL.Core;
+
+interface
+
+uses
+    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(Arg: TScalar): TScalar; static;
+
+        [TRtlFunction('Trunc')]
+        class function Trunc(Arg: TScalar): TScalar; static;
+
+        [TRtlFunction('Ceil')]
+        class function Ceil(Arg: TScalar): TScalar; static;
+
+        [TRtlFunction('Floor')]
+        class function Floor(Arg: TScalar): TScalar; static;
+
+        [TRtlFunction('Sign')]
+        class function Sign(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(Arg: TScalar): TScalar;
+begin
+    case Arg.Kind of
+        skInteger: Result := TScalar.FromInteger(System.Abs(Arg.Value.AsInteger));
+        skInt64: Result := TScalar.FromInt64(System.Abs(Arg.Value.AsInt64));
+        skSingle: Result := TScalar.FromSingle(System.Abs(Arg.Value.AsSingle));
+        skDouble: Result := TScalar.FromDouble(System.Abs(Arg.Value.AsDouble));
+        skDecimal: Result := TScalar.FromDecimal(Arg.Value.AsDecimal.Abs);
+    else
+        // This case should not be reached if the wrapper validation is correct.
+        raise EArgumentException.Create('Abs requires a numeric argument.');
+    end;
+end;
+
+class function TRtlFunctions.Trunc(Arg: TScalar): TScalar;
+begin
+    case Arg.Kind of
+        skInteger, skInt64: Result := Arg; // Trunc on an integer is a no-op
+        skSingle: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsSingle));
+        skDouble: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsDouble));
+        skDecimal: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsDecimal));
+    else
+        raise EArgumentException.Create('Trunc requires a numeric argument.');
+    end;
+end;
+
+class function TRtlFunctions.Ceil(Arg: TScalar): TScalar;
+begin
+    case Arg.Kind of
+        skInteger, skInt64: Result := Arg; // Ceil on an integer is a no-op
+        skSingle: Result := TScalar.FromInt64(System.Math.Ceil(Arg.Value.AsSingle));
+        skDouble: Result := TScalar.FromInt64(System.Math.Ceil(Arg.Value.AsDouble));
+        skDecimal: Result := TScalar.FromInt64(System.Math.Ceil(Double(Arg.Value.AsDecimal)));
+    else
+        raise EArgumentException.Create('Ceil requires a numeric argument.');
+    end;
+end;
+
+class function TRtlFunctions.Floor(Arg: TScalar): TScalar;
+begin
+    case Arg.Kind of
+        skInteger, skInt64: Result := Arg; // Floor on an integer is a no-op
+        skSingle: Result := TScalar.FromInt64(System.Math.Floor(Arg.Value.AsSingle));
+        skDouble: Result := TScalar.FromInt64(System.Math.Floor(Arg.Value.AsDouble));
+        skDecimal: Result := TScalar.FromInt64(System.Math.Floor(Double(Arg.Value.AsDecimal)));
+    else
+        raise EArgumentException.Create('Floor requires a numeric argument.');
+    end;
+end;
+
+class function TRtlFunctions.Sign(Arg: TScalar): TScalar;
+begin
+    case Arg.Kind of
+        skInteger: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsInteger));
+        skInt64: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsInt64));
+        skSingle: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsSingle));
+        skDouble: Result := TScalar.FromInteger(System.Math.Sign(Arg.Value.AsDouble));
+        skDecimal: Result := TScalar.FromInteger(Arg.Value.AsDecimal.Sign);
+    else
+        raise EArgumentException.Create('Sign requires a numeric argument.');
+    end;
+end;
+
+class function TRtlFunctions.Memoize(const Args: TArray<TDataValue>): TDataValue;
+var
+    funcToMemoize: TDataValue.TFunc;
+    cache: TDictionary<Int64, TDataValue>;
+    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.');
+
+    funcToMemoize := Args[0].AsMethod();
+    cache := TDictionary<Int64, TDataValue>.Create;
+
+    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 not (argScalar.Kind in [skInteger, skInt64]) then
+                raise EArgumentException.Create('This memoized function expects an integer argument for caching.');
+
+            if argScalar.Kind = skInteger then
+                key := argScalar.Value.AsInteger
+            else
+                key := argScalar.Value.AsInt64;
+
+            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.Value.AsBoolean) 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.AsInteger;
+            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.Value.AsBoolean) then
+        begin
+            Result := TScalar.FromBoolean(True);
+            exit;
+        end;
+    end;
+
+    Result := TScalar.FromBoolean(False);
+end;
+
+end.