diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr
index 776c3c1..b81eed5 100644
--- a/ASTPlayground/ASTPlayground.dpr
+++ b/ASTPlayground/ASTPlayground.dpr
@@ -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}
diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj
index 434774a..e961501 100644
--- a/ASTPlayground/ASTPlayground.dproj
+++ b/ASTPlayground/ASTPlayground.dproj
@@ -150,6 +150,7 @@
+
Base
diff --git a/Src/AST/Myc.Ast.Dumper.pas b/Src/AST/Myc.Ast.Dumper.pas
index ae84805..82649e6 100644
--- a/Src/AST/Myc.Ast.Dumper.pas
+++ b/Src/AST/Myc.Ast.Dumper.pas
@@ -182,7 +182,7 @@ var
upvalueAddr: TResolvedAddress;
pair: TPair;
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);
diff --git a/Src/AST/Myc.Ast.RTL.Core.pas b/Src/AST/Myc.Ast.RTL.Core.pas
new file mode 100644
index 0000000..5cf4019
--- /dev/null
+++ b/Src/AST/Myc.Ast.RTL.Core.pas
@@ -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; static;
+
+ [TRtlFunction('Map')]
+ class function Map(const Args: TArray): TDataValue; static;
+
+ [TRtlFunction('Reduce')]
+ class function Reduce(const Args: TArray): TDataValue; static;
+
+ [TRtlFunction('Where')]
+ class function Where(const Args: TArray): TDataValue; static;
+
+ [TRtlFunction('Any')]
+ class function Any(const Args: TArray): 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;
+var
+ funcToMemoize: TDataValue.TFunc;
+ cache: TDictionary;
+ 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.Create;
+
+ memoizedFunc :=
+ function(const AArgs: TArray): 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;
+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;
+var
+ sourceArg: TDataValue;
+ sourceSeries: ISeries;
+ accumulator: TDataValue;
+ reducerFunc: TDataValue.TFunc;
+ i: Integer;
+ currentItem: TScalar;
+ reducerArgs: TArray;
+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;
+var
+ sourceArg: TDataValue;
+ sourceSeries: ISeries;
+ predicateFunc: TDataValue.TFunc;
+ matchingIndices: TList;
+ 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.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
+ 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;
+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.
diff --git a/Src/AST/Myc.Ast.RTL.pas b/Src/AST/Myc.Ast.RTL.pas
index 5e9b9c9..9d17a37 100644
--- a/Src/AST/Myc.Ast.RTL.pas
+++ b/Src/AST/Myc.Ast.RTL.pas
@@ -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; 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;
+ 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
+ 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; 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;
+// 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;
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;
-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;
-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;
-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;
-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;
-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;
-var
- sourceArg: TDataValue;
- sourceSeries: ISeries;
- accumulator: TDataValue;
- reducerFunc: TDataValue.TFunc;
- i: Integer;
- currentItem: TScalar;
- reducerArgs: TArray;
-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;
-var
- sourceArg: TDataValue;
- sourceSeries: ISeries;
- predicateFunc: TDataValue.TFunc;
- matchingIndices: TList;
- 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.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)) then
+ begin
+ // Signature matches: class function(const Args: TArray): TDataValue;
+ // For these, we can just cast the pointer directly. No wrapper needed.
+ wrapper :=
+ function(const Args: TArray): 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
- 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;
-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
diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas
index a090754..ede6052 100644
--- a/Src/Data/Myc.Data.Value.pas
+++ b/Src/Data/Myc.Data.Value.pas
@@ -16,17 +16,10 @@ type
private
type
- IVal = interface
-{$ifdef DEBUG}
- function GetTypeHandle: Pointer;
-{$endif}
- end;
-
- TVal = class(TInterfacedObject, IVal)
+ TVal = 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.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 is lost.
-{$ifdef DEBUG}
- Result := '<' + String(PTypeInfo(TDataValue.IVal(FInterface).GetTypeHandle).Name) + '>';
-{$else}
Result := '';
-{$endif}
Ord(vkLazy): Result := Format('', [AsLazy.Kind.ToString]);
else
Result := '[Unknown DataValue]';