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

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

Author: romain
Date: 2010-01-16 10:57:32 +0100 (Sat, 16 Jan 2010)
New Revision: 381

Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.environments.R
   pkg/src/Environment.cpp
   pkg/src/Evaluator.cpp
   pkg/src/Rcpp/Environment.h
Log:
cache the Rcpp namespace

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-16 09:23:19 UTC (rev 380)
+++ pkg/inst/ChangeLog	2010-01-16 09:57:32 UTC (rev 381)
@@ -1,5 +1,10 @@
 2010-01-16  Romain Francois <francoisromain at free.fr>
 
+	* src/Rcpp/Environment.h : the Rcpp namespace is cached because
+	we use it in many places and retrieving it is an "expensive"
+	operation that requires a round trip to the R side
+	* src/Evaluator.cpp: use the cached Rcpp namespace
+
 	* R/Rcpp.package.skeleton: now generating example C++ and R
 	code that uses Rcpp, also the generated Makevars contains
 	a hack so that the generated package can pass check (after

Modified: pkg/inst/unitTests/runit.environments.R
===================================================================
--- pkg/inst/unitTests/runit.environments.R	2010-01-16 09:23:19 UTC (rev 380)
+++ pkg/inst/unitTests/runit.environments.R	2010-01-16 09:57:32 UTC (rev 381)
@@ -323,4 +323,10 @@
 	
 }
 
+test.environment.Rcpp <- function(){
+	funx <- cfunction(signature(), '
+	return Environment::Rcpp_namespace() ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), asNamespace("Rcpp") , msg = "cached Rcpp namespace" )
+}
 

Modified: pkg/src/Environment.cpp
===================================================================
--- pkg/src/Environment.cpp	2010-01-16 09:23:19 UTC (rev 380)
+++ pkg/src/Environment.cpp	2010-01-16 09:57:32 UTC (rev 381)
@@ -317,5 +317,10 @@
     	return Binding( *this, name ) ;
     }
     
+    Environment Environment::RCPP_NAMESPACE = Environment::namespace_env("Rcpp") ;
+    Environment& Environment::Rcpp_namespace() throw() {
+    	    return RCPP_NAMESPACE ;
+    }
+    
 } // namespace Rcpp
 

Modified: pkg/src/Evaluator.cpp
===================================================================
--- pkg/src/Evaluator.cpp	2010-01-16 09:23:19 UTC (rev 380)
+++ pkg/src/Evaluator.cpp	2010-01-16 09:57:32 UTC (rev 381)
@@ -31,9 +31,9 @@
 
    SEXP Evaluator::run(SEXP expr, SEXP env) throw(eval_error) {
 	
-	/* grab the RCPP namespace */
-	SEXP RCPP = PROTECT( R_FindNamespace( Rf_mkString( "Rcpp")  ) );
-	
+   	/* already protected */
+   	SEXP RCPP = Environment::Rcpp_namespace(); 
+   	   
 	SEXP call = PROTECT( Rf_lang3( Rf_install("rcpp_tryCatch") , expr, env ) ) ;
 	
 	/* call the tryCatch call */
@@ -47,10 +47,10 @@
 			Rf_lang1( Rf_install("getCurrentErrorMessage")), 
 			RCPP ) );
 		std::string message = CHAR(STRING_ELT(err_msg,0)) ;
-		UNPROTECT( 4 ) ;
+		UNPROTECT( 3 ) ;
 		throw eval_error(message) ;
 	} else {
-		UNPROTECT(3) ;
+		UNPROTECT(2) ;
 		return res ;
 	}
     }

Modified: pkg/src/Rcpp/Environment.h
===================================================================
--- pkg/src/Rcpp/Environment.h	2010-01-16 09:23:19 UTC (rev 380)
+++ pkg/src/Rcpp/Environment.h	2010-01-16 09:57:32 UTC (rev 381)
@@ -422,6 +422,11 @@
     static Environment base_namespace() throw() ;
     
     /**
+     * @return the Rcpp namespace
+     */
+    static Environment& Rcpp_namespace() throw() ;
+    
+    /**
      * @param name the name of the package of which we want the namespace
      *
      * @return the namespace of the package
@@ -435,6 +440,10 @@
      */
     Environment parent() const throw() ;
     
+private:
+	/* we cache the Rcpp namespace environment since
+	it is used many times internally */
+	static Environment RCPP_NAMESPACE ;
 };
 
 } // namespace Rcpp