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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Jan 10 22:00:18 CET 2010


Author: romain
Date: 2010-01-10 22:00:17 +0100 (Sun, 10 Jan 2010)
New Revision: 335

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

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-10 20:42:38 UTC (rev 334)
+++ pkg/inst/ChangeLog	2010-01-10 21:00:17 UTC (rev 335)
@@ -1,7 +1,13 @@
 2010-01-10  Romain Francois <francoisromain at free.fr>
 
 	* src/Rcpp/Pairlist.h: operator[] for pairlist using proxies
-
+	* src/Pairlist.cpp : idem
+	* inst/unitTests/runit.Pairlist.R: new unit tests
+	
+	* src/Rcpp/Language.h: same for Language
+	* src/Language.cpp : idem
+	* inst/unitTests/runit.Language.R: new unit tests
+	
 	* inst/unitTests/runit.Function.R: added unit test for function
 	throwing exceptions
 

Modified: pkg/inst/unitTests/runit.Language.R
===================================================================
--- pkg/inst/unitTests/runit.Language.R	2010-01-10 20:42:38 UTC (rev 334)
+++ pkg/inst/unitTests/runit.Language.R	2010-01-10 21:00:17 UTC (rev 335)
@@ -64,4 +64,25 @@
 		msg = "Language::push_back" )
 }
 
+test.Language.square <- function(){
+	funx <- cfunction(signature(), '
+	Language p("rnorm") ;
+	p.push_back( 1 ) ;
+	p.push_back( 10.0 ) ;
+	p.push_back( 20.0 ) ;
+	return p[2] ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), 10.0, msg = "Language::operator[] used as rvalue" )
 
+	funx <- cfunction(signature(), '
+	Language p("rnorm") ;
+	p.push_back( 1 ) ;
+	p.push_back( 10.0 ) ;
+	p.push_back( 20.0 ) ;
+	p[1] = "foobar" ;
+	p[2] = p[3] ;
+	return p ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), call("rnorm", "foobar", 20.0, 20.0) , msg = "Pairlist::operator[] used as lvalue" )
+}
+

Modified: pkg/inst/unitTests/runit.Pairlist.R
===================================================================
--- pkg/inst/unitTests/runit.Pairlist.R	2010-01-10 20:42:38 UTC (rev 334)
+++ pkg/inst/unitTests/runit.Pairlist.R	2010-01-10 21:00:17 UTC (rev 335)
@@ -162,7 +162,7 @@
 	
 }
 
-test.Pairlist.square.rvalue <- function(){
+test.Pairlist.square <- function(){
 	funx <- cfunction(signature(), '
 	Pairlist p ;
 	p.push_back( 1 ) ;
@@ -171,9 +171,7 @@
 	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 ) ;
@@ -183,7 +181,7 @@
 	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" )
+	checkEquals( funx(), pairlist(1L, "foobar", 1L) , msg = "Pairlist::operator[] used as lvalue" )
 }
 
 

Modified: pkg/src/Language.cpp
===================================================================
--- pkg/src/Language.cpp	2010-01-10 20:42:38 UTC (rev 334)
+++ pkg/src/Language.cpp	2010-01-10 21:00:17 UTC (rev 335)
@@ -96,6 +96,92 @@
 		}
 	}
 
-
 	
+	/* proxy for operator[] */
+	
+	Language::Proxy::Proxy(Language& v, const size_t& index) :
+		parent(v), index(index) {} ;
+	
+	Language::Proxy& Language::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) );
+		if( index != 0 ) SET_TAG( target, TAG(origin) ); 
+		return *this ;
+	}
+	
+	Language::Proxy& Language::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() ) ;
+		if( index != 0 ) SET_TAG( x, Symbol( rhs.getTag() ) ) ;
+		return *this ;
+	}
+	
+	Language::Proxy& Language::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 ;
+	}
+	
+	
+	/* rvalue uses */
+	
+	Language::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) ;
+	}
+	
+	Language::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 Language::Proxy Language::operator[](int i) const {
+		return Proxy( const_cast<Language&>(*this), i) ;
+	}
+	
+	Language::Proxy Language::operator[](int i){
+		return Proxy( *this, i );
+	}
+	
+	
+	
+	
 } // namespace Rcpp

Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h	2010-01-10 20:42:38 UTC (rev 334)
+++ pkg/src/Rcpp/Language.h	2010-01-10 21:00:17 UTC (rev 335)
@@ -196,8 +196,8 @@
 		}
 	}
 
-	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
@@ -205,7 +205,38 @@
 	 * @param index position where the element is to be removed
 	 */
 	void remove( const int& index ) throw(index_out_of_bounds) ; 
+	
+	class Proxy {
+	public:
+		Proxy( Language& 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:
+		Language& parent; 
+		size_t index ;
+	} ;
 
+	const Proxy operator[]( int i ) const ;
+	Proxy operator[]( int i ) ;
+	
+	friend class Proxy; 
+	
+	
 	~Language() ;
 };
 



More information about the Rcpp-commits mailing list