[Rcpp-commits] r223 - pkg/src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Dec 29 16:53:04 CET 2009


Author: romain
Date: 2009-12-29 16:53:03 +0100 (Tue, 29 Dec 2009)
New Revision: 223

Added:
   pkg/src/exceptions.cpp
Removed:
   pkg/src/exception_handling.cpp
Modified:
   pkg/src/RcppSexp.cpp
   pkg/src/RcppSexp.h
   pkg/src/RcppXPtr.h
Log:
no problem

Modified: pkg/src/RcppSexp.cpp
===================================================================
--- pkg/src/RcppSexp.cpp	2009-12-29 15:20:19 UTC (rev 222)
+++ pkg/src/RcppSexp.cpp	2009-12-29 15:53:03 UTC (rev 223)
@@ -22,42 +22,43 @@
 
 #include <RcppSexp.h>
 #include <algorithm>
+#include <RcppSuperClass.h>
 
 RcppSexp::RcppSexp(const bool & v) {
     logTxt("RcppSexp from bool\n");
     m_sexp = Rf_ScalarLogical(v);
-    R_PreserveObject(m_sexp);
+    protect() ;
 }
 
 RcppSexp::RcppSexp(const double & v) {
     logTxt("RcppSexp from double\n");
     m_sexp = Rf_ScalarReal(v);
-    R_PreserveObject(m_sexp);
+    protect() ;
 }
 
 RcppSexp::RcppSexp(const int & v) {
     logTxt("RcppSexp from int\n");
     m_sexp = Rf_ScalarInteger(v);
-    R_PreserveObject(m_sexp);
+    protect() ;
 }
 
 RcppSexp::RcppSexp(const Rbyte & v) {
     logTxt("RcppSexp from raw\n");
     m_sexp = Rf_ScalarRaw(v);
-    R_PreserveObject(m_sexp);
+    protect() ;
 }
 
 RcppSexp::RcppSexp(const std::string & v) {
     logTxt("RcppSexp from std::string\n");
     m_sexp = Rf_mkString(v.c_str());
-    R_PreserveObject(m_sexp);
+    protect() ;
 }
 
 RcppSexp::RcppSexp(const std::vector<bool> & v) {
     logTxt("RcppSexp from bool vector\n");
     int n = v.size();
     m_sexp = Rf_allocVector(LGLSXP, n);
-    R_PreserveObject(m_sexp);
+    protect() ;
     copy( v.begin(), v.end(), LOGICAL(m_sexp) ) ;
 }
 
@@ -65,7 +66,7 @@
     logTxt("RcppSexp from int vector\n");
     int n = v.size();
     m_sexp = Rf_allocVector(INTSXP, n);
-    R_PreserveObject(m_sexp);
+    protect() ;
     copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
 }
 
@@ -73,7 +74,7 @@
     logTxt("RcppSexp from double vector\n");
     int n = v.size();
     m_sexp = Rf_allocVector(REALSXP, n);
-    R_PreserveObject(m_sexp);
+    protect() ;
     copy( v.begin(), v.end(), REAL(m_sexp) ) ;
 }
 
@@ -81,9 +82,7 @@
     logTxt("RcppSexp from vector<Rbyte> \n");
     int n = v.size();
     m_sexp = Rf_allocVector(RAWSXP, n);
-    R_PreserveObject(m_sexp);
-    // copy the content of the byte vector 
-    // into the raw vector
+    protect() ;
     copy( v.begin(), v.end(), RAW(m_sexp) ) ;
 }
 
@@ -91,7 +90,7 @@
     logTxt("RcppSexp from std::string vector\n");
     int n = v.size();
     m_sexp = Rf_allocVector(STRSXP, n);
-    R_PreserveObject(m_sexp);
+    protect() ;
     int i=0; 
     std::vector<std::string>::const_iterator it = v.begin() ;
     while( i<n ){
@@ -107,7 +106,7 @@
     logTxt("RcppSexp from set<int>\n");
     int n = v.size();
     m_sexp = Rf_allocVector(INTSXP, n);
-    R_PreserveObject(m_sexp);
+    protect() ;
     copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
 }
 
@@ -115,7 +114,7 @@
     logTxt("RcppSexp from set<double>\n");
     int n = v.size();
     m_sexp = Rf_allocVector(REALSXP, n);
-    R_PreserveObject(m_sexp);
+    protect() ;
     copy( v.begin(), v.end(), REAL(m_sexp) ) ;
 }
 
@@ -123,9 +122,7 @@
     logTxt("RcppSexp from set<Rbyte> \n");
     int n = v.size();
     m_sexp = Rf_allocVector(RAWSXP, n);
-    R_PreserveObject(m_sexp);
-    // copy the content of the byte vector 
-    // into the raw vector
+    protect() ;
     copy( v.begin(), v.end(), RAW(m_sexp) ) ;
 }
 
@@ -133,8 +130,8 @@
     logTxt("RcppSexp from set<string>\n");
     int n = v.size();
     m_sexp = Rf_allocVector(STRSXP, n);
-    R_PreserveObject(m_sexp);
-    int i=0; 
+    protect() ;
+    int i=0;
     std::set<std::string>::iterator it = v.begin(); 
     while( i<n ){
     	SET_STRING_ELT(m_sexp, i, Rf_mkChar(it->c_str()));
@@ -143,13 +140,8 @@
     }
 }
 
-
-
-
-
 RcppSexp::~RcppSexp() {
-    logTxt("dtor");
-    R_ReleaseObject(m_sexp);
+    logTxt("~RcppSexp");
 }
 
 double RcppSexp::asDouble() const {
@@ -238,10 +230,6 @@
     return std::string(CHAR(STRING_ELT(m_sexp,0)));
 }
 
-SEXP RcppSexp::asSexp() const {
-    return m_sexp;
-}
-
 std::vector<bool> RcppSexp::asStdVectorBool() const {
     int n = Rf_length(m_sexp);
     std::vector<bool> v(n);
@@ -344,6 +332,28 @@
     return v;
 }
 
+
+
+
+
+RcppSexp::~RcppSexp() {
+    logTxt( "~RcppSexp" ) ;
+	release() ;
+}
+
+void RcppSexp::protect(){
+	if( !isProtected ){
+		isProtected = true ;
+		R_PreserveObject( m_sexp ); 
+	}
+}
+
+void RcppSexp::release(){
+	if( isProtected ){
+		R_ReleaseObject(m_sexp); 
+	}
+}
+
 std::vector<std::string> RcppSexp::attributeNames() const {
 	/* inspired from do_attributes at attrib.c */
 	
@@ -367,16 +377,7 @@
     return false; /* give up */
 }
 
-RcppSexp RcppSexp::attr( const std::string& name) const{
-	SEXP att = Rf_getAttrib( m_sexp, Rf_install( name.c_str() ) );
-	return RcppSexp( att ) ;
+SEXP RcppSexp::attr( const std::string& name) const{
+	return Rf_getAttrib( m_sexp, Rf_install( name.c_str() ) );
 }
 
-bool RcppSexp::isNULL() const{
-	return m_sexp == R_NilValue ;
-}
-
-RcppSexp::operator SEXP() const{
-	return m_sexp ;
-}
-

Modified: pkg/src/RcppSexp.h
===================================================================
--- pkg/src/RcppSexp.h	2009-12-29 15:20:19 UTC (rev 222)
+++ pkg/src/RcppSexp.h	2009-12-29 15:53:03 UTC (rev 223)
@@ -24,12 +24,29 @@
 #define RcppSexp_h
 
 #include <RcppCommon.h>
+#include <RcppSuperClass.h>
 #include <set>
 
-class RcppSexp {
+class RcppSexp: public RcppSuperClass {
 public:
-    RcppSexp(SEXP sexp, int numprot=0) : m_sexp(sexp) { }
-    RcppSexp() : 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 protect and release for ways to protect
+	 * the SEXP from garbage collection, and release to 
+	 * remove the protection
+	 */
+	RcppSexp(SEXP m_sexp = R_NilValue) : m_sexp(m_sexp) {};
+    
+    /**
+	 * if this object is protected rom R's GC, then it is released
+	 * and become subject to garbage collection. See protect 
+	 * and release member functions.
+	 */
+    ~RcppSexp() ;
+	
     RcppSexp(const double & v);
     RcppSexp(const int & v);
     RcppSexp(const Rbyte & v);
@@ -47,13 +64,9 @@
     RcppSexp(const std::set<std::string> & v);
     RcppSexp(const std::set<Rbyte> & v);
     
-    ~RcppSexp();
     
-    /**
-     * implicit conversion to SEXP
-     */
-    operator SEXP() const ;
-    
+    /* we don't provide implicit converters because 
+       of Item 5 in More Effective C++ */
     bool                     asBool() const;
     double                   asDouble() const;
     int                      asInt() const;
@@ -64,18 +77,86 @@
     std::vector<std::string> asStdVectorString() const;
     std::vector<Rbyte>       asStdVectorRaw() const;
     std::vector<bool>        asStdVectorBool() const;
-    SEXP                     asSexp() const;
     
-    /* attributes */
+    
+    /**
+	 * 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 protect();
+	
+	/**
+	 * 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();
+	
+	/**
+	 * implicit conversion to SEXP
+	 */
+	inline operator SEXP() const {
+		return m_sexp ;
+	}
+	
+	
+	/* attributes */
+	
+	/**
+	 * extracts the names of the attributes of the wrapped SEXP
+	 */
     std::vector<std::string> attributeNames() const ;
-    bool hasAttribute( const std::string& attr) const ; 
-    RcppSexp attr( const std::string& name) const ;
     
-    /* NULL */
-    bool isNULL() const ;
+    /**
+     * Identifies if the SEXP has the given attribute
+     */
+	bool hasAttribute( const std::string& attr) const ; 
     
-private:
-    SEXP m_sexp;
+    /**
+     * extract the given attribute
+     */
+    SEXP attr( const std::string& name) const  ;
+    
+    /**
+     * is this object NULL
+     */
+    inline bool isNULL() const{
+    	return m_sexp == R_NilValue ;
+    }
+    
+    /**
+     * The SEXP typeof, calls TYPEOF on the underlying SEXP
+     */
+    inline int sexp_type() const {
+    	return TYPEOF(m_sexp) ;
+    }
+    
+    /** 
+	 * explicit conversion to SEXP
+	 */
+	inline SEXP asSexp() const {
+		return m_sexp ;
+	}
+	
+protected:
+	
+	/**
+	 * The SEXP this is wrapping
+	 */
+	SEXP m_sexp ;
+	
+	/**
+	 * 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
+	 */
+	bool isProtected ;    
+    
 };
 
 #endif

Modified: pkg/src/RcppXPtr.h
===================================================================
--- pkg/src/RcppXPtr.h	2009-12-29 15:20:19 UTC (rev 222)
+++ pkg/src/RcppXPtr.h	2009-12-29 15:53:03 UTC (rev 223)
@@ -23,7 +23,9 @@
 #define RcppXPtr_h
 
 #include <RcppCommon.h>
+#include <RcppSexp.h>
 
+
 template <typename T>
 void delete_finalizer(SEXP p){
 	if( TYPEOF(p) == EXTPTRSXP ){
@@ -33,7 +35,7 @@
 }
 
 template <typename T>
-class RcppXPtr {
+class RcppXPtr : public RcppSuperClass {
 	public:
 		
 		/** 
@@ -41,7 +43,7 @@
 		 *
 		 * @param xp external pointer to wrap
 		 */
-		explicit RcppXPtr(SEXP m_sexp) ;
+		 explicit RcppXPtr(SEXP m_sexp) : RcppSuperClass::RcppSuperClass(m_sexp){} ;
 		
 		/**
 		 * creates a new external pointer wrapping the dumb pointer p. 
@@ -56,19 +58,8 @@
 		 *        so you need to make sure the pointer can be deleted. 
 		 */
   		explicit RcppXPtr(T* p, bool set_delete_finalizer) ;
-  		
+
   		/**
-  		 * if this was built using the SEXP constructor, and no call 
-  		 * to protect was issued, the destructor 
-  		 * does nothing
-  		 *
-  		 * if built using the dumb pointer constructor or a call to 
-  		 * protect was issued, then the external
-  		 * pointer is released (using R_ReleaseObject), so 
-  		 */
-  		~RcppXPtr() ;
-  		
-  		/**
   		 * Returns a reference to the object wrapped. This allows this
   		 * object to look and feel like a dumb pointer to T
   		 */
@@ -94,43 +85,12 @@
   		 */
   		SEXP getTag() ;
   		
-  		/**
-  		 * force this external pointer to be protected from R garbage collection 
-  		 */
-  		void protect() ;
-  		
   		void setDeleteFinalizer() ;
   		
-  		/** 
-  		 * Returns the external pointer (suitable to send to the R side)
-  		 */
-  		SEXP asSexp();
-    	
-  		/**
-   	     * implicit conversion to SEXP. So that we can return these 
-   	     * objects to the R side directly
-   	     */
-   	    operator SEXP() const ;
-   	    
-  	private:
-  		
-  		/**
-  		 * The external pointer
-  		 */
-  		SEXP m_sexp;
-  		
-  		/**
-  		 * set to true if this objects protects the external pointer 
-  		 * from R garbage collection (R_PreserveObject/R_ReleaseObject)
-  		 */
-  		bool isProtected;
 };
 
 template<typename T>
-RcppXPtr<T>::RcppXPtr(SEXP m_sexp) : m_sexp(m_sexp), isProtected(false) {}
-
-template<typename T>
-RcppXPtr<T>::RcppXPtr(T* p, bool set_delete_finalizer = true) : isProtected(false) {
+RcppXPtr<T>::RcppXPtr(T* p, bool set_delete_finalizer = true) : RcppSuperClass::RcppSuperClass() {
 	m_sexp = R_MakeExternalPtr( (void*)p , R_NilValue, R_NilValue) ;
 	if( set_delete_finalizer ){
 		setDeleteFinalizer() ;
@@ -139,25 +99,11 @@
 }
 
 template<typename T>
-void RcppXPtr<T>::protect(){
-	R_PreserveObject( m_sexp ) ;
-	isProtected = true ;
-}
-
-template<typename T>
 void RcppXPtr<T>::setDeleteFinalizer(){
 	R_RegisterCFinalizerEx( m_sexp, delete_finalizer<T> , FALSE) ; 
 }
 
-
 template<typename T>
-RcppXPtr<T>::~RcppXPtr(){
-	if( isProtected ){
-		R_ReleaseObject( m_sexp ) ;
-	}
-}
-
-template<typename T>
 T& RcppXPtr<T>::operator*() const {
 	return *((T*)EXTPTR_PTR( m_sexp )) ;
 }
@@ -177,14 +123,4 @@
 	return EXTPTR_TAG(m_sexp) ;
 }
 
-template<typename T>
-SEXP RcppXPtr<T>::asSexp(){
-	return m_sexp ;
-}
-
-template<typename T>
-RcppXPtr<T>::operator SEXP() const {
-	return m_sexp ;
-}
-
 #endif

Deleted: pkg/src/exception_handling.cpp
===================================================================
--- pkg/src/exception_handling.cpp	2009-12-29 15:20:19 UTC (rev 222)
+++ pkg/src/exception_handling.cpp	2009-12-29 15:53:03 UTC (rev 223)
@@ -1,81 +0,0 @@
-// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
-//
-// exception_handling.cpp: R/C++ interface class library -- common functions
-//
-// Copyright (C) 2009 - 2010 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.h>
-#include <typeinfo>
-#include <exception>
-#include <exception_defines.h>
-#include <cxxabi.h>
-
-/* much inspired from the __verbose_terminate_handler of the GCC */
-void forward_uncaught_exceptions_to_r(){
-	
-    std::string exception_class ;
-    bool has_exception_class = false;
-    std::string exception_what ; 
-	
-    // Make sure there was an exception; terminate is also called for an
-    // attempt to rethrow when there is no suitable exception.
-    std::type_info *t = abi::__cxa_current_exception_type();
-    if (t){
-    	has_exception_class = true ;
-    	const char *name = t->name() ;
-    	// now we need to demangle "name"
-    	
-    	{
-	    int status = -1;
-	    char *dem = 0;
-	    dem = abi::__cxa_demangle(name, 0, 0, &status);
-	    if( status == 0){
-		exception_class = dem ; /* great we can use the demangled name */
-		free(dem);
-	    } else{
-		exception_class = name ; /* just using the mangled name */
-	    }
-    	}
-    }
-	
-    // If the exception is derived from std::exception, we can give more
-    // information.
-    try { 
-    	__throw_exception_again;
-#ifdef __EXCEPTIONS    	
-    } catch (std::exception &exc) { 
-    	exception_what = exc.what() ;
-#endif
-    } catch (...) { 
-    	exception_what = "unrecognized exception" ;
-    }
-    
-    Rf_eval( 
-	    Rf_lang3( 
-		     Rf_install("cpp_exception"), 
-		     Rf_mkString(exception_what.c_str()), 
-		     has_exception_class ? Rf_mkString(exception_class.c_str()) : R_NilValue
-		      ), R_FindNamespace(Rf_mkString("Rcpp"))
-	     ) ; 
-}
-
-SEXP initUncaughtExceptionHandler(){
-    void (*old_terminate)() = std::set_terminate(forward_uncaught_exceptions_to_r);
-    return R_NilValue ;
-}
-

Copied: pkg/src/exceptions.cpp (from rev 222, pkg/src/exception_handling.cpp)
===================================================================
--- pkg/src/exceptions.cpp	                        (rev 0)
+++ pkg/src/exceptions.cpp	2009-12-29 15:53:03 UTC (rev 223)
@@ -0,0 +1,81 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// exception_handling.cpp: R/C++ interface class library -- common functions
+//
+// Copyright (C) 2009 - 2010 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.h>
+#include <typeinfo>
+#include <exception>
+#include <exception_defines.h>
+#include <cxxabi.h>
+
+/* much inspired from the __verbose_terminate_handler of the GCC */
+void forward_uncaught_exceptions_to_r(){
+	
+    std::string exception_class ;
+    bool has_exception_class = false;
+    std::string exception_what ; 
+	
+    // Make sure there was an exception; terminate is also called for an
+    // attempt to rethrow when there is no suitable exception.
+    std::type_info *t = abi::__cxa_current_exception_type();
+    if (t){
+    	has_exception_class = true ;
+    	const char *name = t->name() ;
+    	// now we need to demangle "name"
+    	
+    	{
+	    int status = -1;
+	    char *dem = 0;
+	    dem = abi::__cxa_demangle(name, 0, 0, &status);
+	    if( status == 0){
+		exception_class = dem ; /* great we can use the demangled name */
+		free(dem);
+	    } else{
+		exception_class = name ; /* just using the mangled name */
+	    }
+    	}
+    }
+	
+    // If the exception is derived from std::exception, we can give more
+    // information.
+    try { 
+    	__throw_exception_again;
+#ifdef __EXCEPTIONS    	
+    } catch (std::exception &exc) { 
+    	exception_what = exc.what() ;
+#endif
+    } catch (...) { 
+    	exception_what = "unrecognized exception" ;
+    }
+    
+    Rf_eval( 
+	    Rf_lang3( 
+		     Rf_install("cpp_exception"), 
+		     Rf_mkString(exception_what.c_str()), 
+		     has_exception_class ? Rf_mkString(exception_class.c_str()) : R_NilValue
+		      ), R_FindNamespace(Rf_mkString("Rcpp"))
+	     ) ; 
+}
+
+SEXP initUncaughtExceptionHandler(){
+    void (*old_terminate)() = std::set_terminate(forward_uncaught_exceptions_to_r);
+    return R_NilValue ;
+}
+



More information about the Rcpp-commits mailing list