[Rcpp-commits] r2169 - in pkg/Rcpp: . R inst inst/include inst/include/Rcpp src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Sep 25 10:51:25 CEST 2010
Author: romain
Date: 2010-09-25 10:51:25 +0200 (Sat, 25 Sep 2010)
New Revision: 2169
Modified:
pkg/Rcpp/DESCRIPTION
pkg/Rcpp/NAMESPACE
pkg/Rcpp/R/00_classes.R
pkg/Rcpp/R/01_show.R
pkg/Rcpp/R/02_completion.R
pkg/Rcpp/R/03_prompt.R
pkg/Rcpp/R/Module.R
pkg/Rcpp/R/RcppLdpath.R
pkg/Rcpp/R/tools.R
pkg/Rcpp/inst/ChangeLog
pkg/Rcpp/inst/include/Rcpp/routines.h
pkg/Rcpp/inst/include/RcppCommon.h
pkg/Rcpp/src/Module.cpp
pkg/Rcpp/src/Rcpp_init.c
Log:
more native routines registration
Modified: pkg/Rcpp/DESCRIPTION
===================================================================
--- pkg/Rcpp/DESCRIPTION 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/DESCRIPTION 2010-09-25 08:51:25 UTC (rev 2169)
@@ -1,6 +1,6 @@
Package: Rcpp
Title: Seamless R and C++ Integration
-Version: 0.8.6.2
+Version: 0.8.6.3
Date: $Date$
Author: Dirk Eddelbuettel and Romain Francois, with contributions
by Simon Urbanek, David Reiss and Douglas Bates; based on code written during
Modified: pkg/Rcpp/NAMESPACE
===================================================================
--- pkg/Rcpp/NAMESPACE 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/NAMESPACE 2010-09-25 08:51:25 UTC (rev 2169)
@@ -1,5 +1,15 @@
useDynLib(Rcpp,
- CppField__get, CppField__set
+ as_character_externalptr,
+
+ CppField__get, CppField__set,
+
+ Class__name,
+
+ CppClass__complete, CppClass__methods,
+
+ Module__classes_info,Module__complete,Module__get_class,
+ Module__has_class,Module__has_function,Module__functions_arity,
+ Module__name
)
import( methods )
Modified: pkg/Rcpp/R/00_classes.R
===================================================================
--- pkg/Rcpp/R/00_classes.R 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/R/00_classes.R 2010-09-25 08:51:25 UTC (rev 2169)
@@ -30,10 +30,10 @@
),
methods = list(
get = function(obj_xp){
- .Call( "CppField__get", class_pointer, pointer, obj_xp, PACKAGE = "Rcpp" )
+ .Call( CppField__get, class_pointer, pointer, obj_xp )
},
set = function(obj_xp, value){
- .Call( "CppField__set", class_pointer, pointer, obj_xp, value, PACKAGE = "Rcpp" )
+ .Call( CppField__set, class_pointer, pointer, obj_xp, value )
invisible( NULL )
}
)
Modified: pkg/Rcpp/R/01_show.R
===================================================================
--- pkg/Rcpp/R/01_show.R 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/R/01_show.R 2010-09-25 08:51:25 UTC (rev 2169)
@@ -27,7 +27,7 @@
# stop("C++ object with unset C++ class pointer")
txt <- sprintf( "C++ object <%s> of class '%s' <%s>",
externalptr_address(pointer),
- .Call( "Class__name", cppclass, PACKAGE = "Rcpp" ),
+ .Call( Class__name, cppclass ),
externalptr_address(cppclass)
)
writeLines( txt )
@@ -35,11 +35,11 @@
setMethod( "show", "C++Class", function(object){
txt <- sprintf( "C++ class '%s' <%s>",
- .Call( "Class__name", object at pointer, PACKAGE = "Rcpp" ),
+ .Call( Class__name, object at pointer ),
externalptr_address(object at pointer) )
writeLines( txt )
- met <- .Call( "CppClass__methods", object at pointer, PACKAGE = "Rcpp" )
+ met <- .Call( CppClass__methods, object at pointer )
if( length( met ) ){
txt <- sprintf( "\n%d methods : \n%s", length(met), paste( sprintf(" %s", met), collapse = "\n") )
writeLines( txt )
@@ -60,14 +60,14 @@
writeLines(txt)
}
else {
- info <- .Call( "Module__funtions_arity", pointer, PACKAGE = "Rcpp" )
- name <- .Call( "Module__name", pointer )
+ info <- .Call( Module__functions_arity, pointer )
+ name <- .Call( Module__name, pointer )
txt <- sprintf( "Rcpp module '%s' \n\t%d functions: ", name, length(info) )
writeLines( txt )
txt <- sprintf( "%15s : %d arguments", names(info), info )
writeLines( txt )
- info <- .Call( "Module__classes_info", pointer, PACKAGE = "Rcpp" )
+ info <- .Call( Module__classes_info, pointer )
txt <- sprintf( "\n\t%d classes : ", length(info) )
writeLines( txt )
txt <- sprintf( "%15s ", names(info) )
Modified: pkg/Rcpp/R/02_completion.R
===================================================================
--- pkg/Rcpp/R/02_completion.R 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/R/02_completion.R 2010-09-25 08:51:25 UTC (rev 2169)
@@ -21,7 +21,7 @@
if(identical(pointer, .badModulePointer)) {
stop( "unitialized module" )
}
- grep( pattern , .Call( "Module__complete", pointer, PACKAGE = "Rcpp"), value = TRUE )
+ grep( pattern , .Call( Module__complete, pointer), value = TRUE )
}
setMethod( ".DollarNames", "Module", .DollarNames.Module )
@@ -33,7 +33,7 @@
# FIXME: implement another test
# if(identical(xp, .emptyPointer))
# stop("C++ object with unset pointer to C++ class")
- .Call( "CppClass__complete" , xp , PACKAGE = "Rcpp" )
+ .Call( CppClass__complete , xp )
} )
".DollarNames.C++Object" <- function( x, pattern ){
Modified: pkg/Rcpp/R/03_prompt.R
===================================================================
--- pkg/Rcpp/R/03_prompt.R 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/R/03_prompt.R 2010-09-25 08:51:25 UTC (rev 2169)
@@ -22,13 +22,13 @@
stop(gettextf("Module \"%s\" has not been intialized: try Module(object)",
get("moduleName", envir = as.environment(object))), domain = NA)
else
- .Call( "Module__funtions_arity", pointer, PACKAGE = "Rcpp" )
+ .Call( Module__functions_arity, pointer )
} )
setGeneric( "prompt" )
setMethod( "prompt", "Module", function(object, filename = NULL, name = NULL, ...){
lines <- readLines( system.file( "prompt", "module.Rd", package = "Rcpp" ) )
- if( is.null(name) ) name <- .Call( "Module__name", object at pointer, PACKAGE = "Rcpp" )
+ if( is.null(name) ) name <- .Call( Module__name, object at pointer )
if( is.null(filename) ) filename <- sprintf( "%s-module.Rd", name )
lines <- gsub( "NAME", name, lines )
@@ -46,7 +46,7 @@
## pointer in object was not valid
pointer <- .getModulePointer(object)
- classes <- .Call( "Module__classes_info", pointer, PACKAGE = "Rcpp" )
+ classes <- .Call( Module__classes_info, pointer )
c.txt <- if( length( classes ) ){
sprintf( "classes: \\\\describe{
%s
Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/R/Module.R 2010-09-25 08:51:25 UTC (rev 2169)
@@ -70,13 +70,13 @@
setMethod( "$", "Module", function(x, name){
pointer <- .getModulePointer(x)
- if( .Call( "Module__has_function", pointer, name, PACKAGE = "Rcpp" ) ){
+ if( .Call( Module__has_function, pointer, name ) ){
function( ... ) {
res <- .External( "Module__invoke" , pointer, name, ..., PACKAGE = "Rcpp" )
if( isTRUE( res$void ) ) invisible(NULL) else res$result
}
- } else if( .Call("Module__has_class", pointer, name, PACKAGE = "Rcpp" ) ){
- value <- .Call( "Module__get_class", pointer, name, PACKAGE = "Rcpp" )
+ } 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
} else{
@@ -121,7 +121,7 @@
## [John] One technique is to initialize the pointer to a known value
## and just check whether it's been reset from that (bad) value
xp <- module
- moduleName <- .Call( "Module__name", xp )
+ moduleName <- .Call( Module__name, xp )
module <- new("Module", pointer = xp, packageName = PACKAGE,
moduleName = moduleName)
} else if(is(module, "character")) {
@@ -144,7 +144,7 @@
else
return(module)
}
- classes <- .Call( "Module__classes_info", xp, PACKAGE = "Rcpp" )
+ classes <- .Call( Module__classes_info, xp )
## We need a general strategy for assigning class defintions
## since delaying the initialization of the module causes
@@ -229,7 +229,9 @@
else
.Call( CppField__set, class_pointer, pointer, .pointer, x)
}, list(class_pointer = FIELD$class_pointer,
- pointer = FIELD$pointer))
+ pointer = FIELD$pointer,
+ CppField__get = CppField__get,
+ CppField__set = CppField__set ))
environment(f) <- where
f
}
Modified: pkg/Rcpp/R/RcppLdpath.R
===================================================================
--- pkg/Rcpp/R/RcppLdpath.R 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/R/RcppLdpath.R 2010-09-25 08:51:25 UTC (rev 2169)
@@ -82,128 +82,3 @@
Cxx0xFlags <- function() cat( RcppCxx0xFlags() )
-
-
-## new proposed implementation below, all prefixed with two comments (thanks, Emacs)
-## I put it here as R CMD check doesn't like the previous way of parking it here with
-## a non-standard name
-
-## ## Use R's internal knowledge of path settings to find the lib/ directory
-## ## plus optinally an arch-specific directory on system building multi-arch
-## RcppLdPath <- function() {
-## packageLibPath( package = "Rcpp" )
-## }
-
-## ## Provide linker flags -- i.e. -L/path/to/libRcpp -- as well as an
-## ## optional rpath call needed to tell the Linux dynamic linker about the
-## ## location. This is not needed on OS X where we encode this as library
-## ## built time (see src/Makevars) or Windows where we use a static library
-## ## Updated Jan 2010: We now default to static linking but allow the use
-## ## of rpath on Linux if static==FALSE has been chosen
-## ## Note that this is probably being called from LdFlags()
-## RcppLdFlags <- function(static=staticLinking()) {
-## packageLdFlags( "Rcpp", static )
-## }
-
-## # indicates if Rcpp was compiled with GCC >= 4.3
-## canUseCXX0X <- function() .Call( "canUseCXX0X", PACKAGE = "Rcpp" )
-
-## ## Provide compiler flags -- i.e. -I/path/to/Rcpp.h
-## RcppCxxFlags <- function(cxx0x=FALSE) {
-## iflag <- includeFlag( package = "Rcpp" )
-## paste( iflag, if( cxx0x && canUseCXX0X() ) " -std=c++0x" else "" )
-## }
-
-## ## Shorter names, and call cat() directly
-## ## CxxFlags defaults to no using c++0x extensions are these are considered non-portable
-## CxxFlags <- function(cxx0x=FALSE) {
-## cat(RcppCxxFlags(cxx0x=cxx0x))
-## }
-## ## LdFlags defaults to static linking on the non-Linux platforms Windows and OS X
-## LdFlags <- function(static=staticLinking()) {
-## cat(RcppLdFlags(static=static))
-## }
-
-## # capabilities
-## RcppCapabilities <- capabilities <- function() .Call("capabilities", PACKAGE = "Rcpp")
-
-## # compile, load and call the cxx0x.c script to identify whether
-## # the compiler is GCC >= 4.3
-## RcppCxx0xFlags <- function(){
-## script <- system.file( "discovery", "cxx0x.R", package = "Rcpp" )
-## flag <- capture.output( source( script ) )
-## flag
-## }
-
-## Cxx0xFlags <- function() cat( RcppCxx0xFlags() )
-
-
-
-
-## # indicates the default linking on the current platform
-## #
-## # default is to use static linking on windows an OSX
-## staticLinking <- function(){
-## .Platform$OS.type == "windows" || grepl( "^darwin", R.version$os )
-## }
-
-## # the /lib path of the specified package (maybe including the arch)
-## packageLibPath <- function( package = "Rcpp" ){
-## if (nzchar(.Platform$r_arch)) { ## eg amd64, ia64, mips
-## system.file("lib",.Platform$r_arch,package=package)
-## } else {
-## system.file("lib",package=package)
-## }
-## }
-
-## # on windows wrap the file with shQuote,
-## # otherwise, do nothing
-## wrapFile <- function( file ){
-## if (.Platform$OS.type=="windows") {
-## file <- shQuote(file)
-## }
-## file
-## }
-
-## # generic include flag
-## includeFlag <- function( package = "Rcpp" ){
-## paste( "-I", wrapFile(packageLibPath(package)), sep = "" )
-## }
-
-## # path to the static library file
-## staticLib <- function(package = "Rcpp" ){
-## libfoo.a <- file.path( packageLibPath(package = package), sprintf( "lib%s.a", package ) )
-## wrapFile( libfoo.a )
-## }
-
-## # dynamic library flags for the given package
-## dynamicLib <- function( package = "Rcpp" ){
-## libPath <- packageLibPath( package )
-
-## # general default
-## flags <- sprintf( "-L%s -l%s",
-## libPath,
-## package
-## )
-
-## # linux -rpath bonus
-## if (.Platform$OS.type == "unix") {
-## if (length(grep("^linux",R.version$os))) {
-## flags <- sprintf( "%s -Wl,-rpath,%s", flags, libPath)
-## }
-## }
-
-## flags
-## }
-
-
-## packageLdFlags <- function( package = "Rcpp", static = staticLinking() ){
-## if( static ){
-## staticLib( package = package )
-## } else {
-## dynamicLib( package = package )
-## }
-## }
-
-
-
Modified: pkg/Rcpp/R/tools.R
===================================================================
--- pkg/Rcpp/R/tools.R 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/R/tools.R 2010-09-25 08:51:25 UTC (rev 2169)
@@ -16,6 +16,6 @@
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
externalptr_address <- function(xp){
- .Call( "as_character_externalptr", xp, PACKAGE = "Rcpp" )
+ .Call( as_character_externalptr, xp )
}
Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/inst/ChangeLog 2010-09-25 08:51:25 UTC (rev 2169)
@@ -1,5 +1,13 @@
-2010-09-22 Romain Francois <romain at r-enthusiasts.com>
+2010-09-25 Romain Francois <romain at r-enthusiasts.com>
+ * inst/include/Rcpp/routines.h: declare routines that are registered
+
+ * src/Rcpp_init.c: register routines
+
+ * R/*.R: use registration information in many .Call to speed things up
+
+2010-09-24 Romain Francois <romain at r-enthusiasts.com>
+
* inst/include/Rcpp/sugar/Range.h : Range gains some operators (++,--,n etc ...)
* inst/examples/ConvolveBenchmarks/convolve3_cpp.cpp: using the new Range
Modified: pkg/Rcpp/inst/include/Rcpp/routines.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/routines.h 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/inst/include/Rcpp/routines.h 2010-09-25 08:51:25 UTC (rev 2169)
@@ -22,18 +22,44 @@
#ifndef Rcpp__routines_h
#define Rcpp__routines_h
+#define CALLFUN_0(name) SEXP name()
+#define CALLFUN_1(name) SEXP name(SEXP)
+#define CALLFUN_2(name) SEXP name(SEXP,SEXP)
+#define CALLFUN_3(name) SEXP name(SEXP,SEXP,SEXP)
+#define CALLFUN_4(name) SEXP name(SEXP,SEXP,SEXP,SEXP)
+#define CALLFUN_5(name) SEXP name(SEXP,SEXP,SEXP,SEXP,SEXP)
+
// we have to do the ifdef __cplusplus dance because this file
// is included both in C and C++ files
#ifdef __cplusplus
extern "C" {
#endif
-SEXP CppField__get(SEXP, SEXP, SEXP);
-SEXP CppField__set(SEXP, SEXP, SEXP, SEXP);
+CALLFUN_1(as_character_externalptr) ;
+CALLFUN_3(CppField__get);
+CALLFUN_4(CppField__set);
+CALLFUN_1(Class__name);
+CALLFUN_1(CppClass__complete);
+CALLFUN_1(CppClass__methods);
+
+CALLFUN_1(Module__classes_info) ;
+CALLFUN_1(Module__complete) ;
+CALLFUN_1(Module__functions_arity);
+CALLFUN_2(Module__get_class);
+CALLFUN_2(Module__has_class);
+CALLFUN_2(Module__has_function);
+CALLFUN_1(Module__name);
+
#ifdef __cplusplus
}
#endif
+#undef CALLFUN_0
+#undef CALLFUN_1
+#undef CALLFUN_2
+#undef CALLFUN_3
+#undef CALLFUN_4
+#undef CALLFUN_5
#endif
Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/inst/include/RcppCommon.h 2010-09-25 08:51:25 UTC (rev 2169)
@@ -155,11 +155,6 @@
RcppExport SEXP test_named() ;
RcppExport SEXP capabilities() ;
-/**
- * the address of the pointer wrapped by an external pointer
- */
-RcppExport SEXP as_character_externalptr(SEXP);
-
const char * sexp_to_name(int sexp_type);
#include <Rcpp/exceptions.h>
Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/src/Module.cpp 2010-09-25 08:51:25 UTC (rev 2169)
@@ -75,7 +75,7 @@
return cl->property_class(p) ;
}
-RCPP_FUNCTION_1( Rcpp::IntegerVector, Module__funtions_arity, XP_Module module ){
+RCPP_FUNCTION_1( Rcpp::IntegerVector, Module__functions_arity, XP_Module module ){
return module-> functions_arity() ;
}
RCPP_FUNCTION_1( std::string, Module__name, XP_Module module ){
@@ -87,8 +87,7 @@
RCPP_FUNCTION_1( Rcpp::CharacterVector, Module__complete, XP_Module module ){
return module->complete() ;
}
-extern "C" SEXP CppClass__complete( SEXP xp){
- XP_Class cl(xp) ;
+RCPP_FUNCTION_1( Rcpp::CharacterVector, CppClass__complete, XP_Class cl){
return cl->complete();
}
Modified: pkg/Rcpp/src/Rcpp_init.c
===================================================================
--- pkg/Rcpp/src/Rcpp_init.c 2010-09-25 07:05:57 UTC (rev 2168)
+++ pkg/Rcpp/src/Rcpp_init.c 2010-09-25 08:51:25 UTC (rev 2169)
@@ -25,11 +25,30 @@
#include <Rcpp/routines.h>
+// borrowed from Matrix
+#define CALLDEF(name, n) {#name, (DL_FUNC) &name, n}
+
// TODO: check that having this static does not mess up with
// RInside, and move it within init_Rcpp_routines otherwise
static R_CallMethodDef callEntries[] = {
- {"CppField__get", (DL_FUNC) &CppField__get, 3},
- {"CppField__set", (DL_FUNC) &CppField__set, 4},
+ CALLDEF(as_character_externalptr,1),
+
+ CALLDEF(CppField__get,3),
+ CALLDEF(CppField__set,4),
+
+ CALLDEF(Class__name,1),
+
+ CALLDEF(CppClass__complete,1),
+ CALLDEF(CppClass__methods,1),
+
+ CALLDEF(Module__classes_info,1),
+ CALLDEF(Module__complete,1),
+ CALLDEF(Module__get_class,2),
+ CALLDEF(Module__has_class,2),
+ CALLDEF(Module__has_function,2),
+ CALLDEF(Module__functions_arity,1),
+ CALLDEF(Module__name,1),
+
{NULL, NULL, 0}
};
More information about the Rcpp-commits
mailing list