Skip to content

Commit

Permalink
more flexible impl of is<>
Browse files Browse the repository at this point in the history
  • Loading branch information
romainfrancois committed Oct 2, 2013
1 parent 4674684 commit 398a58c
Show file tree
Hide file tree
Showing 4 changed files with 59 additions and 82 deletions.
82 changes: 20 additions & 62 deletions inst/include/Rcpp/api/meat/is.h
Expand Up @@ -52,84 +52,42 @@ namespace internal{

template <> inline bool is__simple<RObject>( SEXP x ){
return true ;
}
template <> inline bool is__simple<IntegerVector>( SEXP x ){
return TYPEOF(x) == INTSXP ;
}
template <> inline bool is__simple<ComplexVector>( SEXP x ){
return TYPEOF(x) == CPLXSXP ;
}
template <> inline bool is__simple<RawVector>( SEXP x ){
return TYPEOF(x) == RAWSXP ;
}
template <> inline bool is__simple<NumericVector>( SEXP x ){
return TYPEOF(x) == REALSXP ;
}
template <> inline bool is__simple<LogicalVector>( SEXP x ){
return TYPEOF(x) == LGLSXP ;
}
template <> inline bool is__simple<List>( SEXP x ){
return TYPEOF(x) == VECSXP ;
}
template <> inline bool is__simple<IntegerMatrix>( SEXP x ){
return TYPEOF(x) == INTSXP && is_matrix(x) ;
}
template <> inline bool is__simple<ComplexMatrix>( SEXP x ){
return TYPEOF(x) == CPLXSXP && is_matrix(x) ;
}
template <> inline bool is__simple<RawMatrix>( SEXP x ){
return TYPEOF(x) == RAWSXP && is_matrix(x) ;
}
template <> inline bool is__simple<NumericMatrix>( SEXP x ){
return TYPEOF(x) == REALSXP && is_matrix(x) ;
}
template <> inline bool is__simple<LogicalMatrix>( SEXP x ){
return TYPEOF(x) == LGLSXP && is_matrix(x) ;
}
template <> inline bool is__simple<GenericMatrix>( SEXP x ){
return TYPEOF(x) == VECSXP && is_matrix(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__simple<WeakReference>( SEXP x ){
return TYPEOF(x) == WEAKREFSXP ;
}
template <> inline bool is__simple<Symbol>( SEXP x ){
return TYPEOF(x) == SYMSXP ;
}
template <> inline bool is__simple<S4>( SEXP x ){
return ::Rf_isS4(x);
}
template <> inline bool is__simple<Reference>( SEXP x ){
if( ! ::Rf_isS4(x) ) return false ;
return ::Rf_inherits(x, "envRefClass" ) ;
}
template <> inline bool is__simple<Promise>( SEXP x ){
return TYPEOF(x) == PROMSXP ;
}
template <> inline bool is__simple<Pairlist>( SEXP x ){
return TYPEOF(x) == LISTSXP ;
}
template <> inline bool is__simple<Function>( SEXP x ){
return TYPEOF(x) == CLOSXP || TYPEOF(x) == SPECIALSXP || TYPEOF(x) == BUILTINSXP ;
}
template <> inline bool is__simple<Environment>( SEXP x ){
return TYPEOF(x) == ENVSXP ;
}
template <> inline bool is__simple<Formula>( SEXP x ){
if( TYPEOF(x) != LANGSXP ) return false ;
return Rf_inherits( x, "formula" ) ;
}

bool is_module_object_internal(SEXP, const char*) ;
template <typename T> bool is__module__object( SEXP x){
typedef typename std::remove_pointer<T>::type CLASS ;
return is_module_object_internal(x, typeid(CLASS).name() ) ;
template <> inline bool is__simple<Function>( SEXP x ){
return TYPEOF(x) == CLOSXP || TYPEOF(x) == SPECIALSXP || TYPEOF(x) == BUILTINSXP ;
}

template <typename T>
struct ModuleIs {
inline bool test(SEXP x){
typedef typename std::remove_pointer<T>::type CLASS ;
Environment env(x) ;
XPtr<class_Base> xp( env.get(".cppclass") );
return xp->has_typeinfo_name( typeid(CLASS).name() ) ;
}
} ;

template <int RTYPE>
struct Is< Matrix<RTYPE> > {
inline bool test( SEXP x){
return TYPEOF(x) == RTYPE && is_matrix(x) ;
}
} ;


} // namespace internal
Expand Down
45 changes: 32 additions & 13 deletions inst/include/Rcpp/is.h
@@ -1,6 +1,5 @@
//
// is.h: test if an R Object can be seen
// as one type
// is.h: test if an R Object can be seen as one type
//
// Copyright (C) 2013 Dirk Eddelbuettel and Romain Francois
//
Expand Down Expand Up @@ -29,19 +28,39 @@ namespace Rcpp{
// 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, std::false_type ){
return is__simple<T>( x ) ;
}
struct Is {
inline bool test(SEXP x){
return is__simple<T>( x ) ;
}
} ;

template <int RTYPE> struct TypeofIs{
inline bool test(SEXP x){
return TYPEOF(x) == RTYPE ;
}
} ;

template <int RTYPE> struct Is< Vector<RTYPE> > : TypeofIs<RTYPE>{} ;
template <int RTYPE> struct Is< Matrix<RTYPE> > ;

template <> struct Is<Environment> : TypeofIs<ENVSXP> {} ;
template <> struct Is<Pairlist> : TypeofIs<LISTSXP> {} ;
template <> struct Is<Promise> : TypeofIs<PROMSXP> {} ;
template <> struct Is<Symbol> : TypeofIs<SYMSXP> {} ;
template <> struct Is<WeakReference> : TypeofIs<WEAKREFSXP> {} ;

template <typename T> struct ModuleIs ;

template <typename T>
inline bool is__dispatch( SEXP x, std::true_type ){
return is__module__object<T>( x ) ;
}
struct is_type{
typedef typename std::conditional<
Rcpp::traits::is_module_object<T>::value,
typename ModuleIs<T>::type,
typename Is<T>::type
>::type type ;
} ;

}

/** identify if an x can be seen as the T type
Expand All @@ -50,7 +69,7 @@ namespace Rcpp{
* bool is_list = is<List>( x ) ;
*/
template <typename T> bool is( SEXP x ){
return internal::is__dispatch<T>( x, typename traits::is_module_object<T>::type() ) ;
return typename internal::is_type<T>::type().test(x) ;
}

} // Rcpp
Expand Down
9 changes: 7 additions & 2 deletions inst/include/RcppCommon.h
Expand Up @@ -81,9 +81,14 @@ namespace Rcpp{
class String ;

template <int RTYPE> class Vector ;
template <int RTYPE> class Matrix ;
using CharacterVector = Vector<STRSXP> ;

namespace internal{
class Environment ;
class Pairlist ;
class Promise ;
class Symbol ;
class WeakReference ;
namespace internal{
template <typename Class> SEXP make_new_object( Class* ptr ) ;
}
}
Expand Down
5 changes: 0 additions & 5 deletions src/Module.cpp
Expand Up @@ -501,11 +501,6 @@ namespace Rcpp{
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 ) ;
}
}

}
Expand Down

0 comments on commit 398a58c

Please sign in to comment.