[Rcpp-commits] r1326 - in pkg/Rcpp: R inst/include/Rcpp src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed May 26 17:30:31 CEST 2010
Author: romain
Date: 2010-05-26 17:30:30 +0200 (Wed, 26 May 2010)
New Revision: 1326
Modified:
pkg/Rcpp/R/Module.R
pkg/Rcpp/inst/include/Rcpp/Module.h
pkg/Rcpp/src/Module.cpp
Log:
cleanups and shortcuts
Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R 2010-05-26 14:17:59 UTC (rev 1325)
+++ pkg/Rcpp/R/Module.R 2010-05-26 15:30:30 UTC (rev 1326)
@@ -18,7 +18,7 @@
setGeneric( "new" )
setClass( "Module", representation( pointer = "externalptr" ) )
-setClass( "C++Class", representation( module = "externalptr", name = "character" ) )
+setClass( "C++Class", representation( pointer = "externalptr", module = "externalptr" ) )
setClass( "C++Object", representation( module = "externalptr", cppclass = "externalptr", pointer = "externalptr" ) )
Module <- function( module, PACKAGE ){
@@ -45,7 +45,7 @@
info <- .Call( "Module__funtions_arity", object at pointer, PACKAGE = "Rcpp" )
name <- .Call( "Module__name", object at pointer )
txt <- sprintf( "Rcpp module '%s' \n\t%d functions: ", name, length(info) )
- writeLines( txt )
+ writeLines( txt )
txt <- sprintf( "%15s : %d arguments", names(info), info )
writeLines( txt )
@@ -59,13 +59,13 @@
#TODO: maybe attach( Module ), with( Module )
setMethod( "new", "C++Class", function(Class, ...){
- .External( "Module__class__newInstance", Class at module, Class at name, ..., PACKAGE = "Rcpp" )
+ .External( "class__newInstance", Class at module, Class at pointer, ..., PACKAGE = "Rcpp" )
} )
setMethod( "$", "C++Object", function(x, name){
if( .Call( "Class__has_method", x at cppclass, name, PACKAGE = "Rcpp" ) ){
function(...){
- res <- .External( "Class__invoke_method", x at module, x at cppclass, name, x at pointer, ..., PACKAGE = "Rcpp" )
+ res <- .External( "Class__invoke_method", x at cppclass, name, x at pointer, ..., PACKAGE = "Rcpp" )
if( isTRUE( res$void ) ) invisible(NULL) else res$result
}
} else{
Modified: pkg/Rcpp/inst/include/Rcpp/Module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Module.h 2010-05-26 14:17:59 UTC (rev 1325)
+++ pkg/Rcpp/inst/include/Rcpp/Module.h 2010-05-26 15:30:30 UTC (rev 1326)
@@ -73,8 +73,6 @@
Module(const char* name_) ;
SEXP invoke( const std::string& name, SEXP* args, int nargs) ;
- SEXP newClassInstance( const std::string& clazz, SEXP* args, int nargs) ;
- SEXP invokeMethod( const std::string& clazz, const std::string& meth, SEXP obj, SEXP* args, int nargs ) ;
Rcpp::IntegerVector functions_arity() ;
Rcpp::CharacterVector class_names() ;
@@ -196,7 +194,8 @@
class CppClass : public S4{
public:
typedef Rcpp::XPtr<Rcpp::Module> XP ;
- CppClass( Module* p, const std::string& name ) ;
+ CppClass( Module* p, class_Base* clazz ) ;
+ CppClass( SEXP x) ;
} ;
class CppObject : public S4{
@@ -212,10 +211,10 @@
void _rcpp_module_##name##_init() ; \
static Rcpp::Module _rcpp_module_##name( # name ) ; \
extern "C" SEXP _rcpp_module_boot_##name(){ \
- ::setCurrentScope( & _rcpp_module_##name ) ; \
+ ::setCurrentScope( & _rcpp_module_##name ) ; \
_rcpp_module_##name##_init( ) ; \
Rcpp::XPtr<Rcpp::Module> mod_xp( & _rcpp_module_##name , false ) ; \
- ::setCurrentScope( 0 ) ; \
+ ::setCurrentScope( 0 ) ; \
return mod_xp ; \
} \
void _rcpp_module_##name##_init()
Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp 2010-05-26 14:17:59 UTC (rev 1325)
+++ pkg/Rcpp/src/Module.cpp 2010-05-26 15:30:30 UTC (rev 1326)
@@ -42,21 +42,6 @@
return module->get_class( cl ) ;
}
-extern "C" SEXP Module__invoke( SEXP args){
- SEXP p = CDR(args) ;
- XP_Module module( CAR(p) ) ; p = CDR(p) ;
- std::string fun = Rcpp::as<std::string>( CAR(p) ) ; p = CDR(p) ;
-
- SEXP cargs[MAX_ARGS] ;
- int nargs = 0 ;
- for(; nargs<MAX_ARGS; nargs++){
- if( p == R_NilValue ) break ;
- cargs[nargs] = CAR(p) ;
- p = CDR(p) ;
- }
- return module->invoke( fun, cargs, nargs ) ;
-}
-
extern "C" SEXP Module__funtions_arity( SEXP mod_xp ){
Rcpp::XPtr<Rcpp::Module> module(mod_xp) ;
return module-> functions_arity() ;
@@ -72,11 +57,29 @@
return mod->classes_info() ;
}
-extern "C" SEXP Module__class__newInstance(SEXP args){
+
+
+// .External functions
+extern "C" SEXP Module__invoke( SEXP args){
SEXP p = CDR(args) ;
+ XP_Module module( CAR(p) ) ; p = CDR(p) ;
+ std::string fun = Rcpp::as<std::string>( CAR(p) ) ; p = CDR(p) ;
+ SEXP cargs[MAX_ARGS] ;
+ int nargs = 0 ;
+ for(; nargs<MAX_ARGS; nargs++){
+ if( p == R_NilValue ) break ;
+ cargs[nargs] = CAR(p) ;
+ p = CDR(p) ;
+ }
+ return module->invoke( fun, cargs, nargs ) ;
+}
+
+extern "C" SEXP class__newInstance(SEXP args){
+ SEXP p = CDR(args) ;
+
XP_Module module( CAR(p) ) ; p = CDR(p) ;
- std::string clazz = Rcpp::as<std::string>( CAR(p) ) ; p = CDR(p) ;
+ XP_Class clazz( CAR(p) ) ; p = CDR(p);
SEXP cargs[MAX_ARGS] ;
int nargs = 0 ;
for(; nargs<MAX_ARGS; nargs++){
@@ -84,13 +87,12 @@
cargs[nargs] = CAR(p) ;
p = CDR(p) ;
}
- return module->newClassInstance( clazz, cargs, nargs ) ;
+ return Rcpp::CppObject( module, clazz, clazz->newInstance(cargs, nargs ) ) ;
}
extern "C" SEXP Class__invoke_method(SEXP args){
SEXP p = CDR(args) ;
- XP_Module module( CAR(p) ) ; p = CDR(p) ;
XP_Class clazz( CAR(p) ) ; p = CDR(p);
std::string met = Rcpp::as<std::string>( CAR(p) ) ; p = CDR(p) ;
SEXP obj = CAR(p); p = CDR(p) ;
@@ -102,7 +104,8 @@
cargs[nargs] = CAR(p) ;
p = CDR(p) ;
}
- return module->invokeMethod( clazz->name, met, obj, cargs, nargs ) ;
+
+ return clazz->invoke( met, obj, cargs, nargs ) ;
}
@@ -139,17 +142,6 @@
END_RCPP
}
- SEXP Module::newClassInstance( const std::string& name, SEXP* args, int nargs){
- BEGIN_RCPP
- CLASS_MAP::iterator it = classes.find( name );
- if( it == classes.end() ){
- throw std::range_error( "no such class" ) ;
- }
- class_Base* cl = it->second ;
- return CppObject( this, cl, cl->newInstance(args, nargs ) );
- END_RCPP
- }
-
Rcpp::List Module::classes_info(){
int n = classes.size() ;
Rcpp::CharacterVector names(n) ;
@@ -157,7 +149,7 @@
CLASS_MAP::iterator it = classes.begin() ;
for( int i=0; i<n; i++, ++it){
names[i] = it->first ;
- info[i] = CppClass( this , it->first ) ;
+ info[i] = CppClass( this , it->second ) ;
}
info.names() = names ;
return info ;
@@ -186,9 +178,11 @@
return x ;
}
- CppClass::CppClass( Module* p, const std::string& name ) : S4("C++Class") {
- slot( "module" ) = XP( p, false ) ;
- slot( "name" ) = name ;
+ CppClass::CppClass( SEXP x) : S4(x){}
+
+ CppClass::CppClass( Module* p, class_Base* cl ) : S4("C++Class") {
+ slot( "module" ) = XP( p, false ) ;
+ slot( "pointer" ) = XP_Class( cl ) ;
}
CppObject::CppObject( Module* p, class_Base* clazz, SEXP xp ) : S4("C++Object") {
@@ -198,17 +192,11 @@
}
CppClass Module::get_class( const std::string& cl ){
- return CppClass( this, cl ) ;
- }
-
- SEXP Module::invokeMethod( const std::string& clazz, const std::string& meth, SEXP obj, SEXP* args, int nargs ){
BEGIN_RCPP
- CLASS_MAP::iterator it = classes.find( clazz );
- if( it == classes.end() ){
- throw std::range_error( "no such class" ) ;
- }
- return it->second->invoke( meth, obj, args, nargs ) ;
- END_RCPP
+ CLASS_MAP::iterator it = classes.find(cl) ;
+ if( it == classes.end() ) throw std::range_error( "no such class" ) ;
+ return CppClass( this, it->second ) ;
+ END_RCPP
}
}
More information about the Rcpp-commits
mailing list