Rcpp Version 1.0.9
as.h
Go to the documentation of this file.
1 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
2 //
3 // as.h: Rcpp R/C++ interface class library -- convert SEXP to C++ objects
4 //
5 // Copyright (C) 2009 - 2015 Dirk Eddelbuettel and Romain Francois
6 //
7 // This file is part of Rcpp.
8 //
9 // Rcpp is free software: you can redistribute it and/or modify it
10 // under the terms of the GNU General Public License as published by
11 // the Free Software Foundation, either version 2 of the License, or
12 // (at your option) any later version.
13 //
14 // Rcpp is distributed in the hope that it will be useful, but
15 // WITHOUT ANY WARRANTY; without even the implied warranty of
16 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 // GNU General Public License for more details.
18 //
19 // You should have received a copy of the GNU General Public License
20 // along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
21 
22 #ifndef Rcpp__as__h
23 #define Rcpp__as__h
24 
25 #include <Rcpp/internal/Exporter.h>
26 
27 namespace Rcpp {
28 
29  namespace internal {
30 
31  template <typename T> T primitive_as(SEXP x) {
32  if (::Rf_length(x) != 1) {
33  const char* fmt = "Expecting a single value: [extent=%i].";
34  throw ::Rcpp::not_compatible(fmt, ::Rf_length(x));
35  }
37  Shield<SEXP> y(r_cast<RTYPE>(x));
38  typedef typename ::Rcpp::traits::storage_type<RTYPE>::type STORAGE;
39  T res = caster<STORAGE,T>(*r_vector_start<RTYPE>(y));
40  return res;
41  }
42 
43  template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_primitive_tag) {
44  return primitive_as<T>(x);
45  }
46 
47  inline const char* check_single_string(SEXP x) {
48  if (TYPEOF(x) == CHARSXP) return CHAR(x);
49  if (! ::Rf_isString(x) || Rf_length(x) != 1) {
50  const char* fmt = "Expecting a single string value: "
51  "[type=%s; extent=%i].";
52  throw ::Rcpp::not_compatible(fmt,
53  Rf_type2char(TYPEOF(x)),
54  Rf_length(x));
55  }
56 
57  return CHAR(STRING_ELT(::Rcpp::r_cast<STRSXP>(x), 0));
58  }
59 
60 
61  template <typename T> T as_string(SEXP x, Rcpp::traits::true_type) {
62  const char* y = check_single_string(x);
63  return std::wstring(y, y+strlen(y));
64  }
65 
66  template <typename T> T as_string(SEXP x, Rcpp::traits::false_type) {
67  return check_single_string(x);
68  }
69 
70  template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_string_tag) {
71  return as_string<T>(x, typename Rcpp::traits::is_wide_string<T>::type());
72  }
73 
74  template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_RcppString_tag) {
75  if (! ::Rf_isString(x)) {
76  const char* fmt = "Expecting a single string value: "
77  "[type=%s; extent=%i].";
78  throw ::Rcpp::not_compatible(fmt,
79  Rf_type2char(TYPEOF(x)),
80  Rf_length(x));
81  }
82  return STRING_ELT(::Rcpp::r_cast<STRSXP>(x), 0);
83  }
84 
85  template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_generic_tag) {
86  RCPP_DEBUG_1("as(SEXP = <%p>, r_type_generic_tag )", x);
87  ::Rcpp::traits::Exporter<T> exporter(x);
88  RCPP_DEBUG_1("exporter type = %s", DEMANGLE(exporter));
89  return exporter.get();
90  }
91 
92  void* as_module_object_internal(SEXP obj);
93 
94  template <typename T> object<T> as_module_object(SEXP x) {
95  return (T*) as_module_object_internal(x);
96  }
97 
99  template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_const_pointer_tag) {
100  typedef typename Rcpp::traits::remove_const<T>::type T_NON_CONST;
101  return const_cast<T>((T_NON_CONST)as_module_object_internal(x));
102  }
103 
104  template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_pointer_tag) {
105  return as_module_object<typename traits::un_pointer<T>::type>(x);
106  }
107 
109  template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_tag) {
110  T* obj = as_module_object<T>(x);
111  return *obj;
112  }
113 
115  template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_reference_tag) {
116  typedef typename traits::remove_reference<T>::type KLASS;
117  KLASS* obj = as_module_object<KLASS>(x);
118  return *obj;
119  }
120 
122  template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_const_reference_tag) {
123  typedef typename traits::remove_const_and_reference<T>::type KLASS;
124  KLASS* obj = as_module_object<KLASS>(x);
125  return const_cast<T>(*obj);
126  }
127 
129  template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_enum_tag) {
130  return T(primitive_as<int>(x));
131  }
132 
133  }
134 
135 
151  template <typename T> T as(SEXP x) {
152  return internal::as<T>(x, typename traits::r_type_traits<T>::r_category());
153  }
154 
155  template <> inline char as<char>(SEXP x) {
156  return internal::check_single_string(x)[0];
157  }
158 
159  template <typename T>
161  return as< typename traits::remove_const_and_reference<T>::type >(x);
162  }
163 
164  template<> inline SEXP as(SEXP x) { return x; }
165 
166 } // Rcpp
167 
168 #endif
#define RCPP_DEBUG_1(fmt, MSG)
Definition: debug.h:44
#define DEMANGLE(__TYPE__)
Definition: exceptions.h:382
T primitive_as(SEXP x)
Definition: as.h:31
T as(SEXP x, ::Rcpp::traits::r_type_primitive_tag)
Definition: as.h:43
void * as_module_object_internal(SEXP obj)
Definition: as.h:24
const char * check_single_string(SEXP x)
Definition: as.h:47
object< T > as_module_object(SEXP x)
Definition: as.h:94
T as_string(SEXP x, Rcpp::traits::true_type)
Definition: as.h:61
Rcpp API.
Definition: algo.h:28
char as< char >(SEXP x)
Definition: as.h:155
traits::remove_const_and_reference< T >::type bare_as(SEXP x)
Definition: as.h:160
T as(SEXP x)
Definition: as.h:151
remove_const< typename remove_reference< T >::type >::type type