[Rcpp-commits] r512 - in pkg: inst/unitTests src src/Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jan 29 16:26:47 CET 2010
Author: romain
Date: 2010-01-29 16:26:46 +0100 (Fri, 29 Jan 2010)
New Revision: 512
Removed:
pkg/src/Rcpp/as.h
pkg/src/Rcpp/wrap.h
Modified:
pkg/inst/unitTests/runit.RObject.R
pkg/inst/unitTests/runit.environments.R
pkg/src/CharacterVector.cpp
pkg/src/Dimension.cpp
pkg/src/Evaluator.cpp
pkg/src/Function.cpp
pkg/src/Promise.cpp
pkg/src/RObject.cpp
pkg/src/Rcpp.h
pkg/src/Rcpp/CharacterVector.h
pkg/src/Rcpp/DottedPair.h
pkg/src/Rcpp/Environment.h
pkg/src/Rcpp/Evaluator.h
pkg/src/Rcpp/ExpressionVector.h
pkg/src/Rcpp/Function.h
pkg/src/Rcpp/GenericVector.h
pkg/src/Rcpp/Language.h
pkg/src/Rcpp/LogicalVector.h
pkg/src/Rcpp/Named.h
pkg/src/Rcpp/Pairlist.h
pkg/src/Rcpp/Promise.h
pkg/src/Rcpp/RObject.h
pkg/src/Rcpp/SEXP_Vector.h
pkg/src/Rcpp/SimpleVector.h
pkg/src/Rcpp/Symbol.h
pkg/src/Rcpp/VectorBase.h
pkg/src/Rcpp/WeakReference.h
pkg/src/Rcpp/XPtr.h
pkg/src/Rcpp/clone.h
pkg/src/Rcpp/r_cast.h
pkg/src/RcppCommon.cpp
pkg/src/RcppCommon.h
pkg/src/RcppSexp.h
pkg/src/SimpleVector.cpp
pkg/src/VectorBase.cpp
pkg/src/WeakReference.cpp
pkg/src/as.cpp
pkg/src/wrap.cpp
Log:
discovering template meta programming and traits, will send an email later
Modified: pkg/inst/unitTests/runit.RObject.R
===================================================================
--- pkg/inst/unitTests/runit.RObject.R 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/inst/unitTests/runit.RObject.R 2010-01-29 15:26:46 UTC (rev 512)
@@ -25,11 +25,11 @@
test.RObject.asDouble <- function(){
foo <- '
- double d = Rcpp::wrap(x).asDouble();
- return(Rcpp::wrap( 2*d ) );
+ double d = as<double>(x);
+ return(wrap( 2*d ) );
'
funx <- cfunction(signature(x="numeric"), foo,
- Rcpp=TRUE, verbose=FALSE)
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
checkEquals( funx(2.123), 4.246, msg = "RObject.asDouble()" )
checkEquals( funx(2), 4, msg = "RObject.asDouble()" )
checkException( funx(x='2'), msg = "RObject.asDouble() can not convert character" )
@@ -39,10 +39,10 @@
test.RObject.asInt <- function(){
foo <- '
- int i = Rcpp::wrap(x).asInt();
- return(Rcpp::wrap( 2*i ) ); '
+ int i = as<int>(x) ;
+ return(wrap( 2*i ) ); '
funx <- cfunction(signature(x="numeric"), foo,
- Rcpp=TRUE, verbose=FALSE)
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
checkEquals( funx(2.123), 4L, msg = "RObject.asInt()" )
checkEquals( funx(2), 4L, msg = "RObject.asInt()" )
checkEquals( funx(2L), 4.0, msg = "RObject.asInt()" )
@@ -54,10 +54,10 @@
test.RObject.asStdString <- function(){
foo <- '
- std::string s = Rcpp::wrap(x).asStdString();
- return(Rcpp::wrap( s+s ) );'
+ std::string s = as<std::string>(x) ;
+ return(wrap( s+s ) );'
funx <- cfunction(signature(x="character"), foo,
- Rcpp=TRUE, verbose=FALSE)
+ Rcpp=TRUE, verbose=FALSE , includes = "using namespace Rcpp;")
checkEquals( funx("abc"), "abcabc", msg = "RObject.asStdString()" )
checkException( funx(NULL), msg = "RObject.asStdString expects string" )
checkException( funx(0L), msg = "RObject.asStdString expects string" )
@@ -70,9 +70,10 @@
test.RObject.asRaw <- function(){
foo <- '
- Rbyte i = Rcpp::wrap(x).asRaw();
- return(Rcpp::wrap( (Rbyte)(2*i) ) ); '
- funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
+ Rbyte i = as<Rbyte>(x);
+ return(wrap( (Rbyte)(2*i) ) ); '
+ funx <- cfunction(signature(x="raw"), foo,
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
checkEquals( funx(1L), as.raw(2L), msg = "RObject.asRaw(integer)" )
checkEquals( funx(1.3), as.raw(2L), msg = "RObject.asRaw(numeric)" )
checkEquals( funx(as.raw(1)), as.raw(2L), msg = "RObject.asRaw(raw)" )
@@ -88,9 +89,10 @@
test.RObject.asLogical <- function(){
foo <- '
- bool b = Rcpp::wrap(x).asBool();
- return(Rcpp::wrap( !b ));'
- funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
+ bool b = as<bool>(x);
+ return(wrap( !b ));'
+ funx <- cfunction(signature(x="logical"), foo,
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
checkTrue( !funx(TRUE), msg = "RObject::asBool(TRUE) -> true" )
checkTrue( funx(FALSE), msg = "RObject::asBool(FALSE) -> false" )
checkTrue( !funx(1L), msg = "RObject::asBool(1L) -> true" )
@@ -113,14 +115,15 @@
test.RObject.asStdVectorIntResultsSet <- function(){
foo <- '
- std::vector<int> iv = Rcpp::wrap(x).asStdVectorInt();
+ std::vector<int> iv = RObject(x).asStdVectorInt();
for (size_t i=0; i<iv.size(); i++) {
iv[i] = 2*iv[i];
}
RcppResultSet rs;
rs.add("", iv);
return(rs.getSEXP());'
- funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+ funx <- cfunction(signature(x="numeric"), foo,
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
checkEquals( funx(x=2:5), 2:5*2L, msg = "RObject(integer).asStdVectorInt via RcppResultSet" )
checkEquals( funx(x=2:5+.1), 2:5*2L, msg = "RObject(numeric).asStdVectorInt via RcppResultSet" )
checkEquals( funx(x=as.raw(2:5)), 2:5*2L, msg = "RObject(raw).asStdVectorInt via RcppResultSet" )
@@ -129,14 +132,15 @@
}
test.RObject.asStdVectorInt <- function(){
- foo <- '
- std::vector<int> iv = Rcpp::wrap(x).asStdVectorInt();
- for (size_t i=0; i<iv.size(); i++) {
- iv[i] = 2*iv[i];
- }
- return(Rcpp::wrap( iv ) );'
- funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
- checkEquals( funx(x=2:5), 2:5*2L, msg = "RObject(integer).asStdVectorInt" )
+ foo <- '
+ std::vector<int> iv = RObject(x).asStdVectorInt();
+ for (size_t i=0; i<iv.size(); i++) {
+ iv[i] = 2*iv[i];
+ }
+ return(Rcpp::wrap( iv ) );'
+ funx <- cfunction(signature(x="numeric"), foo,
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
+ checkEquals( funx(x=2:5), 2:5*2L, msg = "RObject(integer).asStdVectorInt" )
checkEquals( funx(x=2:5+.1), 2:5*2L, msg = "RObject(numeric).asStdVectorInt" )
checkEquals( funx(x=as.raw(2:5)), 2:5*2L, msg = "RObject(raw).asStdVectorInt" )
checkException( funx("foo"), msg = "RObject(character).asStdVectorInt -> exception" )
@@ -146,12 +150,13 @@
test.RObject.asStdVectorDouble <- function(){
foo <- '
- std::vector<double> iv = Rcpp::wrap(x).asStdVectorDouble();
+ std::vector<double> iv = RObject(x).asStdVectorDouble();
for (size_t i=0; i<iv.size(); i++) {
iv[i] = 2*iv[i];
}
return(Rcpp::wrap( iv ));'
- funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
+ funx <- cfunction(signature(x="numeric"), foo,
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
checkEquals( funx(x=0.1+2:5), 2*(0.1+2:5), msg = "RObject(numeric).asStdVectorDouble" )
checkEquals( funx(x=2:5), 2*(2:5), msg = "RObject(integer).asStdVectorDouble" )
checkEquals( funx(x=as.raw(2:5)), 2*(2:5), msg = "RObject(raw).asStdVectorDouble" )
@@ -162,12 +167,13 @@
test.RObject.asStdVectorRaw <- function(){
foo <- '
- std::vector<Rbyte> iv = Rcpp::wrap(x).asStdVectorRaw();
+ std::vector<Rbyte> iv = RObject(x).asStdVectorRaw();
for (size_t i=0; i<iv.size(); i++) {
iv[i] = 2*iv[i];
}
return(Rcpp::wrap( iv ));'
- funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
+ funx <- cfunction(signature(x="raw"), foo,
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
checkEquals( funx(x=as.raw(0:9)), as.raw(2*(0:9)), msg = "RObject(raw).asStdVectorRaw" )
checkEquals( funx(x=0:9), as.raw(2*(0:9)), msg = "RObject(integer).asStdVectorRaw" )
checkEquals( funx(x=as.numeric(0:9)), as.raw(2*(0:9)), msg = "RObject(numeric).asStdVectorRaw" )
@@ -178,12 +184,13 @@
test.RObject.asStdVectorBool <- function(){
foo <- '
- std::vector<bool> bv = Rcpp::wrap(x).asStdVectorBool();
+ std::vector<bool> bv = RObject(x).asStdVectorBool();
for (size_t i=0; i<bv.size(); i++) {
bv[i].flip() ;
}
return(Rcpp::wrap( bv ));'
- funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
+ funx <- cfunction(signature(x="logical"), foo,
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
checkEquals( funx(x=c(TRUE,FALSE)), c(FALSE, TRUE), msg = "RObject(logical).asStdVectorBool" )
checkEquals( funx(x=c(1L, 0L)), c(FALSE, TRUE), msg = "RObject(integer).asStdVectorBool" )
checkEquals( funx(x=c(1.0, 0.0)), c(FALSE, TRUE), msg = "RObject(numeric).asStdVectorBool" )
@@ -194,12 +201,13 @@
test.RObject.asStdVectorString <- function(){
foo <- '
- std::vector<std::string> iv = Rcpp::wrap(x).asStdVectorString();
+ std::vector<std::string> iv = RObject(x).asStdVectorString();
for (size_t i=0; i<iv.size(); i++) {
iv[i] = iv[i] + iv[i];
}
return(Rcpp::wrap( iv ));'
- funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
+ funx <- cfunction(signature(x="character"), foo,
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
checkEquals( funx(c("foo", "bar")), c("foofoo", "barbar"), msg = "RObject(character).asStdVectorString" )
checkException( funx(1L), msg = "RObject(integer).asStdVectorString -> exception" )
checkException( funx(1.0), msg = "RObject(numeric).asStdVectorString -> exception" )
@@ -254,24 +262,25 @@
test.RObject.attributeNames <- function(){
funx <- cfunction(signature(x="data.frame"), '
- std::vector<std::string> iv = Rcpp::wrap(x).attributeNames();
- return(Rcpp::wrap( iv ));',
- Rcpp=TRUE, verbose=FALSE)
+ std::vector<std::string> iv = RObject(x).attributeNames();
+ return(wrap( iv ));',
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
checkTrue( all( c("names","row.names","class") %in% funx(iris)), msg = "RObject.attributeNames" )
}
test.RObject.hasAttribute <- function(){
funx <- cfunction(signature(x="data.frame"), '
- bool has_class = Rcpp::wrap(x).hasAttribute( "class" ) ;
- return Rcpp::wrap( has_class ) ;',
- Rcpp=TRUE, verbose=FALSE)
+ bool has_class = RObject(x).hasAttribute( "class" ) ;
+ return wrap( has_class ) ;',
+ Rcpp=TRUE, verbose=FALSE,
+ includes = "using namespace Rcpp;")
checkTrue( funx( iris ), msg = "RObject.hasAttribute" )
}
test.RObject.attr <- function(){
funx <- cfunction(signature(x="data.frame"), '
- return Rcpp::wrap(x).attr( "row.names" ) ;
- ', Rcpp=TRUE, verbose=FALSE)
+ return RObject(x).attr( "row.names" ) ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
checkEquals( funx( iris ), 1:150, msg = "RObject.attr" )
}
@@ -285,9 +294,9 @@
test.RObject.isNULL <- function(){
funx <- cfunction(signature(x="ANY"), '
- bool is_null = Rcpp::wrap(x).isNULL() ;
- return Rcpp::wrap( is_null ) ;
- ', Rcpp=TRUE, verbose=FALSE)
+ bool is_null = RObject(x).isNULL() ;
+ return wrap( is_null ) ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
checkTrue( !funx( iris ), msg = "RObject.isNULL(iris) -> false" )
checkTrue( funx(NULL), msg = "RObject.isNULL(NULL) -> true" )
checkTrue( !funx(1L), msg = "RObject.isNULL(integer) -> false" )
Modified: pkg/inst/unitTests/runit.environments.R
===================================================================
--- pkg/inst/unitTests/runit.environments.R 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/inst/unitTests/runit.environments.R 2010-01-29 15:26:46 UTC (rev 512)
@@ -47,9 +47,9 @@
test.environment.get <- function(){
funx <- cfunction(signature(x="environment", name = "character" ), '
- Rcpp::Environment env(x) ;
- return env.get( Rcpp::wrap(name).asStdString() ) ;
- ', Rcpp=TRUE, verbose=FALSE)
+ Environment env(x) ;
+ return env.get( as<std::string>(name) ) ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
e <- new.env( )
e$a <- 1:10
@@ -64,10 +64,10 @@
test.environment.exists <- function(){
funx <- cfunction(signature(x="environment", name = "character" ), '
- Rcpp::Environment env(x) ;
- std::string st = Rcpp::wrap(name).asStdString() ;
- return Rcpp::wrap( env.exists(st) ) ;
- ', Rcpp=TRUE, verbose=FALSE)
+ Environment env(x) ;
+ std::string st = as< std::string >(name) ;
+ return wrap( env.exists( st ) ) ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
e <- new.env( )
e$a <- 1:10
@@ -82,10 +82,10 @@
test.environment.assign <- function(){
funx <- cfunction(signature(x="environment", name = "character", object = "ANY" ), '
- Rcpp::Environment env(x) ;
- std::string st = Rcpp::wrap(name).asStdString() ;
- return Rcpp::wrap( env.assign(st, object) ) ;
- ', Rcpp=TRUE, verbose=FALSE)
+ Environment env(x) ;
+ std::string st = as< std::string>(name) ;
+ return wrap( env.assign(st, object) ) ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
e <- new.env( )
checkTrue( funx(e, "a", 1:10 ), msg = "Environment::assign" )
@@ -101,22 +101,22 @@
}
-test.environment.assign.templated <- function(){
-
- funx <- cfunction(signature(x="environment", name = "character", object = "ANY" ), '
- Rcpp::Environment env(x) ;
- std::string st = Rcpp::wrap(name).asStdString() ;
- return Rcpp::wrap( env.assign(st, object) ) ;
- ', Rcpp=TRUE, verbose=FALSE)
-
- e <- new.env( )
-
-
-}
+## test.environment.assign.templated <- function(){
+##
+## funx <- cfunction(signature(x="environment", name = "character", object = "ANY" ), '
+## Environment env(x) ;
+## std::string st = as<std::string>(name) ;
+## return wrap( env.assign(st, object) ) ;
+## ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+##
+## e <- new.env( )
+##
+##
+## }
test.environment.isLocked <- function(){
funx <- cfunction(signature(x="environment" ), '
- Rcpp::Environment env(x) ;
+ Environment env(x) ;
env.assign( "x1", 1 ) ;
env.assign( "x2", 10.0 ) ;
env.assign( "x3", std::string( "foobar" ) ) ;
@@ -124,7 +124,7 @@
std::vector< std::string > aa(2) ; aa[0] = "foo" ; aa[1] = "bar" ;
env.assign( "x5", aa ) ;
return R_NilValue ;
- ', Rcpp=TRUE, verbose=FALSE)
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
e <- new.env()
funx(e)
@@ -138,10 +138,10 @@
test.environment.bindingIsActive <- function(){
funx <- cfunction(signature(x="environment", name = "character" ), '
- Rcpp::Environment env(x) ;
- std::string st = Rcpp::wrap(name).asStdString() ;
- return Rcpp::wrap( env.bindingIsActive(st) ) ;
- ', Rcpp=TRUE, verbose=FALSE)
+ Environment env(x) ;
+ std::string st = as<std::string>(name);
+ return wrap( env.bindingIsActive(st) ) ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
e <- new.env()
e$a <- 1:10
@@ -158,10 +158,10 @@
test.environment.bindingIsLocked <- function(){
funx <- cfunction(signature(x="environment", name = "character" ), '
- Rcpp::Environment env(x) ;
- std::string st = Rcpp::wrap(name).asStdString() ;
- return Rcpp::wrap( env.bindingIsLocked(st) ) ;
- ', Rcpp=TRUE, verbose=FALSE)
+ Environment env(x) ;
+ std::string st = as<std::string>(name) ;
+ return wrap( env.bindingIsLocked(st) ) ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
e <- new.env()
e$a <- 1:10
@@ -188,11 +188,11 @@
test.environment.lockBinding <- function(){
funx <- cfunction(signature(x="environment", name = "character" ), '
- Rcpp::Environment env(x) ;
- std::string st = Rcpp::wrap(name).asStdString() ;
+ Environment env(x) ;
+ std::string st = as<std::string>(name) ;
env.lockBinding( st ) ;
return R_NilValue ;
- ', Rcpp=TRUE, verbose=FALSE)
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
e <- new.env()
e$a <- 1:10
@@ -207,11 +207,11 @@
test.environment.unlockBinding <- function(){
funx <- cfunction(signature(x="environment", name = "character" ), '
- Rcpp::Environment env(x) ;
- std::string st = Rcpp::wrap(name).asStdString() ;
+ Environment env(x) ;
+ std::string st = as<std::string>(name) ;
env.unlockBinding( st ) ;
return R_NilValue ;
- ', Rcpp=TRUE, verbose=FALSE)
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
e <- new.env()
e$a <- 1:10
@@ -251,8 +251,9 @@
test.environment.namespace.env <- function(){
funx <- cfunction(signature(env = "character" ), '
- std::string st = Rcpp::wrap(env).asStdString() ;
- return Rcpp::Environment::namespace_env(st); ', Rcpp=TRUE, verbose=FALSE)
+ std::string st = as<std::string>(env) ;
+ return Environment::namespace_env(st); ',
+ Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
checkEquals( funx("Rcpp"), asNamespace("Rcpp"), msg = "REnvironment::base_namespace" )
checkTrue(
tryCatch( { funx("----" ) ; FALSE}, "Rcpp::Environment::no_such_namespace" = function(e) TRUE ),
Modified: pkg/src/CharacterVector.cpp
===================================================================
--- pkg/src/CharacterVector.cpp 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/CharacterVector.cpp 2010-01-29 15:26:46 UTC (rev 512)
@@ -20,7 +20,6 @@
// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
#include <Rcpp/CharacterVector.h>
-#include <Rcpp/wrap.h>
namespace Rcpp{
@@ -106,5 +105,11 @@
return StringProxy(*this, offset(i,j) ) ;
}
+// template<> SEXP wrap(const char& v){ return CharacterVector(v); }
+SEXP wrap(const char* const v){ return CharacterVector(v); }
+template<> SEXP wrap(const std::string & v){ return CharacterVector(v); }
+template<> SEXP wrap(const std::vector<std::string> & v){ return CharacterVector(v); }
+
+
} // namespace
Modified: pkg/src/Dimension.cpp
===================================================================
--- pkg/src/Dimension.cpp 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Dimension.cpp 2010-01-29 15:26:46 UTC (rev 512)
@@ -20,8 +20,6 @@
// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
#include <Rcpp/Dimension.h>
-#include <Rcpp/as.h>
-#include <Rcpp/wrap.h>
namespace Rcpp{
@@ -47,7 +45,10 @@
}
Dimension::operator SEXP() const {
- return wrap( dims ) ;
+ SEXP x = PROTECT(Rf_allocVector(INTSXP,dims.size())) ;
+ std::copy( dims.begin(), dims.end(), INTEGER(x) ) ;
+ UNPROTECT(1) ; /* x */
+ return x ;
}
int Dimension::size() const {
@@ -62,5 +63,5 @@
if( i < 0 || i>=static_cast<int>(dims.size()) ) throw std::range_error("index out of bounds") ;
return dims.at(i) ;
}
-
+
} // namespace Rcpp
Modified: pkg/src/Evaluator.cpp
===================================================================
--- pkg/src/Evaluator.cpp 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Evaluator.cpp 2010-01-29 15:26:46 UTC (rev 512)
@@ -57,13 +57,20 @@
return run(expr, R_GlobalEnv );
}
-
namespace internal{
/* this is defined here because we need to be sure that Evaluator is
defined */
SEXP convert_using_rfunction(SEXP x, const char* const fun){
return Evaluator::run( Rf_lcons( Rf_install(fun), Rf_cons(x, R_NilValue) ) ) ;
}
+
+ SEXP try_catch( SEXP expr, SEXP env ){
+ return Evaluator::run(expr, env) ;
+ }
+ SEXP try_catch( SEXP expr ){
+ return Evaluator::run(expr) ;
+ }
+
} // namespace internal
} // namespace Rcpp
Modified: pkg/src/Function.cpp
===================================================================
--- pkg/src/Function.cpp 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Function.cpp 2010-01-29 15:26:46 UTC (rev 512)
@@ -26,8 +26,11 @@
const char* Function::not_a_closure::what() const throw(){
return "not a closure" ;
}
+ const char* Function::no_such_function::what() const throw(){
+ return "no such function" ;
+ }
- Function::Function( SEXP x = R_NilValue ) throw(not_compatible) : RObject::RObject( ){
+ Function::Function( SEXP x = R_NilValue ) throw(not_compatible) : RObject( ){
switch( TYPEOF(x) ){
case CLOSXP:
case SPECIALSXP:
@@ -39,13 +42,18 @@
}
};
+ Function::Function(const std::string& name) throw(no_such_function) : RObject() {
+ SEXP x = PROTECT( Rf_findFun( Rf_install(name.c_str()), R_GlobalEnv ) ) ;
+ setSEXP( x ) ;
+ }
+
Function::~Function(){}
- Environment Function::environment() const throw(not_a_closure){
+ SEXP Function::environment() const throw(not_a_closure){
if( TYPEOF(m_sexp) != CLOSXP ) {
throw not_a_closure() ;
}
- return Environment( CLOENV(m_sexp) ) ;
+ return CLOENV(m_sexp) ;
}
} // namespace Rcpp
Modified: pkg/src/Promise.cpp
===================================================================
--- pkg/src/Promise.cpp 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Promise.cpp 2010-01-29 15:26:46 UTC (rev 512)
@@ -39,10 +39,10 @@
return PRSEEN(m_sexp);
}
- RObject Promise::value() const throw(unevaluated_promise) {
+ SEXP Promise::value() const throw(unevaluated_promise) {
SEXP val = PRVALUE(m_sexp) ;
if( val == R_UnboundValue ) throw unevaluated_promise() ;
- return wrap( val ) ;
+ return val ;
}
bool Promise::was_evaluated() const {
Modified: pkg/src/RObject.cpp
===================================================================
--- pkg/src/RObject.cpp 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/RObject.cpp 2010-01-29 15:26:46 UTC (rev 512)
@@ -19,12 +19,7 @@
// 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/RObject.h>
-#include <Rcpp/Environment.h>
-#include <Rcpp/Symbol.h>
-#include <algorithm>
-#include <Rcpp/as.h>
-#include <Rcpp/wrap.h>
+#include <RcppCommon.h>
namespace Rcpp {
Modified: pkg/src/Rcpp/CharacterVector.h
===================================================================
--- pkg/src/Rcpp/CharacterVector.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/CharacterVector.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,10 +23,9 @@
#define Rcpp_CharacterVector_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
#include <Rcpp/VectorBase.h>
-#include <Rcpp/r_cast.h>
#include <Rcpp/Dimension.h>
+#include <Rcpp/r_cast.h>
namespace Rcpp{
Modified: pkg/src/Rcpp/DottedPair.h
===================================================================
--- pkg/src/Rcpp/DottedPair.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/DottedPair.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,10 +23,9 @@
#define Rcpp_DottedPair_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
+
#include <Rcpp/Symbol.h>
#include <Rcpp/grow.h>
-#include <Rcpp/wrap.h>
#include <Rcpp/Named.h>
namespace Rcpp{
@@ -147,8 +146,7 @@
template <typename T>
Proxy& operator=(const T& rhs){
- SEXP y = wrap(rhs) ;
- SETCAR( node, y ) ;
+ SETCAR( node, wrap(rhs) ) ;
return *this ;
}
Proxy& operator=(const Named& rhs) ;
Modified: pkg/src/Rcpp/Environment.h
===================================================================
--- pkg/src/Rcpp/Environment.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/Environment.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,12 +23,10 @@
#define Rcpp_Environment_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
+
#include <Rcpp/Evaluator.h>
-#include <Rcpp/wrap.h>
#include <Rcpp/Symbol.h>
#include <Rcpp/Language.h>
-#include <Rcpp/as.h>
namespace Rcpp{
@@ -358,8 +356,7 @@
*/
template <typename WRAPPABLE>
bool assign( const std::string& name, const WRAPPABLE& x) const throw(binding_is_locked){
- SEXP y = wrap( x ).asSexp() ;
- return assign( name, y ) ;
+ return assign( name, wrap( x ) ) ;
}
/**
Modified: pkg/src/Rcpp/Evaluator.h
===================================================================
--- pkg/src/Rcpp/Evaluator.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/Evaluator.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,8 +23,7 @@
#define Rcpp_Evaluator_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
-#include <Rcpp/wrap.h>
+
#include <Rcpp/Environment.h>
namespace Rcpp{
Modified: pkg/src/Rcpp/ExpressionVector.h
===================================================================
--- pkg/src/Rcpp/ExpressionVector.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/ExpressionVector.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,7 +23,6 @@
#define Rcpp_ExpressionVector_h
#include <RcppCommon.h>
-#include <Rcpp/wrap.h>
#include <Rcpp/SEXP_Vector.h>
namespace Rcpp{
Modified: pkg/src/Rcpp/Function.h
===================================================================
--- pkg/src/Rcpp/Function.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/Function.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,13 +23,9 @@
#define Rcpp_Function_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
-#include <Rcpp/Pairlist.h>
-#include <Rcpp/Evaluator.h>
-#include <Rcpp/Language.h>
-#include <Rcpp/as.h>
-#include <Rcpp/Environment.h>
+#include <Rcpp/grow.h>
+
namespace Rcpp{
/**
@@ -50,15 +46,40 @@
} ;
/**
+ * thrown when attempting to find a function that
+ * does not exist.
+ */
+ class no_such_function : public std::exception{
+ public:
+ no_such_function() throw(){};
+ virtual ~no_such_function() throw(){}
+ virtual const char* what() const throw() ;
+ } ;
+
+ /**
* Attempts to convert the SEXP to a pair list
*
* @throw not_compatible if the SEXP could not be converted
* to a pair list using as.pairlist
*/
Function(SEXP lang) throw(not_compatible) ;
-
-
+
/**
+ * Finds a function, searching from the global environment
+ *
+ * @param name name of the function
+ */
+ Function(const std::string& name) throw(no_such_function) ;
+
+ // /**
+ // * Finds a function, searching from a specific environment
+ // *
+ // * @param name name of the function
+ // * @param env environment where to find it
+ // */
+ // Function(const std::string& name, SEXP env ) ;
+
+ /**
* calls the function with the specified arguments
*
* @param ...Args variable length argument list. The type of each
@@ -68,15 +89,15 @@
*/
#ifdef HAS_VARIADIC_TEMPLATES
template<typename... Args>
- SEXP operator()( const Args&... args) throw(Evaluator::eval_error){
- return Evaluator::run( Rf_lcons( m_sexp, pairlist(args...) ) ) ;
+ SEXP operator()( const Args&... args) /* throw(Evaluator::eval_error) */ {
+ return internal::try_catch( Rf_lcons( m_sexp, pairlist(args...) ) ) ;
}
#endif
/**
* Returns the environment of this function
*/
- Environment environment() const throw(not_a_closure) ;
+ SEXP environment() const throw(not_a_closure) ;
~Function() ;
};
Modified: pkg/src/Rcpp/GenericVector.h
===================================================================
--- pkg/src/Rcpp/GenericVector.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/GenericVector.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,7 +23,6 @@
#define Rcpp_GenericVector_h
#include <RcppCommon.h>
-#include <Rcpp/wrap.h>
#include <Rcpp/SEXP_Vector.h>
namespace Rcpp{
@@ -31,10 +30,6 @@
typedef SEXP_Vector<VECSXP> GenericVector ;
typedef GenericVector List ;
-#ifdef HAS_INIT_LISTS
-inline GenericVector wrap(std::initializer_list<SEXP> list ){ return GenericVector(list) ; }
-#endif
-
} // namespace
#endif
Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/Language.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -24,10 +24,10 @@
#include <RcppCommon.h>
#include <Rcpp/DottedPair.h>
-#include <Rcpp/RObject.h>
#include <Rcpp/Symbol.h>
+#include <Rcpp/Function.h>
#include <Rcpp/grow.h>
-#include <Rcpp/wrap.h>
+#include <Rcpp/r_cast.h>
namespace Rcpp{
@@ -70,6 +70,11 @@
*/
explicit Language( const Symbol& symbol );
+ // /**
+ // * Creates a call to the given function
+ // */
+ // explicit Language( const Function& function ) ;
+
/**
* Creates a call to the given symbol using variable number of
* arguments
@@ -90,8 +95,12 @@
#ifdef HAS_VARIADIC_TEMPLATES
template<typename... Args>
Language( const std::string& symbol, const Args&... args) : DottedPair(Rf_install(symbol.c_str()), args...) {
- update() ;
- }
+ update() ;
+}
+//template<typename... Args>
+//Language( const Function& function, const Args&... args) : DottedPair(function.asSexp(), args...) {
+// update() ;
+//}
#endif
/**
Modified: pkg/src/Rcpp/LogicalVector.h
===================================================================
--- pkg/src/Rcpp/LogicalVector.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/LogicalVector.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -24,7 +24,6 @@
#include <RcppCommon.h>
#include <Rcpp/SimpleVector.h>
-#include <Rcpp/as.h>
namespace Rcpp{
@@ -55,6 +54,7 @@
} ;
+
} // namespace
#endif
Modified: pkg/src/Rcpp/Named.h
===================================================================
--- pkg/src/Rcpp/Named.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/Named.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,7 +23,7 @@
#define Rcpp_Named_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
+
#include <Rcpp/Symbol.h>
namespace Rcpp{
@@ -50,7 +50,7 @@
Named( const std::string& tag ) : object(R_NilValue), tag(tag){} ;
template<typename T>
- Named( const std::string& tag, const T& value ) : object(R_NilValue), tag(tag) {
+ Named( const std::string& tag, const T& value ) : object(), tag(tag) {
object = wrap( value ) ;
}
Modified: pkg/src/Rcpp/Pairlist.h
===================================================================
--- pkg/src/Rcpp/Pairlist.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/Pairlist.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -24,6 +24,7 @@
#include <RcppCommon.h>
#include <Rcpp/DottedPair.h>
+#include <Rcpp/r_cast.h>
namespace Rcpp{
Modified: pkg/src/Rcpp/Promise.h
===================================================================
--- pkg/src/Rcpp/Promise.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/Promise.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,11 +23,10 @@
#define Rcpp_Promise_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
+
#include <Rcpp/ExpressionVector.h>
#include <Rcpp/Environment.h>
-
namespace Rcpp{
class Promise : public RObject {
@@ -50,7 +49,7 @@
/**
* Return the result of the PRVALUE macro on the promise
*/
- RObject value() const throw(unevaluated_promise) ;
+ SEXP value() const throw(unevaluated_promise) ;
bool was_evaluated() const ;
Modified: pkg/src/Rcpp/RObject.h
===================================================================
--- pkg/src/Rcpp/RObject.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/RObject.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,12 +23,10 @@
#define Rcpp_RObject_h
#include <RcppCommon.h>
-#include <Rcpp/as.h>
-#include <set>
namespace Rcpp{
-class RObject{
+class RObject {
public:
/**
Modified: pkg/src/Rcpp/SEXP_Vector.h
===================================================================
--- pkg/src/Rcpp/SEXP_Vector.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/SEXP_Vector.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -25,6 +25,7 @@
#include <RcppCommon.h>
#include <Rcpp/VectorBase.h>
#include <Rcpp/Environment.h>
+#include <Rcpp/Dimension.h>
namespace Rcpp{
Modified: pkg/src/Rcpp/SimpleVector.h
===================================================================
--- pkg/src/Rcpp/SimpleVector.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/SimpleVector.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,16 +23,13 @@
#define Rcpp_SimpleVector_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
+
#include <Rcpp/VectorBase.h>
#include <Rcpp/r_cast.h>
#include <Rcpp/Dimension.h>
namespace Rcpp{
-template <int RTYPE,typename CTYPE> CTYPE get_zero(){ return static_cast<CTYPE>(0) ; } ;
-template<> Rcomplex get_zero<CPLXSXP,Rcomplex>() ;
-
template <int sexptype, typename T> T* get_pointer(SEXP x){ throw std::exception( "not implemented" ) ; return static_cast<T*>(0); }
template<> double* get_pointer<REALSXP,double>(SEXP x) ;
template<> int* get_pointer<INTSXP,int>(SEXP x) ;
@@ -104,7 +101,7 @@
virtual void update(){ start = get_pointer<RTYPE,CTYPE>(m_sexp) ; }
void init(){
- CTYPE zero = get_zero<RTYPE,CTYPE>() ;
+ CTYPE zero = internal::get_zero<RTYPE,CTYPE>() ;
init( zero ) ;
}
void init( const CTYPE& value){
Modified: pkg/src/Rcpp/Symbol.h
===================================================================
--- pkg/src/Rcpp/Symbol.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/Symbol.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,7 +23,6 @@
#define Rcpp_Symbol_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
namespace Rcpp{
Modified: pkg/src/Rcpp/VectorBase.h
===================================================================
--- pkg/src/Rcpp/VectorBase.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/VectorBase.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,7 +23,7 @@
#define Rcpp_VectorBase_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
+
#include <Rcpp/r_cast.h>
namespace Rcpp{
Modified: pkg/src/Rcpp/WeakReference.h
===================================================================
--- pkg/src/Rcpp/WeakReference.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/WeakReference.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,7 +23,6 @@
#define Rcpp_WeakReference_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
namespace Rcpp{
@@ -46,12 +45,12 @@
/**
* Retrieve the key
*/
- RObject key() const ;
+ SEXP key() ;
/**
* Retrieve the value
*/
- RObject value() const ;
+ SEXP value() ;
} ;
Modified: pkg/src/Rcpp/XPtr.h
===================================================================
--- pkg/src/Rcpp/XPtr.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/XPtr.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -23,7 +23,6 @@
#define Rcpp_XPtr_h
#include <RcppCommon.h>
-#include <Rcpp/RObject.h>
namespace Rcpp{
Deleted: pkg/src/Rcpp/as.h
===================================================================
--- pkg/src/Rcpp/as.h 2010-01-28 19:14:55 UTC (rev 511)
+++ pkg/src/Rcpp/as.h 2010-01-29 15:26:46 UTC (rev 512)
@@ -1,106 +0,0 @@
-// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
-//
-// as.h: Rcpp R/C++ interface class library -- generic converters from SEXP
-//
-// 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_as_h
-#define Rcpp_as_h
-
-#include <RcppCommon.h>
-#include <algorithm>
-
-namespace Rcpp{
-
-/**
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rcpp -r 512
More information about the Rcpp-commits
mailing list