RTL enhancements

This commit is contained in:
Michael Schimmel
2025-09-19 15:05:20 +02:00
parent abbce15362
commit c31985935c
6 changed files with 439 additions and 264 deletions
+2 -1
View File
@@ -18,7 +18,8 @@ uses
Myc.Ast.Traverser in '..\Src\AST\Myc.Ast.Traverser.pas',
Myc.Ast.Binding in '..\Src\AST\Myc.Ast.Binding.pas',
Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas',
Myc.Ast.Dumper in '..\Src\AST\Myc.Ast.Dumper.pas';
Myc.Ast.Dumper in '..\Src\AST\Myc.Ast.Dumper.pas',
Myc.Ast.RTL.Core in '..\Src\AST\Myc.Ast.RTL.Core.pas';
{$R *.res}
+1
View File
@@ -150,6 +150,7 @@
<DCCReference Include="..\Src\AST\Myc.Ast.Binding.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.RTL.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Dumper.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.RTL.Core.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
+2 -2
View File
@@ -182,7 +182,7 @@ var
upvalueAddr: TResolvedAddress;
pair: TPair<string, Integer>;
begin
LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString]);
LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString(TUseBoolStrs.True)]);
Indent;
Log('Parameters:');
@@ -217,7 +217,7 @@ function TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue
var
arg: IAstNode;
begin
LogFmt('FunctionCall (IsTailCall: %s)', [Node.IsTailCall.ToString]);
LogFmt('FunctionCall (IsTailCall: %s)', [Node.IsTailCall.ToString(TUseBoolStrs.True)]);
Indent;
Log('Callee:');
Accept(Node.Callee);
+306
View File
@@ -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.
+127 -242
View File
@@ -7,26 +7,86 @@ interface
uses
System.SysUtils,
System.Math,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Data.Decimal,
Myc.Ast,
Myc.Ast.Nodes,
Myc.Ast.Scope;
Myc.Ast.Nodes;
type
// This attribute is used by the RTTI-based registry to identify
// and register native functions in the runtime scope.
TRtlFunctionAttribute = class(TCustomAttribute)
public
Name: string;
constructor Create(const AName: string);
end;
implementation
uses
System.Generics.Collections;
System.Rtti,
System.TypInfo,
Myc.Ast.RTL.Core;
//--------------------------------------------------------------------------------------------------
//== Native Function Implementations
//== Native Function Implementation (Core Logic)
//--------------------------------------------------------------------------------------------------
// A helper to simplify argument validation for unary numeric functions.
function GetSingleNumericArg(const AName: string; const AArgs: TArray<TDataValue>; out AArg: TScalar): Boolean;
constructor TRtlFunctionAttribute.Create(const AName: string);
begin
inherited Create;
Self.Name := AName;
end;
//--------------------------------------------------------------------------------------------------
//== Library Registration (RTTI-based)
//--------------------------------------------------------------------------------------------------
type
// Defines a pointer to the static class function signature for scalar->scalar functions.
TNativeScalarFunc = function(Arg: TScalar): TScalar;
// A helper record to encapsulate the RTTI-based registration logic.
TRtlRegistry = record
private
class function GetSingleNumericArg(
const AName: string;
const AArgs: TArray<TDataValue>;
out AArg: TScalar
): Boolean; static; inline;
class function CreateScalarWrapper(AFuncName: string; AFuncPtr: Pointer): TDataValue.TFunc; static;
public
class procedure RegisterAll(const AScope: IExecutionScope); static;
end;
// This is the "Wrapper Generator" for the (TScalar):TScalar signature.
// It creates a high-performance anonymous method that uses a direct function pointer.
class function TRtlRegistry.CreateScalarWrapper(AFuncName: string; AFuncPtr: Pointer): TDataValue.TFunc;
var
// Statically typed pointer to the native function.
nativeFunc: TNativeScalarFunc;
begin
nativeFunc := AFuncPtr;
// This is the generated wrapper that will be registered with the interpreter.
Result :=
function(const Args: TArray<TDataValue>): TDataValue
var
argScalar: TScalar;
begin
// 1. Optimized argument validation and unpacking.
GetSingleNumericArg(AFuncName, Args, argScalar);
// 2. Direct, statically typed call via pointer.
Result := TDataValue(nativeFunc(argScalar));
end;
end;
{ TRtlRegistry }
class function TRtlRegistry.GetSingleNumericArg(const AName: string; const AArgs: TArray<TDataValue>; out AArg: TScalar): Boolean;
begin
// This is the validation logic used by the generated wrappers.
if Length(AArgs) <> 1 then
raise EArgumentException.CreateFmt('%s requires exactly one argument.', [AName]);
if AArgs[0].Kind <> vkScalar then
@@ -39,251 +99,76 @@ begin
Result := True;
end;
function NativeAbs(const Args: TArray<TDataValue>): TDataValue;
// Main registration method. Uses RTTI to find and register all functions from TRtlFunctions.
class procedure TRtlRegistry.RegisterAll(const AScope: IExecutionScope);
type
TNativeDataValueFunc1 = function(const Args: TArray<TDataValue>): TDataValue;
var
arg: TScalar;
ctx: TRttiContext;
rtlType: TRttiType;
method: TRttiMethod;
attribute: TCustomAttribute;
rtlAttribute: TRtlFunctionAttribute;
param: TRttiParameter;
wrapper: TDataValue.TFunc;
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;
ctx := TRttiContext.Create;
try
for i := sourceSeries.Count - 1 downto 0 do
rtlType := ctx.GetType(TypeInfo(TRtlFunctions));
for method in rtlType.GetMethods do
begin
item := sourceSeries.Items[i];
predicateResult := predicateFunc([TDataValue(item)]);
if (predicateResult.Kind = vkScalar) and (predicateResult.AsScalar.Value.AsBoolean) then
matchingIndices.Add(i);
end;
// Find functions marked with our custom attribute
for attribute in method.GetAttributes do
begin
if not (attribute is TRtlFunctionAttribute) then
continue;
// 2. Create a helper series from the index
indexSeries := TIndexSeries.Create(matchingIndices.ToArray);
rtlAttribute := attribute as TRtlFunctionAttribute;
wrapper := nil;
// --- Signature Dispatcher ---
// Decide which wrapper to generate based on the method signature.
if (Length(method.GetParameters) = 1) and (method.ReturnType.Handle = TypeInfo(TScalar)) then
begin
param := method.GetParameters[0];
if param.ParamType.Handle = TypeInfo(TScalar) then
begin
// Signature matches: class function(Arg: TScalar): TScalar;
wrapper := CreateScalarWrapper(rtlAttribute.Name, method.CodeAddress);
end;
end
else if (Length(method.GetParameters) = 1) and (method.ReturnType.Handle = TypeInfo(TDataValue)) then
begin
param := method.GetParameters[0];
if (pfConst in param.Flags) and (param.ParamType.Handle = TypeInfo(TArray<TDataValue>)) then
begin
// Signature matches: class function(const Args: TArray<TDataValue>): TDataValue;
// For these, we can just cast the pointer directly. No wrapper needed.
wrapper :=
function(const Args: TArray<TDataValue>): TDataValue
begin
Result := TNativeDataValueFunc1(method.CodeAddress)(Args);
end;
end;
end;
if Assigned(wrapper) then
begin
AScope.Define(rtlAttribute.Name, TDataValue(wrapper));
break; // Found our attribute, proceed to next method
end
else
raise ENotImplemented.Create('Native method wrapper not implemented');
end;
end;
finally
matchingIndices.Free;
ctx.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));
TRtlRegistry.RegisterAll(AScope);
end;
initialization
+1 -19
View File
@@ -16,17 +16,10 @@ type
private
type
IVal = interface
{$ifdef DEBUG}
function GetTypeHandle: Pointer;
{$endif}
end;
TVal<T> = class(TInterfacedObject, IVal)
TVal<T> = class(TInterfacedObject)
Value: T;
{$ifdef DEBUG}
TypeHandle: Pointer;
function GetTypeHandle: Pointer;
{$endif}
constructor Create(const AValue: T);
end;
@@ -176,13 +169,6 @@ begin
{$endif}
end;
{$ifdef DEBUG}
function TDataValue.TVal<T>.GetTypeHandle: Pointer;
begin
Result := TypeHandle;
end;
{$endif}
function TDataValue.AsLazy: ILazy;
begin
Assert(FKind = Ord(vkLazy));
@@ -409,11 +395,7 @@ begin
Ord(vkGeneric):
// Getting meaningful type information for vkGeneric is not easily possible
// without storing additional RTTI, as the specific type of T in TVal<T> is lost.
{$ifdef DEBUG}
Result := '<' + String(PTypeInfo(TDataValue.IVal(FInterface).GetTypeHandle).Name) + '>';
{$else}
Result := '<generic>';
{$endif}
Ord(vkLazy): Result := Format('<lazy[%s]>', [AsLazy.Kind.ToString]);
else
Result := '[Unknown DataValue]';