[Rcpp-commits] r4404 - in pkg/Rcpp: . inst/include/Rcpp inst/include/Rcpp/api/meat inst/include/Rcpp/macros inst/include/Rcpp/traits src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jul 24 18:18:55 CEST 2013


Author: romain
Date: 2013-07-24 18:18:55 +0200 (Wed, 24 Jul 2013)
New Revision: 4404

Added:
   pkg/Rcpp/inst/include/Rcpp/traits/is_module_object.h
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/api/meat/is.h
   pkg/Rcpp/inst/include/Rcpp/is.h
   pkg/Rcpp/inst/include/Rcpp/macros/module.h
   pkg/Rcpp/inst/include/Rcpp/traits/traits.h
   pkg/Rcpp/src/Module.cpp
Log:
support for is<T> where T is module exposed

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/ChangeLog	2013-07-24 16:18:55 UTC (rev 4404)
@@ -1,3 +1,14 @@
+2013-07-24  Romain Francois <romain at r-enthusiasts.com>
+
+        * include/Rcpp/traits/is_module_object.h: trait class that identifies
+        at compile time if a given type is a type exposed by a module, i.e. if 
+        we used the RCPP_EXPOSED_AS macro
+        * include/Rcpp/is.h: able to identify if an object is of a given type
+        exposed by a module (supports references and pointers too). 
+        * src/Module.cpp: implementation of is_module_object_internal that 
+        checks if an object is of a given typeid, used by is<T> where T is 
+        module exposed
+
 2013-07-23  Romain Francois <romain at r-enthusiasts.com>
 
         * include/Rcpp/as.h: support as<T*> and as<const T*> where T is a class

Modified: pkg/Rcpp/inst/include/Rcpp/api/meat/is.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/api/meat/is.h	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/inst/include/Rcpp/api/meat/is.h	2013-07-24 16:18:55 UTC (rev 4404)
@@ -23,121 +23,130 @@
 #define Rcpp_api_meat_is_h
 
 namespace Rcpp{ 
-    
+namespace internal{
+        
     inline bool is_atomic( SEXP x){ return Rf_length(x) == 1 ; } 
     inline bool is_matrix(SEXP x){
         SEXP dim = Rf_getAttrib( x, R_DimSymbol) ;
         return dim != R_NilValue && Rf_length(dim) == 2 ;
     }
     
-    template <> inline bool is<int>( SEXP x ){
+    template <> inline bool is__simple<int>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == INTSXP ;
     }
 
-    template <> inline bool is<double>( SEXP x ){
+    template <> inline bool is__simple<double>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == REALSXP ;
     }
     
-    template <> inline bool is<bool>( SEXP x ){
+    template <> inline bool is__simple<bool>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == LGLSXP ;
     }
     
-    template <> inline bool is<std::string>( SEXP x ){
+    template <> inline bool is__simple<std::string>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == STRSXP ;
     }
     
-    template <> inline bool is<String>( SEXP x ){
+    template <> inline bool is__simple<String>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == STRSXP ;
     }
     
-    template <> inline bool is<RObject>( SEXP x ){
+    template <> inline bool is__simple<RObject>( SEXP x ){
         return true ;
     }
-    template <> inline bool is<IntegerVector>( SEXP x ){
+    template <> inline bool is__simple<IntegerVector>( SEXP x ){
         return TYPEOF(x) == INTSXP ;
     }
-    template <> inline bool is<ComplexVector>( SEXP x ){
+    template <> inline bool is__simple<ComplexVector>( SEXP x ){
         return TYPEOF(x) == CPLXSXP ;
     }
-    template <> inline bool is<RawVector>( SEXP x ){
+    template <> inline bool is__simple<RawVector>( SEXP x ){
         return TYPEOF(x) == RAWSXP ;
     }
-    template <> inline bool is<NumericVector>( SEXP x ){
+    template <> inline bool is__simple<NumericVector>( SEXP x ){
         return TYPEOF(x) == REALSXP ;
     }
-    template <> inline bool is<LogicalVector>( SEXP x ){
+    template <> inline bool is__simple<LogicalVector>( SEXP x ){
         return TYPEOF(x) == LGLSXP ;
     }
-    template <> inline bool is<List>( SEXP x ){
+    template <> inline bool is__simple<List>( SEXP x ){
         return TYPEOF(x) == VECSXP ;
     }
-    template <> inline bool is<IntegerMatrix>( SEXP x ){
+    template <> inline bool is__simple<IntegerMatrix>( SEXP x ){
         return TYPEOF(x) == INTSXP && is_matrix(x) ;
     }
-    template <> inline bool is<ComplexMatrix>( SEXP x ){
+    template <> inline bool is__simple<ComplexMatrix>( SEXP x ){
         return TYPEOF(x) == CPLXSXP && is_matrix(x) ;
     }
-    template <> inline bool is<RawMatrix>( SEXP x ){
+    template <> inline bool is__simple<RawMatrix>( SEXP x ){
         return TYPEOF(x) == RAWSXP && is_matrix(x) ;
     }
-    template <> inline bool is<NumericMatrix>( SEXP x ){
+    template <> inline bool is__simple<NumericMatrix>( SEXP x ){
         return TYPEOF(x) == REALSXP && is_matrix(x) ;
     }
-    template <> inline bool is<LogicalMatrix>( SEXP x ){
+    template <> inline bool is__simple<LogicalMatrix>( SEXP x ){
         return TYPEOF(x) == LGLSXP && is_matrix(x) ;
     }
-    template <> inline bool is<GenericMatrix>( SEXP x ){
+    template <> inline bool is__simple<GenericMatrix>( SEXP x ){
         return TYPEOF(x) == VECSXP && is_matrix(x) ;
     }
     
     
-    template <> inline bool is<DataFrame>( SEXP x ){
+    template <> inline bool is__simple<DataFrame>( SEXP x ){
         if( TYPEOF(x) != VECSXP ) return false ;
         return Rf_inherits( x, "data.frame" ) ;
     }
-    template <> inline bool is<WeakReference>( SEXP x ){
+    template <> inline bool is__simple<WeakReference>( SEXP x ){
         return TYPEOF(x) == WEAKREFSXP ;
     }
-    template <> inline bool is<Symbol>( SEXP x ){
+    template <> inline bool is__simple<Symbol>( SEXP x ){
         return TYPEOF(x) == SYMSXP ;
     }
-    template <> inline bool is<S4>( SEXP x ){
+    template <> inline bool is__simple<S4>( SEXP x ){
         return ::Rf_isS4(x);
     }
-    template <> inline bool is<Reference>( SEXP x ){
+    template <> inline bool is__simple<Reference>( SEXP x ){
         if( ! ::Rf_isS4(x) ) return false ;
         return ::Rf_inherits(x, "envRefClass" ) ;
     }
-    template <> inline bool is<Promise>( SEXP x ){
+    template <> inline bool is__simple<Promise>( SEXP x ){
         return TYPEOF(x) == PROMSXP ;
     }
-    template <> inline bool is<Pairlist>( SEXP x ){
+    template <> inline bool is__simple<Pairlist>( SEXP x ){
         return TYPEOF(x) == LISTSXP ;
     }
-    template <> inline bool is<Function>( SEXP x ){
+    template <> inline bool is__simple<Function>( SEXP x ){
         return TYPEOF(x) == CLOSXP || TYPEOF(x) == SPECIALSXP || TYPEOF(x) == BUILTINSXP ;
     }
-    template <> inline bool is<Environment>( SEXP x ){
+    template <> inline bool is__simple<Environment>( SEXP x ){
         return TYPEOF(x) == ENVSXP ;
     }
-    template <> inline bool is<Formula>( SEXP x ){
+    template <> inline bool is__simple<Formula>( SEXP x ){
         if( TYPEOF(x) != LANGSXP ) return false ; 
         return Rf_inherits( x, "formula" ) ;
     }
     
-    template <> inline bool is<Date>( SEXP x ){
+    template <> inline bool is__simple<Date>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == REALSXP && Rf_inherits( x, "Date" ) ;
     }
-    template <> inline bool is<Datetime>( SEXP x ){
+    template <> inline bool is__simple<Datetime>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == REALSXP && Rf_inherits( x, "POSIXt" ) ;
     }
-    template <> inline bool is<DateVector>( SEXP x ){
+    template <> inline bool is__simple<DateVector>( SEXP x ){
         return TYPEOF(x) == REALSXP && Rf_inherits( x, "Date" ) ;
     }
-    template <> inline bool is<DatetimeVector>( SEXP x ){
+    template <> inline bool is__simple<DatetimeVector>( SEXP x ){
         return TYPEOF(x) == REALSXP && Rf_inherits( x, "POSIXt" ) ;
     }
      
+    bool is_module_object_internal(SEXP, const char*) ;
+    template <typename T> bool is__module__object( SEXP x){
+        typedef typename Rcpp::traits::un_pointer<T>::type CLASS ;
+        return is_module_object_internal(x, typeid(CLASS).name() ) ;     
+    }
+        
+    
+} // namespace internal
 } // namespace Rcpp
 
 #endif

Modified: pkg/Rcpp/inst/include/Rcpp/is.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/is.h	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/inst/include/Rcpp/is.h	2013-07-24 16:18:55 UTC (rev 4404)
@@ -24,13 +24,35 @@
 #define Rcpp__is__h
 
 namespace Rcpp{
-
+      
+    namespace internal{  
+        
+        // simple implementation, for most default types
+        template <typename T> bool is__simple( SEXP x) ;
+        
+        // implementation for module objects
+        template <typename T> bool is__module__object( SEXP x) ;
+        
+        // not a module object
+        template <typename T>
+        inline bool is__dispatch( SEXP x, Rcpp::traits::false_type ){
+            return is__simple<T>( x ) ;
+        }
+        
+        template <typename T>
+        inline bool is__dispatch( SEXP x, Rcpp::traits::true_type ){
+            return is__module__object<T>( x ) ;
+        }
+    }
+    
     /** identify if an x can be seen as the T type
      *  
      *  example:
      *     bool is_list = is<List>( x ) ;
      */
-    template <typename T> bool is( SEXP x ) ;
+    template <typename T> bool is( SEXP x ){
+        return internal::is__dispatch<T>( x, typename traits::is_module_object<T>::type() ) ;    
+    }
     
 } // Rcpp 
 

Modified: pkg/Rcpp/inst/include/Rcpp/macros/module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/macros/module.h	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/inst/include/Rcpp/macros/module.h	2013-07-24 16:18:55 UTC (rev 4404)
@@ -27,23 +27,23 @@
  *  as a parameter of a function or method exposed by modules. This defines
  *  the necessary trait that makes the class as<>'able
  */
-#define RCPP_EXPOSED_AS(CLASS)                                         \
-    namespace Rcpp{ namespace traits{                                  \
-    template<> struct r_type_traits< CLASS* >{                         \
-        typedef r_type_module_object_pointer_tag r_category ;          \
-    } ;                                                                \
-    template<> struct r_type_traits< const CLASS* >{                   \
-        typedef r_type_module_object_const_pointer_tag r_category ;    \
-    } ;                                                                \
-    template<> struct r_type_traits< CLASS >{                          \
-        typedef r_type_module_object_tag r_category ;                  \
-    } ;                                                                \
-    template<> struct r_type_traits< CLASS& >{                         \
-        typedef r_type_module_object_reference_tag r_category ;        \
-    } ;                                                                \
-    template<> struct r_type_traits< const CLASS& >{                   \
-        typedef r_type_module_object_const_reference_tag r_category ;  \
-    } ;                                                                \
+#define RCPP_EXPOSED_AS(CLASS)                                                \
+    namespace Rcpp{ namespace traits{                                         \
+    template<> struct r_type_traits< CLASS* >{                                \
+        typedef r_type_module_object_pointer_tag r_category ;                 \
+    } ;                                                                       \
+    template<> struct r_type_traits< const CLASS* >{                          \
+        typedef r_type_module_object_const_pointer_tag r_category ;           \
+    } ;                                                                       \
+    template<> struct r_type_traits< CLASS >{                                 \
+        typedef r_type_module_object_tag r_category ;                         \
+    } ;                                                                       \
+    template<> struct r_type_traits< CLASS& >{                                \
+        typedef r_type_module_object_reference_tag r_category ;               \
+    } ;                                                                       \
+    template<> struct r_type_traits< const CLASS& >{                          \
+        typedef r_type_module_object_const_reference_tag r_category ;         \
+    } ;                                                                       \
     }}
     
 #define RCPP_EXPOSED_WRAP(CLASS) namespace Rcpp{ namespace traits{ template<> struct wrap_type_traits< CLASS >{typedef wrap_type_module_object_tag wrap_category ; } ; }}

Added: pkg/Rcpp/inst/include/Rcpp/traits/is_module_object.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/traits/is_module_object.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/traits/is_module_object.h	2013-07-24 16:18:55 UTC (rev 4404)
@@ -0,0 +1,41 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */
+//
+// is_module_object.h: Rcpp R/C++ interface class library -- 
+//
+// Copyright (C) 2013 Dirk Eddelbuettel and 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/>.
+
+#ifndef Rcpp__traits__is_module_object__h
+#define Rcpp__traits__is_module_object__h
+
+namespace Rcpp{
+namespace traits{
+      
+	template <typename T> struct is_module_object : 
+		public integral_constant<bool,
+			same_type< typename r_type_traits<T>::r_category, r_type_module_object_tag >::value                ||
+			same_type< typename r_type_traits<T>::r_category, r_type_module_object_pointer_tag >::value        ||
+			same_type< typename r_type_traits<T>::r_category, r_type_module_object_const_pointer_tag >::value  ||
+			same_type< typename r_type_traits<T>::r_category, r_type_module_object_reference_tag >::value      ||
+			same_type< typename r_type_traits<T>::r_category, r_type_module_object_const_reference_tag >::value
+		>{} ;
+
+} // traits
+} // Rcpp
+
+#endif

Modified: pkg/Rcpp/inst/include/Rcpp/traits/traits.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/traits/traits.h	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/inst/include/Rcpp/traits/traits.h	2013-07-24 16:18:55 UTC (rev 4404)
@@ -59,6 +59,7 @@
 #include <Rcpp/traits/remove_reference.h>
 #include <Rcpp/traits/remove_const_and_reference.h>
 #include <Rcpp/traits/result_of.h>
+#include <Rcpp/traits/is_module_object.h>
 
 #endif
 

Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/src/Module.cpp	2013-07-24 16:18:55 UTC (rev 4404)
@@ -502,6 +502,11 @@
 	        SEXP xp = env.get(".pointer") ;
 	        return R_ExternalPtrAddr(xp );
 	    }
+	    bool is_module_object_internal(SEXP obj, const char* clazz){
+	        Environment env(obj) ;
+	        XPtr<class_Base> xp( env.get(".cppclass") );
+	        return xp->has_typeinfo_name( clazz ) ;
+	    }
 	}
 	
 	FunctionProxy GetCppCallable( const std::string& pkg, const std::string& mod, const std::string& fun){



More information about the Rcpp-commits mailing list