From c31985935cb99c890dedc1773a336032fe51754e Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Fri, 19 Sep 2025 15:05:20 +0200 Subject: [PATCH] RTL enhancements --- ASTPlayground/ASTPlayground.dpr | 3 +- ASTPlayground/ASTPlayground.dproj | 1 + Src/AST/Myc.Ast.Dumper.pas | 4 +- Src/AST/Myc.Ast.RTL.Core.pas | 306 +++++++++++++++++++++++++ Src/AST/Myc.Ast.RTL.pas | 369 ++++++++++-------------------- Src/Data/Myc.Data.Value.pas | 20 +- 6 files changed, 439 insertions(+), 264 deletions(-) create mode 100644 Src/AST/Myc.Ast.RTL.Core.pas 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]';