[Rcpp-devel] [Rcpp-commits] r220 - in pkg: . inst inst/examples/RcppInline src

Romain François francoisromain at free.fr
Tue Dec 29 10:41:45 CET 2009


Hi,

I've added the template class RcppXPtr<typename T> into Rcpp to manage 
external pointers in a "smart pointers" way.

I've added an example file to go with it.

Both constructors are explicit so that we forbid implicit conversion. 
Some day if I understand how to make it work, I'll remove the explicitness.

I've marked this as 0.7.0.4 so that I can update the CPP package to use 
them instead of its x_ptr. I'll also update RProtoBuf in due course.

I've documented the RcppXPtr.h but I'm not sure this is the right 
format. Please advise otherwise.

The RcppXPtr class has a 'asSexp' member function as well as RcppSexp, 
and I think it should also have the attributes business. So I was 
thinking maybe they both should extend some class that would provide 
asSexp and the attributes related functions.

Next on my list :
- RcppS4 which will also hold a SEXP and provide convenience C++ member 
functions for accessing the slots.

I'd also like to review RcppFunction, of which I don't like the 
interface. I think it should also hold a SEXP and look like a C++ 
function (Meyers calls them functors), by overloading the operator() and 
taking a varargs list of SEXP.

Romain


On 12/29/2009 10:30 AM, noreply at r-forge.r-project.org wrote:
> Author: romain
> Date: 2009-12-29 10:30:12 +0100 (Tue, 29 Dec 2009)
> New Revision: 220
>
> Added:
>     pkg/inst/examples/RcppInline/external_pointer.r
>     pkg/src/RcppXPtr.h
> Modified:
>     pkg/DESCRIPTION
>     pkg/inst/ChangeLog
>     pkg/src/Rcpp.h
>     pkg/src/RcppExample.cpp
>     pkg/src/exception_handling.cpp
> Log:
> added smart external pointers template class RcppXPtr<typename T>
>
> Modified: pkg/DESCRIPTION
> ===================================================================
> --- pkg/DESCRIPTION	2009-12-28 11:23:31 UTC (rev 219)
> +++ pkg/DESCRIPTION	2009-12-29 09:30:12 UTC (rev 220)
> @@ -1,6 +1,6 @@
>   Package: Rcpp
>   Title: Rcpp R/C++ interface package
> -Version: 0.7.0.3
> +Version: 0.7.0.4
>   Date: $Date$
>   Author: Dirk Eddelbuettel and Romain Francois, with contributions
>    by Simon Urbanek and David Reiss; based on code written during
>
> Modified: pkg/inst/ChangeLog
> ===================================================================
> --- pkg/inst/ChangeLog	2009-12-28 11:23:31 UTC (rev 219)
> +++ pkg/inst/ChangeLog	2009-12-29 09:30:12 UTC (rev 220)
> @@ -1,3 +1,20 @@
> +2009-12-29  Romain Francois<francoisromain at free.fr>
> +
> +	* src/RcppXPtr.h: new smart external pointer wrapper. The RcppXPtr
> +	template can be used to wrap a external pointer (SEXP) so that it
> +	looks like the dumb pointer it is wrapping (as far as the * and ->
> +	operator are concerned). The template parameter controls the type
> +	of object that is wrapped by the pointer.
> +	
> +	* src/Rcpp.h: importing the RcppXPtr.h header
> +	
> +	* src/RcppExample.cpp: added an example of RcppXPtr usage
> +	
> +	* inst/examples/RcppInline/external_pointer.r: added example using
> +	the RcppXPtr template
> +	
> +	* DESCRIPTION: marking this as 0.7.0.4
> +	
>   2009-12-28  Romain Francois<francoisromain at free.fr>
>
>   	* R/exceptions.R: s/uncaught_cpp_exception/cpp_exception/ and added a
>
> Added: pkg/inst/examples/RcppInline/external_pointer.r
> ===================================================================
> --- pkg/inst/examples/RcppInline/external_pointer.r	                        (rev 0)
> +++ pkg/inst/examples/RcppInline/external_pointer.r	2009-12-29 09:30:12 UTC (rev 220)
> @@ -0,0 +1,59 @@
> +#!/usr/bin/r -t
> +#
> +# Copyright (C) 2009 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/>.
> +
> +require(Rcpp)
> +require(inline)
> +
> +funx<- cfunction(signature(), '
> +	/* creating a pointer to a vector<int>  */
> +	std::vector<int>* v = new std::vector<int>  ;
> +	v->push_back( 1 ) ;
> +	v->push_back( 2 ) ;
> +	
> +	/* wrap the pointer as an external pointer */
> +	/* this automatically protected the external pointer from R garbage
> +	   collection until p goes out of scope. */
> +	RcppXPtr<  std::vector<int>  >  p(v) ;
> +	
> +	/* return it back to R, since p goes out of scope after the return
> +	   the external pointer is no more protected by p, but it gets
> +	   protected by being on the R side */
> +	return( p.asSexp() ) ;
> +	
> +', Rcpp=TRUE, verbose=FALSE)
> +xp<- funx()
> +stopifnot( identical( typeof( xp ), "externalptr" ) )
> +
> +# passing the pointer back to C++
> +funx<- cfunction(signature(x = "externalptr" ), '
> +	/* wrapping x as smart external pointer */
> +	/* The SEXP based constructor does not protect the SEXP from
> +	   garbage collection automatically, it is already protected
> +	   because it comes from the R side, however if you want to keep
> +	   the RcppXPtr object on the C(++) side
> +	   and return something else to R, you need to protect the external
> +	   pointer, by using the protect member function */
> +	RcppXPtr<  std::vector<int>  >  p(x) ;
> +	
> +	/* just return the front of the vector as a SEXP */
> +	return( RcppSexp( p->front() ).asSexp() ) ;
> +', Rcpp=TRUE, verbose=FALSE)
> +front<- funx(xp)
> +stopifnot( identical( front, 1L ) )
> +
>
>
> Property changes on: pkg/inst/examples/RcppInline/external_pointer.r
> ___________________________________________________________________
> Name: svn:executable
>     + *
>
> Modified: pkg/src/Rcpp.h
> ===================================================================
> --- pkg/src/Rcpp.h	2009-12-28 11:23:31 UTC (rev 219)
> +++ pkg/src/Rcpp.h	2009-12-29 09:30:12 UTC (rev 220)
> @@ -41,5 +41,6 @@
>   #include<RcppStringVectorView.h>
>   #include<RcppVector.h>
>   #include<RcppVectorView.h>
> +#include<RcppXPtr.h>
>
>   #endif
>
> Modified: pkg/src/RcppExample.cpp
> ===================================================================
> --- pkg/src/RcppExample.cpp	2009-12-28 11:23:31 UTC (rev 219)
> +++ pkg/src/RcppExample.cpp	2009-12-29 09:30:12 UTC (rev 220)
> @@ -461,3 +461,18 @@
>
>       return rl;
>   }
> +
> +RcppExport SEXP RcppXPtrExample_create_external_pointer(){
> +	std::vector<int>  *v = new std::vector<int>  ;
> +	v->push_back( 1 ) ;
> +	v->push_back( 2 ) ;
> +	RcppXPtr<  std::vector<int>  >  p(v) ;
> +	return p.asSexp() ;
> +}
> +
> +RcppExport SEXP RcppXPtrExample_get_external_pointer(SEXP x){
> +	RcppXPtr<  std::vector<int>  >  p(x) ;
> +	return Rf_ScalarInteger( p->back( ) ) ;
> +}
> +
> +
>
> Added: pkg/src/RcppXPtr.h
> ===================================================================
> --- pkg/src/RcppXPtr.h	                        (rev 0)
> +++ pkg/src/RcppXPtr.h	2009-12-29 09:30:12 UTC (rev 220)
> @@ -0,0 +1,179 @@
> +// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
> +//
> +// RcppXPtr.h: Rcpp R/C++ interface class library -- smart external pointers
> +//
> +// Copyright (C) 2009 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 RcppXPtr_h
> +#define RcppXPtr_h
> +
> +#include<RcppCommon.h>
> +
> +template<typename T>
> +void delete_finalizer(SEXP p){
> +	if( TYPEOF(p) == EXTPTRSXP ){
> +		T* ptr = (T*) EXTPTR_PTR(p) ;
> +		delete ptr ;
> +	}
> +}
> +
> +template<typename T>
> +class RcppXPtr {
> +	public:
> +		
> +		/**
> +		 * constructs a RcppXPtr wrapping the external pointer (EXTPTRSXP SEXP)
> +		 *
> +		 * @param xp external pointer to wrap
> +		 */
> +		explicit RcppXPtr(SEXP m_sexp) ;
> +		
> +		/**
> +		 * 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.
> +		 */
> +  		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
> +  		 */
> +  		T&  operator*() const ;
> +  		
> +  		/**
> +  		 * Returns the dumb pointer. This allows to call the ->  operator
> +  		 * on this as if it was the dumb pointer
> +  		 */
> +  		T* operator->() const ;
> +  		
> +  		/**
> +  		 * Returns the 'protected' part of the external pointer, this is
> +  		 * the SEXP that is passed in as the third argument of the
> +  		 * R_MakeExternalPointer function. See Writing R extensions
> +  		 */
> +  		SEXP getProtected() ;
> +  		
> +  		/**
> +  		 * Returns the 'tag' part of the external pointer, this is the
> +  		 * SEXP that is passed in as the 2nd argument of the
> +  		 * R_MakeExternalPointer function. See Writing R extensions
> +  		 */
> +  		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();
> +    	
> +  	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) {
> +	m_sexp = R_MakeExternalPtr( (void*)p , R_NilValue, R_NilValue) ;
> +	if( set_delete_finalizer ){
> +		setDeleteFinalizer() ;
> +	}
> +	protect() ;
> +}
> +
> +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 )) ;
> +}
> +
> +template<typename T>
> +T* RcppXPtr<T>::operator->() const {
> +	return (T*)(EXTPTR_PTR(m_sexp));
> +}
> +
> +template<typename T>
> +SEXP RcppXPtr<T>::getProtected(){
> +	return EXTPTR_PROT(m_sexp) ;
> +}
> +
> +template<typename T>
> +SEXP RcppXPtr<T>::getTag(){
> +	return EXTPTR_TAG(m_sexp) ;
> +}
> +
> +template<typename T>
> +SEXP RcppXPtr<T>::asSexp(){
> +	return m_sexp ;
> +}
> +
> +#endif
>
> Modified: pkg/src/exception_handling.cpp
> ===================================================================
> --- pkg/src/exception_handling.cpp	2009-12-28 11:23:31 UTC (rev 219)
> +++ pkg/src/exception_handling.cpp	2009-12-29 09:30:12 UTC (rev 220)
> @@ -1,6 +1,6 @@
>   // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
>   //
> -// RcppCommon.cpp: R/C++ interface class library -- common functions
> +// exception_handling.cpp: R/C++ interface class library -- common functions
>   //
>   // Copyright (C) 2009 - 2010 Romain Francois
>   //
> @@ -66,8 +66,11 @@
>       }
>
>   	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"))
> +		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(){


-- 
Romain Francois
Professional R Enthusiast
+33(0) 6 28 91 30 30
http://romainfrancois.blog.free.fr
|- http://tr.im/IlMh : CPP package: exposing C++ objects
|- http://tr.im/HlX9 : new package : bibtex
`- http://tr.im/Gq7i : ohloh





More information about the Rcpp-devel mailing list