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

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

Author: romain
Date: 2010-01-10 21:42:38 +0100 (Sun, 10 Jan 2010)
New Revision: 334

Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.Pairlist.R
   pkg/src/Pairlist.cpp
   pkg/src/Rcpp/Pairlist.h
Log:
+Pairlist::operator[]

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-10 09:03:46 UTC (rev 333)
+++ pkg/inst/ChangeLog	2010-01-10 20:42:38 UTC (rev 334)
@@ -1,5 +1,7 @@
 2010-01-10  Romain Francois <francoisromain at free.fr>
 
+	* src/Rcpp/Pairlist.h: operator[] for pairlist using proxies
+
 	* inst/unitTests/runit.Function.R: added unit test for function
 	throwing exceptions
 

Modified: pkg/inst/unitTests/runit.Pairlist.R
===================================================================
--- pkg/inst/unitTests/runit.Pairlist.R	2010-01-10 09:03:46 UTC (rev 333)
+++ pkg/inst/unitTests/runit.Pairlist.R	2010-01-10 20:42:38 UTC (rev 334)
@@ -161,3 +161,29 @@
 	checkEquals( funx(), pairlist(1L, 20.0), msg = "Pairlist::remove(0)" )
 	
 }
+
+test.Pairlist.square.rvalue <- function(){
+	funx <- cfunction(signature(), '
+	Pairlist p ;
+	p.push_back( 1 ) ;
+	p.push_back( 10.0 ) ;
+	p.push_back( 20.0 ) ;
+	return p[1] ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), 10.0, msg = "Pairlist::operator[] used as rvalue" )
+}
+
+test.Pairlist.square.rvalue <- function(){
+	funx <- cfunction(signature(), '
+	Pairlist p ;
+	p.push_back( 1 ) ;
+	p.push_back( 10.0 ) ;
+	p.push_back( 20.0 ) ;
+	p[1] = "foobar" ;
+	p[2] = p[0] ;
+	return p ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), pairlist(1L, "foobar", 1L) , msg = "Pairlist::operator[] used as rvalue" )
+}
+
+

Modified: pkg/src/Pairlist.cpp
===================================================================
--- pkg/src/Pairlist.cpp	2010-01-10 09:03:46 UTC (rev 333)
+++ pkg/src/Pairlist.cpp	2010-01-10 20:42:38 UTC (rev 334)
@@ -62,7 +62,86 @@
 		}
 	}
 
-
+	Pairlist::Proxy::Proxy(Pairlist& v, const size_t& index) :
+		parent(v), index(index) {} ;
+	
+	Pairlist::Proxy& Pairlist::Proxy::operator=(const Proxy& rhs){
+		if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+		if( rhs.index < 0 || rhs.index >=  rhs.parent.length() ) throw index_out_of_bounds() ;
+		
+		SEXP target = parent.asSexp() ;
+		SEXP origin = rhs.parent.asSexp();
+		size_t i=0; 
+		while( i < index ){
+			target = CDR(target) ;
+			i++; 
+		}
+		i=0; 
+		while( i < rhs.index ){
+			origin = CDR(origin) ;
+			i++;
+		}
+		SETCAR( target, CAR(origin) );
+		SET_TAG( target, TAG(origin) ); 
+		return *this ;
+	}
+	
+	Pairlist::Proxy& Pairlist::Proxy::operator=(const Named& rhs){
+		if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+		size_t i = 0 ;
+		SEXP x = parent.asSexp() ; 
+		while( i < index ) {
+			x = CDR(x) ;
+			i++ ;
+		}
+		SETCAR( x, rhs.getSEXP() ) ;
+		SET_TAG( x, Symbol( rhs.getTag() ) ) ;
+		return *this ;
+	}
+	
+	Pairlist::Proxy& Pairlist::Proxy::operator=(SEXP rhs){
+		if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+		SEXP x = parent.asSexp() ; 
+		size_t i = 0 ;
+		while( i < index ) {
+			x = CDR(x) ;
+			i++ ;
+		}
+		SETCAR( x, rhs) ;
+		return *this ;
+	}
+	
+	Pairlist::Proxy::operator SEXP() const{
+		if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+		SEXP x = parent.asSexp() ; 
+		size_t i = 0 ;
+		while( i < index ) {
+			x = CDR(x) ;
+			i++ ;
+		}
+		return CAR(x) ;
+	}
+	
+	Pairlist::Proxy::operator RObject() const{
+		if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+		SEXP x = parent.asSexp() ; 
+		size_t i = 0 ;
+		while( i < index ) {
+			x = CDR(x) ;
+			i++ ;
+		}
+		return wrap( CAR(x) ) ;
+	}
+	
+	const Pairlist::Proxy Pairlist::operator[](int i) const {
+		return Proxy( const_cast<Pairlist&>(*this), i) ;
+	}
+	
+	Pairlist::Proxy Pairlist::operator[](int i){
+		return Proxy( *this, i );
+	}
+	
+	
 	SEXP pairlist(){ return R_NilValue ; }
 
 } // namespace Rcpp

Modified: pkg/src/Rcpp/Pairlist.h
===================================================================
--- pkg/src/Rcpp/Pairlist.h	2010-01-10 09:03:46 UTC (rev 333)
+++ pkg/src/Rcpp/Pairlist.h	2010-01-10 20:42:38 UTC (rev 334)
@@ -24,6 +24,7 @@
 
 #include <RcppCommon.h>
 #include <Rcpp/RObject.h>
+#include <Rcpp/Named.h>
 
 namespace Rcpp{ 
 
@@ -34,7 +35,7 @@
  */
 class Pairlist : public RObject{
 public:
-	
+
 	/**
 	 * Attempts to convert the SEXP to a pair list
 	 *
@@ -149,8 +150,8 @@
 		UNPROTECT(1) ;
 	}
 
-	inline size_t length(){ return Rf_length(m_sexp) ; }
-	inline size_t size(){ return Rf_length(m_sexp) ; }
+	inline size_t length() const { return Rf_length(m_sexp) ; }
+	inline size_t size() const { return Rf_length(m_sexp) ; }
 
 	/**
 	 * Remove the element at the given position
@@ -159,6 +160,36 @@
 	 */
 	void remove( const int& index ) throw(index_out_of_bounds) ; 
 
+	class Proxy {
+	public:
+		Proxy( Pairlist& v, const size_t& index ) ;
+		
+		/* lvalue uses */
+		Proxy& operator=(const Proxy& rhs) ;
+		Proxy& operator=(SEXP rhs) ;
+		
+		template <typename T>
+		Proxy& operator=(const T& rhs){
+			parent.replace( index, rhs ) ;
+			return *this ;
+		}
+		
+		Proxy& operator=(const Named& rhs) ;
+		
+		/* rvalue use */
+		operator SEXP() const ;
+		operator RObject() const ;
+		
+	private:
+		Pairlist& parent; 
+		size_t index ;
+	} ;
+
+	const Proxy operator[]( int i ) const ;
+	Proxy operator[]( int i ) ;
+	
+	friend class Proxy; 
+	
 };
 
 	SEXP pairlist() ;

_______________________________________________
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