[Rcpp-commits] r819 - in pkg/Rcpp: inst inst/unitTests src src/Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Mar 2 14:30:43 CET 2010
Author: romain
Date: 2010-03-02 14:30:43 +0100 (Tue, 02 Mar 2010)
New Revision: 819
Added:
pkg/Rcpp/inst/unitTests/runit.macros.R
Modified:
pkg/Rcpp/inst/ChangeLog
pkg/Rcpp/src/Rcpp/Vector.h
pkg/Rcpp/src/RcppCommon.cpp
pkg/Rcpp/src/RcppCommon.h
Log:
+ macros RCPP_CALL_VECTOR and RCPP_CALL_MATRIX to hide boiler plate switch(TYPEOF(x)){ case INTSXP: return fun( ::Rcpp::Vector<INTSXP>(x) ) ; ... }
Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog 2010-03-02 13:04:44 UTC (rev 818)
+++ pkg/Rcpp/inst/ChangeLog 2010-03-02 13:30:43 UTC (rev 819)
@@ -1,5 +1,13 @@
2010-03-01 Romain Francois <romain at r-enthusiasts.com>
+ * src/Rcpp/Vector.h: Vector gains a nested r_type type that is an
+ integral_constant<int,RTYPE> to facilitate TMP
+ * src/RcppCommon.{h,cpp}: added RCPP_CALL_VECTOR and RCPP_CALL_MATRIX
+ macros to facilitate calling a function templated by T = Vector<RTYPE>
+ the macro hides the boiler-plate switch( TYPEOF(x) ){ case INTSXP : ... }
+
+2010-03-01 Romain Francois <romain at r-enthusiasts.com>
+
* src/Rcpp/Vector.h: more typedef : CharacterMatrix, StringMatrix,
GenericMatrix, ExpressionMatrix, ListMatrix
Added: pkg/Rcpp/inst/unitTests/runit.macros.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.macros.R (rev 0)
+++ pkg/Rcpp/inst/unitTests/runit.macros.R 2010-03-02 13:30:43 UTC (rev 819)
@@ -0,0 +1,36 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2010 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 <http://www.gnu.org/licenses/>.
+
+test.macro.switch <- function(){
+ rcpp_typeof <- function(x){
+ .Call( "rcpp_call_test", x, PACKAGE = "Rcpp" )
+ }
+ sexp_types <- c( integer = 13L, double = 14L, raw = 24L,
+ complex = 15L, logical = 10L, list = 19L,
+ "expression" = 20L, character = 16 )
+ checkEquals( rcpp_typeof(1L ), sexp_types[[ "integer" ]], msg = "RCPP_RETURN_VECTOR <INTSXP> " )
+ checkEquals( rcpp_typeof(1.0), sexp_types[["double"]], msg = "RCPP_RETURN_VECTOR <REALSXP> " )
+ checkEquals( rcpp_typeof(as.raw(0)), sexp_types[["raw"]] , msg = "RCPP_RETURN_VECTOR <RAWSXP> " )
+ checkEquals( rcpp_typeof(1i), sexp_types[["complex"]], msg = "RCPP_RETURN_VECTOR <CPLXSXP> " )
+ checkEquals( rcpp_typeof(TRUE), sexp_types[["logical"]], msg = "RCPP_RETURN_VECTOR <LGLSXP> " )
+ checkEquals( rcpp_typeof(list(1)), sexp_types[["list"]] , msg = "RCPP_RETURN_VECTOR <VECSXP> " )
+ checkEquals( rcpp_typeof(expression(x)), sexp_types[["expression"]], msg = "RCPP_RETURN_VECTOR <EXPRSXP> " )
+ checkEquals( rcpp_typeof(""), sexp_types[["character"]], msg = "RCPP_RETURN_VECTOR <STRSXP> " )
+}
+
Modified: pkg/Rcpp/src/Rcpp/Vector.h
===================================================================
--- pkg/Rcpp/src/Rcpp/Vector.h 2010-03-02 13:04:44 UTC (rev 818)
+++ pkg/Rcpp/src/Rcpp/Vector.h 2010-03-02 13:30:43 UTC (rev 819)
@@ -439,6 +439,8 @@
typedef MatrixRow<RTYPE> Row ;
typedef MatrixColumn<RTYPE> Column ;
+ struct r_type : traits::integral_constant<int,RTYPE>{} ;
+
Vector() : Base() {
Base::setSEXP( Rf_allocVector( RTYPE, 0 ) ) ;
init() ;
Modified: pkg/Rcpp/src/RcppCommon.cpp
===================================================================
--- pkg/Rcpp/src/RcppCommon.cpp 2010-03-02 13:04:44 UTC (rev 818)
+++ pkg/Rcpp/src/RcppCommon.cpp 2010-03-02 13:30:43 UTC (rev 819)
@@ -165,10 +165,19 @@
return std::complex<float>(static_cast<float>(from.r), static_cast<float>(from.i) ) ;
}
+ int rcpp_call_test_(SEXP x){
+ RCPP_RETURN_VECTOR( rcpp_call_test, x );
+ }
+
} // internal
} // Rcpp
+SEXP rcpp_call_test(SEXP x){
+ return Rf_ScalarInteger( ::Rcpp::internal::rcpp_call_test_(x) ) ;
+}
+
+
SEXP RcppXPtrExample_create_external_pointer(){
std::vector<int> *v = new std::vector<int> ;
v->push_back( 1 ) ;
Modified: pkg/Rcpp/src/RcppCommon.h
===================================================================
--- pkg/Rcpp/src/RcppCommon.h 2010-03-02 13:04:44 UTC (rev 818)
+++ pkg/Rcpp/src/RcppCommon.h 2010-03-02 13:30:43 UTC (rev 819)
@@ -24,6 +24,28 @@
#ifndef RcppCommon_h
#define RcppCommon_h
+#define ___RCPP_HANDLE_CASE___( ___RTYPE___ , ___FUN___ , ___OBJECT___ , ___RCPPTYPE___ ) \
+ case ___RTYPE___ : \
+ return ___FUN___( ::Rcpp::___RCPPTYPE___< ___RTYPE___ >( ___OBJECT___ ) ) ;
+
+#define ___RCPP_RETURN___( __FUN__, __SEXP__ , __RCPPTYPE__ ) \
+ SEXP __TMP__ = __SEXP__ ; \
+ switch( TYPEOF( __TMP__ ) ){ \
+ ___RCPP_HANDLE_CASE___( INTSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \
+ ___RCPP_HANDLE_CASE___( REALSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \
+ ___RCPP_HANDLE_CASE___( RAWSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \
+ ___RCPP_HANDLE_CASE___( LGLSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \
+ ___RCPP_HANDLE_CASE___( CPLXSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \
+ ___RCPP_HANDLE_CASE___( STRSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \
+ ___RCPP_HANDLE_CASE___( VECSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \
+ ___RCPP_HANDLE_CASE___( EXPRSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \
+ default: \
+ throw std::range_error( "not a vector" ) ; \
+ }
+
+#define RCPP_RETURN_VECTOR( _FUN_, _SEXP_ ) ___RCPP_RETURN___( _FUN_, _SEXP_ , Vector )
+#define RCPP_RETURN_MATRIX( _FUN_, _SEXP_ ) ___RCPP_RETURN___( _FUN_, _SEXP_ , Matrix )
+
/**
* \brief Rcpp API
*/
@@ -104,6 +126,18 @@
#define RcppExport extern "C"
// #endif
+
+namespace Rcpp{
+namespace internal{
+template <typename T> int rcpp_call_test(T t){
+ return T::r_type::value ;
+}
+int rcpp_call_test_(SEXP) ;
+}
+}
+
+extern "C" SEXP rcpp_call_test(SEXP x) ;
+
char *copyMessageToR(const char* const mesg);
// simple logging help
More information about the Rcpp-commits
mailing list