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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Sep 16 20:36:05 CEST 2010


Author: romain
Date: 2010-09-16 20:36:05 +0200 (Thu, 16 Sep 2010)
New Revision: 2119

Modified:
   pkg/Rcpp/R/00_classes.R
   pkg/Rcpp/inst/include/Rcpp/Module.h
   pkg/Rcpp/src/Module.cpp
   pkg/Rcpp/src/Reference.cpp
Log:
C++Field is now a ReferenceClass

Modified: pkg/Rcpp/R/00_classes.R
===================================================================
--- pkg/Rcpp/R/00_classes.R	2010-09-16 16:27:32 UTC (rev 2118)
+++ pkg/Rcpp/R/00_classes.R	2010-09-16 18:36:05 UTC (rev 2119)
@@ -20,11 +20,20 @@
 ## Stands in for a reference class with those fields.
 setClass( "Module",  contains = "environment" )
 
-setClass( "C++Field", 
-    representation( 
-        pointer = "externalptr", 
-        cpp_class = "character", 
-        read_only = "logical"
+setRefClass( "C++Field", 
+    fieldClasses = list( 
+        pointer       = "externalptr", 
+        cpp_class     = "character", 
+        read_only     = "logical", 
+        class_pointer = "externalptr"
+    ),
+    refMethods = list( 
+        get = function(obj_xp){
+            .Call( "CppField__get", class_pointer, pointer, obj_xp, PACKAGE = "Rcpp" ) 
+        }, 
+        set = function(obj_xp, value){
+            .Call( "CppField__set", class_pointer, pointer, obj_xp, value, PACKAGE = "Rcpp" )
+        }
     )
 )
 

Modified: pkg/Rcpp/inst/include/Rcpp/Module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Module.h	2010-09-16 16:27:32 UTC (rev 2118)
+++ pkg/Rcpp/inst/include/Rcpp/Module.h	2010-09-16 18:36:05 UTC (rev 2119)
@@ -53,7 +53,7 @@
 	class_Base() :name(){} ;
 	class_Base(const char* name_) : name(name_){} ;
 	
-	virtual Rcpp::List fields(){ return Rcpp::List(0); }
+	virtual Rcpp::List fields(SEXP){ return Rcpp::List(0); }
 	virtual bool has_method( const std::string& ){ 
 		return false ; 
 	}
@@ -174,12 +174,13 @@
 } ;
 
 template <typename Class>
-class S4_field : public Rcpp::S4 {
+class S4_field : public Rcpp::Reference {
 public:             
-    S4_field( CppProperty<Class>* p ) : S4( "C++Field" ){
-        slot( "read_only" ) = p->is_readonly() ;
-        slot( "cpp_class" ) = p->get_class();
-        slot( "pointer" )   = Rcpp::XPtr< CppProperty<Class> >( p, false ) ;
+    S4_field( CppProperty<Class>* p, SEXP class_xp ) : Reference( "C++Field" ){
+        field( "read_only" )     = p->is_readonly() ;
+        field( "cpp_class" )     = p->get_class();
+        field( "pointer" )       = Rcpp::XPtr< CppProperty<Class> >( p, false ) ;
+        field( "class_pointer" ) = class_xp ;
     }
 } ;
 
@@ -382,14 +383,14 @@
 	}
 	
 	
-	Rcpp::List fields( ){
+	Rcpp::List fields( SEXP class_xp ){
 	    int n = properties.size() ;
 		Rcpp::CharacterVector pnames(n) ;
 		Rcpp::List out(n) ;
 		typename PROPERTY_MAP::iterator it = properties.begin( ) ;
 		for( int i=0; i<n; i++, ++it){
 			pnames[i] = it->first ;
-			out[i] = S4_field<Class>( it->second ) ; 
+			out[i] = S4_field<Class>( it->second, class_xp ) ; 
 		} 
 		out.names() = pnames ;
 		return out ;

Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp	2010-09-16 16:27:32 UTC (rev 2118)
+++ pkg/Rcpp/src/Module.cpp	2010-09-16 18:36:05 UTC (rev 2119)
@@ -286,7 +286,7 @@
 		mangled_name += cl->name ;
 		slot( ".Data" ) = mangled_name ;
 		
-		slot( "fields" ) = cl->fields() ;
+		slot( "fields" ) = cl->fields( clxp.asSexp() ) ;
 		
 	}
 

Modified: pkg/Rcpp/src/Reference.cpp
===================================================================
--- pkg/Rcpp/src/Reference.cpp	2010-09-16 16:27:32 UTC (rev 2118)
+++ pkg/Rcpp/src/Reference.cpp	2010-09-16 18:36:05 UTC (rev 2119)
@@ -65,14 +65,8 @@
 		}
 	}
 	
-	                  
-	
 	Reference::FieldProxy::FieldProxy( const Reference& v, const std::string& name) throw(no_such_field) : 
-	    parent(v), field_name(name) {
-    	if( !R_has_slot( v, Rf_install(name.c_str())) ){
-    		throw no_such_slot() ; 
-    	}
-    }
+	    parent(v), field_name(name) {}
 
     Reference::FieldProxy& Reference::FieldProxy::operator=(const FieldProxy& rhs){
     	set( rhs.get() ) ;
@@ -108,5 +102,8 @@
     	const_cast<Reference&>(parent).setSEXP( Rf_eval( call, R_GlobalEnv ) );	            
     }
 
+    Reference::FieldProxy Reference::field( const std::string& name) const {
+        return FieldProxy( *this, name );
+    }
 	
 } // namespace Rcpp



More information about the Rcpp-commits mailing list