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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Dec 29 21:18:00 CET 2009


Author: romain
Date: 2009-12-29 21:17:59 +0100 (Tue, 29 Dec 2009)
New Revision: 228

Added:
   pkg/src/RObject.cpp
   pkg/src/Rcpp_RObject.h
   pkg/src/Rcpp_XPtr.h
Removed:
   pkg/src/RcppSexp.cpp
   pkg/src/RcppSexp.h
   pkg/src/RcppXPtr.h
Modified:
   pkg/DESCRIPTION
   pkg/inst/ChangeLog
   pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r
   pkg/inst/examples/RcppInline/RcppSexpTests.r
   pkg/inst/examples/RcppInline/external_pointer.r
   pkg/src/Rcpp.h
   pkg/src/RcppExample.cpp
Log:
introduce namespace Rcpp

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/DESCRIPTION	2009-12-29 20:17:59 UTC (rev 228)
@@ -1,6 +1,6 @@
 Package: Rcpp
 Title: Rcpp R/C++ interface package
-Version: 0.7.0.4
+Version: 0.7.0.5
 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-29 18:47:06 UTC (rev 227)
+++ pkg/inst/ChangeLog	2009-12-29 20:17:59 UTC (rev 228)
@@ -1,5 +1,27 @@
 2009-12-29  Romain Francois <francoisromain at free.fr>
 
+	* src/Rcpp_RObject.{h,cpp}: new namespace Rcpp and new class
+	Rcpp::RObject to replace RcppSexp with the same functionality.
+	
+	* src/Rcpp_XPtr.h: replaces RcppXPtr.h and the class is now 
+	Rcpp::XPtr<> and extends Rcpp::RObject
+	
+	* inst/examples/RcppInline/external_pointer.r: use the new namespace
+	
+	* inst/examples/RcppInline/RcppInlineWithLibsExamples.r: idem
+	
+	* inst/examples/RcppInline/RcppSexpTests.r: idem
+	
+	* DESCRIPTION: marked as version 0.7.0.5
+	
+	* inst/doc/*: fake (empty) vignette and unit test trigger
+	
+	* inst/unitTests/*: prepare the space for unit tests
+	
+	* tests/doRUnit.R : added the usual RUnit tests trigger
+
+2009-12-29  Romain Francois <francoisromain at free.fr>
+
 	* src/RcppXPtr.h: now RcppXPtr extends RcppSexp and RcppSexp manages
 	garbarge collection, attributes, etc ...
 	

Modified: pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r	2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/inst/examples/RcppInline/RcppInlineWithLibsExamples.r	2009-12-29 20:17:59 UTC (rev 228)
@@ -1,4 +1,22 @@
 #!/usr/bin/r -t
+#
+# Copyright (C) 2009 - 2010	Dirk Eddelbuettel
+# 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/>.
 
 suppressMessages(library(Rcpp))
 suppressMessages(library(inline))
@@ -38,7 +56,7 @@
 
     ## now use Rcpp to pass down a parameter for the seed
     gslrng <- '
-    int seed = RcppSexp(par).asInt();
+    int seed = Rcpp::RObject(par).asInt();
 
     gsl_rng *r;
     gsl_rng_env_setup();
@@ -56,7 +74,7 @@
     #endif
 
     gsl_rng_free(r);
-    return RcppSexp(v).asSexp();
+    return Rcpp::RObject(v) ;
     '
 
     ## turn into a function that R can call
@@ -85,8 +103,8 @@
 
     ## now use Rcpp to pass down a parameter for the seed, and a vector size
     gslrng <- '
-    int seed = RcppSexp(s).asInt();
-    int len = RcppSexp(n).asInt();
+    int seed = Rcpp::RObject(s).asInt();
+    int len = Rcpp::RObject(n).asInt();
 
     gsl_rng *r;
     gsl_rng_env_setup();
@@ -100,7 +118,7 @@
     }
     gsl_rng_free(r);
 
-    return RcppSexp(v).asSexp();
+    return Rcpp::RObject(v) ;
     '
 
     ## turn into a function that R can call

Modified: pkg/inst/examples/RcppInline/RcppSexpTests.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppSexpTests.r	2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/inst/examples/RcppInline/RcppSexpTests.r	2009-12-29 20:17:59 UTC (rev 228)
@@ -22,9 +22,9 @@
 
 cat("===Doubles\n")
 foo <- '
-        double d = RcppSexp(x).asDouble();
+        double d = Rcpp::RObject(x).asDouble();
 	std::cout << "Returning twice the value of " << d << " : ";
-	return(RcppSexp( 2*d ).asSexp());
+	return(Rcpp::RObject( 2*d ) );
         '
 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
 cat(funx(x=2.123), "\n")
@@ -35,9 +35,9 @@
 
 cat("\n===Int\n")
 foo <- '
-        int i = RcppSexp(x).asInt();
+        int i = Rcpp::RObject(x).asInt();
 	std::cout << "Returning twice the value of " << i << " : ";
-	return(RcppSexp( 2*i ).asSexp());
+	return(Rcpp::RObject( 2*i ) );
         '
 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
 cat(funx(x=2), "\n")
@@ -47,18 +47,18 @@
 
 cat("\n===String\n")
 foo <- '
-        std::string s = RcppSexp(x).asStdString();
+        std::string s = Rcpp::RObject(x).asStdString();
 	std::cout << "Returning twice the value of " << s << " : ";
-	return(RcppSexp( s+s ).asSexp());
+	return(Rcpp::RObject( s+s ) );
         '
 funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
 cat(funx(x="abc"), "\n")
 
 cat("\n===Raw (bytes)\n")
 foo <- '
-        Rbyte i = RcppSexp(x).asRaw();
+        Rbyte i = Rcpp::RObject(x).asRaw();
 	std::cout << "Returning twice the value of " << (int)i << " : ";
-	return(RcppSexp( (Rbyte)(2*i) ).asSexp());
+	return(Rcpp::RObject( (Rbyte)(2*i) ) );
         '
 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
 cat( funx(x=2), "\n")
@@ -69,9 +69,9 @@
 
 cat("\n=== logical \n")
 foo <- '
-bool b = RcppSexp(x).asBool();
+bool b = Rcpp::RObject(x).asBool();
 std::cout << "flip  " << ( b ? "TRUE" : "FALSE" ) << " : ";
-return(RcppSexp( !b ).asSexp());
+return(Rcpp::RObject( !b ));
 '
 funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
 cat( res <- funx(x=TRUE) , "\n")  ; stopifnot( !res )
@@ -90,7 +90,7 @@
 
 cat("\n===Int Vector via RcppResultSet.getSEXP\n")
 foo <- '
-        std::vector<int> iv = RcppSexp(x).asStdVectorInt();
+        std::vector<int> iv = Rcpp::RObject(x).asStdVectorInt();
 	std::cout << "Returning twice the value of vector : ";
         for (size_t i=0; i<iv.size(); i++) {
             iv[i] = 2*iv[i];
@@ -108,12 +108,12 @@
 
 cat("\n===Int Vector\n")
 foo <- '
-        std::vector<int> iv = RcppSexp(x).asStdVectorInt();
+        std::vector<int> iv = Rcpp::RObject(x).asStdVectorInt();
 	std::cout << "Returning twice the value of vector : ";
         for (size_t i=0; i<iv.size(); i++) {
             iv[i] = 2*iv[i];
         }
-	return(RcppSexp( iv ).asSexp());
+	return(Rcpp::RObject( iv ) );
         '
 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
 print(funx(x=2:5+.1))
@@ -125,12 +125,12 @@
 
 cat("\n===Double Vector\n")
 foo <- '
-        std::vector<double> iv = RcppSexp(x).asStdVectorDouble();
+        std::vector<double> iv = Rcpp::RObject(x).asStdVectorDouble();
 	std::cout << "Returning twice the value of vector : ";
         for (size_t i=0; i<iv.size(); i++) {
             iv[i] = 2*iv[i];
         }
- 	return(RcppSexp( iv ).asSexp());
+ 	return(Rcpp::RObject( iv ));
         '
 funx <- cfunction(signature(x="numeric"), foo, Rcpp=TRUE, verbose=FALSE)
 print(funx(x=0.1+2:5))
@@ -141,12 +141,12 @@
 
 cat("\n===Raw Vector\n")
 foo <- '
-        std::vector<Rbyte> iv = RcppSexp(x).asStdVectorRaw();
+        std::vector<Rbyte> iv = Rcpp::RObject(x).asStdVectorRaw();
 	std::cout << "Returning twice the value of vector : ";
         for (size_t i=0; i<iv.size(); i++) {
             iv[i] = 2*iv[i];
         }
- 	return(RcppSexp( iv ).asSexp());
+ 	return(Rcpp::RObject( iv ));
         '
 funx <- cfunction(signature(x="raw"), foo, Rcpp=TRUE, verbose=FALSE)
 print(funx(x=as.raw(0:9)))
@@ -157,12 +157,12 @@
 
 cat("\n=== vector<bool>\n")
 foo <- '
-std::vector<bool> bv = RcppSexp(x).asStdVectorBool();
+std::vector<bool> bv = Rcpp::RObject(x).asStdVectorBool();
 std::cout << "Flip the value of vector : ";
 for (size_t i=0; i<bv.size(); i++) {
     bv[i].flip() ;
 }
-return(RcppSexp( bv ).asSexp());
+return(Rcpp::RObject( bv ));
 '
 funx <- cfunction(signature(x="logical"), foo, Rcpp=TRUE, verbose=FALSE)
 print(funx(x=c(TRUE,FALSE)))
@@ -176,12 +176,12 @@
 
 cat("\n===String Vector\n")
 foo <- '
-        std::vector<std::string> iv = RcppSexp(x).asStdVectorString();
+        std::vector<std::string> iv = Rcpp::RObject(x).asStdVectorString();
 	std::cout << "Returning twice the value of vector : ";
         for (size_t i=0; i<iv.size(); i++) {
             iv[i] = iv[i] + iv[i];
         }
- 	return(RcppSexp( iv ).asSexp());
+ 	return(Rcpp::RObject( iv ));
         '
 funx <- cfunction(signature(x="character"), foo, Rcpp=TRUE, verbose=FALSE)
 print(funx(x=c("foo", "bar")))
@@ -193,7 +193,7 @@
 iv.insert( 0 ) ;
 iv.insert( 1 ) ;
 iv.insert( 0 ) ;
-return RcppSexp( iv ).asSexp();'
+return Rcpp::RObject( iv );'
 funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>" )
 print(res <- funx())
 stopifnot( identical( res, 0:1 ) )
@@ -204,7 +204,7 @@
 ds.insert( 0.0 );
 ds.insert( 1.0 );
 ds.insert( 0.0 );
-return(RcppSexp( ds ).asSexp()); '
+return(Rcpp::RObject( ds )); '
 funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>")
 print( res <- funx() )
 stopifnot( identical( res, as.numeric(0:1)))
@@ -215,7 +215,7 @@
 bs.insert( (Rbyte)0 ) ;
 bs.insert( (Rbyte)1 ) ;
 bs.insert( (Rbyte)0 ) ;
-return(RcppSexp( bs ).asSexp()); '
+return(Rcpp::RObject( bs )); '
 funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, includes = "#include <set>")
 print( res <- funx() )
 stopifnot( identical( res, as.raw(0:1)))
@@ -226,7 +226,7 @@
 ss.insert( "foo" ) ;
 ss.insert( "bar" ) ;
 ss.insert( "foo" ) ;
-return(RcppSexp( ss ).asSexp()); '
+return(Rcpp::RObject( ss )); '
 funx <- cfunction(signature(), foo, Rcpp=TRUE, verbose=FALSE, include = "#include <set>" )
 print( res <- funx() )
 stopifnot( identical( res, c("bar","foo")) )
@@ -236,29 +236,29 @@
 
 funx <- cfunction(
 	signature(x="data.frame"), '
-std::vector<std::string> iv = RcppSexp(x).attributeNames();
-return(RcppSexp( iv ).asSexp());
+std::vector<std::string> iv = Rcpp::RObject(x).attributeNames();
+return(Rcpp::RObject( iv ));
 ', Rcpp=TRUE, verbose=FALSE)
 res <- funx( iris )
 stopifnot( all( c("names", "row.names", "class" ) %in% res ) )
 
 funx <- cfunction(signature(x="data.frame"), '
-bool has_class = RcppSexp(x).hasAttribute( "class" ) ;
-return RcppSexp( has_class ).asSexp() ;
+bool has_class = Rcpp::RObject(x).hasAttribute( "class" ) ;
+return Rcpp::RObject( has_class ) ;
 ', Rcpp=TRUE, verbose=FALSE)
 res <- funx( iris )
 stopifnot( res )
 
 funx <- cfunction(signature(x="data.frame"), '
-return RcppSexp(x).attr( "row.names" ) ;
+return Rcpp::RObject(x).attr( "row.names" ) ;
 ', Rcpp=TRUE, verbose=FALSE)
 res <- funx( iris )
 stopifnot( identical(res, 1:150) )
 
 #============ NULL
 funx <- cfunction(signature(x="ANY"), '
-bool is_null = RcppSexp(x).isNULL() ;
-return RcppSexp( is_null ).asSexp() ;
+bool is_null = Rcpp::RObject(x).isNULL() ;
+return Rcpp::RObject( is_null ) ;
 ', Rcpp=TRUE, verbose=FALSE)
 res <- funx( iris )
 stopifnot( !res )

Modified: pkg/inst/examples/RcppInline/external_pointer.r
===================================================================
--- pkg/inst/examples/RcppInline/external_pointer.r	2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/inst/examples/RcppInline/external_pointer.r	2009-12-29 20:17:59 UTC (rev 228)
@@ -29,13 +29,12 @@
 	/* 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) ;
+	Rcpp::XPtr< 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() ) ;
-	
+	return( p ) ;
 ', Rcpp=TRUE, verbose=FALSE)
 xp <- funx()
 stopifnot( identical( typeof( xp ), "externalptr" ) )
@@ -46,13 +45,13 @@
 	/* 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
+	   the Rcpp::XPtr 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) ;
+	Rcpp::XPtr< std::vector<int> > p(x) ;
 	
 	/* just return the front of the vector as a SEXP */
-	return( RcppSexp( p->front() ).asSexp() ) ;
+	return( Rcpp::RObject( p->front() ) ) ;
 ', Rcpp=TRUE, verbose=FALSE)
 front <- funx(xp)
 stopifnot( identical( front, 1L ) )

Added: pkg/src/RObject.cpp
===================================================================
--- pkg/src/RObject.cpp	                        (rev 0)
+++ pkg/src/RObject.cpp	2009-12-29 20:17:59 UTC (rev 228)
@@ -0,0 +1,382 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// RObject.cpp: Rcpp R/C++ interface class library -- SEXP support
+//
+// Copyright (C) 2009 Dirk Eddelbuettel
+// 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/>.
+
+#include <Rcpp_RObject.h>
+#include <algorithm>
+
+namespace Rcpp {
+
+RObject::RObject(const bool & v) {
+    logTxt("RObject from bool\n");
+    m_sexp = Rf_ScalarLogical(v);
+    protect() ;
+}
+
+RObject::RObject(const double & v) {
+    logTxt("RObject from double\n");
+    m_sexp = Rf_ScalarReal(v);
+    protect() ;
+}
+
+RObject::RObject(const int & v) {
+    logTxt("RObject from int\n");
+    m_sexp = Rf_ScalarInteger(v);
+    protect() ;
+}
+
+RObject::RObject(const Rbyte & v) {
+    logTxt("RObject from raw\n");
+    m_sexp = Rf_ScalarRaw(v);
+    protect() ;
+}
+
+RObject::RObject(const std::string & v) {
+    logTxt("RObject from std::string\n");
+    m_sexp = Rf_mkString(v.c_str());
+    protect() ;
+}
+
+RObject::RObject(const std::vector<bool> & v) {
+    logTxt("RObject from bool vector\n");
+    int n = v.size();
+    m_sexp = Rf_allocVector(LGLSXP, n);
+    protect() ;
+    copy( v.begin(), v.end(), LOGICAL(m_sexp) ) ;
+}
+
+RObject::RObject(const std::vector<int> & v) {
+    logTxt("RObject from int vector\n");
+    int n = v.size();
+    m_sexp = Rf_allocVector(INTSXP, n);
+    protect() ;
+    copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
+}
+
+RObject::RObject(const std::vector<double> & v) {
+    logTxt("RObject from double vector\n");
+    int n = v.size();
+    m_sexp = Rf_allocVector(REALSXP, n);
+    protect() ;
+    copy( v.begin(), v.end(), REAL(m_sexp) ) ;
+}
+
+RObject::RObject(const std::vector<Rbyte> & v) {
+    logTxt("RObject from vector<Rbyte> \n");
+    int n = v.size();
+    m_sexp = Rf_allocVector(RAWSXP, n);
+    protect() ;
+    copy( v.begin(), v.end(), RAW(m_sexp) ) ;
+}
+
+RObject::RObject(const std::vector<std::string> & v) {
+    logTxt("RObject from std::string vector\n");
+    int n = v.size();
+    m_sexp = Rf_allocVector(STRSXP, n);
+    protect() ;
+    int i=0; 
+    std::vector<std::string>::const_iterator it = v.begin() ;
+    while( i<n ){
+    	SET_STRING_ELT(m_sexp, i, Rf_mkChar(it->c_str()));
+    	i++ ;
+    	it++; 
+    }
+}
+
+/* sets */
+
+RObject::RObject(const std::set<int> & v) {
+    logTxt("RObject from set<int>\n");
+    int n = v.size();
+    m_sexp = Rf_allocVector(INTSXP, n);
+    protect() ;
+    copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
+}
+
+RObject::RObject(const std::set<double> & v) {
+    logTxt("RObject from set<double>\n");
+    int n = v.size();
+    m_sexp = Rf_allocVector(REALSXP, n);
+    protect() ;
+    copy( v.begin(), v.end(), REAL(m_sexp) ) ;
+}
+
+RObject::RObject(const std::set<Rbyte> & v) {
+    logTxt("RObject from set<Rbyte> \n");
+    int n = v.size();
+    m_sexp = Rf_allocVector(RAWSXP, n);
+    protect() ;
+    copy( v.begin(), v.end(), RAW(m_sexp) ) ;
+}
+
+RObject::RObject(const std::set<std::string> & v) {
+    logTxt("RObject from set<string>\n");
+    int n = v.size();
+    m_sexp = Rf_allocVector(STRSXP, n);
+    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()));
+    	i++ ;
+    	it++; 
+    }
+}
+
+RObject::~RObject() {
+	release() ;
+    logTxt("~RObject");
+}
+
+double RObject::asDouble() const {
+    if (Rf_length(m_sexp) != 1) {
+	throw std::range_error("RObject::asDouble expects single value");
+    }
+    switch( TYPEOF(m_sexp) ){
+    	case LGLSXP:
+    		return LOGICAL(m_sexp)[0] ? 1.0 : 0.0 ; 
+    	case REALSXP:
+    		return REAL(m_sexp)[0] ; 
+    	case INTSXP:
+    		return (double)INTEGER(m_sexp)[0]; 
+    	case RAWSXP:
+    		return (double)RAW(m_sexp)[0];
+    	default:
+    		throw std::range_error("RObject::asDouble invalid type");
+    }
+    return 0.0 ; 	// never reached
+}
+
+int RObject::asInt() const {
+    if (Rf_length(m_sexp) != 1) {
+	throw std::range_error("RObject::asInt expects single value");
+    }
+    switch( TYPEOF(m_sexp)){
+    	case LGLSXP:
+    		return LOGICAL(m_sexp)[0] ? 1 : 0 ; 
+    	case REALSXP:
+    		return (int)REAL(m_sexp)[0] ; // some of this might be lost
+    	case INTSXP:
+    		return INTEGER(m_sexp)[0]; 
+    	case RAWSXP:
+    		return (int)RAW(m_sexp)[0];
+    	default:
+    		throw std::range_error("RObject::asInt invalid type");
+    }
+    return 0; 	// never reached
+}
+
+Rbyte RObject::asRaw() const {
+    if (Rf_length(m_sexp) != 1) {
+	throw std::range_error("RObject::asRaw expects single value");
+    }
+    switch( TYPEOF(m_sexp) ){
+    	case LGLSXP:
+    		return LOGICAL(m_sexp)[0] ? (Rbyte)1 : (Rbyte)0 ; 
+    	case REALSXP:
+    		return (Rbyte)REAL(m_sexp)[0] ;
+    	case INTSXP:
+    		return (Rbyte)INTEGER(m_sexp)[0] ;
+    	case RAWSXP:
+    		return RAW(m_sexp)[0] ;
+    	default:
+    		throw std::range_error("RObject::asRaw expects raw, double or int");
+    }
+    return (Rbyte)0; 	// never reached
+}
+
+bool RObject::asBool() const {
+    if (Rf_length(m_sexp) != 1) {
+	throw std::range_error("RObject::asRaw expects single value");
+    }
+    switch( TYPEOF(m_sexp) ){
+    	case LGLSXP:
+    		return LOGICAL(m_sexp)[0] ? true : false ; 
+    	case REALSXP:
+    		return (bool)REAL(m_sexp)[0] ;
+    	case INTSXP:
+    		return (bool)INTEGER(m_sexp)[0] ;
+    	case RAWSXP:
+    		return (bool)RAW(m_sexp)[0] ;
+    	default:
+    		throw std::range_error("RObject::asRaw expects raw, double or int");
+    }
+    return false; 	// never reached
+}
+
+std::string RObject::asStdString() const {
+    if (Rf_length(m_sexp) != 1) {
+	throw std::range_error("RObject::asStdString expects single value");
+    }
+    if (!Rf_isString(m_sexp)) {
+	throw std::range_error("RObject::asStdString expects string");
+    }
+    return std::string(CHAR(STRING_ELT(m_sexp,0)));
+}
+
+std::vector<bool> RObject::asStdVectorBool() const {
+    int n = Rf_length(m_sexp);
+    std::vector<bool> v(n);
+    switch( TYPEOF(m_sexp) ){
+    case LGLSXP:
+    	v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+    	break ;
+    case INTSXP:
+    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
+    	break;
+    case REALSXP:
+    	v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
+    	break;
+    case RAWSXP:
+    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+    	break;
+    default:
+    		throw std::range_error( "RObject::asStdVectorBool(): invalid R type" ) ; 
+    }
+    return v;
+}
+
+
+std::vector<int> RObject::asStdVectorInt() const {
+    int n = Rf_length(m_sexp);
+    std::vector<int> v(n);
+    switch( TYPEOF(m_sexp) ){
+    case LGLSXP:
+    	v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+    	break;
+    case INTSXP:
+    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
+    	break;
+    case REALSXP:
+    	v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
+    	break;
+    case RAWSXP:
+    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+    	break;
+    default:
+    		throw std::range_error( "RObject::asStdVectorInt(): invalid R type" ) ; 
+    }
+    return v;
+}
+
+std::vector<Rbyte> RObject::asStdVectorRaw() const {
+    int n = Rf_length(m_sexp);
+    std::vector<Rbyte> v(n);
+    switch( TYPEOF(m_sexp) ){
+    case LGLSXP:
+    	v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+    	break ;
+    case RAWSXP:
+    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+    	break ;
+    case REALSXP:
+    	v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
+    	break;
+    case INTSXP:
+    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n) ;
+    	break;
+    default:
+    	std::range_error("RObject::asStdVectorRaw expects raw, double or int");
+    }
+    return v;
+}
+
+std::vector<double> RObject::asStdVectorDouble() const {
+    int n = Rf_length(m_sexp);
+    std::vector<double> v(n);
+    switch( TYPEOF(m_sexp) ){
+    case LGLSXP:
+    	v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
+    	break ;
+    case RAWSXP:
+    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
+    	break ;
+    case REALSXP:
+    	v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
+    	break;
+    case INTSXP:
+    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n) ;
+    	break;
+    default:
+    	std::range_error("RObject::asStdVectorDouble expects raw, double or int");
+    }
+    return v;
+}
+
+
+std::vector<std::string> RObject::asStdVectorString() const {
+    int n = Rf_length(m_sexp);
+    std::vector<std::string> v(n);
+    if (!Rf_isString(m_sexp)) {
+	throw std::range_error("RObject::asStdVectorString expects string");
+    }
+    for (int i = 0; i < n; i++) {
+	v[i] = std::string(CHAR(STRING_ELT(m_sexp,i)));
+    }
+    return v;
+}
+
+
+
+
+void RObject::protect(){
+	if( !isProtected ){
+		isProtected = true ;
+		R_PreserveObject( m_sexp ); 
+	}
+}
+
+void RObject::release(){
+	if( isProtected ){
+		R_ReleaseObject(m_sexp); 
+	}
+}
+
+std::vector<std::string> RObject::attributeNames() const {
+	/* inspired from do_attributes at attrib.c */
+	
+	std::vector<std::string> v ;
+	SEXP attrs = ATTRIB(m_sexp);
+    while( attrs != R_NilValue ){
+    	v.push_back( std::string(CHAR(PRINTNAME(TAG(attrs)))) ) ;
+    	attrs = CDR( attrs ) ;
+    }
+    return v ;
+}
+
+bool RObject::hasAttribute( const std::string& attr) const {
+	SEXP attrs = ATTRIB(m_sexp);
+    while( attrs != R_NilValue ){
+    	if( attr == CHAR(PRINTNAME(TAG(attrs))) ){
+    		return true ;
+    	}
+    	attrs = CDR( attrs ) ;
+    }
+    return false; /* give up */
+}
+
+SEXP RObject::attr( const std::string& name) const{
+	return Rf_getAttrib( m_sexp, Rf_install( name.c_str() ) );
+}
+
+
+} // namespace Rcpp
+

Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h	2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/src/Rcpp.h	2009-12-29 20:17:59 UTC (rev 228)
@@ -36,11 +36,13 @@
 #include <RcppNumList.h>
 #include <RcppParams.h>
 #include <RcppResultSet.h>
-#include <RcppSexp.h>
 #include <RcppStringVector.h>
 #include <RcppStringVectorView.h>
 #include <RcppVector.h>
 #include <RcppVectorView.h>
-#include <RcppXPtr.h>
 
+/* new api */
+#include <Rcpp_RObject.h>
+#include <Rcpp_XPtr.h>
+
 #endif

Modified: pkg/src/RcppExample.cpp
===================================================================
--- pkg/src/RcppExample.cpp	2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/src/RcppExample.cpp	2009-12-29 20:17:59 UTC (rev 228)
@@ -466,12 +466,12 @@
 	std::vector<int> *v = new std::vector<int> ;
 	v->push_back( 1 ) ;
 	v->push_back( 2 ) ;
-	RcppXPtr< std::vector<int> > p(v) ;
+	Rcpp::XPtr< std::vector<int> > p(v) ;
 	return p.asSexp() ;
 }
 
 RcppExport SEXP RcppXPtrExample_get_external_pointer(SEXP x){
-	RcppXPtr< std::vector<int> > p(x) ;
+	Rcpp::XPtr< std::vector<int> > p(x) ;
 	return Rf_ScalarInteger( p->back( ) ) ;
 }
 

Deleted: pkg/src/RcppSexp.cpp
===================================================================
--- pkg/src/RcppSexp.cpp	2009-12-29 18:47:06 UTC (rev 227)
+++ pkg/src/RcppSexp.cpp	2009-12-29 20:17:59 UTC (rev 228)
@@ -1,377 +0,0 @@
-// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
-//
-// RcppSexp.h: Rcpp R/C++ interface class library -- SEXP support
-//
-// Copyright (C) 2009 Dirk Eddelbuettel
-// 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/>.
-
-#include <RcppSexp.h>
-#include <algorithm>
-
-RcppSexp::RcppSexp(const bool & v) {
-    logTxt("RcppSexp from bool\n");
-    m_sexp = Rf_ScalarLogical(v);
-    protect() ;
-}
-
-RcppSexp::RcppSexp(const double & v) {
-    logTxt("RcppSexp from double\n");
-    m_sexp = Rf_ScalarReal(v);
-    protect() ;
-}
-
-RcppSexp::RcppSexp(const int & v) {
-    logTxt("RcppSexp from int\n");
-    m_sexp = Rf_ScalarInteger(v);
-    protect() ;
-}
-
-RcppSexp::RcppSexp(const Rbyte & v) {
-    logTxt("RcppSexp from raw\n");
-    m_sexp = Rf_ScalarRaw(v);
-    protect() ;
-}
-
-RcppSexp::RcppSexp(const std::string & v) {
-    logTxt("RcppSexp from std::string\n");
-    m_sexp = Rf_mkString(v.c_str());
-    protect() ;
-}
-
-RcppSexp::RcppSexp(const std::vector<bool> & v) {
-    logTxt("RcppSexp from bool vector\n");
-    int n = v.size();
-    m_sexp = Rf_allocVector(LGLSXP, n);
-    protect() ;
-    copy( v.begin(), v.end(), LOGICAL(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::vector<int> & v) {
-    logTxt("RcppSexp from int vector\n");
-    int n = v.size();
-    m_sexp = Rf_allocVector(INTSXP, n);
-    protect() ;
-    copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::vector<double> & v) {
-    logTxt("RcppSexp from double vector\n");
-    int n = v.size();
-    m_sexp = Rf_allocVector(REALSXP, n);
-    protect() ;
-    copy( v.begin(), v.end(), REAL(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::vector<Rbyte> & v) {
-    logTxt("RcppSexp from vector<Rbyte> \n");
-    int n = v.size();
-    m_sexp = Rf_allocVector(RAWSXP, n);
-    protect() ;
-    copy( v.begin(), v.end(), RAW(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::vector<std::string> & v) {
-    logTxt("RcppSexp from std::string vector\n");
-    int n = v.size();
-    m_sexp = Rf_allocVector(STRSXP, n);
-    protect() ;
-    int i=0; 
-    std::vector<std::string>::const_iterator it = v.begin() ;
-    while( i<n ){
-    	SET_STRING_ELT(m_sexp, i, Rf_mkChar(it->c_str()));
-    	i++ ;
-    	it++; 
-    }
-}
-
-/* sets */
-
-RcppSexp::RcppSexp(const std::set<int> & v) {
-    logTxt("RcppSexp from set<int>\n");
-    int n = v.size();
-    m_sexp = Rf_allocVector(INTSXP, n);
-    protect() ;
-    copy( v.begin(), v.end(), INTEGER(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::set<double> & v) {
-    logTxt("RcppSexp from set<double>\n");
-    int n = v.size();
-    m_sexp = Rf_allocVector(REALSXP, n);
-    protect() ;
-    copy( v.begin(), v.end(), REAL(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::set<Rbyte> & v) {
-    logTxt("RcppSexp from set<Rbyte> \n");
-    int n = v.size();
-    m_sexp = Rf_allocVector(RAWSXP, n);
-    protect() ;
-    copy( v.begin(), v.end(), RAW(m_sexp) ) ;
-}
-
-RcppSexp::RcppSexp(const std::set<std::string> & v) {
-    logTxt("RcppSexp from set<string>\n");
-    int n = v.size();
-    m_sexp = Rf_allocVector(STRSXP, n);
-    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()));
-    	i++ ;
-    	it++; 
-    }
-}
-
-RcppSexp::~RcppSexp() {
-	release() ;
-    logTxt("~RcppSexp");
-}
-
-double RcppSexp::asDouble() const {
-    if (Rf_length(m_sexp) != 1) {
-	throw std::range_error("RcppSexp::asDouble expects single value");
-    }
-    switch( TYPEOF(m_sexp) ){
-    	case LGLSXP:
-    		return LOGICAL(m_sexp)[0] ? 1.0 : 0.0 ; 
-    	case REALSXP:
-    		return REAL(m_sexp)[0] ; 
-    	case INTSXP:
-    		return (double)INTEGER(m_sexp)[0]; 
-    	case RAWSXP:
-    		return (double)RAW(m_sexp)[0];
-    	default:
-    		throw std::range_error("RcppSexp::asDouble invalid type");
-    }
-    return 0.0 ; 	// never reached
-}
-
-int RcppSexp::asInt() const {
-    if (Rf_length(m_sexp) != 1) {
-	throw std::range_error("RcppSexp::asInt expects single value");
-    }
-    switch( TYPEOF(m_sexp)){
-    	case LGLSXP:
-    		return LOGICAL(m_sexp)[0] ? 1 : 0 ; 
-    	case REALSXP:
-    		return (int)REAL(m_sexp)[0] ; // some of this might be lost
-    	case INTSXP:
-    		return INTEGER(m_sexp)[0]; 
-    	case RAWSXP:
-    		return (int)RAW(m_sexp)[0];
-    	default:
-    		throw std::range_error("RcppSexp::asInt invalid type");
-    }
-    return 0; 	// never reached
-}
-
-Rbyte RcppSexp::asRaw() const {
-    if (Rf_length(m_sexp) != 1) {
-	throw std::range_error("RcppSexp::asRaw expects single value");
-    }
-    switch( TYPEOF(m_sexp) ){
-    	case LGLSXP:
-    		return LOGICAL(m_sexp)[0] ? (Rbyte)1 : (Rbyte)0 ; 
-    	case REALSXP:
-    		return (Rbyte)REAL(m_sexp)[0] ;
-    	case INTSXP:
-    		return (Rbyte)INTEGER(m_sexp)[0] ;
-    	case RAWSXP:
-    		return RAW(m_sexp)[0] ;
-    	default:
-    		throw std::range_error("RcppSexp::asRaw expects raw, double or int");
-    }
-    return (Rbyte)0; 	// never reached
-}
-
-bool RcppSexp::asBool() const {
-    if (Rf_length(m_sexp) != 1) {
-	throw std::range_error("RcppSexp::asRaw expects single value");
-    }
-    switch( TYPEOF(m_sexp) ){
-    	case LGLSXP:
-    		return LOGICAL(m_sexp)[0] ? true : false ; 
-    	case REALSXP:
-    		return (bool)REAL(m_sexp)[0] ;
-    	case INTSXP:
-    		return (bool)INTEGER(m_sexp)[0] ;
-    	case RAWSXP:
-    		return (bool)RAW(m_sexp)[0] ;
-    	default:
-    		throw std::range_error("RcppSexp::asRaw expects raw, double or int");
-    }
-    return false; 	// never reached
-}
-
-std::string RcppSexp::asStdString() const {
-    if (Rf_length(m_sexp) != 1) {
-	throw std::range_error("RcppSexp::asStdString expects single value");
-    }
-    if (!Rf_isString(m_sexp)) {
-	throw std::range_error("RcppSexp::asStdString expects string");
-    }
-    return std::string(CHAR(STRING_ELT(m_sexp,0)));
-}
-
-std::vector<bool> RcppSexp::asStdVectorBool() const {
-    int n = Rf_length(m_sexp);
-    std::vector<bool> v(n);
-    switch( TYPEOF(m_sexp) ){
-    case LGLSXP:
-    	v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
-    	break ;
-    case INTSXP:
-    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
-    	break;
-    case REALSXP:
-    	v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
-    	break;
-    case RAWSXP:
-    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
-    	break;
-    default:
-    		throw std::range_error( "RcppSexp::asStdVectorBool(): invalid R type" ) ; 
-    }
-    return v;
-}
-
-
-std::vector<int> RcppSexp::asStdVectorInt() const {
-    int n = Rf_length(m_sexp);
-    std::vector<int> v(n);
-    switch( TYPEOF(m_sexp) ){
-    case LGLSXP:
-    	v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
-    	break;
-    case INTSXP:
-    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n ) ;
-    	break;
-    case REALSXP:
-    	v.assign( REAL(m_sexp), REAL(m_sexp)+n ) ;
-    	break;
-    case RAWSXP:
-    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
-    	break;
-    default:
-    		throw std::range_error( "RcppSexp::asStdVectorInt(): invalid R type" ) ; 
-    }
-    return v;
-}
-
-std::vector<Rbyte> RcppSexp::asStdVectorRaw() const {
-    int n = Rf_length(m_sexp);
-    std::vector<Rbyte> v(n);
-    switch( TYPEOF(m_sexp) ){
-    case LGLSXP:
-    	v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
-    	break ;
-    case RAWSXP:
-    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
-    	break ;
-    case REALSXP:
-    	v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
-    	break;
-    case INTSXP:
-    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n) ;
-    	break;
-    default:
-    	std::range_error("RcppSexp::asStdVectorRaw expects raw, double or int");
-    }
-    return v;
-}
-
-std::vector<double> RcppSexp::asStdVectorDouble() const {
-    int n = Rf_length(m_sexp);
-    std::vector<double> v(n);
-    switch( TYPEOF(m_sexp) ){
-    case LGLSXP:
-    	v.assign( LOGICAL(m_sexp), LOGICAL(m_sexp)+n ) ;
-    	break ;
-    case RAWSXP:
-    	v.assign( RAW(m_sexp), RAW(m_sexp)+n ) ;
-    	break ;
-    case REALSXP:
-    	v.assign( REAL(m_sexp), REAL(m_sexp)+n) ;
-    	break;
-    case INTSXP:
-    	v.assign( INTEGER(m_sexp), INTEGER(m_sexp)+n) ;
-    	break;
-    default:
-    	std::range_error("RcppSexp::asStdVectorDouble expects raw, double or int");
-    }
-    return v;
-}
-
-
-std::vector<std::string> RcppSexp::asStdVectorString() const {
-    int n = Rf_length(m_sexp);
-    std::vector<std::string> v(n);
-    if (!Rf_isString(m_sexp)) {
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/rcpp -r 228
_______________________________________________
Rcpp-commits mailing list
Rcpp-commits at lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-commits


More information about the Rcpp-devel mailing list