[Rcpp-devel] [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
_______________________________________________
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
More information about the Rcpp-devel
mailing list