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

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

Author: romain
Date: 2010-01-30 18:50:20 +0100 (Sat, 30 Jan 2010)
New Revision: 517

Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.Language.R
   pkg/src/Language.cpp
   pkg/src/Rcpp/Language.h
Log:
some mort interface for Language

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-30 17:45:32 UTC (rev 516)
+++ pkg/inst/ChangeLog	2010-01-30 17:50:20 UTC (rev 517)
@@ -1,3 +1,13 @@
+2010-01-30  Romain Francois <francoisromain at free.fr>
+
+	* src/Rcpp/internal/wrap.h: rework wrap using traits and 
+	template meta programming. wrap is now really a template 
+	and has many generated specializations. This file is 
+	a private header and should only be included by RcppCommon.h
+
+	* src/Rcpp/Language.h: Language gains Function aware constructors
+	and eval methods
+
 2010-01-28  Romain Francois <francoisromain at free.fr>
 
 	* src/Rcpp/DottedPair.h: DottedPair::Proxy are no more lazy, i.e

Modified: pkg/inst/unitTests/runit.Language.R
===================================================================
--- pkg/inst/unitTests/runit.Language.R	2010-01-30 17:45:32 UTC (rev 516)
+++ pkg/inst/unitTests/runit.Language.R	2010-01-30 17:50:20 UTC (rev 517)
@@ -88,3 +88,14 @@
 	checkEquals( funx(), call("rnorm", "foobar", 20.0, 20.0) , msg = "Pairlist::operator[] used as lvalue" )
 }
 
+test.Language.function <- function(){
+	funx <- cfunction(signature(g = "function", x = "numeric"), 
+	'
+	Function fun(g) ;
+	Language call( fun );
+	call.push_back(x) ;
+	return Rf_eval( call, R_GlobalEnv ) ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(sort, sample(1:10)), 1:10, msg = "Language( Function ) " )
+}
+

Modified: pkg/src/Language.cpp
===================================================================
--- pkg/src/Language.cpp	2010-01-30 17:45:32 UTC (rev 516)
+++ pkg/src/Language.cpp	2010-01-30 17:50:20 UTC (rev 517)
@@ -33,10 +33,14 @@
 		setSEXP( Rf_lcons( Symbol(symbol), R_NilValue ) );
 	}
 	
-	Language::Language( const Symbol& symbol ){
+	Language::Language( const Symbol& symbol ): DottedPair() {
 		setSEXP( Rf_lcons( symbol, R_NilValue ) ) ;
 	}
 	
+	Language::Language( const Function& function): DottedPair() {
+		setSEXP( Rf_lcons( function, R_NilValue ) ) ;		
+	}
+	
 	Language::~Language(){}
 
 	void Language::setSymbol( const std::string& symbol){
@@ -45,13 +49,25 @@
 	
 	void Language::setSymbol( const Symbol& symbol){
 		SETCAR( m_sexp, symbol ) ;
-		SET_TAG(m_sexp, R_NilValue);
+		SET_TAG(m_sexp, R_NilValue);/* probably not necessary */
 	}
 	
+	void Language::setFunction( const Function& function){
+		SETCAR( m_sexp, function );
+		SET_TAG(m_sexp, R_NilValue); /* probably not necessary */
+	}
+	
 	void Language::update(){ 
 		SET_TYPEOF( m_sexp, LANGSXP ) ;
 		SET_TAG( m_sexp, R_NilValue ) ;
 	}
 	
+	SEXP Language::eval(){
+		return eval( R_GlobalEnv ) ;
+	}
 	
+	SEXP Language::eval( SEXP env ){
+		return internal::try_catch( m_sexp, env );
+	}
+	
 } // namespace Rcpp

Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h	2010-01-30 17:45:32 UTC (rev 516)
+++ pkg/src/Rcpp/Language.h	2010-01-30 17:50:20 UTC (rev 517)
@@ -70,10 +70,12 @@
 	 */
 	explicit Language( const Symbol& symbol ); 
 
-	// /**
-	//  * Creates a call to the given function
-	//  */
-	// explicit Language( const Function& function ) ;
+	/**
+	 * Creates a call to the function
+	 * 
+	 * @param function function to call
+	 */
+	explicit Language( const Function& function) ;
 	
 	/**
 	 * Creates a call to the given symbol using variable number of 
@@ -97,10 +99,10 @@
 Language( const std::string& symbol, const Args&... args) : DottedPair(Rf_install(symbol.c_str()), args...) {
 	update() ;
 }
-//template<typename... Args> 
-//Language( const Function& function, const Args&... args) : DottedPair(function.asSexp(), args...) {
-//	update() ;
-//}
+template<typename... Args> 
+Language( const Function& function, const Args&... args) : DottedPair(function, args...) {
+	update() ;
+}
 #endif	
 	
 	/**
@@ -113,6 +115,21 @@
 	 */
 	void setSymbol( const Symbol& symbol ) ;
 
+	/**
+	 * sets the function
+	 */
+	void setFunction( const Function& function) ;
+	
+	/**
+	 * eval this call in the global environment
+	 */
+	SEXP eval() ;
+	
+	/**
+	 * eval this call in the requested environment
+	 */
+	SEXP eval(SEXP env) ;
+	
 	~Language() ;
 	
 private: