[Rcpp-devel] [Rcpp-commits] r311 - in pkg: inst inst/unitTests src/Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jan 8 09:46:47 CET 2010
Author: romain
Date: 2010-01-08 09:46:47 +0100 (Fri, 08 Jan 2010)
New Revision: 311
Modified:
pkg/inst/ChangeLog
pkg/inst/unitTests/runit.Language.R
pkg/inst/unitTests/runit.Pairlist.R
pkg/src/Rcpp/Language.h
pkg/src/Rcpp/Named.h
pkg/src/Rcpp/Pairlist.h
Log:
added Language::push_back and Pairlist::push_back to append an element at the end of a dotted pair list
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2010-01-07 21:28:05 UTC (rev 310)
+++ pkg/inst/ChangeLog 2010-01-08 08:46:47 UTC (rev 311)
@@ -1,5 +1,11 @@
2010-01-07 Romain Francois <francoisromain at free.fr>
+ * src/Rcpp/Pairlist.h: Pairlist gains a push_back method
+
+ * src/Rcpp/Language.h: idem for Language
+
+2010-01-07 Romain Francois <francoisromain at free.fr>
+
* src/Rcpp/Pairlist.h: gains a push_front method
* src/Rcpp/wrap.h : now the result type of the various wrap
Modified: pkg/inst/unitTests/runit.Language.R
===================================================================
--- pkg/inst/unitTests/runit.Language.R 2010-01-07 21:28:05 UTC (rev 310)
+++ pkg/inst/unitTests/runit.Language.R 2010-01-08 08:46:47 UTC (rev 311)
@@ -50,3 +50,18 @@
}
}
+# same as about but without variadic templates
+test.Language.push.back <- function(){
+ funx <- cfunction(signature(), '
+ Language call("rnorm") ;
+ call.push_back( 10 ) ;
+ call.push_back( Named("mean", 0.0) ) ;
+ call.push_back( 2.0 ) ;
+ return call ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ checkEquals( funx(),
+ call("rnorm", 10L, mean = 0.0, 2.0 ),
+ msg = "Language::push_back" )
+}
+
+
Modified: pkg/inst/unitTests/runit.Pairlist.R
===================================================================
--- pkg/inst/unitTests/runit.Pairlist.R 2010-01-07 21:28:05 UTC (rev 310)
+++ pkg/inst/unitTests/runit.Pairlist.R 2010-01-08 08:46:47 UTC (rev 311)
@@ -66,3 +66,17 @@
msg = "Pairlist::push_front" )
}
+test.Pairlist.push.back <- function(){
+ funx <- cfunction(signature(), '
+ Pairlist p ;
+ p.push_back( 1 ) ;
+ p.push_back( 10.0 ) ;
+ p.push_back( "foo" ) ;
+ p.push_back( Named( "foobar", 10) ) ;
+ return p ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ checkEquals( funx(),
+ pairlist( 1L, 10.0, "foo", foobar = 10),
+ msg = "Pairlist::push_back" )
+}
+
Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h 2010-01-07 21:28:05 UTC (rev 310)
+++ pkg/src/Rcpp/Language.h 2010-01-08 08:46:47 UTC (rev 311)
@@ -36,7 +36,7 @@
*/
class Language : public RObject{
public:
-
+
/**
* Attempts to convert the SEXP to a call
*
@@ -44,7 +44,7 @@
* to a call using as.call
*/
Language(SEXP lang) throw(not_compatible) ;
-
+
/**
* Creates a call using the given symbol as the function name
*
@@ -55,7 +55,7 @@
* > call( "rnorm" )
*/
explicit Language( const std::string& symbol );
-
+
/**
* Creates a call using the given symbol as the function name
*
@@ -65,7 +65,7 @@
* > call( "rnorm" )
*/
explicit Language( const Symbol& symbol );
-
+
/**
* Creates a call to the given symbol using variable number of
* arguments
@@ -90,12 +90,35 @@
setSEXP( Rf_lcons( Symbol(symbol), pairlist( args... ) ) );
}
#endif
-
+
/**
+ * wraps an object and add it at the end of the pairlist
+ * (this require traversing the entire pairlist)
+ *
+ * @param object anything that can be wrapped by one
+ * of the wrap functions, or an object of class Named
+ */
+ template <typename T>
+ void push_back( const T& object){
+ if( isNULL() ){
+ setSEXP( grow( object, m_sexp ) ) ;
+ } else {
+ SEXP x = m_sexp ;
+ /* traverse the pairlist */
+ while( !Rf_isNull(CDR(x)) ){
+ x = CDR(x) ;
+ }
+ SEXP tail = PROTECT( pairlist( object ) );
+ SETCDR( x, tail ) ;
+ UNPROTECT(1) ;
+ }
+ }
+
+ /**
* sets the symbol of the call
*/
void setSymbol( const std::string& symbol);
-
+
/**
* sets the symbol of the call
*/
Modified: pkg/src/Rcpp/Named.h
===================================================================
--- pkg/src/Rcpp/Named.h 2010-01-07 21:28:05 UTC (rev 310)
+++ pkg/src/Rcpp/Named.h 2010-01-08 08:46:47 UTC (rev 311)
@@ -48,12 +48,10 @@
*/
Named( const std::string& tag ) : object(R_NilValue), tag(tag){} ;
-#ifdef HAS_VARIADIC_TEMPLATES
template<typename T>
Named( const std::string& tag, const T& value ) : object(R_NilValue), tag(tag) {
object = wrap( value ) ;
}
-#endif
SEXP getSEXP() const ;
Modified: pkg/src/Rcpp/Pairlist.h
===================================================================
--- pkg/src/Rcpp/Pairlist.h 2010-01-07 21:28:05 UTC (rev 310)
+++ pkg/src/Rcpp/Pairlist.h 2010-01-08 08:46:47 UTC (rev 311)
@@ -76,7 +76,29 @@
setSEXP( grow(object, m_sexp) ) ;
}
-
+ /**
+ * wraps an object and add it at the end of the pairlist
+ * (this require traversing the entire pairlist)
+ *
+ * @param object anything that can be wrapped by one
+ * of the wrap functions, or an object of class Named
+ */
+ template <typename T>
+ void push_back( const T& object){
+ if( isNULL() ){
+ setSEXP( grow( object, m_sexp ) ) ;
+ } else {
+ SEXP x = m_sexp ;
+ /* traverse the pairlist */
+ while( !Rf_isNull(CDR(x)) ){
+ x = CDR(x) ;
+ }
+ SEXP tail = PROTECT( pairlist( object ) );
+ SETCDR( x, tail ) ;
+ UNPROTECT(1) ;
+ }
+ }
+
};
#ifdef HAS_VARIADIC_TEMPLATES
_______________________________________________
Rcpp-commits mailing list
Rcpp-commits at lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-commits
More information about the Rcpp-devel
mailing list