[Rcpp-commits] r2115 - in pkg/Rcpp: . R inst inst/include/Rcpp src

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

Author: romain
Date: 2010-09-16 12:07:09 +0200 (Thu, 16 Sep 2010)
New Revision: 2115

Modified:
   pkg/Rcpp/NAMESPACE
   pkg/Rcpp/R/Module.R
   pkg/Rcpp/inst/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/Module.h
   pkg/Rcpp/src/Module.cpp
Log:
stuff to get and set fields using C++Field external pointers

Modified: pkg/Rcpp/NAMESPACE
===================================================================
--- pkg/Rcpp/NAMESPACE	2010-09-16 09:35:12 UTC (rev 2114)
+++ pkg/Rcpp/NAMESPACE	2010-09-16 10:07:09 UTC (rev 2115)
@@ -14,7 +14,6 @@
 S3method( .DollarNames, "Module" )
 exportMethods( prompt, show )
 exportMethods( new, .DollarNames )
-
 exportMethods( referenceMethods )
 
 

Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R	2010-09-16 09:35:12 UTC (rev 2114)
+++ pkg/Rcpp/R/Module.R	2010-09-16 10:07:09 UTC (rev 2115)
@@ -15,6 +15,13 @@
 # You should have received a copy of the GNU General Public License
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
+.getField <- function( class_xp, field_xp, obj_xp ){
+    .Call( "CppField__get", class_xp, field_xp, obj_xp, PACKAGE = "Rcpp" )
+}
+.setField <- function( class_xp, field_xp, obj_xp, value ){
+    .Call( "CppField__set", class_xp, field_xp, obj_xp, value, PACKAGE = "Rcpp" )
+}
+
 setGeneric( "new" )
 
 internal_function <- function(pointer){

Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog	2010-09-16 09:35:12 UTC (rev 2114)
+++ pkg/Rcpp/inst/ChangeLog	2010-09-16 10:07:09 UTC (rev 2115)
@@ -5,6 +5,13 @@
     * inst/Rcpp/Module.h: added C++ class S4_field that builds S4 objects of 
     class C++Field. Build the list of fields as part of the creation of the 
     C++Class objects
+    
+    * src/Module.cpp: .Call functions CppField__get and CppField__set to get/set
+    values of an object's field using external pointers directly (no std::map
+    lookup internally)
+    
+    * R/Module.R: (unexported) functions .getField and .setField that 
+    call CppField__get and CppField__set
 
 2010-09-15  Romain Francois <romain at r-enthusiasts.com>
 

Modified: pkg/Rcpp/inst/include/Rcpp/Module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Module.h	2010-09-16 09:35:12 UTC (rev 2114)
+++ pkg/Rcpp/inst/include/Rcpp/Module.h	2010-09-16 10:07:09 UTC (rev 2115)
@@ -84,6 +84,15 @@
 		throw std::range_error( "cannot set property" ) ;
 	}
 	
+	
+	virtual SEXP getProperty__( SEXP, SEXP ) {
+		throw std::range_error( "cannot retrieve property" ) ;
+	}
+	virtual void setProperty__( SEXP, SEXP, SEXP) {
+		throw std::range_error( "cannot set property" ) ;
+	}
+	
+	
 	std::string name ;
 } ;
 
@@ -166,7 +175,7 @@
 
 template <typename Class>
 class S4_field : public Rcpp::S4 {
-public:
+public:             
     S4_field( CppProperty<Class>* p ) : S4( "C++Field" ){
         slot( "read_only" ) = p->is_readonly() ;
         slot( "cpp_class" ) = p->get_class();
@@ -357,6 +366,22 @@
 	VOID_END_RCPP
 	}
 	
+	
+	SEXP getProperty__( SEXP field_xp , SEXP object) {
+	BEGIN_RCPP
+		prop_class* prop = reinterpret_cast< prop_class* >( EXTPTR_PTR( field_xp ) ) ;
+	    return prop->get( XP(object) ); 
+	END_RCPP
+	}
+	
+	void setProperty__( SEXP field_xp, SEXP object, SEXP value)  {
+	BEGIN_RCPP
+		prop_class* prop = reinterpret_cast< prop_class* >( EXTPTR_PTR( field_xp ) ) ;
+	    return prop->set( XP(object), value ); 
+	VOID_END_RCPP
+	}
+	
+	
 	Rcpp::List fields( ){
 	    int n = properties.size() ;
 		Rcpp::CharacterVector pnames(n) ;

Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp	2010-09-16 09:35:12 UTC (rev 2114)
+++ pkg/Rcpp/src/Module.cpp	2010-09-16 10:07:09 UTC (rev 2115)
@@ -99,7 +99,18 @@
 	return R_NilValue ;
 }
 
+// these operate directly on the external pointers, rather than 
+// looking up the property in the map
+RCPP_FUNCTION_3(SEXP, CppField__get, XP_Class cl, SEXP field_xp, SEXP obj){
+	return cl->getProperty__( field_xp, obj ) ;
+}
+RCPP_FUNCTION_4(SEXP, CppField__set, XP_Class cl, SEXP field_xp, SEXP obj, SEXP value){
+	cl->setProperty__( field_xp, obj, value ) ;
+	return R_NilValue ;
+}
 
+
+
 // .External functions
 extern "C" SEXP InternalFunction_invoke( SEXP args ){
 	SEXP p = CDR(args) ;