[Rcpp-devel] [Rcpp-commits] r260 - in pkg: R inst src src/Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jan 3 12:30:08 CET 2010
Author: romain
Date: 2010-01-03 12:30:08 +0100 (Sun, 03 Jan 2010)
New Revision: 260
Modified:
pkg/R/RcppLdpath.R
pkg/inst/ChangeLog
pkg/src/Environment.cpp
pkg/src/Evaluator.cpp
pkg/src/Language.cpp
pkg/src/RObject.cpp
pkg/src/Rcpp/Environment.h
pkg/src/Rcpp/Language.h
pkg/src/Rcpp/RObject.h
pkg/src/Rcpp/XPtr.h
pkg/src/RcppSexp.h
pkg/src/Symbol.cpp
Log:
cleanup the GC system
Modified: pkg/R/RcppLdpath.R
===================================================================
--- pkg/R/RcppLdpath.R 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/R/RcppLdpath.R 2010-01-03 11:30:08 UTC (rev 260)
@@ -30,7 +30,7 @@
## Provide compiler flags -- i.e. -I/path/to/Rcpp.h
RcppCxxFlags <- function() {
- paste("-I", RcppLdPath(), if( canUseCXX0X ) " -std=c++0x" else "", 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 08:53:19 UTC (rev 259)
+++ pkg/inst/ChangeLog 2010-01-03 11:30:08 UTC (rev 260)
@@ -1,5 +1,15 @@
2010-01-03 Romain Francois <francoisromain at free.fr>
+ * src/Rcpp/RObject.h: rework the garbage collection mechanism so that
+ it is automatic and hidden. methods preserve and release are now
+ private to the RObject class and the SEXP may only be changed using
+ the protected setSEXP member function. isPreserved and forgetPreserve
+ are defunct.
+
+ * src/Rcpp/RObject.h: RObject gains assignment operators and copy constructors
+
+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
Modified: pkg/src/Environment.cpp
===================================================================
--- pkg/src/Environment.cpp 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/src/Environment.cpp 2010-01-03 11:30:08 UTC (rev 260)
@@ -45,19 +45,14 @@
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{
+ if( ! Rf_isEnvironment(x) ) {
/* 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() ;
+ setSEXP( evaluator.getResult().asSexp() ) ;
} else{
throw not_compatible( ) ;
}
@@ -67,34 +62,39 @@
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 ;
+ setSEXP( R_GlobalEnv ) ;
} else if( name == "package:base" ){
- m_sexp = R_BaseEnv ;
+ setSEXP( 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() ;
+ setSEXP( evaluator.getResult().asSexp() ) ;
} else{
throw no_such_env(name) ;
}
}
}
- Environment::Environment(int pos) throw(no_such_env) : RObject(R_EmptyEnv){
+ Environment::Environment(int pos) throw(no_such_env) : RObject(R_GlobalEnv){
Evaluator evaluator( Rf_lang2(Symbol("as.environment"), Rf_ScalarInteger(pos) ) ) ;
evaluator.run() ;
if( evaluator.successfull() ){
- m_sexp = evaluator.getResult() ;
- preserved = true ;
- evaluator.getResult().forgetPreserve() ;
+ setSEXP( evaluator.getResult() ) ;
} else{
throw no_such_env(pos) ;
}
}
+ Environment::Environment( const Environment& other ) throw() {
+ setSEXP( other.asSexp() ) ;
+ }
+
+ Environment& Environment::operator=(const Environment& other) throw() {
+ setSEXP( other.asSexp() ) ;
+ return *this ;
+ }
+
Environment::~Environment(){
logTxt( "~Environment" ) ;
}
Modified: pkg/src/Evaluator.cpp
===================================================================
--- pkg/src/Evaluator.cpp 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/src/Evaluator.cpp 2010-01-03 11:30:08 UTC (rev 260)
@@ -27,8 +27,8 @@
Evaluator::Evaluator( SEXP expression = R_NilValue) :
expression(expression),
error_occured(false),
- result(R_NilValue),
- error(R_NilValue) {}
+ result(),
+ error() {}
Evaluator::~Evaluator(){}
@@ -36,11 +36,9 @@
Environment rcpp = Environment::namespace_env("Rcpp") ;
SEXP call = Rf_lang3( Rf_install("protectedEval"), expression, env ) ;
result = wrap( Rf_eval( call, rcpp ) );
- result.preserve() ;
error_occured = LOGICAL( Rf_eval( Rf_lang1( Rf_install("errorOccured")) , rcpp) )[0] ;
if( error_occured ){
error = wrap( Rf_eval( Rf_lang1(Rf_install("getCurrentError")) , rcpp) );
- error.preserve() ;
}
}
Modified: pkg/src/Language.cpp
===================================================================
--- pkg/src/Language.cpp 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/src/Language.cpp 2010-01-03 11:30:08 UTC (rev 260)
@@ -25,14 +25,14 @@
namespace Rcpp {
- Language::Language( SEXP lang = R_NilValue ) throw(not_compatible) : RObject::RObject(lang){
+ Language::Language( SEXP lang = R_NilValue ) throw(not_compatible) : RObject::RObject( ){
/* if this is not trivially a call, then try to convert it to one */
- if( m_sexp != R_NilValue && TYPEOF(m_sexp) != LANGSXP ){
+ if( lang != R_NilValue && TYPEOF(lang) != LANGSXP ){
/* taken from do_ascall */
switch( TYPEOF(lang) ){
case LISTSXP :
- m_sexp = Rf_duplicate( lang ) ;
+ Rf_duplicate( lang ) ;
break ;
case VECSXP:
case EXPRSXP:
@@ -40,33 +40,35 @@
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 ) ) ;
+ SEXP res, ap;
+ PROTECT( ap = res = 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))));
+ 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) ;
+ setSEXP(res) ;
}
default:
throw not_compatible() ;
}
SET_TYPEOF(m_sexp, LANGSXP);
SET_TAG(m_sexp, R_NilValue);
+ } else{
+ setSEXP( lang ) ;
}
};
Language::Language( const std::string& symbol ): RObject::RObject(R_NilValue) {
- m_sexp = Rf_lcons( Symbol(symbol), R_NilValue ) ;
- preserve() ;
+ setSEXP( Rf_lcons( Symbol(symbol), R_NilValue ) );
}
Language::Language( const Symbol& symbol ){
- m_sexp = Rf_lcons( symbol, R_NilValue ) ;
- preserve() ;
+ setSEXP( Rf_lcons( symbol, R_NilValue ) ) ;
}
Language::~Language(){}
Modified: pkg/src/RObject.cpp
===================================================================
--- pkg/src/RObject.cpp 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/src/RObject.cpp 2010-01-03 11:30:08 UTC (rev 260)
@@ -26,6 +26,44 @@
namespace Rcpp {
+void RObject::setSEXP(SEXP x){
+ /* if we are setting to the same SEXP as we already have, do nothing */
+ if( x != m_sexp ){
+
+ /* the previous SEXP was not NULL, so release it */
+ release() ;
+
+ /* set the SEXP */
+ m_sexp = x ;
+
+ /* the new SEXP is not NULL, so preserve it */
+ preserve() ;
+ }
+}
+
+/* copy constructor */
+RObject::RObject( const RObject& other ){
+ SEXP x = other.asSexp() ;
+ setSEXP( x ) ;
+}
+
+RObject& RObject::operator=( const RObject& other){
+ SEXP x = other.asSexp() ;
+ setSEXP( x ) ;
+ return *this ;
+}
+
+RObject& RObject::operator=( SEXP other ){
+ setSEXP( other ) ;
+ return *this ;
+}
+
+RObject::~RObject() {
+ release() ;
+ logTxt("~RObject");
+}
+
+
RObject wrap(SEXP m_sexp=R_NilValue){
switch( TYPEOF(m_sexp) ){
case ENVSXP:
@@ -41,35 +79,30 @@
RObject wrap(const bool & v){
logTxt("RObject from bool\n");
RObject o(Rf_ScalarLogical(v));
- o.preserve() ;
return o ;
}
RObject wrap(const double & v){
logTxt("RObject from double\n");
RObject o(Rf_ScalarReal(v));
- o.preserve() ;
return o ;
}
RObject wrap(const int & v){
logTxt("RObject from int\n");
RObject o(Rf_ScalarInteger(v));
- o.preserve() ;
return o ;
}
RObject wrap(const Rbyte & v){
logTxt("RObject from raw\n");
RObject o(Rf_ScalarRaw(v));
- o.preserve() ;
return o ;
}
RObject wrap(const std::string & v){
logTxt("RObject from std::string\n");
RObject o(Rf_mkString(v.c_str()));
- o.preserve() ;
return o ;
}
@@ -79,7 +112,6 @@
SEXP m_sexp = PROTECT( Rf_allocVector(LGLSXP, n) );
copy( v.begin(), v.end(), LOGICAL(m_sexp) ) ;
RObject o(m_sexp) ;
- o.preserve() ;
UNPROTECT(1) ; /* m_sexp now preserved by o */
return o ;
}
@@ -90,7 +122,6 @@
SEXP m_sexp = PROTECT( Rf_allocVector(INTSXP, n) );
copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
RObject o(m_sexp) ;
- o.preserve() ;
UNPROTECT(1) ;
return o ;
}
@@ -101,7 +132,6 @@
SEXP m_sexp = PROTECT( Rf_allocVector(REALSXP, n) );
copy( v.begin(), v.end(), REAL(m_sexp) ) ;
RObject o(m_sexp) ;
- o.preserve() ;
UNPROTECT(1) ;
return o ;
}
@@ -112,7 +142,6 @@
SEXP m_sexp = PROTECT(Rf_allocVector(RAWSXP, n));
copy( v.begin(), v.end(), RAW(m_sexp) ) ;
RObject o(m_sexp) ;
- o.preserve() ;
UNPROTECT(1) ;
return o ;
}
@@ -129,7 +158,6 @@
it++;
}
RObject o(m_sexp) ;
- o.preserve() ;
UNPROTECT(1) ;
return o ;
}
@@ -142,7 +170,6 @@
SEXP m_sexp = Rf_allocVector(INTSXP, n);
copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
RObject o(m_sexp) ;
- o.preserve() ;
UNPROTECT(1) ;
return o ;
}
@@ -153,7 +180,6 @@
SEXP m_sexp = Rf_allocVector(REALSXP, n);
copy( v.begin(), v.end(), REAL(m_sexp) ) ;
RObject o(m_sexp) ;
- o.preserve() ;
UNPROTECT(1) ;
return o ;
}
@@ -164,7 +190,6 @@
SEXP m_sexp = Rf_allocVector(RAWSXP, n);
copy( v.begin(), v.end(), RAW(m_sexp) ) ;
RObject o(m_sexp) ;
- o.preserve() ;
UNPROTECT(1) ;
return o ;
}
@@ -181,16 +206,10 @@
it++;
}
RObject o(m_sexp) ;
- o.preserve() ;
UNPROTECT(1) ;
return o ;
}
-RObject::~RObject() {
- logTxt("~RObject");
- release() ;
-}
-
double RObject::asDouble() const {
if (Rf_length(m_sexp) != 1) {
throw std::range_error("RObject::asDouble expects single value");
@@ -379,23 +398,6 @@
return v;
}
-void RObject::preserve(){
- if( !preserved ){
- preserved = true ;
- R_PreserveObject( m_sexp );
- }
-}
-
-void RObject::release(){
- if( preserved ){
- R_ReleaseObject(m_sexp);
- }
-}
-
-void RObject::forgetPreserve(){
- preserved = false ;
-}
-
std::vector<std::string> RObject::attributeNames() const {
/* inspired from do_attributes at attrib.c */
Modified: pkg/src/Rcpp/Environment.h
===================================================================
--- pkg/src/Rcpp/Environment.h 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/src/Rcpp/Environment.h 2010-01-03 11:30:08 UTC (rev 260)
@@ -145,6 +145,16 @@
Environment(SEXP x) throw(not_compatible);
/**
+ * copy constructor
+ */
+ Environment(const Environment& other) throw() ;
+
+ /**
+ * assignment
+ */
+ Environment& operator=(const Environment& other) throw();
+
+ /**
* Gets the environment associated with the given name
*
* @param name name of the environment, e.g "package:Rcpp"
Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/src/Rcpp/Language.h 2010-01-03 11:30:08 UTC (rev 260)
@@ -101,11 +101,8 @@
#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() ;
+ /* TODO: should we first allocate and protect the list ?*/
+ setSEXP( Rf_lcons( Symbol(symbol), pack( args... ) ) );
}
#endif
~Language() ;
Modified: pkg/src/Rcpp/RObject.h
===================================================================
--- pkg/src/Rcpp/RObject.h 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/src/Rcpp/RObject.h 2010-01-03 11:30:08 UTC (rev 260)
@@ -29,26 +29,46 @@
class RObject{
public:
+
+ /**
+ * default constructor. uses R_NilValue
+ */
+ RObject() : m_sexp(R_NilValue) {} ;
/**
- * wraps a SEXP. The SEXP is not automatically
- * protected from garbage collection because it might be
- * protected from elsewhere (e.g. if it comes from the
- * R side).
- *
- * See preserve and release for ways to protect
- * the SEXP from garbage collection, and release to
- * remove the protection
+ * wraps a SEXP. The SEXP is automatically protected from garbage
+ * collection by this object and the protection vanishes when this
+ * object is destroyed
*/
- RObject(SEXP m_sexp = R_NilValue) : m_sexp(m_sexp), preserved(false){};
+ RObject(SEXP x) : m_sexp(R_NilValue) { setSEXP(x) ; };
/**
+ * Copy constructor. set this SEXP to the SEXP of the copied object
+ */
+ RObject( const RObject& other ) ;
+
+ /**
+ * Assignment operator. set this SEXP to the SEXP of the copied object
+ */
+ RObject& operator=( const RObject& other ) ;
+
+ /**
+ * Assignement operator. Set this SEXP to the given SEXP
+ */
+ RObject& operator=( SEXP other ) ;
+
+ /**
* if this object is protected rom R's GC, then it is released
* and become subject to garbage collection. See preserve
* and release member functions.
*/
~RObject() ;
+ /**
+ * implicit conversion to SEXP
+ */
+ inline operator SEXP() const { return m_sexp ; }
+
/* we don't provide implicit converters because
of Item 5 in More Effective C++ */
bool asBool() const;
@@ -62,52 +82,9 @@
std::vector<Rbyte> asStdVectorRaw() const;
std::vector<bool> asStdVectorBool() const;
+ inline bool isPreserved() { DEFUNCT("isPreserved") ; return m_sexp != R_NilValue ; }
+ inline void forgetPreserve() { DEFUNCT("forgetPreserve") ; }
- /**
- * protects the wrapped SEXP from garbage collection. This
- * calls the R_PreserveObject function on the underlying SEXP.
- *
- * Note that this does not use the PROTECT/UNPROTECT dance
- */
- void preserve();
-
- /**
- * explicitely release this object to R garbage collection. This
- * calls the R_ReleaseObject function on the underlying SEXP.
- * This is automatically done by the destructor if we protected
- * the SEXP (using the protect member function)
- */
- void release();
-
- /**
- * Indicates if the underlying SEXP is preserved by this object
- */
- inline bool isPreserved() const{ return preserved ; }
-
- /**
- * when this object goes out of scope, if the wrapped SEXP is currently
- * protected from R's garbage collection, it becomes subject to garbage
- * collection.
- *
- * This method allows this object to forget that it is preserving
- * the SEXP.
- *
- * This can be used when we want some other RObject to assume ownership
- * of the SEXP. This needs to be used with EXTRA care. If the SEXP
- * was preserved by one object and the protection was not passed to another,
- * there is a great chance that there will be memory leaks.
- *
- * This might be improved later, possibly with using shared smart pointer
- * or by doing what auto_ptr does with the assignment operator
- */
- void forgetPreserve() ;
-
- /**
- * implicit conversion to SEXP
- */
- inline operator SEXP() const { return m_sexp ; }
-
-
/* attributes */
/**
@@ -128,7 +105,7 @@
/**
* is this object NULL
*/
- inline bool isNULL() const{ return m_sexp == R_NilValue ; }
+ inline bool isNULL() const{ return Rf_isNull(m_sexp) ; }
/**
* The SEXP typeof, calls TYPEOF on the underlying SEXP
@@ -142,21 +119,27 @@
protected:
-
+
/**
- * The SEXP this is wrapping
+ * sets the SEXP wrapped by this object
+ *
+ * @param x new SEXP to attach to this object
*/
- SEXP m_sexp ;
-
+ void setSEXP(SEXP x) ;
+
+ inline void DEFUNCT(const std::string& method ){ Rf_warning("method %s is defunct", method.c_str() ) ; }
+
/**
- * true if this protects the SEXP from garbage collection
- * using R_ReleaseObject/R_PreserveObject strategy
- *
- * if this is true then the object will be release and become
- * subject to R garbage collection when this object is deleted
+ * The SEXP this is wrapping. This has to be considered read only.
+ * to change it, use setSEXP
*/
- bool preserved ;
+ SEXP m_sexp ;
+private:
+
+ void preserve(){ if( m_sexp != R_NilValue ) R_PreserveObject(m_sexp) ; }
+ void release() { if( m_sexp != R_NilValue ) R_ReleaseObject(m_sexp) ; }
+
};
// factories
Modified: pkg/src/Rcpp/XPtr.h
===================================================================
--- pkg/src/Rcpp/XPtr.h 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/src/Rcpp/XPtr.h 2010-01-03 11:30:08 UTC (rev 260)
@@ -48,15 +48,14 @@
/**
* creates a new external pointer wrapping the dumb pointer p.
- * This calls R_PreserveObject to prevent the external pointer
- * from R garbage collection
*
* @param p dumb pointer to some object
* @param set_delete_finalizer if set to true, a finalizer will
* be registered for the external pointer. The finalizer
* is called when the xp is garbage collected. The finalizer
* is merely a call to the delete operator or the pointer
- * so you need to make sure the pointer can be deleted.
+ * so you need to make sure the pointer can be "delete" d
+ * this way (has to be a C++ object)
*/
explicit XPtr(T* p, bool set_delete_finalizer) ;
@@ -92,11 +91,10 @@
template<typename T>
XPtr<T>::XPtr(T* p, bool set_delete_finalizer = true) : RObject::RObject() {
- m_sexp = R_MakeExternalPtr( (void*)p , R_NilValue, R_NilValue) ;
+ setSEXP( R_MakeExternalPtr( (void*)p , R_NilValue, R_NilValue) ) ;
if( set_delete_finalizer ){
setDeleteFinalizer() ;
}
- preserve() ;
}
template<typename T>
Modified: pkg/src/RcppSexp.h
===================================================================
--- pkg/src/RcppSexp.h 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/src/RcppSexp.h 2010-01-03 11:30:08 UTC (rev 260)
@@ -83,13 +83,13 @@
* Calls the preserve method of the wrapped RObject, which
* prevents the underlying SEXP from being garbage collected
*/
- inline void protect(){ object.preserve() ; }
+ inline void protect(){ /* object.preserve() ; */ }
/**
* calls the release method of the RObject. the underlying SEXP
* becomes subject of garbage collection
*/
- inline void release() { object.release() };
+ inline void release() { /* object.release() */ };
/**
* implicit conversion to SEXP
Modified: pkg/src/Symbol.cpp
===================================================================
--- pkg/src/Symbol.cpp 2010-01-03 08:53:19 UTC (rev 259)
+++ pkg/src/Symbol.cpp 2010-01-03 11:30:08 UTC (rev 260)
@@ -29,30 +29,31 @@
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) ;
+ Symbol::Symbol( SEXP x = R_NilValue ) throw(not_compatible) : RObject::RObject() {
+ if( x != R_NilValue ){
+ int type = TYPEOF(x) ;
switch( type ){
case SYMSXP:
break; /* nothing to do */
case CHARSXP:
- m_sexp = Rf_install(CHAR(m_sexp)) ;
+ setSEXP( Rf_install(CHAR(x)) ) ;
break ;
case STRSXP:
{
/* FIXME: check that there is at least one element */
- m_sexp = Rf_install( CHAR(STRING_ELT(m_sexp, 0 )) ) ;
+ setSEXP( Rf_install( CHAR(STRING_ELT(x, 0 )) ) );
break ;
}
default:
throw not_compatible(type) ;
}
+ } else {
+ setSEXP( x ) ;
}
}
Symbol::Symbol(const std::string& symbol){
- m_sexp = Rf_install(symbol.c_str()) ;
- preserve() ;
+ setSEXP( Rf_install(symbol.c_str()) );
}
Symbol::~Symbol(){}
_______________________________________________
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