// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
//
// Module.h: Rcpp R/C++ interface class library -- Rcpp modules
//
// Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
//
// 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
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
#include
// templates CppFunction0, ..., CppFunction65
#include
#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 ;
} ;
#include
#include
#include
#include
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 = 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)
} ;
#include
#include
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 ;
} ;
}
// function factories
#include
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){};
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