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, Myc.Data.Scalar, Myc.Data.Value, Myc.Ast, 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.Rtti, System.TypInfo, Myc.Ast.Scope, Myc.Ast.RTL.Core; //-------------------------------------------------------------------------------------------------- //== Native Function Implementation (Core Logic) //-------------------------------------------------------------------------------------------------- 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; public class procedure RegisterAll(const AScope: IExecutionScope); static; 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 raise EArgumentException.CreateFmt('%s requires a scalar argument.', [AName]); AArg := AArgs[0].AsScalar; // The check for specific numeric kinds is no longer necessary, // as TScalar can only be Ordinal or Float. Result := True; end; // 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 ctx: TRttiContext; rtlType: TRttiType; method: TRttiMethod; attribute: TCustomAttribute; rtlAttribute: TRtlFunctionAttribute; param: TRttiParameter; wrapper: TDataValue.TFunc; begin ctx := TRttiContext.Create; try rtlType := ctx.GetType(TypeInfo(TRtlFunctions)); for method in rtlType.GetMethods do begin // Find functions marked with our custom attribute for attribute in method.GetAttributes do begin if not (attribute is TRtlFunctionAttribute) then continue; if method.MethodKind <> mkClassFunction then continue; 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; // Build a factory that captures the method's name and CodeAddress. var wrapperFactory := function(AName: string; CodeAddress: Pointer): TDataValue.TFunc begin Result := function(const Args: TArray): TDataValue var argScalar: TScalar; begin GetSingleNumericArg(AName, Args, argScalar); Result := TDataValue(TNativeScalarFunc(CodeAddress)(argScalar)); end; end; wrapper := wrapperFactory(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; // Build a factory that captures the method's CodeAddress. var wrapperFactory := function(CodeAddress: Pointer): TDataValue.TFunc begin Result := function(const Args: TArray): TDataValue begin Result := TNativeDataValueFunc1(CodeAddress)(Args); end; end; // Create the wrapper wrapper := wrapperFactory(method.CodeAddress); 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.CreateFmt('Native method wrapper for %s() not implemented', [method.Name]); end; end; finally ctx.Free; end; end; procedure RegisterRtlFunctions(const AScope: IExecutionScope); begin TRtlRegistry.RegisterAll(AScope); end; initialization // Register this library's functions with the central AST factory. TAst.RegisterLibrary(RegisterRtlFunctions); end.