Files
MycLib/Src/AST/Myc.Ast.RTL.Core.pas
T
Michael Schimmel c31985935c RTL enhancements
2025-09-19 15:05:20 +02:00

307 lines
11 KiB
ObjectPascal

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.