// Module.h: Rcpp R/C++ interface class library -- Rcpp modules // // Copyright (C) 2010 - 2026 Dirk Eddelbuettel, Romain Francois and IƱaki Ucar // // This file is part of Rcpp. // // Rcpp is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // Rcpp is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with Rcpp. If not, see . #ifndef Rcpp_Module_h #define Rcpp_Module_h #include #include namespace Rcpp{ namespace internal{ template std::string get_converter_name(const char* from, const char* to){ std::string method_name( ".___converter___" ) ; typedef typename Rcpp::traits::r_type_traits< typename Rcpp::traits::remove_const_and_reference::type >::r_category FROM_CATEGORY ; if( Rcpp::traits::same_type< FROM_CATEGORY, ::Rcpp::traits::r_type_module_object_tag >::value ){ method_name += "Rcpp_" ; } method_name += from ; method_name += "___" ; typedef typename Rcpp::traits::r_type_traits< typename Rcpp::traits::remove_const_and_reference::type >::r_category TO_CATEGORY ; if( Rcpp::traits::same_type< TO_CATEGORY, ::Rcpp::traits::r_type_module_object_tag >::value ){ method_name += "Rcpp_" ; } method_name += to ; return method_name ; } } class CppClass ; class CppObject ; template class result { public: result( T* ptr_ ) : ptr(ptr_){} operator T*(){ return ptr ; } private: T* ptr; } ; template class object { public: typedef T object_type ; object( T* ptr_ ) : ptr(ptr_){} operator T*(){ return ptr ; } T* operator->(){ return ptr ; } T& operator&(){ return *ptr ; } T* ptr ; } ; namespace internal { template SEXP make_new_object( Class* ptr ){ Rcpp::XPtr xp( ptr, true ) ; Function maker = Environment::Rcpp_namespace()[ "cpp_object_maker"] ; return maker( typeid(Class).name() , xp ) ; } } } #include #include namespace Rcpp { template inline void signature(std::string& s, const char* name) { s.clear(); s += get_return_type() + " " + name + "("; int n = sizeof...(T); int i = 0; // Using initializer list as c++11 implementation of a fold expression (void)std::initializer_list{ (s += get_return_type(), s += (++i == n ? "" : ", "), 0)... }; s += ")"; } template class CppFunctionN : public CppFunction { public: CppFunctionN(RESULT_TYPE (*fun)(T...), const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun) {} SEXP operator()(SEXP* args) { BEGIN_RCPP return call(ptr_fun, args); END_RCPP } inline int nargs() { return sizeof...(T); } inline bool is_void() { return std::is_void::value; } inline void signature(std::string& s, const char* name) { Rcpp::signature(s, name); } inline DL_FUNC get_function_ptr() { return (DL_FUNC)(RCPP_FUNC)ptr_fun; } private: RESULT_TYPE (*ptr_fun)(T...); }; template class CppFunction_WithFormalsN : public CppFunctionN { public: CppFunction_WithFormalsN(RESULT_TYPE (*fun)(T...), Rcpp::List formals_, const char* docstring = 0) : CppFunctionN(fun, docstring), formals(formals_) {} SEXP get_formals() { return formals; } private: Rcpp::List formals; }; } #include #include namespace Rcpp{ template class CppMethod { public: typedef Rcpp::XPtr XP ; CppMethod() {} virtual SEXP operator()(Class* /*object*/, SEXP* /*args*/) { return R_NilValue ; } virtual ~CppMethod(){} virtual int nargs(){ return 0 ; } virtual bool is_void(){ return false ; } virtual bool is_const(){ return false ; } virtual void signature(std::string& s, const char* name ){ s = name ; } } ; template class CppInheritedMethod : public CppMethod { public: typedef Rcpp::XPtr XP ; typedef CppMethod ParentMethod ; CppInheritedMethod( ParentMethod* parent_method_pointer_ ) : parent_method_pointer(parent_method_pointer_) {} SEXP operator()( Class* object, SEXP* args){ return (*parent_method_pointer)( (Parent*)object, args ) ; } inline int nargs(){ return parent_method_pointer->nargs() ; } inline bool is_void(){ return parent_method_pointer->is_void() ; } inline bool is_const(){ return parent_method_pointer->is_const() ; } inline void signature(std::string& s, const char* name){ return parent_method_pointer->signature(s, name) ; } private: ParentMethod* parent_method_pointer ; } ; template inline void ctor_signature(std::string& s, const std::string& classname) { s.assign(classname); s += "("; int n = sizeof...(T); int i = 0; // Using initializer list as c++11 implementation of a fold expression (void)std::initializer_list{ (s += get_return_type(), s += (++i == n ? "" : ", "), 0)... }; s += ")"; } template class Constructor_Base { public: virtual Class* get_new( SEXP* args, int nargs ) = 0 ; virtual int nargs() = 0 ; virtual void signature(std::string& s, const std::string& class_name) = 0 ; } ; template class Constructor: public Constructor_Base { public: virtual Class* get_new( SEXP* args, int nargs ){ return get_new_impl(args, nargs, traits::make_index_sequence()); } virtual int nargs(){ return sizeof...(T) ; } virtual void signature(std::string& s, const std::string& class_name ){ ctor_signature(s, class_name) ; } private: template Class* get_new_impl(SEXP* args, int /*nargs*/, traits::index_sequence) { return new Class( as(args[Is])... ) ; } }; template class Factory_Base { public: virtual Class* get_new( SEXP* args, int nargs ) = 0 ; virtual int nargs() = 0 ; virtual void signature(std::string& s, const std::string& class_name) = 0 ; } ; template class Factory : public Factory_Base { public: Factory( Class* (*fun)(T...) ) : ptr_fun(fun){} virtual Class* get_new( SEXP* args, int /*nargs*/ ){ return get_new( args, traits::make_index_sequence() ) ; } virtual int nargs(){ return sizeof...(T) ; } virtual void signature(std::string& s, const std::string& class_name ){ ctor_signature(s, class_name) ; } private: template Class* get_new( SEXP* args, traits::index_sequence ){ return ptr_fun( bare_as(args[I])... ) ; } Class* (*ptr_fun)(T...) ; } ; inline bool yes( SEXP* /*args*/, int /* nargs */ ){ return true ; } template bool yes_arity( SEXP* /* args */ , int nargs){ return nargs == n ; } typedef bool (*ValidConstructor)(SEXP*,int) ; typedef bool (*ValidMethod)(SEXP*,int) ; template class SignedConstructor { public: SignedConstructor( Constructor_Base* ctor_, ValidConstructor valid_, const char* doc ) : ctor(ctor_), valid(valid_), docstring(doc == 0 ? "" : doc){} Constructor_Base* ctor ; ValidConstructor valid ; std::string docstring ; inline int nargs(){ return ctor->nargs() ; } inline void signature(std::string& buffer, const std::string& class_name){ ctor->signature(buffer, class_name) ; } } ; template class SignedFactory { public: SignedFactory( Factory_Base* fact_, ValidConstructor valid_, const char* doc ) : fact(fact_), valid(valid_), docstring(doc == 0 ? "" : doc){} Factory_Base* fact ; ValidConstructor valid ; std::string docstring ; inline int nargs(){ return fact->nargs() ; } inline void signature(std::string& buffer, const std::string& class_name){ fact->signature(buffer, class_name) ; } } ; template class SignedMethod { public: typedef CppMethod METHOD ; SignedMethod( METHOD* m, ValidMethod valid_, const char* doc ) : method(m), valid(valid_), docstring(doc == 0 ? "" : doc) {} METHOD* method ; ValidMethod valid ; std::string docstring ; inline int nargs(){ return method->nargs() ; } inline bool is_void(){ return method->is_void() ; } inline bool is_const(){ return method->is_const() ; } inline void signature(std::string& s, const char* name){ method->signature(s, name); } } ; template class S4_CppConstructor : public Reference { typedef Reference Base; public: typedef XPtr XP_Class ; typedef Reference::Storage Storage ; S4_CppConstructor( SignedConstructor* m, const XP_Class& class_xp, const std::string& class_name, std::string& buffer ) : Reference( "C++Constructor" ){ RCPP_DEBUG( "S4_CppConstructor( SignedConstructor* m, SEXP class_xp, const std::string& class_name, std::string& buffer" ) ; field( "pointer" ) = Rcpp::XPtr< SignedConstructor >( m, false ) ; field( "class_pointer" ) = class_xp ; field( "nargs" ) = m->nargs() ; m->signature( buffer, class_name ) ; field( "signature" ) = buffer ; field( "docstring" ) = m->docstring ; } RCPP_CTOR_ASSIGN_WITH_BASE(S4_CppConstructor) } ; template class S4_CppOverloadedMethods : public Rcpp::Reference { typedef Rcpp::Reference Base; public: typedef Rcpp::XPtr XP_Class ; typedef SignedMethod signed_method_class ; typedef std::vector vec_signed_method ; S4_CppOverloadedMethods( vec_signed_method* m, const XP_Class& class_xp, const char* name, std::string& buffer ) : Reference( "C++OverloadedMethods" ){ int n = static_cast(m->size()) ; Rcpp::LogicalVector voidness(n), constness(n) ; Rcpp::CharacterVector docstrings(n), signatures(n) ; Rcpp::IntegerVector nargs(n) ; signed_method_class* met ; for( int i=0; iat(i) ; nargs[i] = met->nargs() ; voidness[i] = met->is_void() ; constness[i] = met->is_const() ; docstrings[i] = met->docstring ; met->signature(buffer, name) ; signatures[i] = buffer ; } field( "pointer" ) = Rcpp::XPtr< vec_signed_method >( m, false ) ; field( "class_pointer" ) = class_xp ; field( "size" ) = n ; field( "void" ) = voidness ; field( "const" ) = constness ; field( "docstrings" ) = docstrings ; field( "signatures" ) = signatures ; field( "nargs" ) = nargs ; } RCPP_CTOR_ASSIGN_WITH_BASE(S4_CppOverloadedMethods) } ; template class CppMethodImplN : public CppMethod { public: typedef typename std::conditional::type Method; typedef CppMethod method_class; typedef typename Rcpp::traits::remove_const_and_reference::type CLEANED_RESULT_TYPE; CppMethodImplN(Method m) : method_class(), met(m) {} SEXP operator()(Class* object, SEXP* args) { // Can't pass pointer to member function directly to `call()`, so wrap it in a lambda auto f = [&object, this](T... cpp_args) -> CLEANED_RESULT_TYPE { return (object->*met)(cpp_args...); }; return call(f, args); } inline int nargs() { return sizeof...(T); } inline bool is_void() { return std::is_void::value; } inline bool is_const() { return IsConst; } inline void signature(std::string& s, const char* name) { Rcpp::signature(s, name); } private: Method met; }; template using CppMethodN = CppMethodImplN; template using const_CppMethodN = CppMethodImplN; template class Pointer_CppMethodImplN : public CppMethod { public: typedef typename std::conditional::type Method; typedef CppMethod method_class; typedef typename Rcpp::traits::remove_const_and_reference::type CLEANED_RESULT_TYPE; Pointer_CppMethodImplN(Method m) : method_class(), met(m) {} SEXP operator()(Class* object, SEXP* args) { // Need to have `object` as the first argument to the function, so wrap it in a lambda auto f = [&object, this](T... cpp_args) -> CLEANED_RESULT_TYPE { return met(object, cpp_args...); }; return call(f, args); } inline int nargs() { return sizeof...(T); } inline bool is_void() { return std::is_void::value; } inline bool is_const() { return IsConst; } inline void signature(std::string& s, const char* name) { Rcpp::signature(s, name); } private: Method met; }; template using Pointer_CppMethodN = Pointer_CppMethodImplN; template using Const_Pointer_CppMethodN = Pointer_CppMethodImplN; template class CppProperty { public: typedef Rcpp::XPtr XP ; CppProperty(const char* doc = 0) : docstring( doc == 0 ? "" : doc ) {} ; virtual ~CppProperty(){} ; virtual SEXP get(Class* ) { throw std::range_error("cannot retrieve property"); } virtual void set(Class*, SEXP) { throw std::range_error("cannot set property"); } virtual bool is_readonly(){ return false; } virtual std::string get_class(){ return ""; } std::string docstring ; } ; template class CppInheritedProperty : public CppProperty { public: typedef CppProperty Base ; CppInheritedProperty( CppProperty* parent_property_ ) : Base( parent_property_->docstring.c_str() ), parent_property(parent_property_) {} SEXP get( Class* obj ){ return parent_property->get( (Parent*)obj ) ; } void set( Class* obj, SEXP s) { parent_property->set( (Parent*)obj, s ) ; } bool is_readonly(){ return parent_property->is_readonly() ; } std::string get_class(){ return parent_property->get_class() ; } private: CppProperty* parent_property ; } ; template class CppFinalizer{ public: CppFinalizer(){} ; virtual void run(Class* ){} ; } ; template class FunctionFinalizer : public CppFinalizer { public: typedef void (*Pointer)(Class*) ; FunctionFinalizer( Pointer p ) : finalizer(p){} ; virtual void run(Class* object){ finalizer( object ) ; } private: Pointer finalizer ; } ; template class S4_field : public Rcpp::Reference { typedef Rcpp::Reference Base; public: typedef XPtr XP_Class ; S4_field( CppProperty* p, const XP_Class& class_xp ) : Reference( "C++Field" ){ RCPP_DEBUG( "S4_field( CppProperty* p, const XP_Class& class_xp )" ) field( "read_only" ) = p->is_readonly() ; field( "cpp_class" ) = p->get_class(); field( "pointer" ) = Rcpp::XPtr< CppProperty >( p, false ) ; field( "class_pointer" ) = class_xp ; field( "docstring" ) = p->docstring ; } RCPP_CTOR_ASSIGN_WITH_BASE(S4_field) } ; #include #include template class enum_ { public: typedef enum_ self ; enum_( const char* name_ ) : name(name_), values(), parent_typeinfo_name( typeid(Parent).name() ){ } ~enum_(){ Rcpp::Module* module = getCurrentScope() ; module->add_enum( parent_typeinfo_name, name, values ) ; } self& value( const char* name_, Enum value_ ){ values.insert( PAIR( name_, static_cast( value_ ) ) ) ; return *this ; } private: std::string name ; typedef std::map< std::string, int > MAP ; typedef MAP::value_type PAIR ; MAP values ; std::string parent_typeinfo_name ; } ; } namespace Rcpp { template void function(const char* name_, RESULT_TYPE (*fun)(T... t), const char* docstring = 0) { Rcpp::Module* scope = ::getCurrentScope(); if (scope) { scope->Add(name_, new CppFunctionN(fun, docstring)); } } template void function(const char* name_, RESULT_TYPE (*fun)(T... t), Rcpp::List formals, const char* docstring = 0) { Rcpp::Module* scope = ::getCurrentScope(); if (scope) { scope->Add(name_, new CppFunction_WithFormalsN(fun, formals, docstring)); } } } namespace Rcpp { template void converter( const char* from, const char* to, TO (*fun)(FROM), const char* docstring = 0 ){ std::string fun_name = internal::get_converter_name( from, to ) ; function( fun_name.c_str(), fun, docstring ) ; } class CppClass : public S4{ typedef S4 Base; public: typedef XPtr XP_Class ; typedef Rcpp::XPtr XP ; CppClass( SEXP x) : S4(x){}; // #nocov CppClass( Module* p, class_Base* cl, std::string& buffer ) : S4("C++Class") { XP_Class clxp( cl, false, R_NilValue, R_NilValue ) ; slot( "module" ) = XP( p, false ) ; slot( "pointer" ) = clxp ; buffer = "Rcpp_" ; buffer += cl->name ; slot( ".Data" ) = buffer ; slot( "fields" ) = cl->fields( clxp ) ; slot( "methods" ) = cl->getMethods( clxp, buffer ) ; slot( "constructors") = cl->getConstructors( clxp, buffer ) ; slot( "docstring" ) = cl->docstring ; slot( "typeid" ) = cl->get_typeinfo_name() ; slot( "enums" ) = cl->enums ; slot( "parents" ) = cl->parents ; } RCPP_CTOR_ASSIGN_WITH_BASE(CppClass) } ; class CppObject : public S4{ typedef S4 Base; public: typedef Rcpp::XPtr XP ; CppObject( Module* p, class_Base* clazz, SEXP xp ) : S4("C++Object") { slot( "module" ) = XP( p, false ) ; slot( "cppclass" ) = Rcpp::XPtr( clazz, false ) ; slot( "pointer" ) = xp ; } RCPP_CTOR_ASSIGN_WITH_BASE(CppObject) } ; } #define RCPP_MODULE_BOOT(name) _rcpp_module_boot_##name #define RCPP_MODULE(name) \ void _rcpp_module_##name##_init() ; \ static Rcpp::Module _rcpp_module_##name( # name ) ; \ extern "C" SEXP _rcpp_module_boot_##name(){ \ ::setCurrentScope( & _rcpp_module_##name ) ; \ _rcpp_module_##name##_init( ) ; \ Rcpp::XPtr mod_xp(& _rcpp_module_##name , false); \ ::setCurrentScope( 0 ) ; \ return mod_xp ; \ } \ void _rcpp_module_##name##_init() // silly little dance to suppress a 'defined but not used variable' warning #ifdef __GNUC__ #define VARIABLE_IS_NOT_USED __attribute__ ((unused)) #else #define VARIABLE_IS_NOT_USED #endif // static variable to hold Rf_install symbol to prevent it from being gc'ed static VARIABLE_IS_NOT_USED SEXP moduleSym = NULL; // helper macro to cache the result of Rf_install("Module"): once // it is allocated and in the symbol table it is safe from gc #define GET_MODULE_SYM ( moduleSym == NULL ? moduleSym = Rf_install("Module") : moduleSym ) // this macro is called by code wanting to load a module -- see RInside's rinside_module_sample0.cpp #define LOAD_RCPP_MODULE(NAME) \ Shield __load_module_call__( Rf_lang2( GET_MODULE_SYM, _rcpp_module_boot_##NAME() ) ); \ Rcpp_fast_eval( __load_module_call__, R_GlobalEnv ); #endif