[Rcpp-commits] r565 - 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
Thu Feb 4 11:56:11 CET 2010
Author: romain
Date: 2010-02-04 11:56:11 +0100 (Thu, 04 Feb 2010)
New Revision: 565
Modified:
pkg/inst/ChangeLog
pkg/inst/unitTests/runit.IntegerVector.R
pkg/inst/unitTests/runit.Language.R
pkg/inst/unitTests/runit.S4.R
pkg/src/RObject.cpp
pkg/src/Rcpp/DottedPair.h
pkg/src/Rcpp/RObject.h
pkg/src/Rcpp/VectorBase.h
pkg/src/Rcpp/internal/wrap.h
pkg/src/Rcpp/traits/r_sexptype_traits.h
pkg/src/Rcpp/traits/r_type_traits.h
pkg/src/RcppCommon.h
pkg/src/VectorBase.cpp
Log:
one more level of dispatch in wrap, DottedPair::operator<<, DottedPair::operator>>, ...
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/inst/ChangeLog 2010-02-04 10:56:11 UTC (rev 565)
@@ -1,3 +1,29 @@
+2010-02-03 Romain Francois <francoisromain at free.fr>
+
+ * src/Rcpp/internal/wrap.h : one more level of dispatch to
+ identify if there needs a cast between the primitive
+ iterated over and the target storage type. For example
+ size_t needs a cast to be stored in an integer vector. This
+ will be useful for the RProtoBuf package with e.g. types like
+ google::protobuf::int64 which needs to be cast to double.
+ Consequently the special handling of bool has been withdrawn
+ as bool can now be assimilated to a primitive type that does
+ require casting (to int)
+
+2010-02-03 Romain Francois <francoisromain at free.fr>
+
+ * src/Rcpp/VectorBase.h: VectorBase gains a names method that
+ uses the proxy pattern to get or set the names of a vector
+
+ * src/Rcpp/DottedPair.h: DottedPair gains a << operator to
+ add an object to the queue of the list. this is much useful
+ when variadic templates are not available
+
+ * src/Rcpp/RObject.h: support for slot assignment. The slot
+ method now uses the proxy pattern.
+
+ * inst/unitTests/runit.S4.R: unit test for slot assignment
+
2010-02-02 Romain Francois <francoisromain at free.fr>
* src/internal/r_coerce.h : coercion is now handled by a templated
Modified: pkg/inst/unitTests/runit.IntegerVector.R
===================================================================
--- pkg/inst/unitTests/runit.IntegerVector.R 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/inst/unitTests/runit.IntegerVector.R 2010-02-04 10:56:11 UTC (rev 565)
@@ -122,3 +122,25 @@
checkEquals( funx(), 0:3, msg = "assign(int*, int*)" )
}
+test.IntegerVector.names.set <- function(){
+ funx <- cfunction(signature(), '
+ IntegerVector y(2) ;
+ std::vector<std::string> names(2) ;
+ names[0] = "foo" ;
+ names[1] = "bar" ;
+ y.names() = names ;
+ return y ;
+ ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ checkEquals( names(funx()), c("foo", "bar"),
+ msg = "Vector::names" )
+}
+
+test.IntegerVector.names.get <- function(){
+ funx <- cfunction(signature(x = "integer"), '
+ IntegerVector y(x) ;
+ return y.names() ;
+ ', Rcpp = TRUE, includes = "using namespace Rcpp;" )
+ checkEquals( funx( c("foo" = 1L, "bar" = 2L) ), c("foo", "bar"),
+ msg = "Vector::names get" )
+}
+
Modified: pkg/inst/unitTests/runit.Language.R
===================================================================
--- pkg/inst/unitTests/runit.Language.R 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/inst/unitTests/runit.Language.R 2010-02-04 10:56:11 UTC (rev 565)
@@ -99,3 +99,13 @@
checkEquals( funx(sort, sample(1:10)), 1:10, msg = "Language( Function ) " )
}
+test.Language.inputoperator <- function(){
+ funx <- cfunction(signature(),
+ '
+ Language call( "rnorm" );
+ call << 10 << Named( "sd", 10 ) ;
+ return call ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ checkEquals( funx(), call("rnorm", 10L, sd = 10L ) , msg = "Language<<" )
+}
+
Modified: pkg/inst/unitTests/runit.S4.R
===================================================================
--- pkg/inst/unitTests/runit.S4.R 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/inst/unitTests/runit.S4.R 2010-02-04 10:56:11 UTC (rev 565)
@@ -38,5 +38,31 @@
checkEquals( funx(tr),
list( TRUE, TRUE, FALSE, 2.0, 2.0 )
, msg = "slot management" )
+
+ funx <- cfunction(signature(x = "ANY" ), '
+ RObject y(x) ;
+ y.slot( "x" ) = 10.0 ;
+ y.slot( "y" ) = 20.0 ;
+ return R_NilValue ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ funx( tr )
+ checkEquals( tr at x, 10.0 , msg = "slot('x') = 10" )
+ checkEquals( tr at y, 20.0 , msg = "slot('y') = 20" )
+
+ funx <- cfunction(signature(x = "ANY" ), '
+ RObject y(x) ;
+ y.slot( "foo" ) = 10.0 ;
+ return R_NilValue ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ checkException( funx( tr ), msg = "slot does not exist" )
+
+ funx <- cfunction(signature(x = "ANY" ), '
+ RObject y(x) ;
+ y.slot( "foo" ) ;
+ return R_NilValue ;
+ ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+ checkException( funx( tr ), msg = "slot does not exist" )
+
+
}
Modified: pkg/src/RObject.cpp
===================================================================
--- pkg/src/RObject.cpp 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/src/RObject.cpp 2010-02-04 10:56:11 UTC (rev 565)
@@ -96,7 +96,42 @@
return false; /* give up */
}
+RObject::SlotProxy::SlotProxy( const RObject& v, const std::string& name) :
+ parent(v), slot_name(name)
+{
+ if( !R_has_slot( v, Rf_install(name.c_str())) ){
+ throw no_such_slot() ;
+ }
+} ;
+RObject::SlotProxy& RObject::SlotProxy::operator=(const SlotProxy& rhs){
+ set( rhs.get() ) ;
+ return *this ;
+}
+
+const char* RObject::no_such_slot::what( ) const throw() {
+ return "no such slot" ;
+}
+
+SEXP RObject::SlotProxy::get() const {
+ return internal::try_catch(
+ Rf_lcons( Rf_install("slot"), Rf_cons( parent ,
+ Rf_cons( Rf_mkString(slot_name.c_str()) , R_NilValue)))) ;
+
+}
+
+void RObject::SlotProxy::set( SEXP x) const {
+ internal::try_catch(
+ Rf_lcons( Rf_install("slot<-"),
+ Rf_cons( parent, Rf_cons( Rf_mkString(slot_name.c_str()),
+ Rf_cons( Rf_ScalarLogical(TRUE) ,
+ Rf_cons( x , R_NilValue) ) )))) ;
+}
+
+RObject::SlotProxy::operator SEXP() const {
+ return get() ;
+}
+
RObject::AttributeProxy::AttributeProxy( const RObject& v, const std::string& name) :
parent(v), attr_name(name) {};
@@ -120,9 +155,9 @@
return R_has_slot( m_sexp, Rf_mkString(name.c_str()) ) ;
}
-RObject RObject::slot(const std::string& name) const throw(not_s4){
+RObject::SlotProxy RObject::slot(const std::string& name) const throw(not_s4){
if( !Rf_isS4(m_sexp) ) throw not_s4() ;
- return R_do_slot( m_sexp, Rf_mkString(name.c_str()) ) ;
+ return SlotProxy( *this, name ) ;
}
Modified: pkg/src/Rcpp/DottedPair.h
===================================================================
--- pkg/src/Rcpp/DottedPair.h 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/src/Rcpp/DottedPair.h 2010-02-04 10:56:11 UTC (rev 565)
@@ -169,6 +169,18 @@
virtual ~DottedPair() = 0 ;
+ template <typename T>
+ friend DottedPair& operator<<(DottedPair& os, const T& t){
+ os.push_back( t ) ;
+ return os ;
+ }
+
+ template <typename T>
+ friend DottedPair& operator>>( const T& t, DottedPair& s){
+ s.push_front(t);
+ return s ;
+ }
+
};
} // namespace Rcpp
Modified: pkg/src/Rcpp/RObject.h
===================================================================
--- pkg/src/Rcpp/RObject.h 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/src/Rcpp/RObject.h 2010-02-04 10:56:11 UTC (rev 565)
@@ -51,6 +51,16 @@
virtual const char* what() const throw() ;
} ;
+ /**
+ * Exception thrown when attempting to convert a SEXP
+ */
+ class no_such_slot : public std::exception{
+ public:
+ no_such_slot() throw(){};
+ virtual ~no_such_slot() throw(){} ;
+ virtual const char* what() const throw() ;
+ } ;
+
class index_out_of_bounds: public std::exception{
public:
index_out_of_bounds() throw(){};
@@ -149,6 +159,36 @@
std::string attr_name ;
} ;
+ class SlotProxy {
+ public:
+ SlotProxy( const RObject& v, const std::string& name) ;
+
+ /* lvalue uses */
+ SlotProxy& operator=(const SlotProxy& rhs) ;
+
+ template <typename T>
+ SlotProxy& operator=(const T& rhs){
+ set( wrap(rhs) ) ;
+ return *this ;
+ }
+
+ /* rvalue use */
+ operator SEXP() const ;
+
+ template <typename T> operator T() const {
+ T t = Rcpp::as<T>(get()) ;
+ return t ;
+ } ;
+
+ private:
+ const RObject& parent;
+ std::string slot_name ;
+
+ SEXP get() const ;
+ void set(SEXP x ) const;
+ } ;
+
+
/**
* extract or set the given attribute
*
@@ -204,10 +244,8 @@
*
* @throw not_s4 if this is not an S4 object
*/
- RObject slot(const std::string& name) const throw(not_s4) ;
- /* TODO : implement the proxy pattern here so that we can get and
- set the slot the same way */
-
+ SlotProxy slot(const std::string& name) const throw(not_s4) ;
+
protected:
/**
Modified: pkg/src/Rcpp/VectorBase.h
===================================================================
--- pkg/src/Rcpp/VectorBase.h 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/src/Rcpp/VectorBase.h 2010-02-04 10:56:11 UTC (rev 565)
@@ -63,6 +63,35 @@
/* TODO: 3 dimensions, ... n dimensions through variadic templates */
+ class NamesProxy {
+ public:
+ NamesProxy( const VectorBase& v) ;
+
+ /* lvalue uses */
+ NamesProxy& operator=(const NamesProxy& rhs) ;
+
+ template <typename T>
+ NamesProxy& operator=(const T& rhs){
+ set( wrap(rhs) ) ;
+ return *this ;
+ }
+
+ /* rvalue use */
+ operator SEXP() const ;
+
+ template <typename T> operator T() const {
+ T t = Rcpp::as<T>(get()) ;
+ return t ;
+ } ;
+
+ private:
+ const VectorBase& parent;
+
+ SEXP get() const ;
+ void set(SEXP x) const;
+ } ;
+
+ NamesProxy names() const ;
} ;
} // namespace
Modified: pkg/src/Rcpp/internal/wrap.h
===================================================================
--- pkg/src/Rcpp/internal/wrap.h 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/src/Rcpp/internal/wrap.h 2010-02-04 10:56:11 UTC (rev 565)
@@ -41,37 +41,62 @@
// {{{ range wrap
// {{{ unnamed range wrap
+
+template <typename FROM, typename TO> TO caster(FROM from){
+ return static_cast<TO>(from) ;
+}
+
/**
- * Range based wrap implementation that deals with iterator over
- * primitive types (int, double, etc ...)
- *
- * This produces an unnamed vector of the appropriate type
+ * Range based primitive wrap implementation. used when
+ * - T is a primitive type, indicated by the r_type_traits
+ * - T needs a static_cast to be of the type suitable to fit in the R vector
+ *
+ * This produces an unnamed vector of the appropriate type using the
+ * std::transform algorithm
*/
template <typename InputIterator, typename T>
-SEXP range_wrap_dispatch___impl( InputIterator first, InputIterator last, ::Rcpp::traits::r_type_primitive_tag){
+SEXP primitive_range_wrap__impl( InputIterator first, InputIterator last, ::Rcpp::traits::true_type ){
size_t size = std::distance( first, last ) ;
const int RTYPE = ::Rcpp::traits::r_sexptype_traits<T>::rtype ;
SEXP x = PROTECT( Rf_allocVector( RTYPE, size ) );
- std::copy( first, last, r_vector_start<RTYPE, typename ::Rcpp::traits::storage_type<RTYPE>::type >(x) ) ;
+ std::transform( first, last,
+ r_vector_start< RTYPE, typename ::Rcpp::traits::storage_type<RTYPE>::type >(x),
+ caster< T, typename ::Rcpp::traits::storage_type<RTYPE>::type >
+ ) ;
UNPROTECT(1) ;
return x ;
-} ;
+}
/**
- * Range based wrap implementation that deals with iterators over bool
- *
- * This produces an unnamed logical vector
+ * Range based primitive wrap implementation. used when :
+ * - T is a primitive type
+ * - T does not need a cast
+ *
+ * This produces an unnamed vector of the appropriate type using
+ * the std::copy algorithm
*/
template <typename InputIterator, typename T>
-SEXP range_wrap_dispatch___impl( InputIterator first, InputIterator last, ::Rcpp::traits::r_type_bool_tag){
+SEXP primitive_range_wrap__impl( InputIterator first, InputIterator last, ::Rcpp::traits::false_type ){
size_t size = std::distance( first, last ) ;
- SEXP x = PROTECT( Rf_allocVector( LGLSXP, size ) );
- std::transform( first, last, LOGICAL(x), bool_to_Rboolean ) ;
+ const int RTYPE = ::Rcpp::traits::r_sexptype_traits<T>::rtype ;
+ SEXP x = PROTECT( Rf_allocVector( RTYPE, size ) );
+ std::copy( first, last, r_vector_start<RTYPE, typename ::Rcpp::traits::storage_type<RTYPE>::type >(x) ) ;
UNPROTECT(1) ;
return x ;
+}
+
+
+/**
+ * Range based wrap implementation that deals with iterator over
+ * primitive types (int, double, etc ...)
+ *
+ * This produces an unnamed vector of the appropriate type
+ */
+template <typename InputIterator, typename T>
+SEXP range_wrap_dispatch___impl( InputIterator first, InputIterator last, ::Rcpp::traits::r_type_primitive_tag){
+ return primitive_range_wrap__impl<InputIterator,T>( first, last, typename ::Rcpp::traits::r_sexptype_needscast<T>() ) ;
} ;
-
/**
* range based wrap implementation that deals with iterators over
* some type U. each U object is itself wrapped
@@ -115,14 +140,17 @@
// }}}
// {{{ named range wrap
+
/**
* range based wrap implementation that deals with iterators over
* pair<const string,T> where T is a primitive type : int, double ...
*
+ * This version is used when there is no need to cast T
+ *
* This produces a named R vector of the appropriate type
*/
template <typename InputIterator, typename T>
-SEXP range_wrap_dispatch___impl( InputIterator first, InputIterator last, ::Rcpp::traits::r_type_pairstring_primitive_tag){
+SEXP range_wrap_dispatch___impl__cast( InputIterator first, InputIterator last, ::Rcpp::traits::false_type ){
size_t size = std::distance( first, last ) ;
const int RTYPE = ::Rcpp::traits::r_sexptype_traits<typename T::second_type>::rtype ;
SEXP x = PROTECT( Rf_allocVector( RTYPE, size ) );
@@ -141,22 +169,27 @@
return x ;
} ;
-/**
- * Range based wrap implementation that deals with iterators
- * over pair<const string,bool>
- *
- * This produces a named character vector
+/**
+ * range based wrap implementation that deals with iterators over
+ * pair<const string,T> where T is a primitive type : int, double ...
+ *
+ * This version is used when T needs to be cast to the associated R
+ * type
+ *
+ * This produces a named R vector of the appropriate type
*/
template <typename InputIterator, typename T>
-SEXP range_wrap_dispatch___impl( InputIterator first, InputIterator last, ::Rcpp::traits::r_type_pairstring_bool_tag){
+SEXP range_wrap_dispatch___impl__cast( InputIterator first, InputIterator last, ::Rcpp::traits::true_type ){
size_t size = std::distance( first, last ) ;
- SEXP x = PROTECT( Rf_allocVector( LGLSXP, size ) );
+ const int RTYPE = ::Rcpp::traits::r_sexptype_traits<typename T::second_type>::rtype ;
+ SEXP x = PROTECT( Rf_allocVector( RTYPE, size ) );
SEXP names = PROTECT( Rf_allocVector( STRSXP, size ) ) ;
+ typedef typename ::Rcpp::traits::storage_type<RTYPE>::type CTYPE ;
+ CTYPE* start = r_vector_start<RTYPE,CTYPE>(x) ;
size_t i =0;
- std::string buf ;
- int* start = LOGICAL(x) ;
+ std::string buf ;
for( ; i<size; i++, ++first){
- start[i] = bool_to_Rboolean( (*first).second );
+ start[i] = static_cast<CTYPE>( (*first).second );
buf = (*first).first ;
SET_STRING_ELT( names, i, Rf_mkChar(buf.c_str()) ) ;
}
@@ -166,6 +199,21 @@
} ;
+/**
+ * range based wrap implementation that deals with iterators over
+ * pair<const string,T> where T is a primitive type : int, double ...
+ *
+ * This dispatches further depending on whether the type needs
+ * a cast to fit into the associated R type
+ *
+ * This produces a named R vector of the appropriate type
+ */
+template <typename InputIterator, typename T>
+SEXP range_wrap_dispatch___impl( InputIterator first, InputIterator last, ::Rcpp::traits::r_type_pairstring_primitive_tag){
+ return range_wrap_dispatch___impl__cast<InputIterator,T>( first, last,
+ typename ::Rcpp::traits::r_sexptype_needscast<typename T::second_type>() ) ;
+} ;
+
/**
* Range based wrap implementation that deals with iterators over
* pair<const string, U> where U is wrappable. This is the kind of
@@ -255,31 +303,38 @@
// {{{ primitive wrap (wrapping a single primitive value)
/**
- * primitive wrap for 'easy' primitive types: int, double, Rbyte, Rcomplex
- *
- * This produces a vector of length 1 of the appropriate type
+ * wraps a single primitive value when there is no need for a cast
*/
template <typename T>
-SEXP primitive_wrap__impl( const T& object, ::Rcpp::traits::r_type_primitive_tag ){
+SEXP primitive_wrap__impl__cast( const T& object, ::Rcpp::traits::false_type ){
const int RTYPE = ::Rcpp::traits::r_sexptype_traits<T>::rtype ;
SEXP x = PROTECT( Rf_allocVector( RTYPE, 1 ) );
r_vector_start<RTYPE, typename ::Rcpp::traits::storage_type<RTYPE>::type >(x)[0] = object ;
UNPROTECT(1);
return x;
-}
+} ;
/**
- * primitive wrap for bool
+ * wraps a single primitive value when a cast is needed
+ */
+template <typename T>
+SEXP primitive_wrap__impl__cast( const T& object, ::Rcpp::traits::true_type ){
+ const int RTYPE = ::Rcpp::traits::r_sexptype_traits<T>::rtype ;
+ SEXP x = PROTECT( Rf_allocVector( RTYPE, 1 ) );
+ r_vector_start<RTYPE, typename ::Rcpp::traits::storage_type<RTYPE>::type >(x)[0] = static_cast< typename ::Rcpp::traits::storage_type<RTYPE>::type >(object) ;
+ UNPROTECT(1);
+ return x;
+} ;
+
+/**
+ * primitive wrap for 'easy' primitive types: int, double, Rbyte, Rcomplex
*
- * This produces a logical vector of length 1
+ * This produces a vector of length 1 of the appropriate type
*/
template <typename T>
-SEXP primitive_wrap__impl( const T& object, ::Rcpp::traits::r_type_bool_tag){
- SEXP x = PROTECT( ::Rf_allocVector( LGLSXP, 1) );
- LOGICAL(x)[0] = static_cast<int>(object);
- UNPROTECT(1) ; /* x */
- return x;
-}
+SEXP primitive_wrap__impl( const T& object, ::Rcpp::traits::r_type_primitive_tag ){
+ return primitive_wrap__impl__cast( object, typename ::Rcpp::traits::r_sexptype_needscast<T>() );
+} ;
/**
* primitive wrap for types that can be converted implicitely to std::string
Modified: pkg/src/Rcpp/traits/r_sexptype_traits.h
===================================================================
--- pkg/src/Rcpp/traits/r_sexptype_traits.h 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/src/Rcpp/traits/r_sexptype_traits.h 2010-02-04 10:56:11 UTC (rev 565)
@@ -32,13 +32,25 @@
*/
template <typename T> struct r_sexptype_traits{ enum{ rtype = VECSXP }; } ;
template<> struct r_sexptype_traits<int>{ enum{ rtype = INTSXP } ; } ;
-template<> struct r_sexptype_traits<size_t>{ enum{ rtype = INTSXP } ; } ;
template<> struct r_sexptype_traits<double>{ enum{ rtype = REALSXP } ; } ;
template<> struct r_sexptype_traits<bool>{ enum{ rtype = LGLSXP } ; } ;
template<> struct r_sexptype_traits<std::string>{ enum{ rtype = STRSXP } ; } ;
template<> struct r_sexptype_traits<Rcomplex>{ enum{ rtype = CPLXSXP } ; } ;
template<> struct r_sexptype_traits<Rbyte>{ enum{ rtype = RAWSXP } ; } ;
+template<> struct r_sexptype_traits<size_t>{ enum{ rtype = INTSXP } ; } ;
+template<> struct r_sexptype_traits<float>{ enum{ rtype = REALSXP } ; } ;
+
+
+/**
+ * Indicates if a primitive type needs a static_cast
+ */
+template <typename T> struct r_sexptype_needscast : public true_type{};
+template<> struct r_sexptype_needscast<int> : public false_type{} ;
+template<> struct r_sexptype_needscast<double> : public false_type{} ;
+template<> struct r_sexptype_needscast<Rcomplex> : public false_type{} ;
+template<> struct r_sexptype_needscast<Rbyte> : public false_type{} ;
+
} // traits
} // Rcpp
Modified: pkg/src/Rcpp/traits/r_type_traits.h
===================================================================
--- pkg/src/Rcpp/traits/r_type_traits.h 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/src/Rcpp/traits/r_type_traits.h 2010-02-04 10:56:11 UTC (rev 565)
@@ -44,13 +44,8 @@
struct r_type_generic_tag{} ;
/**
- * Indentifies the bool type
- */
-struct r_type_bool_tag{} ;
-
-/**
* Identifies that the type if pair<const std::string,T> where T
- * is a primitive type that needs no special handling
+ * is a primitive type
*/
struct r_type_pairstring_primitive_tag{} ;
@@ -65,11 +60,6 @@
struct r_type_pairstring_generic_tag{} ;
/**
- * Identifies pair<const std::string,bool>
- */
-struct r_type_pairstring_bool_tag{} ;
-
-/**
* R type trait. Helps wrap.
*/
template <typename T> struct r_type_traits { typedef r_type_generic_tag r_category ; } ;
@@ -79,23 +69,27 @@
*/
template <typename T> struct r_type_traits< std::pair<const std::string,T> > { typedef r_type_pairstring_generic_tag r_category ; } ;
template<> struct r_type_traits< std::pair<const std::string,int> >{ typedef r_type_pairstring_primitive_tag r_category ; } ;
-template<> struct r_type_traits< std::pair<const std::string,size_t> >{ typedef r_type_pairstring_primitive_tag r_category ; } ;
template<> struct r_type_traits< std::pair<const std::string,double> >{ typedef r_type_pairstring_primitive_tag r_category ; } ;
template<> struct r_type_traits< std::pair<const std::string,Rbyte> >{ typedef r_type_pairstring_primitive_tag r_category ; } ;
template<> struct r_type_traits< std::pair<const std::string,Rcomplex> >{ typedef r_type_pairstring_primitive_tag r_category ; } ;
-template<> struct r_type_traits< std::pair<const std::string,bool> >{ typedef r_type_pairstring_bool_tag r_category ; } ;
+template<> struct r_type_traits< std::pair<const std::string,bool> >{ typedef r_type_pairstring_primitive_tag r_category ; } ;
template<> struct r_type_traits< std::pair<const std::string,std::string> >{ typedef r_type_pairstring_string_tag r_category ; } ;
template<> struct r_type_traits< std::pair<const std::string,char> >{ typedef r_type_pairstring_string_tag r_category ; } ;
+template<> struct r_type_traits< std::pair<const std::string,size_t> >{ typedef r_type_pairstring_primitive_tag r_category ; } ;
+template<> struct r_type_traits< std::pair<const std::string,float> >{ typedef r_type_pairstring_primitive_tag r_category ; } ;
+
template<> struct r_type_traits<int>{ typedef r_type_primitive_tag r_category ; } ;
-template<> struct r_type_traits<size_t>{ typedef r_type_primitive_tag r_category ; } ;
template<> struct r_type_traits<double>{ typedef r_type_primitive_tag r_category ; } ;
template<> struct r_type_traits<Rbyte>{ typedef r_type_primitive_tag r_category ; } ;
template<> struct r_type_traits<Rcomplex>{ typedef r_type_primitive_tag r_category ; } ;
-template<> struct r_type_traits<bool>{ typedef r_type_bool_tag r_category ; } ;
+template<> struct r_type_traits<bool>{ typedef r_type_primitive_tag r_category ; } ;
template<> struct r_type_traits<std::string>{ typedef r_type_string_tag r_category ; } ;
template<> struct r_type_traits<char>{ typedef r_type_string_tag r_category ; } ;
+template<> struct r_type_traits<size_t>{ typedef r_type_primitive_tag r_category ; } ;
+template<> struct r_type_traits<float>{ typedef r_type_primitive_tag r_category ; } ;
+
} // traits
} // Rcpp
Modified: pkg/src/RcppCommon.h
===================================================================
--- pkg/src/RcppCommon.h 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/src/RcppCommon.h 2010-02-04 10:56:11 UTC (rev 565)
@@ -148,7 +148,6 @@
} // namespace internal
-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 ; }
Modified: pkg/src/VectorBase.cpp
===================================================================
--- pkg/src/VectorBase.cpp 2010-02-02 21:56:45 UTC (rev 564)
+++ pkg/src/VectorBase.cpp 2010-02-04 10:56:11 UTC (rev 565)
@@ -42,4 +42,31 @@
return i ;
}
-} // namespace
+ VectorBase::NamesProxy::NamesProxy( const VectorBase& v) : parent(v){} ;
+ VectorBase::NamesProxy& VectorBase::NamesProxy::operator=( const NamesProxy& rhs){
+ set( rhs.get() ) ;
+ return *this ;
+ }
+ VectorBase::NamesProxy::operator SEXP() const { return get() ; }
+ SEXP VectorBase::NamesProxy::get() const {
+ return RCPP_GET_NAMES(parent) ;
+ }
+ void VectorBase::NamesProxy::set(SEXP x) const {
+ SEXP new_vec = PROTECT( internal::try_catch(
+ Rf_lcons( Rf_install("names<-"),
+ Rf_cons( parent, Rf_cons( x , R_NilValue) )))) ;
+ /* names<- makes a new vector, so we have to change
+ the SEXP of the parent of this proxy, it might be
+ worth to work directly with the names attribute instead
+ of using the names<- R function, but then we need to
+ take care of coercion, recycling, etc ... we cannot just
+ brutally assign the names attribute */
+ const_cast<VectorBase&>(parent).setSEXP( new_vec ) ;
+ UNPROTECT(1) ; /* new_vec */
+ }
+
+ VectorBase::NamesProxy VectorBase::names() const{
+ return NamesProxy(*this) ;
+ }
+
+} // namespace )
More information about the Rcpp-commits
mailing list