[Rcpp-commits] r2764 - in pkg/Rcpp: inst/include/Rcpp inst/include/Rcpp/internal src

[noreply at r-forge.r-project.org]

Author: romain
Date: 2010-12-10 15:34:50 +0100 (Fri, 10 Dec 2010)
New Revision: 2764

Modified:
   pkg/Rcpp/inst/include/Rcpp/barrier.h
   pkg/Rcpp/inst/include/Rcpp/internal/wrap.h
   pkg/Rcpp/src/barrier.cpp
Log:
crossing the WB for VECSXP too (when sure this is safe)

Modified: pkg/Rcpp/inst/include/Rcpp/barrier.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/barrier.h	2010-12-10 13:49:09 UTC (rev 2763)
+++ pkg/Rcpp/inst/include/Rcpp/barrier.h	2010-12-10 14:34:50 UTC (rev 2764)
@@ -30,5 +30,6 @@
 
 SEXP get_vector_elt(SEXP, int) ;
 void set_vector_elt(SEXP, int, SEXP ) ;
+SEXP* get_vector_ptr(SEXP) ;
 
 #endif

Modified: pkg/Rcpp/inst/include/Rcpp/internal/wrap.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/internal/wrap.h	2010-12-10 13:49:09 UTC (rev 2763)
+++ pkg/Rcpp/inst/include/Rcpp/internal/wrap.h	2010-12-10 14:34:50 UTC (rev 2764)
@@ -128,6 +128,40 @@
 	return primitive_range_wrap__impl<InputIterator,T>( first, last, typename ::Rcpp::traits::r_sexptype_needscast<T>() ) ;
 }
 
+template <typename InputIterator>
+inline SEXP vecsxp_range_wrap__isSEXP( InputIterator first, InputIterator last, Rcpp::traits::true_type ){
+	size_t size = std::distance( first, last ) ;
+	SEXP x = PROTECT( Rf_allocVector( VECSXP, size ) );
+	for( size_t i =0; i < size; i++, ++first ){
+		SET_VECTOR_ELT( x, i, ::Rcpp::wrap(*first) ) ;
+	}
+	UNPROTECT(1) ;
+	return x ;
+}
+
+template <typename InputIterator>
+inline SEXP vecsxp_range_wrap__isSEXP( InputIterator first, InputIterator last, Rcpp::traits::false_type ){
+	size_t size = std::distance( first, last ) ;
+	SEXP x = PROTECT( Rf_allocVector( VECSXP, size ) );
+	SEXP *x_ptr = get_vector_ptr(x) ;
+	for( size_t i =0; i < size; i++, ++first ){
+		x_ptr[i] = ::Rcpp::wrap(*first) ;
+	}
+	UNPROTECT(1) ;
+	return x ;
+}
+
+template <typename InputIterator, typename U>
+inline SEXP vecsxp_range_wrap( InputIterator first, InputIterator last, const U& ){
+	return vecsxp_range_wrap__isSEXP<InputIterator>( 
+		first, last, 
+		typename Rcpp::traits::same_type<U,SEXP>()
+    ) ;
+}
+
+
+
+
 /** 
  * range based wrap implementation that deals with iterators over 
  * some type U. each U object is itself wrapped
@@ -136,16 +170,7 @@
  */
 template <typename InputIterator, typename T>
 inline SEXP range_wrap_dispatch___impl( InputIterator first, InputIterator last, ::Rcpp::traits::r_type_generic_tag ){ 
-	size_t size = std::distance( first, last ) ;
-	SEXP x = PROTECT( Rf_allocVector( VECSXP, size ) );
-	size_t i =0 ;
-	while( i < size ){
-		SET_VECTOR_ELT( x, i, ::Rcpp::wrap(*first) ) ;
-		i++ ;
-		++first ;
-	}
-	UNPROTECT(1) ;
-	return x ;
+	return vecsxp_range_wrap( first, last, *first ) ;
 }
 
 /**

Modified: pkg/Rcpp/src/barrier.cpp
===================================================================
--- pkg/Rcpp/src/barrier.cpp	2010-12-10 13:49:09 UTC (rev 2763)
+++ pkg/Rcpp/src/barrier.cpp	2010-12-10 14:34:50 UTC (rev 2764)
@@ -43,4 +43,5 @@
 void set_vector_elt(SEXP x, int i, SEXP value){
     SET_VECTOR_ELT(x, i, value ) ;
 }
+SEXP* get_vector_ptr(SEXP x){ return VECTOR_PTR(x) ; }