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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jan 7 22:03:06 CET 2010


Author: romain
Date: 2010-01-07 22:03:05 +0100 (Thu, 07 Jan 2010)
New Revision: 308

Removed:
   pkg/src/Rcpp/pairlist.h
   pkg/src/pairlist.cpp
Modified:
   pkg/inst/unitTests/runit.Function.R
   pkg/src/Function.cpp
   pkg/src/Pairlist.cpp
   pkg/src/Rcpp/Function.h
   pkg/src/Rcpp/Language.h
   pkg/src/Rcpp/Pairlist.h
Log:
added Function::environment(), moved pairlist.{h,cpp} files (lower case) to upper case files to avoid file collisions

Modified: pkg/inst/unitTests/runit.Function.R
===================================================================
--- pkg/inst/unitTests/runit.Function.R	2010-01-07 18:19:14 UTC (rev 307)
+++ pkg/inst/unitTests/runit.Function.R	2010-01-07 21:03:05 UTC (rev 308)
@@ -47,3 +47,16 @@
 	}
 }
 
+test.Function.env <- function(){
+	funx <- cfunction(signature(x="function"), '
+	Function fun(x) ;
+	return fun.environment() ;
+	', Rcpp=TRUE, verbose=FALSE, 
+	includes = "using namespace Rcpp;" )
+	checkEquals( funx(rnorm), asNamespace("stats" ), msg = "Function::environment" )
+	checkException( funx(is.function), 
+		msg = "Function::environment( builtin) : exception" )
+	checkException( funx(`~`), 
+		msg = "Function::environment( special) : exception" )
+}
+

Modified: pkg/src/Function.cpp
===================================================================
--- pkg/src/Function.cpp	2010-01-07 18:19:14 UTC (rev 307)
+++ pkg/src/Function.cpp	2010-01-07 21:03:05 UTC (rev 308)
@@ -27,6 +27,10 @@
 
 namespace Rcpp {
 	
+	const char* Function::not_a_closure::what() throw(){
+		return "not a closure" ; 
+	}
+	
 	Function::Function( SEXP x = R_NilValue ) throw(not_compatible) : RObject::RObject( ){
 		switch( TYPEOF(x) ){
 		case CLOSXP:
@@ -41,4 +45,11 @@
 	
 	Function::~Function(){}	
 	
+	Environment Function::environment() const throw(not_a_closure){
+		if( TYPEOF(m_sexp) != CLOSXP ) {
+			throw not_a_closure() ;
+		}
+		return Environment( CLOENV(m_sexp) ) ;
+	}
+	
 } // namespace Rcpp

Modified: pkg/src/Pairlist.cpp
===================================================================
--- pkg/src/Pairlist.cpp	2010-01-07 18:19:14 UTC (rev 307)
+++ pkg/src/Pairlist.cpp	2010-01-07 21:03:05 UTC (rev 308)
@@ -51,5 +51,6 @@
 	
 	Pairlist::~Pairlist(){}
 	
+	SEXP pairlist(){ return R_NilValue ; }
 	
 } // namespace Rcpp

Modified: pkg/src/Rcpp/Function.h
===================================================================
--- pkg/src/Rcpp/Function.h	2010-01-07 18:19:14 UTC (rev 307)
+++ pkg/src/Rcpp/Function.h	2010-01-07 21:03:05 UTC (rev 308)
@@ -24,7 +24,7 @@
 
 #include <RcppCommon.h>
 #include <Rcpp/RObject.h>
-#include <Rcpp/pairlist.h>
+#include <Rcpp/Pairlist.h>
 #include <Rcpp/Evaluator.h>
 
 namespace Rcpp{ 
@@ -34,6 +34,17 @@
  */
 class Function : public RObject{
 public:
+
+	/**
+	 * thrown when attempting to get/set the environment of 
+	 * a function that is a not a closure (CLOSXP)
+	 */
+	class not_a_closure : public std::exception{
+	public:
+		not_a_closure() throw() {} ;
+		~not_a_closure() throw() {} ;
+		const char* what() throw() ;
+	} ;
 	
 	/**
 	 * Attempts to convert the SEXP to a pair list
@@ -42,8 +53,8 @@
 	 * to a pair list using as.pairlist
 	 */
 	Function(SEXP lang) throw(not_compatible) ;
-	
-	
+
+
 	/**
 	 * calls the function with the specified arguments
 	 *
@@ -67,8 +78,13 @@
 			return evaluator.getError() ;
 		}
 	}
-#endif	
+#endif
 	
+	/**
+	 * Returns the environment of this function
+	 */
+	Environment environment() const throw(not_a_closure) ;
+	
 	~Function() ;
 };
 

Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h	2010-01-07 18:19:14 UTC (rev 307)
+++ pkg/src/Rcpp/Language.h	2010-01-07 21:03:05 UTC (rev 308)
@@ -25,7 +25,7 @@
 #include <RcppCommon.h>
 #include <Rcpp/RObject.h>
 #include <Rcpp/Symbol.h>
-#include <Rcpp/pairlist.h>
+#include <Rcpp/Pairlist.h>
 
 namespace Rcpp{ 
 

Modified: pkg/src/Rcpp/Pairlist.h
===================================================================
--- pkg/src/Rcpp/Pairlist.h	2010-01-07 18:19:14 UTC (rev 307)
+++ pkg/src/Rcpp/Pairlist.h	2010-01-07 21:03:05 UTC (rev 308)
@@ -24,7 +24,6 @@
 
 #include <RcppCommon.h>
 #include <Rcpp/RObject.h>
-#include <Rcpp/pairlist.h>
 
 namespace Rcpp{ 
 
@@ -67,6 +66,21 @@
 	~Pairlist() ;
 };
 
+#ifdef HAS_VARIADIC_TEMPLATES
+	SEXP pairlist() ;
+	template<typename T, typename... Args>
+	SEXP pairlist( const T& first, const Args&... args ){
+		return grow(first, pairlist(args...) ) ;
+	}
+ 	/* end of the recursion, wrap first to make the CAR and use 
+ 	   R_NilValue as the CDR of the list */
+	template<typename T>
+	SEXP pairlist( const T& first){
+		return grow(first, R_NilValue ) ; 
+	}
+#endif
+
+
 } // namespace Rcpp
 
 #endif

Deleted: pkg/src/Rcpp/pairlist.h
===================================================================
--- pkg/src/Rcpp/pairlist.h	2010-01-07 18:19:14 UTC (rev 307)
+++ pkg/src/Rcpp/pairlist.h	2010-01-07 21:03:05 UTC (rev 308)
@@ -1,48 +0,0 @@
-// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
-//
-// pairlist.h: Rcpp R/C++ interface class library -- variadic templates to create pairlists
-//
-// 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_pairlist_h
-#define Rcpp_pairlist_h
-
-#include <RcppCommon.h>
-#include <Rcpp/Named.h>
-#include <Rcpp/grow.h>
-
-namespace Rcpp{
-	/* recursive packing of the arguments into a list, 
-	  use first as the CAR and build the CDR from the remaining args recursively */
-#ifdef HAS_VARIADIC_TEMPLATES
-	SEXP pairlist() ;
-	template<typename T, typename... Args>
-	SEXP pairlist( const T& first, const Args&... args ){
-		return grow(first, pairlist(args...) ) ;
-	}
- 	/* end of the recursion, wrap first to make the CAR and use 
- 	   R_NilValue as the CDR of the list */
-	template<typename T>
-	SEXP pairlist( const T& first){
-		return grow(first, R_NilValue ) ; 
-	}
-#endif
-
-} // namespace Rcpp
-
-#endif

Deleted: pkg/src/pairlist.cpp
===================================================================
--- pkg/src/pairlist.cpp	2010-01-07 18:19:14 UTC (rev 307)
+++ pkg/src/pairlist.cpp	2010-01-07 21:03:05 UTC (rev 308)
@@ -1,28 +0,0 @@
-// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
-//
-// pairlist.cpp: Rcpp R/C++ interface class library -- variadic templates to create pairlists
-//
-// 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/pairlist.h>
-
-namespace Rcpp{
-	
-	SEXP pairlist(){ return R_NilValue ; }
-	
-} // namespace Rcpp



More information about the Rcpp-commits mailing list