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

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

Author: romain
Date: 2010-01-11 15:14:09 +0100 (Mon, 11 Jan 2010)
New Revision: 341

Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.environments.R
   pkg/src/Environment.cpp
   pkg/src/Rcpp/Environment.h
Log:
+Environment::operator[]( const std::string )

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-11 12:58:22 UTC (rev 340)
+++ pkg/inst/ChangeLog	2010-01-11 14:14:09 UTC (rev 341)
@@ -1,5 +1,12 @@
 2010-01-10  Romain Francois <francoisromain at free.fr>
 
+	* src/Rcpp/Environment.h: operator[](string) for environment
+	allowing to get/set values of a binding in this environment. 
+	The Environment::Binding class has been created to act as
+	a proxy.
+	* src/Environment.cpp: idem
+	* inst/unitTests/runit.environments.R: unit tests for the above
+
 	* src/Rcpp/Pairlist.h: operator[] for pairlist using proxies
 	* src/Pairlist.cpp : idem
 	* inst/unitTests/runit.Pairlist.R: new unit tests

Modified: pkg/inst/unitTests/runit.environments.R
===================================================================
--- pkg/inst/unitTests/runit.environments.R	2010-01-11 12:58:22 UTC (rev 340)
+++ pkg/inst/unitTests/runit.environments.R	2010-01-11 14:14:09 UTC (rev 341)
@@ -303,3 +303,24 @@
 	checkEquals( funx(e), emptyenv() , msg = "Environment::parent" )
 	
 }
+
+test.environment.square <- function(){
+	
+	funx <- cfunction(signature( env = "environment" ), '
+	Environment e(env) ;
+	List out(3) ;
+	out[0] = e["x"] ;
+	e["y"] = 2 ;
+	out[1] = e["y"] ;
+	e["x"] = "foo"; 
+	out[2] = e["x"] ;
+	return out ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	
+	env <- new.env( )
+	env[["x"]] <- 10L
+	checkEquals( funx(env), list( 10L, 2L, "foo") )
+	
+}
+
+

Modified: pkg/src/Environment.cpp
===================================================================
--- pkg/src/Environment.cpp	2010-01-11 12:58:22 UTC (rev 340)
+++ pkg/src/Environment.cpp	2010-01-11 14:14:09 UTC (rev 341)
@@ -23,6 +23,7 @@
 #include <Rcpp/Evaluator.h>
 #include <Rcpp/Symbol.h>
 #include <Rcpp/Language.h>
+#include <Rcpp/wrap.h>
 
 namespace Rcpp {
 
@@ -265,5 +266,56 @@
     }
     Environment::no_such_env::~no_such_env() throw() {}
     
+    
+    
+    Environment::Binding::Binding( Environment& env, const std::string& name): 
+    	env(env), name(name){}
+    
+    bool Environment::Binding::active() const{
+    	return env.bindingIsActive( name ) ; 
+    }
+    
+    bool Environment::Binding::exists() const{
+    	return env.exists( name ) ; 
+    }
+    
+    bool Environment::Binding::locked() const{
+    	return env.bindingIsLocked( name ) ; 
+    }
+    
+    void Environment::Binding::lock() {
+    	    env.lockBinding( name ) ;
+    }
+    
+    void Environment::Binding::unlock() {
+    	    env.unlockBinding( name ) ;
+    }
+    
+    Environment::Binding& Environment::Binding::operator=( SEXP rhs ){
+    	    env.assign( name, rhs ) ;
+    	    return *this ;
+    }
+    
+    Environment::Binding& Environment::Binding::operator=( const Binding& rhs){
+    	    env.assign( name, rhs.env.get(rhs.name) ) ;
+    	    return *this ;
+    }
+    
+    Environment::Binding::operator SEXP() const{
+    	return env.get( name );    
+    }
+    
+    Environment::Binding::operator RObject() const{
+    	return wrap( env.get( name ) );
+    }
+    
+    const Environment::Binding Environment::operator[]( const std::string& name) const{
+    	return Binding( const_cast<Environment&>(*this), name );
+    }
+    
+    Environment::Binding Environment::operator[]( const std::string& name) {
+    	return Binding( *this, name ) ;
+    }
+    
 } // namespace Rcpp
 

Modified: pkg/src/Rcpp/Environment.h
===================================================================
--- pkg/src/Rcpp/Environment.h	2010-01-11 12:58:22 UTC (rev 340)
+++ pkg/src/Rcpp/Environment.h	2010-01-11 14:14:09 UTC (rev 341)
@@ -120,6 +120,39 @@
     		std::string message ;
     } ;
     
+    class Binding {
+    public:
+    	    Binding( Environment& env, const std::string& name) ;
+    	    
+    	    bool active() const ;
+    	    bool locked() const ;
+    	    bool exists() const ;
+    	    void lock( ) ;
+    	    void unlock() ;
+    	    
+    	    /* lvalue uses */
+    	    Binding& operator=(const Binding& rhs) ;
+    	    Binding& operator=(SEXP rhs) ;
+    	    
+    	    template <typename T>
+    	    Binding& operator=(const T& rhs){
+    	    	    env.assign( name, wrap(rhs) ) ;
+    	    	    return *this ;
+    	    }
+    	    
+    	    /* rvalue */
+    	    operator SEXP() const ;
+    	    operator RObject() const ;
+    	    
+    private:
+    	    Environment& env ;
+    	    std::string name ;
+    } ;
+    
+    const Binding operator[]( const std::string& name) const ;
+    Binding operator[](const std::string& name) ;
+    friend class Binding ;
+    
     /**
      * wraps the given environment
      *

_______________________________________________
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