// cpp11 version: 0.3.1.1 // vendored on: 2021-08-11 #pragma once #include // for modf #include // for initializer_list #include // for std::shared_ptr, std::weak_ptr, std::unique_ptr #include // for string, basic_string #include // for decay, enable_if, is_same, is_convertible #include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_xlength, R_xlen_t #include "cpp11/protect.hpp" // for stop, protect, safe, protect::function namespace cpp11 { template using enable_if_t = typename std::enable_if::type; template using decay_t = typename std::decay::type; template struct is_smart_ptr : std::false_type {}; template struct is_smart_ptr> : std::true_type {}; template struct is_smart_ptr> : std::true_type {}; template struct is_smart_ptr> : std::true_type {}; template using enable_if_constructible_from_sexp = enable_if_t::value && // workaround for gcc 4.8 std::is_class::value && std::is_constructible::value, R>; template using enable_if_is_sexp = enable_if_t::value, R>; template using enable_if_convertible_to_sexp = enable_if_t::value, R>; template using disable_if_convertible_to_sexp = enable_if_t::value, R>; template using enable_if_integral = enable_if_t::value && !std::is_same::value && !std::is_same::value, R>; template using enable_if_floating_point = typename std::enable_if::value, R>::type; template using enable_if_enum = enable_if_t::value, R>; template using enable_if_bool = enable_if_t::value, R>; template using enable_if_char = enable_if_t::value, R>; template using enable_if_std_string = enable_if_t::value, R>; template using enable_if_c_string = enable_if_t::value, R>; // https://stackoverflow.com/a/1521682/2055486 // inline bool is_convertable_without_loss_to_integer(double value) { double int_part; return std::modf(value, &int_part) == 0.0; } template enable_if_constructible_from_sexp as_cpp(SEXP from) { return T(from); } template enable_if_is_sexp as_cpp(SEXP from) { return from; } template enable_if_integral as_cpp(SEXP from) { if (Rf_isInteger(from)) { if (Rf_xlength(from) == 1) { return INTEGER_ELT(from, 0); } } else if (Rf_isReal(from)) { if (Rf_xlength(from) == 1) { if (ISNA(REAL_ELT(from, 0))) { return NA_INTEGER; } double value = REAL_ELT(from, 0); if (is_convertable_without_loss_to_integer(value)) { return value; } } } else if (Rf_isLogical(from)) { if (Rf_xlength(from) == 1) { if (LOGICAL_ELT(from, 0) == NA_LOGICAL) { return NA_INTEGER; } } } stop("Expected single integer value"); } template enable_if_enum as_cpp(SEXP from) { if (Rf_isInteger(from)) { using underlying_type = typename std::underlying_type::type; using int_type = typename std::conditional::value, int, // as_cpp would trigger // undesired string conversions underlying_type>::type; return static_cast(as_cpp(from)); } stop("Expected single integer value"); } template enable_if_bool as_cpp(SEXP from) { if (Rf_isLogical(from)) { if (Rf_xlength(from) == 1) { return LOGICAL_ELT(from, 0) == 1; } } stop("Expected single logical value"); } template enable_if_floating_point as_cpp(SEXP from) { if (Rf_isReal(from)) { if (Rf_xlength(from) == 1) { return REAL_ELT(from, 0); } } // All 32 bit integers can be coerced to doubles, so we just convert them. if (Rf_isInteger(from)) { if (Rf_xlength(from) == 1) { if (INTEGER_ELT(from, 0) == NA_INTEGER) { return NA_REAL; } return INTEGER_ELT(from, 0); } } // Also allow NA values if (Rf_isLogical(from)) { if (Rf_xlength(from) == 1) { if (LOGICAL_ELT(from, 0) == NA_LOGICAL) { return NA_REAL; } } } stop("Expected single double value"); } template enable_if_char as_cpp(SEXP from) { if (Rf_isString(from)) { if (Rf_xlength(from) == 1) { return unwind_protect([&] { return Rf_translateCharUTF8(STRING_ELT(from, 0))[0]; }); } } stop("Expected string vector of length 1"); } template enable_if_c_string as_cpp(SEXP from) { if (Rf_isString(from)) { if (Rf_xlength(from) == 1) { // TODO: use vmaxget / vmaxset here? return {unwind_protect([&] { return Rf_translateCharUTF8(STRING_ELT(from, 0)); })}; } } stop("Expected string vector of length 1"); } template enable_if_std_string as_cpp(SEXP from) { return {as_cpp(from)}; } /// Temporary workaround for compatibility with cpp11 0.1.0 template enable_if_t, T>::value, decay_t> as_cpp(SEXP from) { return as_cpp>(from); } template enable_if_integral as_sexp(T from) { return safe[Rf_ScalarInteger](from); } template enable_if_floating_point as_sexp(T from) { return safe[Rf_ScalarReal](from); } template enable_if_bool as_sexp(T from) { return safe[Rf_ScalarLogical](from); } template enable_if_c_string as_sexp(T from) { return unwind_protect([&] { return Rf_ScalarString(Rf_mkCharCE(from, CE_UTF8)); }); } template enable_if_std_string as_sexp(const T& from) { return as_sexp(from.c_str()); } template > enable_if_integral as_sexp(const Container& from) { R_xlen_t size = from.size(); SEXP data = safe[Rf_allocVector](INTSXP, size); auto it = from.begin(); int* data_p = INTEGER(data); for (R_xlen_t i = 0; i < size; ++i, ++it) { data_p[i] = *it; } return data; } inline SEXP as_sexp(std::initializer_list from) { return as_sexp>(from); } template > enable_if_floating_point as_sexp(const Container& from) { R_xlen_t size = from.size(); SEXP data = safe[Rf_allocVector](REALSXP, size); auto it = from.begin(); double* data_p = REAL(data); for (R_xlen_t i = 0; i < size; ++i, ++it) { data_p[i] = *it; } return data; } inline SEXP as_sexp(std::initializer_list from) { return as_sexp>(from); } template > enable_if_bool as_sexp(const Container& from) { R_xlen_t size = from.size(); SEXP data = safe[Rf_allocVector](LGLSXP, size); auto it = from.begin(); int* data_p = LOGICAL(data); for (R_xlen_t i = 0; i < size; ++i, ++it) { data_p[i] = *it; } return data; } inline SEXP as_sexp(std::initializer_list from) { return as_sexp>(from); } namespace detail { template SEXP as_sexp_strings(const Container& from, AsCstring&& c_str) { R_xlen_t size = from.size(); SEXP data; try { data = PROTECT(safe[Rf_allocVector](STRSXP, size)); auto it = from.begin(); for (R_xlen_t i = 0; i < size; ++i, ++it) { SET_STRING_ELT(data, i, safe[Rf_mkCharCE](c_str(*it), CE_UTF8)); } } catch (const unwind_exception& e) { UNPROTECT(1); throw e; } UNPROTECT(1); return data; } } // namespace detail class r_string; template using disable_if_r_string = enable_if_t::value, R>; template > enable_if_t::value && !std::is_convertible::value, SEXP> as_sexp(const Container& from) { return detail::as_sexp_strings(from, [](const std::string& s) { return s.c_str(); }); } template enable_if_c_string as_sexp(const Container& from) { return detail::as_sexp_strings(from, [](const char* s) { return s; }); } inline SEXP as_sexp(std::initializer_list from) { return as_sexp>(from); } template > enable_if_convertible_to_sexp as_sexp(const T& from) { return from; } } // namespace cpp11