[Rcpp-devel] [Rcpp-commits] r291 - in pkg: inst src src/Rcpp

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jan 7 10:13:44 CET 2010


Author: romain
Date: 2010-01-07 10:13:44 +0100 (Thu, 07 Jan 2010)
New Revision: 291

Added:
   pkg/src/Rcpp/Rcpp_Rinternals.h
   pkg/src/Rcpp/WeakReference.h
   pkg/src/WeakReference.cpp
Modified:
   pkg/inst/ChangeLog
   pkg/src/GenericVector.cpp
   pkg/src/Rcpp.h
   pkg/src/Rcpp/GenericVector.h
   pkg/src/RcppCommon.h
   pkg/src/Symbol.cpp
Log:
added simple class Rcpp::WeakReference to manage WEAKREFSXP

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-06 16:44:55 UTC (rev 290)
+++ pkg/inst/ChangeLog	2010-01-07 09:13:44 UTC (rev 291)
@@ -1,3 +1,16 @@
+2010-01-07  Romain Francois <francoisromain at free.fr>
+
+	* src/Rcpp/WeakReference.h: new class Rcpp::WeakReference
+	to wrap WEAKREFSXP with accessors to the key and value
+	* src/WeakReference.cpp: implementation
+
+	* src/Rcpp/Rcpp_Rinternals.h: borrowed from Rinternals so that 
+	we can use VECTOR_PTR (which R forbids unless we define 
+	USE_RINTERNALS, but defining it disables NO_R_REMAP)
+
+	* src/Rcpp/GenericVector.h : added begin and end to allow 
+	stl type iteration over generic vectors.
+
 2010-01-06  Dirk Eddelbuettel  <deddelbuettel at wtchi-stat-l1.wolve.com>
 
 	* src/RcppCommon.h: Protect definition of logTxt by #ifndef

Modified: pkg/src/GenericVector.cpp
===================================================================
--- pkg/src/GenericVector.cpp	2010-01-06 16:44:55 UTC (rev 290)
+++ pkg/src/GenericVector.cpp	2010-01-07 09:13:44 UTC (rev 291)
@@ -60,4 +60,12 @@
 	SET_VECTOR_ELT(m_sexp,i,value) ;
 }
 
+SEXP* GenericVector::begin(){
+	return RCPP_VECTOR_PTR(m_sexp) ;
+}
+
+SEXP* GenericVector::end(){
+	return RCPP_VECTOR_PTR(m_sexp) + LENGTH(m_sexp) ;
+}
+
 } // namespace 

Modified: pkg/src/Rcpp/GenericVector.h
===================================================================
--- pkg/src/Rcpp/GenericVector.h	2010-01-06 16:44:55 UTC (rev 290)
+++ pkg/src/Rcpp/GenericVector.h	2010-01-07 09:13:44 UTC (rev 291)
@@ -54,6 +54,11 @@
 	
 	SEXP get(const int& i) const ;
 	void set(const int& i, SEXP value ) ;
+	
+	SEXP* begin(); 
+	SEXP* end() ;
+	
+	
 } ;
 
 typedef GenericVector List ;

Added: pkg/src/Rcpp/Rcpp_Rinternals.h
===================================================================
--- pkg/src/Rcpp/Rcpp_Rinternals.h	                        (rev 0)
+++ pkg/src/Rcpp/Rcpp_Rinternals.h	2010-01-07 09:13:44 UTC (rev 291)
@@ -0,0 +1,106 @@
+#ifndef Rcpp_Rinternals_h
+#define Rcpp_Rinternals_h
+
+/* all of this comes from Rinternals.h so that we can get access to 
+   DATA_PTR since R forbids to use VECTOR_PTR, we need to be able to call
+   VECTOR_PTR to have pointer arithmetics on generic vectors, character
+   vectors, expression vectors, etc... 
+   
+   below we define RCPP_VECTOR_PTR we can use where we would use
+   VECTOR_PTR
+   
+   We cannot just define USE_RINTERNALS because it clashes with our use
+   of R_NOREMAP
+   
+   There might be a possibility to not have to use pointer arithmztics
+   with VECTOR_PTR but we would need to implement a custom iterator
+   for Rcpp::GenericVector, ..., if we manage this then we will remove 
+   these
+   
+   */
+
+/* Flags */
+struct sxpinfo_struct {
+    SEXPTYPE type      :  5;/* ==> (FUNSXP == 99) %% 2^5 == 3 == CLOSXP
+			     * -> warning: `type' is narrower than values
+			     *              of its type
+			     * when SEXPTYPE was an enum */
+    unsigned int obj   :  1;
+    unsigned int named :  2;
+    unsigned int gp    : 16;
+    unsigned int mark  :  1;
+    unsigned int debug :  1;
+    unsigned int trace :  1;  /* functions and memory tracing */
+    unsigned int spare :  1;  /* currently unused */
+    unsigned int gcgen :  1;  /* old generation number */
+    unsigned int gccls :  3;  /* node class */
+}; /*		    Tot: 32 */
+
+struct vecsxp_struct {
+    R_len_t	length;
+    R_len_t	truelength;
+};
+
+struct primsxp_struct {
+    int offset;
+};
+
+struct symsxp_struct {
+    struct SEXPREC *pname;
+    struct SEXPREC *value;
+    struct SEXPREC *internal;
+};
+
+struct listsxp_struct {
+    struct SEXPREC *carval;
+    struct SEXPREC *cdrval;
+    struct SEXPREC *tagval;
+};
+
+struct envsxp_struct {
+    struct SEXPREC *frame;
+    struct SEXPREC *enclos;
+    struct SEXPREC *hashtab;
+};
+
+struct closxp_struct {
+    struct SEXPREC *formals;
+    struct SEXPREC *body;
+    struct SEXPREC *env;
+};
+
+struct promsxp_struct {
+    struct SEXPREC *value;
+    struct SEXPREC *expr;
+    struct SEXPREC *env;
+};
+
+#define SEXPREC_HEADER \
+    struct sxpinfo_struct sxpinfo; \
+    struct SEXPREC *attrib; \
+    struct SEXPREC *gengc_next_node, *gengc_prev_node
+
+/* The standard node structure consists of a header followed by the
+   node data. */
+typedef struct SEXPREC {
+    SEXPREC_HEADER;
+    union {
+	struct primsxp_struct primsxp;
+	struct symsxp_struct symsxp;
+	struct listsxp_struct listsxp;
+	struct envsxp_struct envsxp;
+	struct closxp_struct closxp;
+	struct promsxp_struct promsxp;
+    } u;
+} SEXPREC, *SEXP;
+
+typedef struct VECTOR_SEXPREC {
+    SEXPREC_HEADER;
+    struct vecsxp_struct vecsxp;
+} VECTOR_SEXPREC, *VECSEXP;
+typedef union { VECTOR_SEXPREC s; double align; } SEXPREC_ALIGN;
+#define RCPP_DATAPTR(x)	(((SEXPREC_ALIGN *) (x)) + 1)
+#define RCPP_VECTOR_PTR(x)	((SEXP *) RCPP_DATAPTR(x))
+
+#endif
+

Added: pkg/src/Rcpp/WeakReference.h
===================================================================
--- pkg/src/Rcpp/WeakReference.h	                        (rev 0)
+++ pkg/src/Rcpp/WeakReference.h	2010-01-07 09:13:44 UTC (rev 291)
@@ -0,0 +1,58 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// WeakReference.h: Rcpp R/C++ interface class library -- weak references
+//
+// Copyright (C) 2009 - 2010	Romain Francois and Dirk Eddelbuettel
+//
+// 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_WeakReference_h
+#define Rcpp_WeakReference_h
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+
+namespace Rcpp{
+
+class WeakReference : public RObject {
+public:
+	WeakReference() : RObject(){}
+
+	/**
+	 * wraps a weak reference
+	 *
+	 * @param x presumably a SEXP of SEXTYPE WEAKREFSXP
+	 *
+	 * @throw not_compatible if x is not a weak reference
+	 */
+	WeakReference( SEXP x) throw(not_compatible) : RObject() ; 
+
+	/** 
+	 * Retrieve the key
+	 */
+	SEXP key() const ; 
+
+	/**
+	 * Retrieve the value
+	 */
+	SEXP value() const ;
+
+} ;
+
+
+}
+
+#endif

Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h	2010-01-06 16:44:55 UTC (rev 290)
+++ pkg/src/Rcpp.h	2010-01-07 09:13:44 UTC (rev 291)
@@ -61,5 +61,6 @@
 #include <Rcpp/RawVector.h>
 #include <Rcpp/LogicalVector.h>
 #include <Rcpp/GenericVector.h>
+#include <Rcpp/WeakReference.h>
 
 #endif

Modified: pkg/src/RcppCommon.h
===================================================================
--- pkg/src/RcppCommon.h	2010-01-06 16:44:55 UTC (rev 290)
+++ pkg/src/RcppCommon.h	2010-01-07 09:13:44 UTC (rev 291)
@@ -50,8 +50,8 @@
 #include <R_ext/Callbacks.h>
 #include <Rversion.h>
 #define GET_NAMES(x)	Rf_getAttrib(x, R_NamesSymbol)
+#include <Rcpp/Rcpp_Rinternals.h>
 
-
 // #ifdef BUILDING_DLL
 // #define RcppExport extern "C" __declspec(dllexport)
 // #else

Modified: pkg/src/Symbol.cpp
===================================================================
--- pkg/src/Symbol.cpp	2010-01-06 16:44:55 UTC (rev 290)
+++ pkg/src/Symbol.cpp	2010-01-07 09:13:44 UTC (rev 291)
@@ -42,9 +42,7 @@
 			default:
 				throw not_compatible("cannot convert to symbol (SYMSXP)") ;
 			}
-		} else {
-			setSEXP( x ) ;
-		}
+		} 
 	}
 	
 	Symbol::Symbol(const std::string& symbol){

Added: pkg/src/WeakReference.cpp
===================================================================
--- pkg/src/WeakReference.cpp	                        (rev 0)
+++ pkg/src/WeakReference.cpp	2010-01-07 09:13:44 UTC (rev 291)
@@ -0,0 +1,43 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// WeakReference.h: Rcpp R/C++ interface class library -- weak references
+//
+// Copyright (C) 2009 - 2010	Romain Francois and Dirk Eddelbuettel
+//
+// 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/WeakReference.h>
+
+namespace Rcpp{
+	
+	WeakReference::WeakReference( SEXP x) throw(not_compatible) : RObject(){
+		if( TYPEOF(x) == WEAKREFSXP ){
+			setSEXP(x) ; 
+		} else{
+			throw not_compatible( "not a weak reference" ) ;
+		}
+	}
+	
+	SEXP WeakReference::key() const {
+		return isNULL() ? R_NilValue : R_WeakRefKey(m_sexp) ;
+	}
+	
+	SEXP WeakReference::value() const {
+		return isNULL() ? R_NilValue : R_WeakRefValue(m_sexp) ;
+	}
+	
+}
+// namesapce

_______________________________________________
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