[Rcpp-commits] r259 - in pkg: . R inst inst/unitTests src src/Rcpp

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Jan 3 09:53:20 CET 2010


Author: romain
Date: 2010-01-03 09:53:19 +0100 (Sun, 03 Jan 2010)
New Revision: 259

Added:
   pkg/inst/unitTests/runit.Language.R
   pkg/inst/unitTests/runit.Symbol.R
   pkg/src/Language.cpp
   pkg/src/Rcpp/Language.h
   pkg/src/Rcpp/Symbol.h
   pkg/src/Symbol.cpp
Modified:
   pkg/DESCRIPTION
   pkg/R/RcppLdpath.R
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.environments.R
   pkg/src/Environment.cpp
   pkg/src/Evaluator.cpp
   pkg/src/Makevars
   pkg/src/RObject.cpp
   pkg/src/Rcpp.h
   pkg/src/Rcpp/Environment.h
   pkg/src/Rcpp/Evaluator.h
   pkg/src/RcppCommon.cpp
   pkg/src/RcppCommon.h
Log:
added Language and Symbol class. use C++0x features

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/DESCRIPTION	2010-01-03 08:53:19 UTC (rev 259)
@@ -1,6 +1,6 @@
 Package: Rcpp
 Title: Rcpp R/C++ interface package
-Version: 0.7.1
+Version: 0.7.1.1
 Date: $Date$
 Author: Dirk Eddelbuettel and Romain Francois, with contributions 
  by Simon Urbanek and David Reiss; based on code written during 

Modified: pkg/R/RcppLdpath.R
===================================================================
--- pkg/R/RcppLdpath.R	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/R/RcppLdpath.R	2010-01-03 08:53:19 UTC (rev 259)
@@ -26,9 +26,11 @@
     invisible(flags)
 }
 
+canUseCXX0X <- function() .Call( "canUseCXX0X", PACKAGE = "Rcpp" )
+
 ## Provide compiler flags -- i.e. -I/path/to/Rcpp.h
 RcppCxxFlags <- function() {
-    paste("-I", RcppLdPath(), sep="")
+    paste("-I", RcppLdPath(), if( canUseCXX0X ) " -std=c++0x" else "", sep="")
 }
 
 ## Shorter names, and call cat() directly

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/inst/ChangeLog	2010-01-03 08:53:19 UTC (rev 259)
@@ -1,3 +1,41 @@
+2010-01-03  Romain Francois <francoisromain at free.fr>
+
+	* src/RcppCommon.h: added the CXX0X define that controls whether
+	we can use C++0x features offered by the gcc. currently the define
+	is hardcoded, but this will eventually be a configure guess. The 
+	canUseCXX0X function can be called to bring this back to R
+	
+	* R/RcppLdPath.R: added the canUseCXX0X R function to query 
+	the internal canUseCXX0X function, use this in RcppCxxFlags so that 
+	code linking against Rcpp (inline code or packages) can take 
+	advantage of it
+
+2010-01-03  Romain Francois <francoisromain at free.fr>
+
+	* src/Rcpp/Language.h : new class Rcpp::Language to manage calls
+	(LANGSXP SEXP)
+	
+	* src/Language.cpp : implementation
+	
+	* inst/unitTests/runit.Language.R: unit tests
+
+2010-01-03  Romain Francois <francoisromain at free.fr>
+
+	* src/Rcpp/Environment.h : added constructors and made the SEXP based
+	constructor smarter (using as.environment)
+	
+	* inst/unitTests/runit.environments.R: more unit tests
+	
+2010-01-03  Romain Francois <francoisromain at free.fr>
+
+	* src/Rcpp/Symbol.h: new class Rcpp::Symbol to encapsulate 
+	symbols. This allows to use Symbol("rnorm") instead of the most cryptic
+	Rf_install("rnorm")
+	
+	* src/Symbol.cpp: implementation
+	
+	* inst/unitTests/runit.Symbol.R: unit tests
+
 2010-01-03  Dirk Eddelbuettel  <edd at debian.org>
 
 	* doxyfile: updated to current doxygen standard using -u

Added: pkg/inst/unitTests/runit.Language.R
===================================================================
--- pkg/inst/unitTests/runit.Language.R	                        (rev 0)
+++ pkg/inst/unitTests/runit.Language.R	2010-01-03 08:53:19 UTC (rev 259)
@@ -0,0 +1,36 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+#
+# This file is part of Rcpp.
+#
+# Rcpp is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# Rcpp is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+.setUp <- function(){
+	suppressMessages( require( inline ) )
+}
+
+test.Language <- function(){
+	funx <- cfunction(signature(x="ANY"), 'return Language(x) ;', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx( call("rnorm") ), call("rnorm" ), msg = "Language( LANGSXP )" )
+	# checkEquals( funx( list( as.name("rnorm") ) ), call("rnorm" ), 
+	# 	msg = "Language( list with 1st arg symbol )" )
+	checkException( funx(funx), msg = "Language not compatible with function" )
+	checkException( funx(new.env()), msg = "Language not compatible with environment" )
+	checkException( funx(1:10), msg = "Language not compatible with integer" )
+	checkException( funx(TRUE), msg = "Language not compatible with logical" )
+	checkException( funx(1.3), msg = "Language not compatible with numeric" )
+	checkException( funx(as.raw(1) ), msg = "Language not compatible with raw" )
+}
+

Added: pkg/inst/unitTests/runit.Symbol.R
===================================================================
--- pkg/inst/unitTests/runit.Symbol.R	                        (rev 0)
+++ pkg/inst/unitTests/runit.Symbol.R	2010-01-03 08:53:19 UTC (rev 259)
@@ -0,0 +1,54 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+#
+# This file is part of Rcpp.
+#
+# Rcpp is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# Rcpp is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+.setUp <- function(){
+	suppressMessages( require( inline ) )
+}
+
+test.Symbol <- function(){
+	funx <- cfunction(signature(), '
+	SEXP res = PROTECT( Rf_allocVector( LGLSXP, 4) ) ;
+	/* SYMSXP */
+	LOGICAL(res)[0] = Symbol( Rf_install("foobar") ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
+	
+	/* CHARSXP */
+	LOGICAL(res)[1] = Symbol( Rf_mkChar("foobar") ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
+	
+	/* STRSXP */
+	LOGICAL(res)[2] = Symbol( Rf_mkString("foobar") ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
+	
+	/* std::string */
+	LOGICAL(res)[3] = Symbol( "foobar" ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
+	
+	UNPROTECT(1) ; /* res */
+	return res ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkTrue( all( funx() ), msg = "Symbol creation" )
+}
+
+test.Symbol.notcompatible <- function(){
+	funx <- cfunction(signature(x="ANY"), 'return Symbol(x);', 
+		Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkException( funx(funx), msg = "Symbol not compatible with function" )
+	checkException( funx(asNamespace("Rcpp")), msg = "Symbol not compatible with environment" )
+	checkException( funx(1:10), msg = "Symbol not compatible with integer" )
+	checkException( funx(TRUE), msg = "Symbol not compatible with logical" )
+	checkException( funx(1.3), msg = "Symbol not compatible with numeric" )
+	checkException( funx(as.raw(1) ), msg = "Symbol not compatible with raw" )
+}

Modified: pkg/inst/unitTests/runit.environments.R
===================================================================
--- pkg/inst/unitTests/runit.environments.R	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/inst/unitTests/runit.environments.R	2010-01-03 08:53:19 UTC (rev 259)
@@ -1,6 +1,6 @@
 #!/usr/bin/r -t
 #
-# Copyright (C) 2009 - 2010	Romain Francois
+# Copyright (C) 2009 - 2010	Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -238,5 +238,40 @@
 	
 }
 
+test.environment.constructor.SEXP <- function(){
+	funx <- cfunction(signature( env = "ANY" ), 'return Environment( env ) ;', 
+		Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx( globalenv() ), globalenv(), msg = "Environment( environment ) - 1" )
+	checkEquals( funx( baseenv() ), baseenv(), msg = "Environment( environment ) - 2" )
+	checkEquals( funx( asNamespace("Rcpp") ), asNamespace("Rcpp"), msg = "Environment( environment ) - 3" )
+	
+	checkEquals( funx( ".GlobalEnv" ), globalenv(), msg = "Environment( character ) - 1" )
+	checkEquals( funx( "package:base" ), baseenv(), msg = "Environment( character ) - 2" )
+	checkEquals( funx( "package:Rcpp" ), as.environment("package:Rcpp") , msg = 'Environment( "package:Rcpp") ' )
+	
+	checkEquals( funx(1L), globalenv(), msg = "Environment( SEXP{integer} )" )
+}
 
+test.environment.constructor.stdstring <- function(){
+	funx <- cfunction(signature( env = "character" ), '
+	std::string st = RObject(env).asStdString() ;
+	return Environment( st ) ; ', 
+	Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	
+	checkEquals( funx( ".GlobalEnv" ), globalenv(), msg = "Environment( std::string ) - 1" )
+	checkEquals( funx( "package:base" ), baseenv(), msg = "Environment( std::string ) - 2" )
+	checkEquals( funx( "package:Rcpp" ), as.environment("package:Rcpp") , 
+		msg = 'Environment( std::string ) - 3' )
+	
+}
 
+test.environment.constructor.int <- function(){
+	funx <- cfunction(signature( env = "integer" ), '
+	int pos = RObject(env).asInt() ;
+	return Environment( pos ) ;', 
+	Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	for( i in 1:length(search())){
+		checkEquals( funx(i), as.environment(i), msg = sprintf("Environment(int) - %d", i) ) 
+	}
+}
+

Modified: pkg/src/Environment.cpp
===================================================================
--- pkg/src/Environment.cpp	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/src/Environment.cpp	2010-01-03 08:53:19 UTC (rev 259)
@@ -2,7 +2,7 @@
 //
 // Environment.cpp: Rcpp R/C++ interface class library -- Environments
 //
-// Copyright (C) 2009 - 2010	Romain Francois
+// Copyright (C) 2009 - 2010	Dirk Eddelbuettel and Romain Francois
 //
 // This file is part of Rcpp.
 //
@@ -20,6 +20,8 @@
 // along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
 #include <Rcpp/Environment.h>
+#include <Rcpp/Evaluator.h>
+#include <Rcpp/Symbol.h>
 
 namespace Rcpp {
 
@@ -41,13 +43,58 @@
     s->val = R_FindNamespace(s->sym);
 }
 
+    Environment::Environment( SEXP x = R_GlobalEnv) throw(not_compatible) : RObject::RObject(x){
+	
+    	if( Rf_isEnvironment(x) ){
+    		/* this is an environment, that's easy */
+    		m_sexp = x; 
+    	} else{
+    		
+    		/* not an environment, but maybe convertible to one using 
+    		   as.environment, try that */
+    		Evaluator evaluator( Rf_lang2(Symbol("as.environment"), x ) ) ;
+    		evaluator.run() ;
+    		if( evaluator.successfull() ){
+    			m_sexp = evaluator.getResult() ;
+    			preserved = true ;
+    			evaluator.getResult().forgetPreserve() ;
+    		} else{
+    			throw not_compatible( ) ; 
+    		}
+    	}
+    }
 
-    Environment::Environment( SEXP m_sexp = R_GlobalEnv) : RObject::RObject(m_sexp){
-	if( TYPEOF(m_sexp) != ENVSXP ){
-	    throw std::runtime_error( "not an environment" ) ;
-	}
+    Environment::Environment( const std::string& name) throw(no_such_env) : RObject(R_EmptyEnv){
+    	/* similar to matchEnvir at envir.c */
+    	if( name == ".GlobalEnv" ) {
+    		m_sexp = R_GlobalEnv ;
+    	} else if( name == "package:base" ){
+    		m_sexp = R_BaseEnv ;
+    	} else{
+    		Evaluator evaluator( Rf_lang2(Symbol("as.environment"), Rf_mkString(name.c_str()) ) ) ;
+    		evaluator.run() ;
+    		if( evaluator.successfull() ){
+    			m_sexp = evaluator.getResult() ;
+    			preserved = true ;
+    			evaluator.getResult().forgetPreserve() ;
+    		} else{
+    			throw no_such_env(name) ; 
+    		}
+    	}
     }
-	
+    
+    Environment::Environment(int pos) throw(no_such_env) : RObject(R_EmptyEnv){
+    	Evaluator evaluator( Rf_lang2(Symbol("as.environment"), Rf_ScalarInteger(pos) ) ) ;
+    	evaluator.run() ;
+    	if( evaluator.successfull() ){
+    		m_sexp = evaluator.getResult() ;
+    		preserved = true ;
+    		evaluator.getResult().forgetPreserve() ;
+    	} else{
+    		throw no_such_env(pos) ; 
+    	}
+    }
+    
     Environment::~Environment(){
 	logTxt( "~Environment" ) ;
     }
@@ -137,7 +184,7 @@
     }
     
     Environment Environment::empty_env() throw() {
-    	return Environment(R_GlobalEnv) ;
+    	return Environment(R_EmptyEnv) ;
     }
     
     Environment Environment::base_env() throw(){
@@ -180,5 +227,22 @@
     }
     Environment::no_such_namespace::~no_such_namespace() throw() {}
     
+    Environment::no_such_env::no_such_env(const std::string& name) : 
+    	message("no environment called : '" + name + "'" ) {}
+    Environment::no_such_env::no_such_env(int pos) : 
+    	message("no environment in the given position" ) {}
+    const char* Environment::no_such_env::what() const throw(){
+    	return message.c_str() ;
+    }
+    Environment::no_such_env::~no_such_env() throw() {}
+    
+    Environment::not_compatible::not_compatible() throw() {}
+    const char* Environment::not_compatible::what() const throw(){
+    	return "cannot convert to environment" ;
+    }
+    Environment::not_compatible::~not_compatible() throw() {}
+    
+    
+    
 } // namespace Rcpp
 

Modified: pkg/src/Evaluator.cpp
===================================================================
--- pkg/src/Evaluator.cpp	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/src/Evaluator.cpp	2010-01-03 08:53:19 UTC (rev 259)
@@ -32,7 +32,7 @@
 	
     Evaluator::~Evaluator(){} 
 	
-    void Evaluator::run(SEXP env ){
+    void Evaluator::run(SEXP env ) throw() {
 	Environment rcpp = Environment::namespace_env("Rcpp") ;
 	SEXP call = Rf_lang3( Rf_install("protectedEval"), expression, env ) ;
 	result = wrap( Rf_eval( call, rcpp ) ); 
@@ -43,5 +43,9 @@
 	    error.preserve() ;
 	}
     }
-	
+    
+    void Evaluator::run() throw() {
+    	run( R_GlobalEnv) ;
+    }
+
 } // namespace Rcpp

Added: pkg/src/Language.cpp
===================================================================
--- pkg/src/Language.cpp	                        (rev 0)
+++ pkg/src/Language.cpp	2010-01-03 08:53:19 UTC (rev 259)
@@ -0,0 +1,82 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Language.cpp: Rcpp R/C++ interface class library -- Language objects ( calls )
+//
+// Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#include <Rcpp/Language.h>
+#include <Rcpp/Evaluator.h>
+#include <RcppCommon.h>
+
+namespace Rcpp {
+	
+	Language::Language( SEXP lang = R_NilValue ) throw(not_compatible) : RObject::RObject(lang){
+		/* if this is not trivially a call, then try to convert it to one */
+		if( m_sexp != R_NilValue && TYPEOF(m_sexp) != LANGSXP ){
+	    		
+	    		/* taken from do_ascall */
+	    		switch( TYPEOF(lang) ){
+	    		case LISTSXP :
+	    			m_sexp = Rf_duplicate( lang ) ;
+	    			break ;
+	    		case VECSXP:
+	    		case EXPRSXP:
+	    			{
+	    				int n = Rf_length(lang) ;
+	    				if( n == 0 ) throw not_compatible() ;
+	    				SEXP names = GET_NAMES(lang) ; 
+	    				SEXP ap;
+	    				PROTECT( ap = m_sexp = Rf_allocList( n ) ) ;
+	    				for( int i=0; i<n; i++){
+	    					SETCAR(ap, VECTOR_ELT(lang, i));
+	    					if (names != R_NilValue && !Rf_StringBlank(STRING_ELT(names, i)))
+	    					SET_TAG(ap, Rf_install(Rf_translateChar(STRING_ELT(names, i))));
+	    					ap = CDR( ap) ;
+	    				}
+	    				UNPROTECT(1) ;
+	    			}
+	    		default:
+	    			throw not_compatible() ;
+	    		}
+	    		SET_TYPEOF(m_sexp, LANGSXP);
+	    		SET_TAG(m_sexp, R_NilValue);
+		}
+		
+	};
+	
+	Language::Language( const std::string& symbol ): RObject::RObject(R_NilValue) {
+		m_sexp = Rf_lcons( Symbol(symbol), R_NilValue ) ;
+		preserve() ;
+	}
+	
+	Language::Language( const Symbol& symbol ){
+		m_sexp = Rf_lcons( symbol, R_NilValue ) ;
+		preserve() ;
+	}
+	
+	Language::~Language(){}
+	
+	Language::not_compatible::not_compatible() throw() {}
+    	const char* Language::not_compatible::what() const throw(){
+    		return "cannot convert to call" ;
+    	}
+    	Language::not_compatible::~not_compatible() throw() {}
+    
+	
+	
+} // namespace Rcpp

Modified: pkg/src/Makevars
===================================================================
--- pkg/src/Makevars	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/src/Makevars	2010-01-03 08:53:19 UTC (rev 259)
@@ -25,7 +25,7 @@
 USERLIB	=	libRcpp$(DYLIB_EXT)
 USERLIBST =	libRcpp.a
 
-PKG_CPPFLAGS += -I.
+PKG_CPPFLAGS += -I. -std=c++0x
 
 userLibrary: 	$(USERLIB) $(USERLIBST)
 		- at if test ! -e $(USERDIR)$(R_ARCH); then mkdir -p $(USERDIR)$(R_ARCH); fi

Modified: pkg/src/RObject.cpp
===================================================================
--- pkg/src/RObject.cpp	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/src/RObject.cpp	2010-01-03 08:53:19 UTC (rev 259)
@@ -20,12 +20,22 @@
 // along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
 #include <Rcpp/RObject.h>
+#include <Rcpp/Environment.h>
+#include <Rcpp/Symbol.h>
 #include <algorithm>
 
 namespace Rcpp {
 
 RObject wrap(SEXP m_sexp=R_NilValue){
-    return RObject(m_sexp) ;
+	switch( TYPEOF(m_sexp) ){
+		case ENVSXP:
+			return Environment(m_sexp); 
+		case SYMSXP:
+			return Symbol(m_sexp) ;
+		default:
+			break ;
+	}
+	return RObject(m_sexp) ;
 }
 	
 RObject wrap(const bool & v){

Modified: pkg/src/Rcpp/Environment.h
===================================================================
--- pkg/src/Rcpp/Environment.h	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/src/Rcpp/Environment.h	2010-01-03 08:53:19 UTC (rev 259)
@@ -94,15 +94,72 @@
     		std::string message ;
     } ;
     
+    /**
+     * Exception thrown when attempting to convert a SEXP to 
+     * an environment using as.environment
+     */
+    class not_compatible: public std::exception{
+    	public:
+    		not_compatible() throw() ;
+    		
+    		/**
+    		 * The message: cannot convert to environment 
+    		 */
+    		const char* what() const throw() ;
+    		
+    		~not_compatible() throw() ;
+    	
+    } ;
+
+    /**
+     * Exception thrown when attempting to get an environment from a 
+     * name
+     */
+    class no_such_env: public std::exception{
+    	public:
+    		/**
+    		 * @param name name of the environment, e.g "package:Rcpp"
+    		 */
+    		no_such_env( const std::string& name) ;
+    		
+    		/**
+    		 * @paral pos search path position where there is no environment
+    		 */
+    		no_such_env(int pos) ;
+    		
+    		/**
+    		 * The message: no such environment : '{name}' 
+    		 */
+    		const char* what() const throw() ;
+    		
+    		~no_such_env() throw() ;
+    	private:
+    		std::string message ;
+    } ;
     
     /**
      * wraps the given environment
      *
      * if the SEXP is not an environment, and exception is thrown
      */
-    Environment(SEXP m_sexp) ;
+    Environment(SEXP x) throw(not_compatible);
     
     /**
+     * Gets the environment associated with the given name
+     *
+     * @param name name of the environment, e.g "package:Rcpp"
+     */
+    Environment( const std::string& name ) throw(no_such_env) ;
+    
+    /**
+     * Gets the environment in the given position of the search path
+     * 
+     * @param pos (1-based) position of the environment, e.g pos=1 gives the
+     *        global environment
+     */
+    Environment( int pos ) throw(no_such_env) ;
+    
+    /**
      * Nothing specific
      */ 
     ~Environment() ;

Modified: pkg/src/Rcpp/Evaluator.h
===================================================================
--- pkg/src/Rcpp/Evaluator.h	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/src/Rcpp/Evaluator.h	2010-01-03 08:53:19 UTC (rev 259)
@@ -32,10 +32,12 @@
 public:
     Evaluator(SEXP expression ) ;
     ~Evaluator() ;
-    void run(SEXP env) ;
+    void run(SEXP env) throw() ;
+    void run() throw() ;
     inline RObject getResult() const { return result ; }
     inline RObject getError() const { return error ; }
-	
+    inline bool successfull() const { return !error_occured ; }
+    
 private:		
     SEXP expression ;
     bool error_occured ;

Added: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h	                        (rev 0)
+++ pkg/src/Rcpp/Language.h	2010-01-03 08:53:19 UTC (rev 259)
@@ -0,0 +1,136 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Language.h: Rcpp R/C++ interface class library -- language objects (calls)
+//
+// Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp_Language_h
+#define Rcpp_Language_h
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+#include <Rcpp/Symbol.h>
+
+namespace Rcpp{ 
+
+/** 
+ * C++ wrapper around calls (LANGSXP SEXP)
+ *
+ * This represents calls that can be evaluated
+ */
+class Language : public RObject{
+public:
+	/**
+	 * Exception thrown when attempting to convert a SEXP to 
+	 * a call using as.call
+	 */
+	class not_compatible: public std::exception{
+		public:
+			not_compatible() throw() ;
+			
+			/**
+			 * The message: cannot convert to call 
+			 */
+			const char* what() const throw() ;
+			
+			~not_compatible() throw() ;
+		
+	} ;
+  	
+	/**
+	 * Attempts to convert the SEXP to a call
+	 *
+	 * @throw not_compatible if the SEXP could not be converted
+	 * to a call using as.call
+	 */
+	Language(SEXP lang) throw(not_compatible) ;
+	
+	/**
+	 * Creates a call using the given symbol as the function name
+	 *
+	 * @param symbol symbol name to call
+	 *
+	 * Language( "rnorm" ) makes a SEXP similar to this (expressed in R)
+	 * > as.call( as.list( as.name( "rnorm") ) )
+	 * > call( "rnorm" )
+	 */
+	Language( const std::string& symbol ); 
+	
+	/**
+	 * Creates a call using the given symbol as the function name
+	 *
+	 * @param symbol symbol name to call
+	 *
+	 * Language( Symbol("rnorm") ) makes a SEXP similar to this: 
+	 * > call( "rnorm" )
+	 */
+	Language( const Symbol& symbol ); 
+	
+	/**
+	 * Creates a call to the given symbol using variable number of 
+	 * arguments
+	 *
+	 * @param symbol symbol
+	 * @param ...Args variable length argument list. The type of each 
+	 *        argument must be wrappable, meaning there need to be 
+	 *        a wrap function that takes this type as its parameter
+	 * 
+	 * @example Language( "rnorm", 10, 0.0 ) 
+	 * will create the same call as 
+	 * > call( "rnorm", 10L, 0.0 )
+	 *
+	 * 10 is wrapped as an integer vector using wrap( const& int )
+	 * 0.0 is wrapped as a numeric vector using wrap( const& double )
+	 * ...
+	 */
+#ifdef CXX0X
+template<typename... Args> 
+	Language( const std::string& symbol, const Args&... args) : RObject(R_NilValue) {
+		SEXP x; 
+		PROTECT( x = Rf_lcons( Symbol(symbol), pack( args... ) ) );
+		m_sexp = x ;
+		UNPROTECT(1) ;
+		preserve() ;
+	}
+#endif	
+	~Language() ;
+
+private:
+	
+	/* recursive packing of the arguments into a list, 
+	  use first as the CAR and build the CDR from the remaining args recursively */
+#ifdef CXX0X
+	template<typename T, typename... Args>
+	SEXP pack( const T& first, const Args&... args ){
+		return Rf_cons( wrap(first), pack( args... ) ) ;
+	}
+#endif	
+	
+	/* end of the recursion, wrap first to make the CAR and use 
+	   R_NilValue as the CDR of the list */
+#ifdef CXX0X
+template<typename T>
+	SEXP pack( const T& first){
+		return Rf_cons( wrap(first), R_NilValue ) ; 
+	}
+#endif
+};
+
+} // namespace Rcpp
+
+#endif

Added: pkg/src/Rcpp/Symbol.h
===================================================================
--- pkg/src/Rcpp/Symbol.h	                        (rev 0)
+++ pkg/src/Rcpp/Symbol.h	2010-01-03 08:53:19 UTC (rev 259)
@@ -0,0 +1,75 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Symbol.h: Rcpp R/C++ interface class library -- access R environments
+//
+// Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp_Symbol_h
+#define Rcpp_Symbol_h
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+
+namespace Rcpp{ 
+
+class Symbol: public RObject{
+public:
+
+    /**
+     * Exception thrown when attempting to create a Symbol from a 
+     * SEXP that is not compatible
+     */
+    class not_compatible: public std::exception{
+    	public:
+    		not_compatible(int type) throw() ;
+    		
+    		/**
+    		 * The message: not compatible with Symbol
+    		 */
+    		const char* what() const throw();
+    		
+    		~not_compatible() throw() ;
+    		
+    	private:
+    		int type ;
+    } ;
+    	
+    /**
+     * wraps the SEXP into a Symbol object. 
+     * 
+     * @param m_sexp Accepted SEXP types are SYMSXP, CHARSXP and STRSXP
+     * in the last case, the first element of the character vector 
+     * is silently used
+     */
+    Symbol(SEXP x) throw(not_compatible) ;
+    
+    /**
+     *
+     */
+    Symbol(const std::string& symbol) ;
+    
+    /**
+     * Nothing specific
+     */ 
+    ~Symbol() ;
+
+};
+
+} // namespace Rcpp
+
+#endif

Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/src/Rcpp.h	2010-01-03 08:53:19 UTC (rev 259)
@@ -45,6 +45,8 @@
 #include <Rcpp/RObject.h>
 #include <Rcpp/XPtr.h>
 #include <Rcpp/Environment.h>
-#include <Rcpp/Evaluator.h> 
+#include <Rcpp/Evaluator.h>
+#include <Rcpp/Symbol.h>
+#include <Rcpp/Language.h>
 
 #endif

Modified: pkg/src/RcppCommon.cpp
===================================================================
--- pkg/src/RcppCommon.cpp	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/src/RcppCommon.cpp	2010-01-03 08:53:19 UTC (rev 259)
@@ -40,3 +40,32 @@
     Rprintf("%s:%d %s\n", file, line, expression);
 }
 
+SEXP test_variadic() {
+	SEXP res = PROTECT( Rf_allocVector(INTSXP, 5) ) ; 
+#ifdef CXX0X
+	INTEGER(res)[0] = variadic_length() ; 
+	INTEGER(res)[1] = variadic_length(1) ;
+	INTEGER(res)[2] = variadic_length(1, 3.3) ;
+	INTEGER(res)[3] = variadic_length(1, "foo", 'f') ;
+	INTEGER(res)[4] = variadic_length(1, 2, 2.3f, "foo", std::string("foobar") ) ;
+#else
+	INTEGER(res)[0] = 0 ; 
+	INTEGER(res)[1] = 1 ;
+	INTEGER(res)[2] = 2 ;
+	INTEGER(res)[3] = 3 ;
+	INTEGER(res)[4] = 4 ;
+#endif
+	UNPROTECT(1) ;
+	return res;
+}
+
+SEXP canUseCXX0X(){
+	SEXP res ;
+#ifdef CXX0X
+	return Rf_ScalarLogical( TRUE ) ;
+#else
+	return Rf_ScalarLogical( FALSE ) ;
+#endif
+}
+
+

Modified: pkg/src/RcppCommon.h
===================================================================
--- pkg/src/RcppCommon.h	2010-01-03 01:24:38 UTC (rev 258)
+++ pkg/src/RcppCommon.h	2010-01-03 08:53:19 UTC (rev 259)
@@ -24,6 +24,10 @@
 #ifndef RcppCommon_h
 #define RcppCommon_h
 
+// TODO: need to bring this from the configure step
+//       but I have no idea how to do it
+#define CXX0X
+
 #include <exception>
 #include <iostream>
 #include <sstream>
@@ -40,7 +44,9 @@
 #include <Rinternals.h>
 #include <R_ext/Callbacks.h>
 #include <Rversion.h>
+#define GET_NAMES(x)	Rf_getAttrib(x, R_NamesSymbol)
 
+
 // #ifdef BUILDING_DLL
 // #define RcppExport extern "C" __declspec(dllexport)
 // #else
@@ -59,4 +65,13 @@
 void forward_uncaught_exceptions_to_r() ;
 RcppExport SEXP initUncaughtExceptionHandler() ; 
 
+/* just testing variadic templates */
+#ifdef CXX0X
+template<typename... Args>
+int variadic_length( const Args&... args) { return sizeof...(Args) ; }
 #endif
+
+RcppExport SEXP test_variadic() ; 
+RcppExport SEXP canUseCXX0X() ;
+
+#endif

Added: pkg/src/Symbol.cpp
===================================================================
--- pkg/src/Symbol.cpp	                        (rev 0)
+++ pkg/src/Symbol.cpp	2010-01-03 08:53:19 UTC (rev 259)
@@ -0,0 +1,61 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Symbol.cpp: Rcpp R/C++ interface class library -- Symbols
+//
+// Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#include <Rcpp/Symbol.h>
+
+namespace Rcpp {
+
+	Symbol::not_compatible::not_compatible(int type) throw() {}
+	Symbol::not_compatible::~not_compatible() throw() {}
+	const char* Symbol::not_compatible::what() const throw() {
+		return "not compatible with Symbol, excepting SYMSXP, CHARSXP or STRSXP" ;
+	}
+	
+	Symbol::Symbol( SEXP x = R_NilValue ) throw(not_compatible) : RObject::RObject(x) {
+		if( m_sexp != R_NilValue ){
+			int type = TYPEOF(m_sexp) ;
+			switch( type ){
+			case SYMSXP:
+				break; /* nothing to do */
+			case CHARSXP:
+				m_sexp = Rf_install(CHAR(m_sexp)) ;
+				break ;
+			case STRSXP:
+				{
+					/* FIXME: check that there is at least one element */
+					m_sexp = Rf_install( CHAR(STRING_ELT(m_sexp, 0 )) ) ;
+					break ;
+				}
+			default:
+				throw not_compatible(type) ;
+			}
+		}
+	}
+	
+	Symbol::Symbol(const std::string& symbol){
+		m_sexp = Rf_install(symbol.c_str()) ;
+		preserve() ;
+	}
+	
+	Symbol::~Symbol(){}
+	
+} // namespace Rcpp
+



More information about the Rcpp-commits mailing list