[Rcpp-commits] r311 - in pkg: inst inst/unitTests src/Rcpp

[noreply at r-forge.r-project.org]

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