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

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

Author: romain
Date: 2012-10-29 13:17:53 +0100 (Mon, 29 Oct 2012)
New Revision: 3853

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/R/Module.R
   pkg/Rcpp/inst/include/Rcpp/Module.h
Log:
added .convert_to to modules

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2012-10-29 11:23:48 UTC (rev 3852)
+++ pkg/Rcpp/ChangeLog	2012-10-29 12:17:53 UTC (rev 3853)
@@ -2,6 +2,10 @@
 
 	* R/Module.R: Taking care of a check warning
 	* include/Rcpp/module/macros.h: adding RCPP_EXPOSED_CLASS_NODECL
+    * include/Rcpp/Module.h: introducing convert_to to facilitate conversion to 
+    other class. 
+    * R/Module.R: Methods registered internally with convert_to will generate
+    the appropriate as S4 method. 
 
 2012-10-28  Dirk Eddelbuettel  <edd at debian.org>
 

Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R	2012-10-29 11:23:48 UTC (rev 3852)
+++ pkg/Rcpp/R/Module.R	2012-10-29 12:17:53 UTC (rev 3853)
@@ -247,8 +247,20 @@
                     x
                 } , where = where )
             }
-
         }
+        
+        as_rx <- "^[.]___as___(.+)$"
+        if( length( matches <- grep( as_rx, names(CLASS at methods) ) ) ){
+            for( i in matches ){
+                met <- names(CLASS at methods)[i]
+                to <- sub( as_rx, "\\1", met )
+                converter <- function( from ){}
+                body( converter ) <- substitute( { from$CONVERT() }, 
+                    list( CONVERT = met )
+                )
+                setAs( clname, to, converter, where = where)
+            }
+        }
 
     }
     if(length(classes)) {

Modified: pkg/Rcpp/inst/include/Rcpp/Module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Module.h	2012-10-29 11:23:48 UTC (rev 3852)
+++ pkg/Rcpp/inst/include/Rcpp/Module.h	2012-10-29 12:17:53 UTC (rev 3853)
@@ -25,6 +25,19 @@
 #include <Rcpp/config.h>
 
 namespace Rcpp{
+    
+    namespace internal{
+        template <typename OUT>
+        std::string get_as_method_name(const char* target){
+            std::string method_name( ".___as___" ) ;
+            typedef typename Rcpp::traits::r_type_traits<OUT>::r_category CATEGORY ;
+            if( Rcpp::traits::same_type< CATEGORY, ::Rcpp::traits::r_type_module_object_tag >::value ){
+                method_name += "Rcpp_" ;    
+            }
+            method_name += target ;
+            return method_name ;
+        }
+    }
 
     class CppClass ;
     class CppObject ;
@@ -593,6 +606,19 @@
 #include <Rcpp/module/Module_generated_method.h>
 #include <Rcpp/module/Module_generated_Pointer_method.h>
         
+        template <typename OUT>
+        self& convert_to( const char* target, OUT (Class::*fun)(void), const char* docstring = 0 ){
+            std::string method_name = internal::get_as_method_name<OUT>(target) ; 
+            method( method_name.c_str() , fun, docstring, &yes ) ;
+            return *this ;
+        }
+        template <typename OUT>
+        self& convert_to( const char* target, OUT (*fun)(Class*), const char* docstring = 0 ){
+            std::string method_name = internal::get_as_method_name<OUT>(target) ; 
+            method( method_name.c_str(), fun, docstring, &yes ) ;
+            return *this ;
+        }
+        
         bool has_method( const std::string& m){
             return vec_methods.find(m) != vec_methods.end() ;
         }