[Rcpp-commits] r2519 - in pkg/Rcpp: . R inst/include/Rcpp src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Nov 25 13:07:21 CET 2010
Author: romain
Date: 2010-11-25 13:07:21 +0100 (Thu, 25 Nov 2010)
New Revision: 2519
Modified:
pkg/Rcpp/NAMESPACE
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:
when the module actually starts, its content is cached into an internal environment inside the module environment
Modified: pkg/Rcpp/NAMESPACE
===================================================================
--- pkg/Rcpp/NAMESPACE 2010-11-25 11:06:36 UTC (rev 2518)
+++ pkg/Rcpp/NAMESPACE 2010-11-25 12:07:21 UTC (rev 2519)
@@ -9,7 +9,8 @@
CppClass__complete, CppClass__methods,
Module__classes_info,Module__complete,Module__get_class,
- Module__has_class,Module__has_function,Module__functions_arity,
+ Module__has_class,Module__has_function, Module__functions_arity,
+ Module__functions_names,
Module__name, Module__get_function,
CppObject__finalize,
Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R 2010-11-25 11:06:36 UTC (rev 2518)
+++ pkg/Rcpp/R/Module.R 2010-11-25 12:07:21 UTC (rev 2519)
@@ -67,36 +67,44 @@
.Object
})
+.get_Module_function <- function(x, name, pointer = .getModulePointer(x) ){
+ pointer <- .getModulePointer(x)
+ info <- .Call( Module__get_function, pointer, name )
+ fun_ptr <- info[[1L]]
+ doc <- info[[3L]]
+ sign <- info[[4L]]
+ formal_args <- info[[5L]]
+ 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 )
+ }
+ out <- new( "C++Function", f, pointer = fun_ptr, docstring = doc, signature = sign )
+ if( ! is.null( formal_args ) ){
+ formals( out ) <- formal_args
+ }
+ out
+}
+.get_Module_Class <- function( x, name, pointer = .getModulePointer(x) ){
+ value <- .Call( Module__get_class, pointer, name )
+ value at generator <- get("refClassGenerators",envir=x)[[as.character(value)]]
+ value
+}
+
setMethod( "$", "Module", function(x, name){
pointer <- .getModulePointer(x)
if( .Call( Module__has_function, pointer, name ) ){
- info <- .Call( Module__get_function, pointer, name )
- fun_ptr <- info[[1L]]
- doc <- info[[3L]]
- sign <- info[[4L]]
- formal_args <- info[[5L]]
- 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 )
- }
- out <- new( "C++Function", f, pointer = fun_ptr, docstring = doc, signature = sign )
- if( ! is.null( formal_args ) ){
- formals( out ) <- formal_args
- }
- out
+ .get_Module_function( x, name, pointer )
} 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
+ .get_Module_Class( x, name, pointer )
} else{
stop( "no such method or class in module" )
}
@@ -170,6 +178,9 @@
if(environmentIsLocked(where))
where <- .GlobalEnv # or???
generators <- list()
+
+ storage <- new.env()
+
for( i in seq_along(classes) ){
CLASS <- classes[[i]]
clname <- as.character(CLASS)
@@ -222,8 +233,17 @@
}
}
+ storage[[ clname ]] <- .get_Module_Class( module, clname, xp )
}
module$refClassGenerators <- generators
+
+ # functions
+ functions <- .Call( Module__functions_names, xp )
+ for( fun in functions ){
+ storage[[ fun ]] <- .get_Module_function( module, fun, xp )
+ }
+
+ assign( "storage", storage, envir = as.environment(module) )
module
}
Modified: pkg/Rcpp/inst/include/Rcpp/Module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Module.h 2010-11-25 11:06:36 UTC (rev 2518)
+++ pkg/Rcpp/inst/include/Rcpp/Module.h 2010-11-25 12:07:21 UTC (rev 2519)
@@ -119,6 +119,8 @@
SEXP invoke( const std::string& /* name */, SEXP* /* args */, int /* nargs */ ) ;
Rcpp::IntegerVector functions_arity() ;
+ Rcpp::CharacterVector functions_names() ;
+
Rcpp::CharacterVector class_names() ;
Rcpp::List classes_info() ;
Rcpp::CharacterVector complete() ;
Modified: pkg/Rcpp/inst/include/Rcpp/routines.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/routines.h 2010-11-25 11:06:36 UTC (rev 2518)
+++ pkg/Rcpp/inst/include/Rcpp/routines.h 2010-11-25 12:07:21 UTC (rev 2519)
@@ -48,6 +48,7 @@
CALLFUN_1(Module__classes_info) ;
CALLFUN_1(Module__complete) ;
CALLFUN_1(Module__functions_arity);
+CALLFUN_1(Module__functions_names);
CALLFUN_2(Module__get_class);
CALLFUN_2(Module__has_class);
CALLFUN_2(Module__has_function);
Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp 2010-11-25 11:06:36 UTC (rev 2518)
+++ pkg/Rcpp/src/Module.cpp 2010-11-25 12:07:21 UTC (rev 2519)
@@ -84,6 +84,9 @@
RCPP_FUNCTION_1( Rcpp::IntegerVector, Module__functions_arity, XP_Module module ){
return module-> functions_arity() ;
}
+RCPP_FUNCTION_1( Rcpp::CharacterVector, Module__functions_names, XP_Module module ){
+ return module-> functions_names() ;
+}
RCPP_FUNCTION_1( std::string, Module__name, XP_Module module ){
return module->name;
}
@@ -323,6 +326,16 @@
return x ;
}
+ Rcpp::CharacterVector Module::functions_names(){
+ int n = functions.size() ;
+ Rcpp::CharacterVector names( n );
+ MAP::iterator it = functions.begin() ;
+ for( int i=0; i<n; i++, ++it){
+ names[i] = it->first ;
+ }
+ return names ;
+ }
+
Rcpp::CharacterVector Module::complete(){
int nf = functions.size() ;
int nc = classes.size() ;
Modified: pkg/Rcpp/src/Rcpp_init.c
===================================================================
--- pkg/Rcpp/src/Rcpp_init.c 2010-11-25 11:06:36 UTC (rev 2518)
+++ pkg/Rcpp/src/Rcpp_init.c 2010-11-25 12:07:21 UTC (rev 2519)
@@ -52,6 +52,7 @@
CALLDEF(Module__has_class,2),
CALLDEF(Module__has_function,2),
CALLDEF(Module__functions_arity,1),
+ CALLDEF(Module__functions_names,1),
CALLDEF(Module__name,1),
CALLDEF(Module__get_function, 2),
More information about the Rcpp-commits
mailing list