[Rcpp-commits] r563 - in pkg: . inst inst/unitTests src src/Rcpp src/Rcpp/internal src/Rcpp/traits

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Feb 2 22:12:48 CET 2010


Author: romain
Date: 2010-02-02 22:12:47 +0100 (Tue, 02 Feb 2010)
New Revision: 563

Added:
   pkg/inst/unitTests/runit.traits.R
   pkg/src/Rcpp/as.h
   pkg/src/Rcpp/internal/r_coerce.h
   pkg/src/Rcpp/traits/has_iterator.h
   pkg/src/coerce.cpp
Modified:
   pkg/DESCRIPTION
   pkg/inst/ChangeLog
   pkg/src/Rcpp/internal/wrap.h
   pkg/src/Rcpp/traits/integral_constant.h
   pkg/src/Rcpp/traits/wrap_type_traits.h
   pkg/src/RcppCommon.h
   pkg/src/as.cpp
Log:
the old mc donald had wifi ... or something like that

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2010-02-02 10:41:24 UTC (rev 562)
+++ pkg/DESCRIPTION	2010-02-02 21:12:47 UTC (rev 563)
@@ -1,13 +1,42 @@
 Package: Rcpp
-Title: Rcpp R/C++ interface package
+Title: Seamless R and C++ integration
 Version: 0.7.4.1
 Date: $Date$
 Author: Dirk Eddelbuettel and Romain Francois, with contributions 
  by Simon Urbanek and David Reiss; based on code written during 
  2005 and 2006 by Dominick Samperi 
 Maintainer: Dirk Eddelbuettel <edd at debian.org>
-Description: R/C++ interface classes and examples
- The Rcpp library maps data types betweeen R and C++, and includes support
+Description: Seamless R and C++ integration
+ .
+ The Rcpp package contains is C++ library that facilitates
+ integration of R and C++ in various ways
+ .
+ R data types (SEXP) are matched to C++ objects in a class hierarchy.
+ All R types are supporter (vectors, functions, environment, etc ...)
+ and each type is mapped to a dedicated class. For example numeric 
+ vectors are represented as instances of the Rcpp::NumericVector class, 
+ environments are represented as instances of Rcpp::Environment, 
+ functions are represented as Rcpp::Function, etc ...
+ .
+ The underlying c++ library also offers the Rcpp::wrap function which 
+ is a templated function that transforms an arbitrary object into a SEXP. 
+ This makes straightforward to implement C++ logic in terms of standard
+ C++ types such as stl containers and then wrap them when they need
+ to be returned to R. wrap uses advanced template meta programming 
+ techniques and currently supports : primitive types 
+ (bool, int, double, size_t, Rbyte, Rcomplex, std::string), stl-type
+ containers (e.g std::vector<T>) where T is wrappable, stl-type 
+ maps (e.g std::map<std::string,T>) where T is wrappable, and arbitrary 
+ types that support implicit conversion to SEXP
+ .
+ The reversed conversion (from R to C++) is performed by the Rcpp::as
+ function template offering a similar degree of flexibility
+ .
+ The package also contains a set of classes --- which we call the 
+ `classic Rcpp api` --- that were an initial attempt at 
+ R and C++ integration. Due to its continued use, the classic api
+ is retained and will be supported for the foreseable future. The 
+ classic api and includes support
  for R types real, integer, character, vector, matrix, Date, datetime (i.e.
  POSIXct) at microsecond resolution, data frame, and function. Transfer to and
  from simple or complex SEXP objects is made easy thanks to automatic

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-02-02 10:41:24 UTC (rev 562)
+++ pkg/inst/ChangeLog	2010-02-02 21:12:47 UTC (rev 563)
@@ -1,5 +1,14 @@
 2010-02-02  Romain Francois <francoisromain at free.fr>
 
+	* src/internal/r_coerce.h : coercion is now handled by a templated
+	function r_coerce<int,int>, for example r_coerce<INTSXP,REALSXP>
+	takes an int, performs coercion and returns a double
+
+	* src/traits/has_iterator.h : introduce a trait that uses the
+	SFINAE idiom to check if a class T has a nested type called
+	"iterator". This helps wrap dispatch which now uses the 
+	range based wrap implementation in that case
+
 	* src/Rcpp/wrap.h: The range based wrap function is exposed
 	at the Rcpp:: level. The interface is 
 	wrap( InputIterator first, InputIterator last )

Added: pkg/inst/unitTests/runit.traits.R
===================================================================
--- pkg/inst/unitTests/runit.traits.R	                        (rev 0)
+++ pkg/inst/unitTests/runit.traits.R	2010-02-02 21:12:47 UTC (rev 563)
@@ -0,0 +1,45 @@
+#!/usr/bin/r -t
+#
+# 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/>.
+
+.setUp <- function(){
+	suppressMessages( require( inline ) )
+}
+
+test.has.iterator <- function(){
+	
+	has_iterator <- function(clazz = "std::vector<int>" ){
+		code <- '
+		bool ok = Rcpp::traits::has_iterator< %s >::value ;
+		return wrap(ok) ;
+		'
+		funx <- cfunction(signature(),sprintf( code, clazz ) , 
+		Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+		funx()
+	}
+	checkTrue( has_iterator( "std::vector<int>" ), msg = "has_iterator< std::vector<int> >" )
+	checkTrue( has_iterator( "std::list<int>" ), msg = "has_iterator< std::ist<int> >" )
+	checkTrue( has_iterator( "std::deque<int>" ), msg = "has_iterator< std::deque<int> >" )
+	checkTrue( has_iterator( "std::set<int>" ), msg = "has_iterator< std::set<int> >" )
+	checkTrue( has_iterator( "std::map<std::string,int>" ), msg = "has_iterator< std::map<string,int> >" )
+	
+	checkTrue( ! has_iterator( "std::pair<std::string,int>" ), msg = "has_iterator< std::pair<string,int> >" )
+	checkTrue( ! has_iterator( "Rcpp::Symbol" ), msg = "Rcpp::Symbol" )
+	
+}
+

Added: pkg/src/Rcpp/as.h
===================================================================
--- pkg/src/Rcpp/as.h	                        (rev 0)
+++ pkg/src/Rcpp/as.h	2010-02-02 21:12:47 UTC (rev 563)
@@ -0,0 +1,59 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// as.h: Rcpp R/C++ interface class library -- convert SEXP to C++ objects
+//
+// Copyright (C) 2009 - 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
+
+namespace Rcpp{
+
+/** 
+ * Generic converted from SEXP to the typename. T can be any type that 
+ * has a constructor taking a SEXP, which is the case for all our 
+ * RObject and derived classes. 
+ *
+ * If it is not possible to add the SEXP constructor, e.g you don't control
+ * the type, you can specialize the as template to perform the 
+ * requested conversion
+ *
+ * This is used for example in Environment, so that for example the code
+ * below will work as long as there is a way to as<> the Foo type
+ *
+ * Environment x = ... ; // some environment
+ * Foo y = x["bla"] ;    // if as<Foo> makes sense then this works !!
+ */
+template <typename T> T as( SEXP m_sexp) {
+	T t(m_sexp);
+	return t ;
+}
+template<> bool 			as<bool>(SEXP m_sexp) ;
+template<> double                   	as<double>(SEXP m_sexp) ;
+template<> int                      	as<int>(SEXP m_sexp) ;
+template<> Rbyte                    	as<Rbyte>(SEXP m_sexp) ;
+template<> std::string              	as<std::string>(SEXP m_sexp) ;
+template<> std::vector<int>         	as< std::vector<int> >(SEXP m_sexp) ;
+template<> std::vector<double>      	as< std::vector<double> >(SEXP m_sexp) ;
+template<> std::vector<std::string> 	as< std::vector<std::string> >(SEXP m_sexp) ;
+template<> std::vector<Rbyte>       	as< std::vector<Rbyte> >(SEXP m_sexp) ;
+template<> std::vector<bool>        	as< std::vector<bool> >(SEXP m_sexp) ;
+
+} // Rcpp 
+
+#endif

Added: pkg/src/Rcpp/internal/r_coerce.h
===================================================================
--- pkg/src/Rcpp/internal/r_coerce.h	                        (rev 0)
+++ pkg/src/Rcpp/internal/r_coerce.h	2010-02-02 21:12:47 UTC (rev 563)
@@ -0,0 +1,75 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */
+//
+// r_coerce.h: Rcpp R/C++ interface class library -- coercion
+//
+// 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__internal__r_coerce__h
+#define Rcpp__internal__r_coerce__h
+
+namespace Rcpp{
+namespace internal{
+
+template <int FROM, int TO>
+typename ::Rcpp::traits::storage_type<TO>::type 
+r_coerce( typename ::Rcpp::traits::storage_type<FROM>::type from ){
+	// this implementation is never actually called
+	return static_cast<typename ::Rcpp::traits::storage_type<TO>::type >(from);
+} ;
+template <> int r_coerce<INTSXP,INTSXP>(int from) ;
+template <> int r_coerce<LGLSXP,LGLSXP>(int from) ;
+template <> double r_coerce<REALSXP,REALSXP>(double from);
+template <> Rcomplex r_coerce<CPLXSXP,CPLXSXP>(Rcomplex from);
+template <> Rbyte r_coerce<RAWSXP,RAWSXP>(Rbyte from) ;
+
+// -> INTSXP
+template <> int r_coerce<LGLSXP,INTSXP>(int from) ;
+template <> int r_coerce<REALSXP,INTSXP>(double from);
+template <> int r_coerce<CPLXSXP,INTSXP>(Rcomplex from);
+template <> int r_coerce<RAWSXP,INTSXP>(Rbyte from) ;
+
+// -> REALSXP
+template <> double r_coerce<LGLSXP,REALSXP>(int from) ;
+template <> double r_coerce<INTSXP,REALSXP>(int from);
+template <> double r_coerce<CPLXSXP,REALSXP>(Rcomplex from);
+template <> double r_coerce<RAWSXP,REALSXP>(Rbyte from) ;
+
+// -> LGLSXP
+template <> int r_coerce<REALSXP,LGLSXP>(double from) ;
+template <> int r_coerce<INTSXP,LGLSXP>(int from);
+template <> int r_coerce<CPLXSXP,LGLSXP>(Rcomplex from);
+template <> int r_coerce<RAWSXP,LGLSXP>(Rbyte from) ;
+
+// -> RAWSXP
+template <> Rbyte r_coerce<REALSXP,RAWSXP>(double from) ;
+template <> Rbyte r_coerce<INTSXP,RAWSXP>(int from);
+template <> Rbyte r_coerce<CPLXSXP,RAWSXP>(Rcomplex from);
+template <> Rbyte r_coerce<LGLSXP,RAWSXP>(int from) ;
+
+// -> CPLXSXP
+template <> Rcomplex r_coerce<REALSXP,CPLXSXP>(double from) ;
+template <> Rcomplex r_coerce<INTSXP,CPLXSXP>(int from);
+template <> Rcomplex r_coerce<RAWSXP,CPLXSXP>(Rbyte from);
+template <> Rcomplex r_coerce<LGLSXP,CPLXSXP>(int from) ;
+
+
+} // internal
+} // Rcpp
+
+#endif

Modified: pkg/src/Rcpp/internal/wrap.h
===================================================================
--- pkg/src/Rcpp/internal/wrap.h	2010-02-02 10:41:24 UTC (rev 562)
+++ pkg/src/Rcpp/internal/wrap.h	2010-02-02 21:12:47 UTC (rev 563)
@@ -320,12 +320,19 @@
 	return x ;
 }
 
-/** 
- * Called when no implicit conversion to SEXP is possible
- * This generates compile time errors
+/**
+ * This is the worst case : 
+ * - not a primitive
+ * - not implicitely convertible tp SEXP
+ * - not iterable
+ *
+ * so we just give up and attempt to use static_assert to generate 
+ * a compile time message if it is available, otherwise we use 
+ * implicit conversion to SEXP to bomb the compiler, which will give
+ * quite a cryptic message
  */
 template <typename T>
-SEXP wrap_dispatch_unknown( const T& object, ::Rcpp::traits::false_type){
+SEXP wrap_dispatch_unknown_iterable(const T& object, ::Rcpp::traits::false_type){
 	// here we know that T is not convertible to SEXP
 #ifdef HAS_CXX0X
 	static_assert( !sizeof(T), "cannot convert type to SEXP" ) ;
@@ -336,21 +343,36 @@
 #endif
 	return R_NilValue ; // -Wall
 }
-// }}}
 
-// {{{ wrap dispatch
-/** 
- * generic wrap for stl containers. This implementation is used
- * when the type T is an STL-like container, with a begin() method
- * and an end() method
+/**
+ * Here we know for sure that type T has a T::iterator typedef
+ * so we hope for the best and call the range based wrap with begin
+ * and end
  *
- * further dispatch is performed internally by the range_wrap 
- * template based on the type of object iterated over
+ * This works fine for all stl containers and classes T that have : 
+ * - T::iterator
+ * - T::iterator begin()
+ * - T::iterator end()
+ *
+ * If someone knows a better way, please advise
  */
-template <typename T> SEXP wrap_dispatch( const T& object, ::Rcpp::traits::wrap_type_stl_container_tag ){
+template <typename T>
+SEXP wrap_dispatch_unknown_iterable(const T& object, ::Rcpp::traits::true_type){
 	return range_wrap( object.begin(), object.end() ) ;
 }
 
+/** 
+ * Called when no implicit conversion to SEXP is possible and this is 
+ * not tagged as a primitive type, checks whether the type is 
+ * iterable
+ */
+template <typename T>
+SEXP wrap_dispatch_unknown( const T& object, ::Rcpp::traits::false_type){
+	return wrap_dispatch_unknown_iterable( object, typename ::Rcpp::traits::has_iterator<T>::type() ) ;
+}
+// }}}
+
+// {{{ wrap dispatch
 /**
  * wrapping a __single__ primitive type : int, double, std::string, size_t, 
  * Rbyte, Rcomplex
@@ -386,48 +408,17 @@
 template <typename T> SEXP wrap(const T& object){
 	return internal::wrap_dispatch( object, typename ::Rcpp::traits::wrap_type_traits<T>::wrap_category() ) ;
 }
-// {{{ // explicit instanciations (not needed)
-// template SEXP wrap<int>(const int& object) ;
-// template SEXP wrap<double>(const double& object) ;
-// template SEXP wrap<Rbyte>(const Rbyte& object) ;
-// template SEXP wrap<Rcomplex>(const Rcomplex& object) ;
-// template SEXP wrap<bool>(const bool& object) ;
-// template SEXP wrap<std::string>(const std::string& object) ;
-// template SEXP wrap< std::vector<int> >( const std::vector<int>& object ) ;
-// template SEXP wrap< std::vector<double> >( const std::vector<double>& object ) ;
-// template SEXP wrap< std::vector<Rbyte> >( const std::vector<Rbyte>& object ) ;
-// template SEXP wrap< std::vector<Rcomplex> >( const std::vector<Rcomplex>& object ) ;
-// template SEXP wrap< std::vector<bool> >( const std::vector<bool>& object ) ;
-// 
-// template SEXP wrap< std::set<int> >( const std::set<int>& object ) ;
-// template SEXP wrap< std::set<double> >( const std::set<double>& object ) ;
-// template SEXP wrap< std::set<Rbyte> >( const std::set<Rbyte>& object ) ;
-// 
-// template SEXP wrap< std::deque<int> >( const std::deque<int>& object ) ;
-// template SEXP wrap< std::deque<double> >( const std::deque<double>& object ) ;
-// template SEXP wrap< std::deque<Rbyte> >( const std::deque<Rbyte>& object ) ;
-// template SEXP wrap< std::deque<Rcomplex> >( const std::deque<Rcomplex>& object ) ;
-// template SEXP wrap< std::deque<bool> >( const std::deque<bool>& object ) ;
-// }}}
 
-// special cases - FIXME : these are not template specializations of wrap<>
+// special case - FIXME : this is not template specializations of wrap<>
 inline SEXP wrap(const char* const v ){ return Rf_mkString(v) ; } ;
 
+/**
+ * Range based version of wrap
+ */
 template <typename InputIterator>
 SEXP wrap(InputIterator first, InputIterator last){ return internal::range_wrap( first, last ) ; }
 
 
-// wrap( { ... } ) : disabled for now
-// #ifdef HAS_INIT_LISTS
-// inline SEXP wrap(std::initializer_list<bool> v) { return internal::range_wrap( v.begin() , v.end() ); };
-// inline SEXP wrap(std::initializer_list<std::string> v ) { return internal::range_wrap( v.begin() , v.end() ); };
-// inline SEXP wrap(std::initializer_list<SEXP> v ) { return internal::range_wrap( v.begin() , v.end() ); };
-// inline SEXP wrap(std::initializer_list<Rbyte> v) { return internal::range_wrap( v.begin() , v.end() ); };
-// inline SEXP wrap(std::initializer_list<double> v) { return internal::range_wrap( v.begin() , v.end() ); } ; 
-// inline SEXP wrap(std::initializer_list<int> v) { return internal::range_wrap( v.begin() , v.end() ); } ; 
-// #endif
-
-
 } // Rcpp
 
 #endif

Added: pkg/src/Rcpp/traits/has_iterator.h
===================================================================
--- pkg/src/Rcpp/traits/has_iterator.h	                        (rev 0)
+++ pkg/src/Rcpp/traits/has_iterator.h	2010-02-02 21:12:47 UTC (rev 563)
@@ -0,0 +1,66 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */
+//
+// has_iterator.h: Rcpp R/C++ interface class library -- identify if a class has a nested iterator typedef
+//
+// 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__traits__has_iterator__h
+#define Rcpp__traits__has_iterator__h
+
+/* "inspired" from the tr1_impl/functional file
+   This uses the SFINAE technique to identify if a class T has 
+   an iterator typedef
+*/
+
+namespace Rcpp{
+namespace traits{
+
+  struct __sfinae_types {
+    typedef char __one;
+    typedef struct { char __arr[2]; } __two;
+  };
+  
+  template<typename T>
+  class _has_iterator_helper : __sfinae_types {
+      template<typename U> struct _Wrap_type { };
+
+      template<typename U>
+        static __one __test(_Wrap_type<typename U::iterator>*);
+
+      template<typename U>
+        static __two __test(...);
+
+    public:
+      static const bool value = sizeof(__test<T>(0)) == 1;
+    };
+
+  /** 
+   * uses the SFINAE idiom to check if a class has an 
+   * nested iterator typedef. For example : 
+   *
+   * has_iterator< std::vector<int> >::value is true
+   * has_iterator< Rcpp::Symbol >::value is false
+   */
+  template<typename T> struct has_iterator : 
+  	integral_constant<bool,_has_iterator_helper<T>::value> { };
+
+} // traits
+} // Rcpp
+
+#endif

Modified: pkg/src/Rcpp/traits/integral_constant.h
===================================================================
--- pkg/src/Rcpp/traits/integral_constant.h	2010-02-02 10:41:24 UTC (rev 562)
+++ pkg/src/Rcpp/traits/integral_constant.h	2010-02-02 21:12:47 UTC (rev 563)
@@ -26,7 +26,7 @@
 namespace Rcpp{
 namespace traits{
 	
-template <class _T, _T _V> struct integral_constant {
+template <typename _T, _T _V> struct integral_constant {
     static  const _T                value = _V;
     typedef _T                      value_type;
     typedef integral_constant<_T,_V> type;
@@ -34,6 +34,9 @@
  typedef integral_constant<bool, true> true_type;
  typedef integral_constant<bool, false> false_type;
 
+template <typename T, typename U> struct both : 
+	public integral_constant<bool, T::value && U::value>{};
+ 
 }
 }
 

Modified: pkg/src/Rcpp/traits/wrap_type_traits.h
===================================================================
--- pkg/src/Rcpp/traits/wrap_type_traits.h	2010-02-02 10:41:24 UTC (rev 562)
+++ pkg/src/Rcpp/traits/wrap_type_traits.h	2010-02-02 21:12:47 UTC (rev 563)
@@ -27,11 +27,6 @@
 namespace traits{
 
 /**
- * Identifies an stl type container, with begin and end methods. 
- */
-struct wrap_type_stl_container_tag{};
-
-/**
  * primitive type : int, double, std::string, Rcomplex, size_t, Rbyte
  */
 struct wrap_type_primitive_tag{};
@@ -45,35 +40,14 @@
  * Type trait that helps the dispatch of wrap to the proper method
  *
  * This builds a struct that contains a typedef called wrap_category
- * that has to be one of "wrap_type_stl_container_tag", 
- * "wrap_type_primitive_tag" or "wrap_type_unknown_tag"
+ * that has to be one of "wrap_type_primitive_tag" or "wrap_type_unknown_tag"
  *
- * The default is "wrap_type_unknown_tag" and many
- * partial or complete specializations
- * are defined below.
+ * The default is "wrap_type_unknown_tag" and this is specialized
+ * for primitive types
  */
 template <typename T> struct wrap_type_traits { typedef wrap_type_unknown_tag wrap_category; } ;
 
 /**
- * partial specialization for stl containers
- */ 
-template <typename T> struct wrap_type_traits< std::vector<T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-template <typename T> struct wrap_type_traits< std::list<T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-template <typename T> struct wrap_type_traits< std::set<T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-template <typename T> struct wrap_type_traits< std::deque<T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-template <typename T> struct wrap_type_traits< std::multiset<T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-template <typename T> struct wrap_type_traits< std::map<std::string,T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-template <typename T> struct wrap_type_traits< std::multimap<std::string,T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-#ifdef HAS_TR1_UNORDERED_MAP
-template <typename T> struct wrap_type_traits< std::tr1::unordered_map<std::string,T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-template <typename T> struct wrap_type_traits< std::tr1::unordered_multimap<std::string,T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-#endif
-#ifdef HAS_TR1_UNORDERED_SET
-template <typename T> struct wrap_type_traits< std::tr1::unordered_set<T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-template <typename T> struct wrap_type_traits< std::tr1::unordered_multiset<T> > { typedef wrap_type_stl_container_tag wrap_category ; } ;
-#endif
-
-/**
  * Total specialization for primitive types
  */
 template <> struct wrap_type_traits<int> { typedef wrap_type_primitive_tag wrap_category; } ;

Modified: pkg/src/RcppCommon.h
===================================================================
--- pkg/src/RcppCommon.h	2010-02-02 10:41:24 UTC (rev 562)
+++ pkg/src/RcppCommon.h	2010-02-02 21:12:47 UTC (rev 563)
@@ -148,84 +148,18 @@
 	
 } // namespace internal 
 
-/** 
- * Generic converted from SEXP to the typename. T can be any type that 
- * has a constructor taking a SEXP, which is the case for all our 
- * RObject and derived classes. 
- *
- * If it is not possible to add the SEXP constructor, e.g you don't control
- * the type, you can overload the as template to perform the 
- * requested conversion
- *
- * This is used for example in Environment, so that for example the code
- * below will work as long as there is a way to as<> the Foo type
- *
- * Environment x = ... ; // some environment
- * Foo y = x["bla"] ;    // if as<Foo> makes sense then this works !!
- */
-template <typename T> T as( SEXP m_sexp) {
-	T t(m_sexp);
-	return t ;
-}
-template<> bool 			as<bool>(SEXP m_sexp) ;
-template<> double                   	as<double>(SEXP m_sexp) ;
-template<> int                      	as<int>(SEXP m_sexp) ;
-template<> Rbyte                    	as<Rbyte>(SEXP m_sexp) ;
-template<> std::string              	as<std::string>(SEXP m_sexp) ;
-template<> std::vector<int>         	as< std::vector<int> >(SEXP m_sexp) ;
-template<> std::vector<double>      	as< std::vector<double> >(SEXP m_sexp) ;
-template<> std::vector<std::string> 	as< std::vector<std::string> >(SEXP m_sexp) ;
-template<> std::vector<Rbyte>       	as< std::vector<Rbyte> >(SEXP m_sexp) ;
-template<> std::vector<bool>        	as< std::vector<bool> >(SEXP m_sexp) ;
-
-
-/* FIXME: turn the functions below into a template */
-
-/* these do not take care of coercion*/
+inline int bool_to_Rboolean(bool x){ return x ? TRUE : FALSE ; }
 inline bool Rboolean_to_bool( int x){ return x == TRUE ; }
 inline bool int_to_bool(int x){ return x != 0 ; }
 inline bool double_to_bool(double x){ return x != 0.0 ; }
 inline bool Rbyte_to_bool(Rbyte x){ return x != static_cast<Rbyte>(0) ; }
 
-/* these take care of coercion */
-inline int bool_to_Rboolean(bool x){ return x ? TRUE : FALSE ; }
-
-inline int Rboolean_to_int(int x){ return (x==NA_LOGICAL) ? NA_INTEGER : x ; }
-inline int double_to_int(double x){ 
-	if (ISNAN(x)) return NA_INTEGER;
-	else if (x > INT_MAX || x <= INT_MIN ) {
-		return NA_INTEGER;
-	}
-	return static_cast<int>(x);
-}
-inline int Rbyte_to_int(Rbyte x){ return static_cast<int>(x); }
-
-inline Rbyte Rboolean_to_Rbyte(int x){ return x == TRUE ? static_cast<Rbyte>(1) : static_cast<Rbyte>(0) ;}
-inline Rbyte double_to_Rbyte(double x){ 
-	if( x == NA_REAL) return (Rbyte)0 ; 
-	int y = static_cast<int>(x) ;
-	return (y < 0 || y > 255) ? (Rbyte)0 : (Rbyte)y ;
-} 
-inline Rbyte int_to_Rbyte(int x){
-	return (x < 0 || x > 255) ? static_cast<Rbyte>(0) : static_cast<Rbyte>(x) ;
-}
-
-inline double Rbyte_to_double(Rbyte x){
-	return static_cast<double>(x) ;
-}
-inline double int_to_double(int x){
-	return x == NA_INTEGER ? NA_REAL : static_cast<double>(x) ;
-}
-inline double Rboolean_to_double(int x){
-	return x == NA_LOGICAL ? NA_REAL : static_cast<double>(x) ;
-}
-
-inline int int_to_RBoolean(int x){ return ( x == NA_INTEGER ) ? NA_LOGICAL : (x!=0); }
-
 } // namespace Rcpp
 
+
 // DO NOT CHANGE THE ORDER OF THESE INCLUDES
 #include <Rcpp/traits/integral_constant.h>
+#include <Rcpp/traits/has_iterator.h>
 #include <Rcpp/traits/has_na.h>
 #include <Rcpp/traits/storage_type.h>
 #include <Rcpp/traits/r_sexptype_traits.h>
@@ -233,6 +167,9 @@
 #include <Rcpp/traits/r_type_traits.h>
 #include <Rcpp/traits/wrap_type_traits.h>
 
+#include <Rcpp/internal/r_coerce.h>
+#include <Rcpp/as.h>
+
 #include <Rcpp/internal/r_vector.h>
 #include <Rcpp/internal/convertible.h>
 #include <Rcpp/internal/wrap.h>

Modified: pkg/src/as.cpp
===================================================================
--- pkg/src/as.cpp	2010-02-02 10:41:24 UTC (rev 562)
+++ pkg/src/as.cpp	2010-02-02 21:12:47 UTC (rev 563)
@@ -29,13 +29,13 @@
     }
     switch( TYPEOF(m_sexp) ){
     	case LGLSXP:
-    		return Rboolean_to_double( LOGICAL(m_sexp)[0] ) ; 
+    		return internal::r_coerce<LGLSXP,REALSXP>( LOGICAL(m_sexp)[0] ) ; 
     	case REALSXP:
     		return REAL(m_sexp)[0] ; 
     	case INTSXP:
-    		return int_to_double( INTEGER(m_sexp)[0] ); 
+    		return internal::r_coerce<INTSXP,REALSXP>( INTEGER(m_sexp)[0] ); 
     	case RAWSXP:
-    		return static_cast<double>( RAW(m_sexp)[0] );
+    		return internal::r_coerce<RAWSXP,REALSXP>( RAW(m_sexp)[0] );
     	default:
     		throw std::range_error("as<double> invalid type");
     }
@@ -48,13 +48,13 @@
     }
     switch( TYPEOF(m_sexp)){
     	case LGLSXP:
-    		return Rboolean_to_int( LOGICAL(m_sexp)[0] ) ; 
+    		return internal::r_coerce<LGLSXP,INTSXP>( LOGICAL(m_sexp)[0] ) ; 
     	case REALSXP:
-    		return double_to_int( REAL(m_sexp)[0] ); // some of this might be lost
+    		return internal::r_coerce<REALSXP,INTSXP>( REAL(m_sexp)[0] ); // some of this might be lost
     	case INTSXP:
     		return INTEGER(m_sexp)[0]; 
     	case RAWSXP:
-    		return static_cast<int>( RAW(m_sexp)[0] );
+    		return internal::r_coerce<RAWSXP,INTSXP>( RAW(m_sexp)[0] );
     	default:
     		throw std::range_error("as<int>");
     }
@@ -67,11 +67,11 @@
     }
     switch( TYPEOF(m_sexp) ){
     	case LGLSXP:
-    		return Rboolean_to_Rbyte( LOGICAL(m_sexp)[0] ) ; 
+    		return internal::r_coerce<LGLSXP,RAWSXP>( LOGICAL(m_sexp)[0] ) ; 
     	case REALSXP:
-    		return double_to_Rbyte( REAL(m_sexp)[0] );
+    		return internal::r_coerce<REALSXP,RAWSXP>( REAL(m_sexp)[0] );
     	case INTSXP:
-    		return int_to_Rbyte( INTEGER(m_sexp)[0] );
+    		return internal::r_coerce<INTSXP,RAWSXP>( INTEGER(m_sexp)[0] );
     	case RAWSXP:
     		return RAW(m_sexp)[0] ;
     	default:
@@ -140,13 +140,13 @@
     	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
     	break;
     case LGLSXP:
-    	std::transform( LOGICAL(m_sexp), LOGICAL(m_sexp)+n, v.begin(), Rboolean_to_int ) ;
+    	std::transform( LOGICAL(m_sexp), LOGICAL(m_sexp)+n, v.begin(), internal::r_coerce<LGLSXP,INTSXP> ) ;
     	break;
     case REALSXP:
-    	std::transform( REAL(m_sexp), REAL(m_sexp)+n, v.begin(), double_to_int ) ;
+    	std::transform( REAL(m_sexp), REAL(m_sexp)+n, v.begin(), internal::r_coerce<REALSXP,INTSXP> ) ;
     	break;
     case RAWSXP:
-    	std::transform( RAW(m_sexp), RAW(m_sexp)+n, v.begin(), Rbyte_to_int ) ;
+    	std::transform( RAW(m_sexp), RAW(m_sexp)+n, v.begin(), internal::r_coerce<RAWSXP,INTSXP> ) ;
     	break;
     default:
     		throw std::range_error( "as< vector<int> >: invalid R type" ) ; 
@@ -159,16 +159,16 @@
     std::vector<Rbyte> v(n);
     switch( TYPEOF(m_sexp) ){
     case LGLSXP:
-    	std::transform( LOGICAL(m_sexp), LOGICAL(m_sexp)+n, v.begin(), Rboolean_to_Rbyte ) ;
+    	std::transform( LOGICAL(m_sexp), LOGICAL(m_sexp)+n, v.begin(), internal::r_coerce<LGLSXP,RAWSXP> ) ;
     	break ;
     case RAWSXP:
     	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
     	break ;
     case REALSXP:
-    	std::transform( REAL(m_sexp), REAL(m_sexp)+n, v.begin(), double_to_Rbyte ) ;
+    	std::transform( REAL(m_sexp), REAL(m_sexp)+n, v.begin(), internal::r_coerce<REALSXP,RAWSXP> ) ;
     	break;
     case INTSXP:
-    	std::transform( INTEGER(m_sexp), INTEGER(m_sexp)+n, v.begin(), int_to_Rbyte ) ;
+    	std::transform( INTEGER(m_sexp), INTEGER(m_sexp)+n, v.begin(), internal::r_coerce<INTSXP,RAWSXP> ) ;
     	break;
     default:
     	throw std::range_error("as< vector<Rbyte> > expects raw, double or int");
@@ -181,16 +181,16 @@
     std::vector<double> v(n);
     switch( TYPEOF(m_sexp) ){
     case LGLSXP:
-    	std::transform( LOGICAL(m_sexp), LOGICAL(m_sexp)+n, v.begin(), Rboolean_to_double ) ;
+    	std::transform( LOGICAL(m_sexp), LOGICAL(m_sexp)+n, v.begin(), internal::r_coerce<LGLSXP,REALSXP> ) ;
     	break ;
     case RAWSXP:
-    	std::transform( RAW(m_sexp), RAW(m_sexp)+n, v.begin(), Rbyte_to_double ) ;
+    	std::transform( RAW(m_sexp), RAW(m_sexp)+n, v.begin(), internal::r_coerce<RAWSXP,REALSXP> ) ;
     	break ;
     case REALSXP:
     	v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
     	break;
     case INTSXP:
-    	std::transform( INTEGER(m_sexp), INTEGER(m_sexp)+n, v.begin(), int_to_double) ;
+    	std::transform( INTEGER(m_sexp), INTEGER(m_sexp)+n, v.begin(), internal::r_coerce<INTSXP,REALSXP>) ;
     	break;
     default:
     	    throw std::range_error("as< vector<double> >:  expects raw, double or int");

Added: pkg/src/coerce.cpp
===================================================================
--- pkg/src/coerce.cpp	                        (rev 0)
+++ pkg/src/coerce.cpp	2010-02-02 21:12:47 UTC (rev 563)
@@ -0,0 +1,142 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// coerce.cpp: Rcpp R/C++ interface class library -- coercion
+//
+// 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 <RcppCommon.h>
+
+namespace Rcpp{ 
+namespace internal{
+
+template <> int r_coerce<INTSXP,INTSXP>(int from) { return from ; }
+template <> int r_coerce<LGLSXP,LGLSXP>(int from) { return from ; }
+template <> double r_coerce<REALSXP,REALSXP>(double from) { return from ; }
+template <> Rcomplex r_coerce<CPLXSXP,CPLXSXP>(Rcomplex from) { return from ; }
+template <> Rbyte r_coerce<RAWSXP,RAWSXP>(Rbyte from) { return from ; }
+
+// -> INTSXP
+template <> int r_coerce<LGLSXP,INTSXP>(int from){
+	return (from==NA_LOGICAL) ? NA_INTEGER : from ;
+}
+template <> int r_coerce<REALSXP,INTSXP>(double from){
+	if (ISNAN(from)) return NA_INTEGER;
+	else if (from > INT_MAX || from <= INT_MIN ) {
+		return NA_INTEGER;
+	}
+	return static_cast<int>(from);
+
+}
+template <> int r_coerce<CPLXSXP,INTSXP>(Rcomplex from){
+	return r_coerce<REALSXP,INTSXP>(from.r) ;
+}
+template <> int r_coerce<RAWSXP,INTSXP>(Rbyte from){
+	return static_cast<int>(from);
+}
+
+// -> REALSXP
+template <> double r_coerce<LGLSXP,REALSXP>(int from){
+	return from == NA_LOGICAL ? NA_REAL : static_cast<double>(from) ;
+}
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/rcpp -r 563


More information about the Rcpp-commits mailing list