Michael Schimmel
294 lines
10 KiB
ObjectPascal
294 lines
10 KiB
ObjectPascal
unit Myc.Ast.RTL;
|
|
|
|
interface
|
|
|
|
// This unit is intended to be included in a 'uses' clause.
|
|
// It self-registers its functions via its initialization section.
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Math,
|
|
Myc.Data.Scalar,
|
|
Myc.Data.Value,
|
|
Myc.Data.Decimal,
|
|
Myc.Ast,
|
|
Myc.Ast.Nodes,
|
|
Myc.Ast.Scope;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Generics.Collections;
|
|
|
|
//--------------------------------------------------------------------------------------------------
|
|
//== Native Function Implementations
|
|
//--------------------------------------------------------------------------------------------------
|
|
|
|
// A helper to simplify argument validation for unary numeric functions.
|
|
function GetSingleNumericArg(const AName: string; const AArgs: TArray<TDataValue>; out AArg: TScalar): Boolean;
|
|
begin
|
|
if Length(AArgs) <> 1 then
|
|
raise EArgumentException.CreateFmt('%s requires exactly one argument.', [AName]);
|
|
if AArgs[0].Kind <> vkScalar then
|
|
raise EArgumentException.CreateFmt('%s requires a scalar argument.', [AName]);
|
|
|
|
AArg := AArgs[0].AsScalar;
|
|
if not (AArg.Kind in [skInteger, skInt64, skSingle, skDouble, skDecimal]) then
|
|
raise EArgumentException.CreateFmt('%s requires a numeric argument, but got %s.', [AName, AArg.Kind.ToString]);
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
function NativeAbs(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
arg: TScalar;
|
|
begin
|
|
GetSingleNumericArg('Abs', Args, arg);
|
|
case arg.Kind of
|
|
skInteger: Result := TScalar.FromInteger(Abs(arg.Value.AsInteger));
|
|
skInt64: Result := TScalar.FromInt64(Abs(arg.Value.AsInt64));
|
|
skSingle: Result := TScalar.FromSingle(Abs(arg.Value.AsSingle));
|
|
skDouble: Result := TScalar.FromDouble(Abs(arg.Value.AsDouble));
|
|
skDecimal: Result := TScalar.FromDecimal(arg.Value.AsDecimal.Abs);
|
|
else
|
|
// Should be caught by GetSingleNumericArg, but as a safeguard:
|
|
raise EArgumentException.Create('Abs requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
function NativeTrunc(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
arg: TScalar;
|
|
begin
|
|
GetSingleNumericArg('Trunc', Args, arg);
|
|
case arg.Kind of
|
|
skInteger, skInt64: Result := arg; // Trunc on an integer is a no-op
|
|
skSingle: Result := TScalar.FromInt64(Trunc(arg.Value.AsSingle));
|
|
skDouble: Result := TScalar.FromInt64(Trunc(arg.Value.AsDouble));
|
|
skDecimal: Result := TScalar.FromInt64(Trunc(arg.Value.AsDecimal));
|
|
else
|
|
raise EArgumentException.Create('Trunc requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
function NativeCeil(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
arg: TScalar;
|
|
begin
|
|
GetSingleNumericArg('Ceil', Args, arg);
|
|
case arg.Kind of
|
|
skInteger, skInt64: Result := arg; // Ceil on an integer is a no-op
|
|
skSingle: Result := TScalar.FromInt64(Ceil(arg.Value.AsSingle));
|
|
skDouble: Result := TScalar.FromInt64(Ceil(arg.Value.AsDouble));
|
|
skDecimal: Result := TScalar.FromInt64(Ceil(Double(arg.Value.AsDecimal)));
|
|
else
|
|
raise EArgumentException.Create('Ceil requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
function NativeFloor(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
arg: TScalar;
|
|
begin
|
|
GetSingleNumericArg('Floor', Args, arg);
|
|
case arg.Kind of
|
|
skInteger, skInt64: Result := arg; // Floor on an integer is a no-op
|
|
skSingle: Result := TScalar.FromInt64(Floor(arg.Value.AsSingle));
|
|
skDouble: Result := TScalar.FromInt64(Floor(arg.Value.AsDouble));
|
|
skDecimal: Result := TScalar.FromInt64(Floor(Double(arg.Value.AsDecimal)));
|
|
else
|
|
raise EArgumentException.Create('Floor requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
function NativeSign(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
arg: TScalar;
|
|
begin
|
|
GetSingleNumericArg('Sign', Args, arg);
|
|
case arg.Kind of
|
|
skInteger: Result := TScalar.FromInteger(Sign(arg.Value.AsInteger));
|
|
skInt64: Result := TScalar.FromInteger(Sign(arg.Value.AsInt64));
|
|
skSingle: Result := TScalar.FromInteger(Sign(arg.Value.AsSingle));
|
|
skDouble: Result := TScalar.FromInteger(Sign(arg.Value.AsDouble));
|
|
skDecimal: Result := TScalar.FromInteger(arg.Value.AsDecimal.Sign);
|
|
else
|
|
raise EArgumentException.Create('Sign requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
// Maps a series to a new series by applying a function to each element.
|
|
function NativeMap(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;
|
|
|
|
// Reduces a series into a single value.
|
|
function NativeReduce(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.');
|
|
|
|
// Extract arguments
|
|
sourceSeries := sourceArg.AsSeries;
|
|
accumulator := Args[1];
|
|
reducerFunc := Args[2].AsMethod();
|
|
|
|
// Iterate from oldest to newest element (index Count-1 to 0)
|
|
for i := sourceSeries.Count - 1 downto 0 do
|
|
begin
|
|
currentItem := sourceSeries.Items[i];
|
|
reducerArgs := [accumulator, TDataValue(currentItem)];
|
|
accumulator := reducerFunc(reducerArgs);
|
|
end;
|
|
|
|
Result := accumulator;
|
|
end;
|
|
|
|
// Filters a series based on a predicate.
|
|
function NativeWhere(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();
|
|
|
|
// 1. Eagerly build the index of matching items
|
|
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;
|
|
|
|
// 2. Create a helper series from the index
|
|
indexSeries := TIndexSeries.Create(matchingIndices.ToArray);
|
|
finally
|
|
matchingIndices.Free;
|
|
end;
|
|
|
|
// 3. Define a mapper to transform an index back to a value from the original series
|
|
mapperFunc :=
|
|
function(const AArgs: TArray<TDataValue>): TDataValue
|
|
var
|
|
idx: Integer;
|
|
begin
|
|
idx := AArgs[0].AsScalar.Value.AsInteger;
|
|
Result := TDataValue(sourceSeries.Items[idx]);
|
|
end;
|
|
|
|
// 4. Use TMapSeries to create the final, filtered series
|
|
finalSeries := TDataValue.Map(indexSeries, mapperFunc);
|
|
Result := TDataValue.FromSeries(finalSeries);
|
|
end;
|
|
|
|
// Checks if any element in a series satisfies a predicate.
|
|
function NativeAny(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;
|
|
|
|
//--------------------------------------------------------------------------------------------------
|
|
//== Library Registration
|
|
//--------------------------------------------------------------------------------------------------
|
|
|
|
procedure RegisterRtlFunctions(const AScope: IExecutionScope);
|
|
begin
|
|
AScope.Define('Abs', TDataValue(NativeAbs));
|
|
AScope.Define('Trunc', TDataValue(NativeTrunc));
|
|
AScope.Define('Ceil', TDataValue(NativeCeil));
|
|
AScope.Define('Floor', TDataValue(NativeFloor));
|
|
AScope.Define('Sign', TDataValue(NativeSign));
|
|
AScope.Define('Map', TDataValue(NativeMap));
|
|
AScope.Define('Reduce', TDataValue(NativeReduce));
|
|
AScope.Define('Where', TDataValue(NativeWhere));
|
|
AScope.Define('Any', TDataValue(NativeAny));
|
|
end;
|
|
|
|
initialization
|
|
// Register this library's functions with the central AST factory.
|
|
TAst.RegisterLibrary(RegisterRtlFunctions);
|
|
|
|
end.
|