// 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