[Rcpp-commits] r2498 - in pkg/Rcpp: . R inst/include/Rcpp src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Nov 23 13:44:08 CET 2010
Author: romain
Date: 2010-11-23 13:44:08 +0100 (Tue, 23 Nov 2010)
New Revision: 2498
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/NAMESPACE
pkg/Rcpp/R/00_classes.R
pkg/Rcpp/R/Module.R
pkg/Rcpp/inst/include/Rcpp/Module.h
pkg/Rcpp/inst/include/Rcpp/routines.h
pkg/Rcpp/src/Module.cpp
pkg/Rcpp/src/Rcpp_init.c
Log:
minor improvements in calling exposed C++ functions
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2010-11-23 11:21:24 UTC (rev 2497)
+++ pkg/Rcpp/ChangeLog 2010-11-23 12:44:08 UTC (rev 2498)
@@ -1,3 +1,8 @@
+2010-11-23 Romain Francois <romain at r-enthusiasts.com>
+
+ * R/Module.R: calling an exposed C++ more efficiently by using the xp directly
+ rather than traversing the map internally
+
2010-11-22 Romain Francois <romain at r-enthusiasts.com>
* R/00_classes.R: C++OverloadedMethods gains an "info" class methods, factored
Modified: pkg/Rcpp/NAMESPACE
===================================================================
--- pkg/Rcpp/NAMESPACE 2010-11-23 11:21:24 UTC (rev 2497)
+++ pkg/Rcpp/NAMESPACE 2010-11-23 12:44:08 UTC (rev 2498)
@@ -10,7 +10,8 @@
Module__classes_info,Module__complete,Module__get_class,
Module__has_class,Module__has_function,Module__functions_arity,
- Module__name, CppObject__finalize,
+ Module__name, Module__get_function,
+ CppObject__finalize,
get_rcpp_cache, init_Rcpp_cache, reset_current_error,
rcpp_error_recorder, rcpp_set_current_error, rcpp_get_current_error,
Modified: pkg/Rcpp/R/00_classes.R
===================================================================
--- pkg/Rcpp/R/00_classes.R 2010-11-23 11:21:24 UTC (rev 2497)
+++ pkg/Rcpp/R/00_classes.R 2010-11-23 12:44:08 UTC (rev 2498)
@@ -89,4 +89,10 @@
contains = "function"
)
+setClass( "C++ModuleFunction",
+ representation(
+ pointer = "externalptr"
+ )
+ , contains = "function"
+)
Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R 2010-11-23 11:21:24 UTC (rev 2497)
+++ pkg/Rcpp/R/Module.R 2010-11-23 12:44:08 UTC (rev 2498)
@@ -56,7 +56,7 @@
moduleName = "UNKNOWN",
packageName = "",
pointer = .badModulePointer, ...) {
- env <- new.env(TRUE, emptyenv())
+ env <- new.env(TRUE, emptyenv())
as(.Object, "environment") <- env
assign("pointer", pointer, envir = env)
assign("packageName", packageName, envir = env)
@@ -71,14 +71,25 @@
setMethod( "$", "Module", function(x, name){
pointer <- .getModulePointer(x)
if( .Call( Module__has_function, pointer, name ) ){
- function( ... ) {
- res <- .External( Module__invoke , pointer, name, ... )
- if( isTRUE( res$void ) ) invisible(NULL) else res$result
+ info <- .Call( Module__get_function, pointer, name )
+ fun_ptr <- info[[1L]]
+ f <- function(...) NULL
+ stuff <- list( fun_pointer = fun_ptr, InternalFunction_invoke = InternalFunction_invoke )
+ body(f) <- if( info[[2]] ) {
+ substitute( {
+ .External( InternalFunction_invoke, fun_pointer, ... )
+ invisible(NULL)
+ }, stuff )
+ } else {
+ substitute( {
+ .External( InternalFunction_invoke, fun_pointer, ... )
+ }, stuff )
}
+ new( "C++Function", f, pointer = fun_ptr )
} else if( .Call( Module__has_class, pointer, name ) ){
- value <- .Call( Module__get_class, pointer, name )
- value at generator <- get("refClassGenerators",envir=x)[[as.character(value)]]
- value
+ value <- .Call( Module__get_class, pointer, name )
+ value at generator <- get("refClassGenerators",envir=x)[[as.character(value)]]
+ value
} else{
stop( "no such method or class in module" )
}
Modified: pkg/Rcpp/inst/include/Rcpp/Module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Module.h 2010-11-23 11:21:24 UTC (rev 2497)
+++ pkg/Rcpp/inst/include/Rcpp/Module.h 2010-11-23 12:44:08 UTC (rev 2498)
@@ -119,6 +119,7 @@
Rcpp::CharacterVector class_names() ;
Rcpp::List classes_info() ;
Rcpp::CharacterVector complete() ;
+ SEXP get_function_ptr( const std::string& ) ;
inline void Add( const char* name_ , CppFunction* ptr){
functions.insert( FUNCTION_PAIR( name_ , ptr ) ) ;
Modified: pkg/Rcpp/inst/include/Rcpp/routines.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/routines.h 2010-11-23 11:21:24 UTC (rev 2497)
+++ pkg/Rcpp/inst/include/Rcpp/routines.h 2010-11-23 12:44:08 UTC (rev 2498)
@@ -51,6 +51,7 @@
CALLFUN_2(Module__get_class);
CALLFUN_2(Module__has_class);
CALLFUN_2(Module__has_function);
+CALLFUN_2(Module__get_function);
CALLFUN_1(Module__name);
CALLFUN_2(CppObject__finalize);
Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp 2010-11-23 11:21:24 UTC (rev 2497)
+++ pkg/Rcpp/src/Module.cpp 2010-11-23 12:44:08 UTC (rev 2498)
@@ -32,7 +32,9 @@
RCPP_FUNCTION_1( bool, Class__has_default_constructor, XP_Class cl ){
return cl->has_default_constructor() ;
}
-
+RCPP_FUNCTION_2( SEXP, Module__get_function, XP_Module module, std::string fun ){
+ return module->get_function_ptr( fun ) ;
+}
RCPP_FUNCTION_2( bool, Class__has_method, XP_Class cl, std::string m){
return cl->has_method(m) ;
}
@@ -109,8 +111,6 @@
return R_NilValue ;
}
-
-
// .External functions
extern "C" SEXP InternalFunction_invoke( SEXP args ){
SEXP p = CDR(args) ;
@@ -268,6 +268,22 @@
END_RCPP
}
+ SEXP Module::get_function_ptr( const std::string& name ){
+ MAP::iterator it = functions.begin() ;
+ int n = functions.size() ;
+ CppFunction* fun = 0 ;
+ for( int i=0; i<n; i++, ++it){
+ if( name.compare( it->first ) == 0){
+ fun = it->second ;
+ break ;
+ }
+ }
+ return Rcpp::List::create(
+ Rcpp::XPtr<CppFunction>( fun, false ),
+ fun->is_void()
+ ) ;
+ }
+
Rcpp::List Module::classes_info(){
int n = classes.size() ;
Rcpp::CharacterVector names(n) ;
Modified: pkg/Rcpp/src/Rcpp_init.c
===================================================================
--- pkg/Rcpp/src/Rcpp_init.c 2010-11-23 11:21:24 UTC (rev 2497)
+++ pkg/Rcpp/src/Rcpp_init.c 2010-11-23 12:44:08 UTC (rev 2498)
@@ -53,6 +53,7 @@
CALLDEF(Module__has_function,2),
CALLDEF(Module__functions_arity,1),
CALLDEF(Module__name,1),
+ CALLDEF(Module__get_function, 2),
CALLDEF(get_rcpp_cache,0),
CALLDEF(init_Rcpp_cache,0),
More information about the Rcpp-commits
mailing list