diff --git a/DESCRIPTION b/DESCRIPTION index b79b3692..20f96703 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,7 +36,6 @@ Suggests: rmarkdown, testthat (>= 3.0.0) LinkingTo: - cpp11, plogr (>= 0.2.0) VignetteBuilder: knitr diff --git a/man/RPostgres-package.Rd b/man/RPostgres-package.Rd index 5a4bc89c..0aac434d 100644 --- a/man/RPostgres-package.Rd +++ b/man/RPostgres-package.Rd @@ -4,9 +4,9 @@ \name{RPostgres-package} \alias{RPostgres} \alias{RPostgres-package} -\title{RPostgres: Rcpp Interface to PostgreSQL} +\title{RPostgres: C++ Interface to PostgreSQL} \description{ -Fully DBI-compliant Rcpp-backed interface to PostgreSQL \url{https://www.postgresql.org/}, an open-source relational database. +Fully DBI-compliant C++-backed interface to PostgreSQL \url{https://www.postgresql.org/}, an open-source relational database. } \seealso{ Useful links: diff --git a/src/Makevars.in b/src/Makevars.in index 997f0450..eb498e21 100644 --- a/src/Makevars.in +++ b/src/Makevars.in @@ -1,4 +1,4 @@ -PKG_CPPFLAGS=@cflags@ -Ivendor -DRCPP_DEFAULT_INCLUDE_CALL=false -DRCPP_USING_UTF8_ERROR_STRING -DBOOST_NO_AUTO_PTR @plogr@ +PKG_CPPFLAGS=@cflags@ -Ivendor -DRCPP_DEFAULT_INCLUDE_CALL=false -DRCPP_USING_UTF8_ERROR_STRING -DBOOST_NO_AUTO_PTR @plogr@ -Ivendor/cpp11 PKG_CFLAGS=$(C_VISIBILITY) PKG_CXXFLAGS=$(CXX_VISIBILITY) diff --git a/src/Makevars.win b/src/Makevars.win index f672d883..942d78e1 100644 --- a/src/Makevars.win +++ b/src/Makevars.win @@ -1,5 +1,5 @@ RWINLIB = ../windows/libpq -PKG_CPPFLAGS = -I$(RWINLIB)/include -Ivendor -DRCPP_DEFAULT_INCLUDE_CALL=false -DRCPP_USING_UTF8_ERROR_STRING -DBOOST_NO_AUTO_PTR +PKG_CPPFLAGS = -I$(RWINLIB)/include -Ivendor -DRCPP_DEFAULT_INCLUDE_CALL=false -DRCPP_USING_UTF8_ERROR_STRING -DBOOST_NO_AUTO_PTR -Ivendor/cpp11 PKG_LIBS = -L$(RWINLIB)/lib$(R_ARCH) -L$(RWINLIB)/lib \ -lpq -lpgport -lpgcommon -lssl -lcrypto -lwsock32 -lsecur32 -lws2_32 -lgdi32 -lcrypt32 -lwldap32 diff --git a/src/vendor/cpp11/cpp11.hpp b/src/vendor/cpp11/cpp11.hpp new file mode 100644 index 00000000..203cd742 --- /dev/null +++ b/src/vendor/cpp11/cpp11.hpp @@ -0,0 +1,26 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include "cpp11/R.hpp" +#include "cpp11/altrep.hpp" +#include "cpp11/as.hpp" +#include "cpp11/attribute_proxy.hpp" +#include "cpp11/data_frame.hpp" +#include "cpp11/doubles.hpp" +#include "cpp11/environment.hpp" +#include "cpp11/external_pointer.hpp" +#include "cpp11/function.hpp" +#include "cpp11/integers.hpp" +#include "cpp11/list.hpp" +#include "cpp11/list_of.hpp" +#include "cpp11/logicals.hpp" +#include "cpp11/matrix.hpp" +#include "cpp11/named_arg.hpp" +#include "cpp11/protect.hpp" +#include "cpp11/r_bool.hpp" +#include "cpp11/r_string.hpp" +#include "cpp11/r_vector.hpp" +#include "cpp11/raws.hpp" +#include "cpp11/sexp.hpp" +#include "cpp11/strings.hpp" diff --git a/src/vendor/cpp11/cpp11/R.hpp b/src/vendor/cpp11/cpp11/R.hpp new file mode 100644 index 00000000..7c1a3b48 --- /dev/null +++ b/src/vendor/cpp11/cpp11/R.hpp @@ -0,0 +1,63 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#ifdef R_INTERNALS_H_ +#if !(defined(R_NO_REMAP) && defined(STRICT_R_HEADERS)) +#error R headers were included before cpp11 headers \ + and at least one of R_NO_REMAP or STRICT_R_HEADERS \ + was not defined. +#endif +#endif + +#define R_NO_REMAP +#define STRICT_R_HEADERS +#include "Rinternals.h" + +// clang-format off +#ifdef __clang__ +# pragma clang diagnostic push +# pragma clang diagnostic ignored "-Wattributes" +#endif + +#ifdef __GNUC__ +# pragma GCC diagnostic push +# pragma GCC diagnostic ignored "-Wattributes" +#endif +// clang-format on + +#include +#include "cpp11/altrep.hpp" + +namespace cpp11 { +namespace literals { + +constexpr R_xlen_t operator"" _xl(unsigned long long int value) { return value; } + +} // namespace literals + +namespace traits { +template +struct get_underlying_type { + using type = T; +}; +} // namespace traits + +template +inline T na(); + +template +inline typename std::enable_if::type, double>::value, + bool>::type +is_na(const T& value) { + return value == na(); +} + +template +inline typename std::enable_if::type, double>::value, + bool>::type +is_na(const T& value) { + return ISNA(value); +} + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/altrep.hpp b/src/vendor/cpp11/cpp11/altrep.hpp new file mode 100644 index 00000000..c57f6385 --- /dev/null +++ b/src/vendor/cpp11/cpp11/altrep.hpp @@ -0,0 +1,44 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include "Rversion.h" + +#if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0) +#define HAS_ALTREP +#endif + +#ifndef HAS_ALTREP + +#define ALTREP(x) false + +#define REAL_ELT(x, i) REAL(x)[i] +#define INTEGER_ELT(x, i) INTEGER(x)[i] +#define LOGICAL_ELT(x, i) LOGICAL(x)[i] +#define RAW_ELT(x, i) RAW(x)[i] + +#define SET_REAL_ELT(x, i, val) REAL(x)[i] = val +#define SET_INTEGER_ELT(x, i, val) INTEGER(x)[i] = val +#define SET_LOGICAL_ELT(x, i, val) LOGICAL(x)[i] = val +#define SET_RAW_ELT(x, i, val) RAW(x)[i] = val + +#define REAL_GET_REGION(...) \ + do { \ + } while (false) + +#define INTEGER_GET_REGION(...) \ + do { \ + } while (false) +#endif + +#if !defined HAS_ALTREP || (defined(R_VERSION) && R_VERSION < R_Version(3, 6, 0)) + +#define LOGICAL_GET_REGION(...) \ + do { \ + } while (false) + +#define RAW_GET_REGION(...) \ + do { \ + } while (false) + +#endif diff --git a/src/vendor/cpp11/cpp11/as.hpp b/src/vendor/cpp11/cpp11/as.hpp new file mode 100644 index 00000000..aeb52fb6 --- /dev/null +++ b/src/vendor/cpp11/cpp11/as.hpp @@ -0,0 +1,338 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for modf +#include // for initializer_list +#include // for std::shared_ptr, std::weak_ptr, std::unique_ptr +#include +#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_convertible_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_convertible_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; + } + } + } + + throw std::length_error("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)); + } + + throw std::length_error("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; + } + } + + throw std::length_error("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; + } + } + } + + throw std::length_error("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]; }); + } + } + + throw std::length_error("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)); })}; + } + } + + throw std::length_error("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 diff --git a/src/vendor/cpp11/cpp11/attribute_proxy.hpp b/src/vendor/cpp11/cpp11/attribute_proxy.hpp new file mode 100644 index 00000000..c64a9477 --- /dev/null +++ b/src/vendor/cpp11/cpp11/attribute_proxy.hpp @@ -0,0 +1,50 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for initializer_list +#include // for string, basic_string + +#include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_install, PROTECT, Rf_... +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/protect.hpp" // for protect, safe, protect::function + +namespace cpp11 { + +class sexp; + +template +class attribute_proxy { + private: + const T& parent_; + SEXP symbol_; + + public: + attribute_proxy(const T& parent, const char* index) + : parent_(parent), symbol_(safe[Rf_install](index)) {} + + attribute_proxy(const T& parent, const std::string& index) + : parent_(parent), symbol_(safe[Rf_install](index.c_str())) {} + + attribute_proxy(const T& parent, SEXP index) : parent_(parent), symbol_(index) {} + + template + attribute_proxy& operator=(C rhs) { + SEXP value = PROTECT(as_sexp(rhs)); + Rf_setAttrib(parent_.data(), symbol_, value); + UNPROTECT(1); + return *this; + } + + template + attribute_proxy& operator=(std::initializer_list rhs) { + SEXP value = PROTECT(as_sexp(rhs)); + Rf_setAttrib(parent_.data(), symbol_, value); + UNPROTECT(1); + return *this; + } + + operator SEXP() const { return safe[Rf_getAttrib](parent_.data(), symbol_); } +}; + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/data_frame.hpp b/src/vendor/cpp11/cpp11/data_frame.hpp new file mode 100644 index 00000000..08103f03 --- /dev/null +++ b/src/vendor/cpp11/cpp11/data_frame.hpp @@ -0,0 +1,102 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for abs +#include +#include // for initializer_list +#include // for string, basic_string +#include // for move + +#include "R_ext/Arith.h" // for NA_INTEGER +#include "cpp11/R.hpp" // for Rf_xlength, SEXP, SEXPREC, INTEGER +#include "cpp11/attribute_proxy.hpp" // for attribute_proxy +#include "cpp11/list.hpp" // for list, r_vector<>::r_vector, r_v... +#include "cpp11/r_vector.hpp" // for r_vector + +namespace cpp11 { + +class named_arg; +namespace writable { +class data_frame; +} // namespace writable + +class data_frame : public list { + using list::list; + + friend class writable::data_frame; + + /* we cannot use Rf_getAttrib because it has a special case for c(NA, -n) and creates + * the full vector */ + static SEXP get_attrib0(SEXP x, SEXP sym) { + for (SEXP attr = ATTRIB(x); attr != R_NilValue; attr = CDR(attr)) { + if (TAG(attr) == sym) { + return CAR(attr); + } + } + + return R_NilValue; + } + + static int calc_nrow(SEXP x) { + auto nms = get_attrib0(x, R_RowNamesSymbol); + bool has_short_rownames = + (Rf_isInteger(nms) && Rf_xlength(nms) == 2 && INTEGER(nms)[0] == NA_INTEGER); + if (has_short_rownames) { + return abs(INTEGER(nms)[1]); + } + + if (!Rf_isNull(nms)) { + return Rf_xlength(nms); + } + + if (Rf_xlength(x) == 0) { + return 0; + } + + return Rf_xlength(VECTOR_ELT(x, 0)); + } + + public: + /* Adapted from + * https://github.com/wch/r-source/blob/f2a0dfab3e26fb42b8b296fcba40cbdbdbec767d/src/main/attrib.c#L198-L207 + */ + R_xlen_t nrow() const { return calc_nrow(*this); } + R_xlen_t ncol() const { return size(); } +}; + +namespace writable { +class data_frame : public cpp11::data_frame { + private: + writable::list set_data_frame_attributes(writable::list&& x) { + x.attr(R_RowNamesSymbol) = {NA_INTEGER, -static_cast(calc_nrow(x))}; + x.attr(R_ClassSymbol) = "data.frame"; + return std::move(x); + } + + public: + data_frame(const SEXP data) : cpp11::data_frame(set_data_frame_attributes(data)) {} + data_frame(const SEXP data, bool is_altrep) + : cpp11::data_frame(set_data_frame_attributes(data), is_altrep) {} + data_frame(std::initializer_list il) + : cpp11::data_frame(set_data_frame_attributes(writable::list(il))) {} + data_frame(std::initializer_list il) + : cpp11::data_frame(set_data_frame_attributes(writable::list(il))) {} + + using cpp11::data_frame::ncol; + using cpp11::data_frame::nrow; + + attribute_proxy attr(const char* name) const { return {*this, name}; } + + attribute_proxy attr(const std::string& name) const { + return {*this, name.c_str()}; + } + + attribute_proxy attr(SEXP name) const { return {*this, name}; } + + attribute_proxy names() const { return {*this, R_NamesSymbol}; } +}; + +} // namespace writable + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/declarations.hpp b/src/vendor/cpp11/cpp11/declarations.hpp new file mode 100644 index 00000000..202f31fb --- /dev/null +++ b/src/vendor/cpp11/cpp11/declarations.hpp @@ -0,0 +1,65 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include +#include +#include + +// Davis: From what I can tell, you'd only ever define this if you need to include +// `declarations.hpp` manually in a file, i.e. to possibly use `BEGIN_CPP11` with a +// custom `END_CPP11`, as textshaping does do. Otherwise, `declarations.hpp` is included +// in `code.cpp` and should contain all of the cpp11 type definitions that the generated +// function signatures need to link against. +#ifndef CPP11_PARTIAL +#include "cpp11.hpp" +namespace writable = ::cpp11::writable; +using namespace ::cpp11; +#endif + +#include + +namespace cpp11 { +// No longer used, but was previously used in `code.cpp` code generation in cpp11 0.1.0. +// `code.cpp` could be generated with cpp11 0.1.0, but the package could be compiled with +// cpp11 >0.1.0, so `unmove()` must exist in newer cpp11 too. Eventually remove this once +// we decide enough time has gone by since `unmove()` was removed. +// https://github.com/r-lib/cpp11/issues/88 +// https://github.com/r-lib/cpp11/pull/75 +template +T& unmove(T&& t) { + return t; +} +} // namespace cpp11 + +#ifdef HAS_UNWIND_PROTECT +#define CPP11_UNWIND R_ContinueUnwind(err); +#else +#define CPP11_UNWIND \ + do { \ + } while (false); +#endif + +#define CPP11_ERROR_BUFSIZE 8192 + +#define BEGIN_CPP11 \ + SEXP err = R_NilValue; \ + char buf[CPP11_ERROR_BUFSIZE] = ""; \ + try { +#define END_CPP11 \ + } \ + catch (cpp11::unwind_exception & e) { \ + err = e.token; \ + } \ + catch (std::exception & e) { \ + strncpy(buf, e.what(), sizeof(buf) - 1); \ + } \ + catch (...) { \ + strncpy(buf, "C++ error (unknown cause)", sizeof(buf) - 1); \ + } \ + if (buf[0] != '\0') { \ + Rf_errorcall(R_NilValue, "%s", buf); \ + } else if (err != R_NilValue) { \ + CPP11_UNWIND \ + } \ + return R_NilValue; diff --git a/src/vendor/cpp11/cpp11/doubles.hpp b/src/vendor/cpp11/cpp11/doubles.hpp new file mode 100644 index 00000000..13392ead --- /dev/null +++ b/src/vendor/cpp11/cpp11/doubles.hpp @@ -0,0 +1,165 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for min, tranform +#include // for array +#include // for initializer_list + +#include "R_ext/Arith.h" // for ISNA +#include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_allocVector, REAL +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/named_arg.hpp" // for named_arg +#include "cpp11/protect.hpp" // for SEXP, SEXPREC, REAL_ELT, R_Preserve... +#include "cpp11/r_vector.hpp" // for vector, vector<>::proxy, vector<>::... +#include "cpp11/sexp.hpp" // for sexp + +// Specializations for doubles + +namespace cpp11 { + +template <> +inline SEXP r_vector::valid_type(SEXP data) { + if (data == nullptr) { + throw type_error(REALSXP, NILSXP); + } + if (TYPEOF(data) != REALSXP) { + throw type_error(REALSXP, TYPEOF(data)); + } + return data; +} + +template <> +inline double r_vector::operator[](const R_xlen_t pos) const { + // NOPROTECT: likely too costly to unwind protect every elt + return is_altrep_ ? REAL_ELT(data_, pos) : data_p_[pos]; +} + +template <> +inline typename r_vector::underlying_type* r_vector::get_p(bool is_altrep, + SEXP data) { + if (is_altrep) { + return nullptr; + } else { + return REAL(data); + } +} + +template <> +inline void r_vector::const_iterator::fill_buf(R_xlen_t pos) { + length_ = std::min(64_xl, data_->size() - pos); + REAL_GET_REGION(data_->data_, pos, length_, buf_.data()); + block_start_ = pos; +} + +typedef r_vector doubles; + +namespace writable { + +template <> +inline typename r_vector::proxy& r_vector::proxy::operator=( + const double& rhs) { + if (is_altrep_) { + // NOPROTECT: likely too costly to unwind protect every set elt + SET_REAL_ELT(data_, index_, rhs); + } else { + *p_ = rhs; + } + return *this; +} + +template <> +inline r_vector::proxy::operator double() const { + if (p_ == nullptr) { + // NOPROTECT: likely too costly to unwind protect every elt + return REAL_ELT(data_, index_); + } else { + return *p_; + } +} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(as_sexp(il)), capacity_(il.size()) {} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(safe[Rf_allocVector](REALSXP, il.size())), + capacity_(il.size()) { + protect_ = preserved.insert(data_); + int n_protected = 0; + + try { + unwind_protect([&] { + Rf_setAttrib(data_, R_NamesSymbol, Rf_allocVector(STRSXP, capacity_)); + SEXP names = PROTECT(Rf_getAttrib(data_, R_NamesSymbol)); + ++n_protected; + auto it = il.begin(); + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + data_p_[i] = REAL_ELT(it->value(), 0); + SET_STRING_ELT(names, i, Rf_mkCharCE(it->name(), CE_UTF8)); + } + UNPROTECT(n_protected); + }); + } catch (const unwind_exception& e) { + preserved.release(protect_); + UNPROTECT(n_protected); + throw e; + } +} + +template <> +inline void r_vector::reserve(R_xlen_t new_capacity) { + data_ = data_ == R_NilValue ? safe[Rf_allocVector](REALSXP, new_capacity) + : safe[Rf_xlengthgets](data_, new_capacity); + SEXP old_protect = protect_; + protect_ = preserved.insert(data_); + preserved.release(old_protect); + + data_p_ = REAL(data_); + capacity_ = new_capacity; +} + +template <> +inline void r_vector::push_back(double value) { + while (length_ >= capacity_) { + reserve(capacity_ == 0 ? 1 : capacity_ *= 2); + } + if (is_altrep_) { + SET_REAL_ELT(data_, length_, value); + } else { + data_p_[length_] = value; + } + ++length_; +} + +typedef r_vector doubles; + +} // namespace writable + +typedef r_vector integers; + +inline doubles as_doubles(SEXP x) { + if (TYPEOF(x) == REALSXP) { + return doubles(x); + } + + else if (TYPEOF(x) == INTSXP) { + integers xn(x); + size_t len = xn.size(); + writable::doubles ret(len); + std::transform(xn.begin(), xn.end(), ret.begin(), [](int value) { + return value == NA_INTEGER ? NA_REAL : static_cast(value); + }); + return ret; + } + + throw type_error(REALSXP, TYPEOF(x)); +} + +template <> +inline double na() { + return NA_REAL; +} + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/environment.hpp b/src/vendor/cpp11/cpp11/environment.hpp new file mode 100644 index 00000000..0f176c0f --- /dev/null +++ b/src/vendor/cpp11/cpp11/environment.hpp @@ -0,0 +1,76 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for string, basic_string + +#include "Rversion.h" // for R_VERSION, R_Version +#include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_install, Rf_findVarIn... +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/protect.hpp" // for protect, protect::function, safe, unwin... +#include "cpp11/sexp.hpp" // for sexp + +#if R_VERSION >= R_Version(4, 0, 0) +#define HAS_REMOVE_VAR_FROM_FRAME +#endif + +#ifndef HAS_REMOVE_VAR_FROM_FRAME +#include "cpp11/function.hpp" +#endif + +namespace cpp11 { + +class environment { + private: + sexp env_; + + class proxy { + SEXP parent_; + SEXP name_; + + public: + proxy(SEXP parent, SEXP name) : parent_(parent), name_(name) {} + + template + proxy& operator=(T value) { + safe[Rf_defineVar](name_, as_sexp(value), parent_); + return *this; + } + operator SEXP() const { return safe[Rf_findVarInFrame3](parent_, name_, TRUE); }; + operator sexp() const { return SEXP(); }; + }; + + public: + environment(SEXP env) : env_(env) {} + environment(sexp env) : env_(env) {} + proxy operator[](const SEXP name) const { return {env_, name}; } + proxy operator[](const char* name) const { return operator[](safe[Rf_install](name)); } + proxy operator[](const std::string& name) const { return operator[](name.c_str()); } + + bool exists(SEXP name) const { + SEXP res = safe[Rf_findVarInFrame3](env_, name, FALSE); + return res != R_UnboundValue; + } + bool exists(const char* name) const { return exists(safe[Rf_install](name)); } + + bool exists(const std::string& name) const { return exists(name.c_str()); } + + void remove(SEXP name) { + PROTECT(name); +#ifdef HAS_REMOVE_VAR_FROM_FRAME + R_removeVarFromFrame(name, env_); +#else + auto remove = package("base")["remove"]; + remove(name, "envir"_nm = env_); +#endif + UNPROTECT(1); + } + + void remove(const char* name) { remove(safe[Rf_install](name)); } + + R_xlen_t size() const { return Rf_xlength(env_); } + + operator SEXP() const { return env_; } +}; + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/external_pointer.hpp b/src/vendor/cpp11/cpp11/external_pointer.hpp new file mode 100644 index 00000000..37b1494f --- /dev/null +++ b/src/vendor/cpp11/cpp11/external_pointer.hpp @@ -0,0 +1,169 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for nullptr_t, NULL +#include // for bad_weak_ptr +#include // for add_lvalue_reference + +#include "cpp11/R.hpp" // for SEXP, SEXPREC, TYPEOF, R_NilValue, R_C... +#include "cpp11/protect.hpp" // for protect, safe, protect::function +#include "cpp11/r_bool.hpp" // for r_bool +#include "cpp11/r_vector.hpp" // for type_error +#include "cpp11/sexp.hpp" // for sexp + +namespace cpp11 { + +template +void default_deleter(T* obj) { + delete obj; +} + +template > +class external_pointer { + private: + sexp data_ = R_NilValue; + + static SEXP valid_type(SEXP data) { + if (data == nullptr) { + throw type_error(EXTPTRSXP, NILSXP); + } + if (TYPEOF(data) != EXTPTRSXP) { + throw type_error(EXTPTRSXP, TYPEOF(data)); + } + + return data; + } + + static void r_deleter(SEXP p) { + if (TYPEOF(p) != EXTPTRSXP) return; + + T* ptr = static_cast(R_ExternalPtrAddr(p)); + + if (ptr == NULL) { + return; + } + + R_ClearExternalPtr(p); + + Deleter(ptr); + } + + public: + using pointer = T*; + + external_pointer() noexcept {} + external_pointer(std::nullptr_t) noexcept {} + + external_pointer(SEXP data) : data_(valid_type(data)) {} + + external_pointer(pointer p, bool use_deleter = true, bool finalize_on_exit = true) + : data_(safe[R_MakeExternalPtr]((void*)p, R_NilValue, R_NilValue)) { + if (use_deleter) { + R_RegisterCFinalizerEx(data_, r_deleter, static_cast(finalize_on_exit)); + } + } + + external_pointer(const external_pointer& rhs) { + data_ = safe[Rf_shallow_duplicate](rhs.data_); + } + + external_pointer(external_pointer&& rhs) { reset(rhs.release()); } + + external_pointer& operator=(external_pointer&& rhs) noexcept { reset(rhs.release()); } + + external_pointer& operator=(std::nullptr_t) noexcept { reset(); }; + + operator SEXP() const noexcept { return data_; } + + pointer get() const noexcept { + pointer addr = static_cast(R_ExternalPtrAddr(data_)); + if (addr == nullptr) { + return nullptr; + } + return addr; + } + + typename std::add_lvalue_reference::type operator*() { + pointer addr = get(); + if (addr == nullptr) { + throw std::bad_weak_ptr(); + } + return *get(); + } + + pointer operator->() const { + pointer addr = get(); + if (addr == nullptr) { + throw std::bad_weak_ptr(); + } + return get(); + } + + pointer release() noexcept { + if (get() == nullptr) { + return nullptr; + } + pointer ptr = get(); + R_ClearExternalPtr(data_); + + return ptr; + } + + void reset(pointer ptr = pointer()) { + SEXP old_data = data_; + data_ = safe[R_MakeExternalPtr]((void*)ptr, R_NilValue, R_NilValue); + r_deleter(old_data); + } + + void swap(external_pointer& other) noexcept { + SEXP tmp = other.data_; + other.data_ = data_; + data_ = tmp; + } + + operator bool() noexcept { return data_ != nullptr; } +}; + +template +void swap(external_pointer& lhs, external_pointer& rhs) noexcept { + lhs.swap(rhs); +} + +template +bool operator==(const external_pointer& x, + const external_pointer& y) { + return x.data_ == y.data_; +} + +template +bool operator!=(const external_pointer& x, + const external_pointer& y) { + return x.data_ != y.data_; +} + +template +bool operator<(const external_pointer& x, + const external_pointer& y) { + return x.data_ < y.data_; +} + +template +bool operator<=(const external_pointer& x, + const external_pointer& y) { + return x.data_ <= y.data_; +} + +template +bool operator>(const external_pointer& x, + const external_pointer& y) { + return x.data_ > y.data_; +} + +template +bool operator>=(const external_pointer& x, + const external_pointer& y) { + return x.data_ >= y.data_; +} + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/function.hpp b/src/vendor/cpp11/cpp11/function.hpp new file mode 100644 index 00000000..d1ce6734 --- /dev/null +++ b/src/vendor/cpp11/cpp11/function.hpp @@ -0,0 +1,118 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for strcmp + +#include // for snprintf +#include // for string, basic_string +#include // for forward + +#include "cpp11/R.hpp" // for SEXP, SEXPREC, CDR, Rf_install, SETCAR +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/named_arg.hpp" // for named_arg +#include "cpp11/protect.hpp" // for protect, protect::function, safe +#include "cpp11/sexp.hpp" // for sexp + +namespace cpp11 { + +class function { + public: + function(SEXP data) : data_(data) {} + + template + sexp operator()(Args&&... args) const { + // Size of the arguments plus one for the function name itself + R_xlen_t num_args = sizeof...(args) + 1; + + sexp call(safe[Rf_allocVector](LANGSXP, num_args)); + + construct_call(call, data_, std::forward(args)...); + + return safe[Rf_eval](call, R_GlobalEnv); + } + + private: + SEXP data_; + + template + SEXP construct_call(SEXP val, const named_arg& arg, Args&&... args) const { + SETCAR(val, arg.value()); + SET_TAG(val, safe[Rf_install](arg.name())); + val = CDR(val); + return construct_call(val, std::forward(args)...); + } + + // Construct the call recursively, each iteration adds an Arg to the pairlist. + // We need + template + SEXP construct_call(SEXP val, const T& arg, Args&&... args) const { + SETCAR(val, as_sexp(arg)); + val = CDR(val); + return construct_call(val, std::forward(args)...); + } + + // Base case, just return + SEXP construct_call(SEXP val) const { return val; } +}; + +class package { + public: + package(const char* name) : data_(get_namespace(name)) {} + package(const std::string& name) : data_(get_namespace(name.c_str())) {} + function operator[](const char* name) { + return safe[Rf_findFun](safe[Rf_install](name), data_); + } + function operator[](const std::string& name) { return operator[](name.c_str()); } + + private: + static SEXP get_namespace(const char* name) { + if (strcmp(name, "base") == 0) { + return R_BaseEnv; + } + sexp name_sexp = safe[Rf_install](name); + return safe[Rf_findVarInFrame](R_NamespaceRegistry, name_sexp); + } + + SEXP data_; +}; + +inline void message(const char* fmt_arg) { + static auto R_message = cpp11::package("base")["message"]; +#ifdef CPP11_USE_FMT + std::string msg = fmt::format(fmt_arg); + R_message(msg.c_str()); +#else + char buff[1024]; + int msg; + msg = std::snprintf(buff, 1024, "%s", fmt_arg); + if (msg >= 0 && msg < 1024) { + R_message(buff); + } +#endif +} + +template +void message(const char* fmt_arg, Args... args) { + static auto R_message = cpp11::package("base")["message"]; +#ifdef CPP11_USE_FMT + std::string msg = fmt::format(fmt_arg, args...); + R_message(msg.c_str()); +#else + char buff[1024]; + int msg; + msg = std::snprintf(buff, 1024, fmt_arg, args...); + if (msg >= 0 && msg < 1024) { + R_message(buff); + } +#endif +} + +inline void message(const std::string& fmt_arg) { message(fmt_arg.c_str()); } + +template +void message(const std::string& fmt_arg, Args... args) { + message(fmt_arg.c_str(), args...); +} + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/integers.hpp b/src/vendor/cpp11/cpp11/integers.hpp new file mode 100644 index 00000000..46a9ccfc --- /dev/null +++ b/src/vendor/cpp11/cpp11/integers.hpp @@ -0,0 +1,175 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for min +#include // for array +#include // for initializer_list + +#include "R_ext/Arith.h" // for NA_INTEGER +#include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_allocVector +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/attribute_proxy.hpp" // for attribute_proxy +#include "cpp11/named_arg.hpp" // for named_arg +#include "cpp11/protect.hpp" // for preserved +#include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy +#include "cpp11/sexp.hpp" // for sexp + +// Specializations for integers + +namespace cpp11 { + +template <> +inline SEXP r_vector::valid_type(SEXP data) { + if (data == nullptr) { + throw type_error(INTSXP, NILSXP); + } + if (TYPEOF(data) != INTSXP) { + throw type_error(INTSXP, TYPEOF(data)); + } + return data; +} + +template <> +inline int r_vector::operator[](const R_xlen_t pos) const { + // NOPROTECT: likely too costly to unwind protect every elt + return is_altrep_ ? INTEGER_ELT(data_, pos) : data_p_[pos]; +} + +template <> +inline typename r_vector::underlying_type* r_vector::get_p(bool is_altrep, + SEXP data) { + if (is_altrep) { + return nullptr; + } else { + return INTEGER(data); + } +} + +template <> +inline void r_vector::const_iterator::fill_buf(R_xlen_t pos) { + length_ = std::min(64_xl, data_->size() - pos); + INTEGER_GET_REGION(data_->data_, pos, length_, buf_.data()); + block_start_ = pos; +} + +typedef r_vector integers; + +namespace writable { + +template <> +inline typename r_vector::proxy& r_vector::proxy::operator=(const int& rhs) { + if (is_altrep_) { + // NOPROTECT: likely too costly to unwind protect every set elt + SET_INTEGER_ELT(data_, index_, rhs); + } else { + *p_ = rhs; + } + return *this; +} + +template <> +inline r_vector::proxy::operator int() const { + if (p_ == nullptr) { + // NOPROTECT: likely too costly to unwind protect every elt + return INTEGER_ELT(data_, index_); + } else { + return *p_; + } +} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(as_sexp(il)), capacity_(il.size()) {} + +template <> +inline void r_vector::reserve(R_xlen_t new_capacity) { + data_ = data_ == R_NilValue ? safe[Rf_allocVector](INTSXP, new_capacity) + : safe[Rf_xlengthgets](data_, new_capacity); + SEXP old_protect = protect_; + + // Protect the new data + protect_ = preserved.insert(data_); + + // Release the old protection; + preserved.release(old_protect); + + data_p_ = INTEGER(data_); + capacity_ = new_capacity; +} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(safe[Rf_allocVector](INTSXP, il.size())), + capacity_(il.size()) { + protect_ = preserved.insert(data_); + int n_protected = 0; + + try { + unwind_protect([&] { + Rf_setAttrib(data_, R_NamesSymbol, Rf_allocVector(STRSXP, capacity_)); + SEXP names = PROTECT(Rf_getAttrib(data_, R_NamesSymbol)); + ++n_protected; + auto it = il.begin(); + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + data_p_[i] = INTEGER_ELT(it->value(), 0); + SET_STRING_ELT(names, i, Rf_mkCharCE(it->name(), CE_UTF8)); + } + UNPROTECT(n_protected); + }); + } catch (const unwind_exception& e) { + preserved.release(protect_); + UNPROTECT(n_protected); + throw e; + } +} + +template <> +inline void r_vector::push_back(int value) { + while (length_ >= capacity_) { + reserve(capacity_ == 0 ? 1 : capacity_ *= 2); + } + if (is_altrep_) { + // NOPROTECT: likely too costly to unwind protect every elt + SET_INTEGER_ELT(data_, length_, value); + } else { + data_p_[length_] = value; + } + ++length_; +} + +typedef r_vector integers; + +} // namespace writable + +template <> +inline int na() { + return NA_INTEGER; +} + +// forward declaration + +typedef r_vector doubles; + +inline integers as_integers(SEXP x) { + if (TYPEOF(x) == INTSXP) { + return integers(x); + } else if (TYPEOF(x) == REALSXP) { + doubles xn(x); + writable::integers ret(xn.size()); + std::transform(xn.begin(), xn.end(), ret.begin(), [](double value) { + if (ISNA(value)) { + return NA_INTEGER; + } + if (!is_convertible_without_loss_to_integer(value)) { + throw std::runtime_error("All elements must be integer-like"); + } + return static_cast(value); + }); + return ret; + } + + throw type_error(INTSXP, TYPEOF(x)); +} + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/list.hpp b/src/vendor/cpp11/cpp11/list.hpp new file mode 100644 index 00000000..b6a0e0b5 --- /dev/null +++ b/src/vendor/cpp11/cpp11/list.hpp @@ -0,0 +1,141 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for initializer_list + +#include "cpp11/R.hpp" // for SEXP, SEXPREC, SET_VECTOR_ELT +#include "cpp11/attribute_proxy.hpp" // for attribute_proxy +#include "cpp11/named_arg.hpp" // for named_arg +#include "cpp11/protect.hpp" // for preserved +#include "cpp11/r_string.hpp" // for r_string +#include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy +#include "cpp11/sexp.hpp" // for sexp + +// Specializations for list + +namespace cpp11 { + +template <> +inline SEXP r_vector::valid_type(SEXP data) { + if (data == nullptr) { + throw type_error(VECSXP, NILSXP); + } + if (TYPEOF(data) != VECSXP) { + throw type_error(VECSXP, TYPEOF(data)); + } + return data; +} + +template <> +inline SEXP r_vector::operator[](const R_xlen_t pos) const { + return VECTOR_ELT(data_, pos); +} + +template <> +inline SEXP r_vector::operator[](const r_string& name) const { + SEXP names = this->names(); + R_xlen_t size = Rf_xlength(names); + + for (R_xlen_t pos = 0; pos < size; ++pos) { + auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos)); + if (name == cur) { + return operator[](pos); + } + } + return R_NilValue; +} + +template <> +inline typename r_vector::underlying_type* r_vector::get_p(bool, SEXP) { + return nullptr; +} + +template <> +inline void r_vector::const_iterator::fill_buf(R_xlen_t) { + return; +} + +template <> +inline SEXP r_vector::const_iterator::operator*() const { + return VECTOR_ELT(data_->data(), pos_); +} + +typedef r_vector list; + +namespace writable { + +template <> +inline typename r_vector::proxy& r_vector::proxy::operator=(const SEXP& rhs) { + SET_VECTOR_ELT(data_, index_, rhs); + return *this; +} + +template <> +inline r_vector::proxy::operator SEXP() const { + return VECTOR_ELT(data_, index_); +} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(safe[Rf_allocVector](VECSXP, il.size())), + capacity_(il.size()) { + protect_ = preserved.insert(data_); + auto it = il.begin(); + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + SET_VECTOR_ELT(data_, i, *it); + } +} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(safe[Rf_allocVector](VECSXP, il.size())), + capacity_(il.size()) { + protect_ = preserved.insert(data_); + int n_protected = 0; + + try { + unwind_protect([&] { + Rf_setAttrib(data_, R_NamesSymbol, Rf_allocVector(STRSXP, capacity_)); + SEXP names = PROTECT(Rf_getAttrib(data_, R_NamesSymbol)); + ++n_protected; + auto it = il.begin(); + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + SET_VECTOR_ELT(data_, i, it->value()); + SET_STRING_ELT(names, i, Rf_mkCharCE(it->name(), CE_UTF8)); + } + UNPROTECT(n_protected); + }); + } catch (const unwind_exception& e) { + preserved.release(protect_); + UNPROTECT(n_protected); + throw e; + } +} + +template <> +inline void r_vector::reserve(R_xlen_t new_capacity) { + data_ = data_ == R_NilValue ? safe[Rf_allocVector](VECSXP, new_capacity) + : safe[Rf_xlengthgets](data_, new_capacity); + + SEXP old_protect = protect_; + protect_ = preserved.insert(data_); + preserved.release(old_protect); + + capacity_ = new_capacity; +} + +template <> +inline void r_vector::push_back(SEXP value) { + while (length_ >= capacity_) { + reserve(capacity_ == 0 ? 1 : capacity_ *= 2); + } + SET_VECTOR_ELT(data_, length_, value); + ++length_; +} + +typedef r_vector list; + +} // namespace writable + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/list_of.hpp b/src/vendor/cpp11/cpp11/list_of.hpp new file mode 100644 index 00000000..6a87c794 --- /dev/null +++ b/src/vendor/cpp11/cpp11/list_of.hpp @@ -0,0 +1,73 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for string, basic_string + +#include "cpp11/R.hpp" // for R_xlen_t, SEXP, SEXPREC, LONG_VECTOR_SUPPORT +#include "cpp11/list.hpp" // for list + +namespace cpp11 { + +template +class list_of : public list { + public: + list_of(const list& data) : list(data) {} + +#ifdef LONG_VECTOR_SUPPORT + T operator[](int pos) const { return operator[](static_cast(pos)); } +#endif + + T operator[](R_xlen_t pos) const { return list::operator[](pos); } + + T operator[](const char* pos) const { return list::operator[](pos); } + + T operator[](const std::string& pos) const { return list::operator[](pos.c_str()); } +}; + +namespace writable { +template +class list_of : public writable::list { + public: + list_of(const list& data) : writable::list(data) {} + list_of(R_xlen_t n) : writable::list(n) {} + + class proxy { + private: + writable::list::proxy data_; + + public: + proxy(const writable::list::proxy& data) : data_(data) {} + + operator T() const { return static_cast(*this); } + operator SEXP() const { return static_cast(data_); } +#ifdef LONG_VECTOR_SUPPORT + typename T::proxy operator[](int pos) { return static_cast(data_)[pos]; } +#endif + typename T::proxy operator[](R_xlen_t pos) { return static_cast(data_)[pos]; } + proxy operator[](const char* pos) { static_cast(data_)[pos]; } + proxy operator[](const std::string& pos) { return static_cast(data_)[pos]; } + proxy& operator=(const T& rhs) { + data_ = rhs; + + return *this; + } + }; + +#ifdef LONG_VECTOR_SUPPORT + proxy operator[](int pos) { + return {writable::list::operator[](static_cast(pos))}; + } +#endif + + proxy operator[](R_xlen_t pos) { return writable::list::operator[](pos); } + + proxy operator[](const char* pos) { return {writable::list::operator[](pos)}; } + + proxy operator[](const std::string& pos) { + return writable::list::operator[](pos.c_str()); + } +}; +} // namespace writable + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/logicals.hpp b/src/vendor/cpp11/cpp11/logicals.hpp new file mode 100644 index 00000000..2eba7bb6 --- /dev/null +++ b/src/vendor/cpp11/cpp11/logicals.hpp @@ -0,0 +1,148 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for min +#include // for array +#include // for initializer_list + +#include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_all... +#include "cpp11/attribute_proxy.hpp" // for attribute_proxy +#include "cpp11/named_arg.hpp" // for named_arg +#include "cpp11/protect.hpp" // for preserved +#include "cpp11/r_bool.hpp" // for r_bool +#include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy +#include "cpp11/sexp.hpp" // for sexp + +// Specializations for logicals + +namespace cpp11 { + +template <> +inline SEXP r_vector::valid_type(SEXP data) { + if (data == nullptr) { + throw type_error(LGLSXP, NILSXP); + } + if (TYPEOF(data) != LGLSXP) { + throw type_error(LGLSXP, TYPEOF(data)); + } + return data; +} + +template <> +inline r_bool r_vector::operator[](const R_xlen_t pos) const { + return is_altrep_ ? LOGICAL_ELT(data_, pos) : data_p_[pos]; +} + +template <> +inline typename r_vector::underlying_type* r_vector::get_p(bool is_altrep, + SEXP data) { + if (is_altrep) { + return nullptr; + } else { + return LOGICAL(data); + } +} + +template <> +inline void r_vector::const_iterator::fill_buf(R_xlen_t pos) { + length_ = std::min(64_xl, data_->size() - pos); + LOGICAL_GET_REGION(data_->data_, pos, length_, buf_.data()); + block_start_ = pos; +} + +typedef r_vector logicals; + +namespace writable { + +template <> +inline typename r_vector::proxy& r_vector::proxy::operator=( + const r_bool& rhs) { + if (is_altrep_) { + SET_LOGICAL_ELT(data_, index_, rhs); + } else { + *p_ = rhs; + } + return *this; +} + +template <> +inline r_vector::proxy::operator r_bool() const { + if (p_ == nullptr) { + return LOGICAL_ELT(data_, index_); + } else { + return *p_; + } +} + +inline bool operator==(const r_vector::proxy& lhs, r_bool rhs) { + return static_cast(lhs).operator==(rhs); +} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(Rf_allocVector(LGLSXP, il.size())), capacity_(il.size()) { + protect_ = preserved.insert(data_); + auto it = il.begin(); + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + SET_LOGICAL_ELT(data_, i, *it); + } +} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(safe[Rf_allocVector](LGLSXP, il.size())), + capacity_(il.size()) { + protect_ = preserved.insert(data_); + int n_protected = 0; + + try { + unwind_protect([&] { + Rf_setAttrib(data_, R_NamesSymbol, Rf_allocVector(STRSXP, capacity_)); + SEXP names = PROTECT(Rf_getAttrib(data_, R_NamesSymbol)); + ++n_protected; + auto it = il.begin(); + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + data_p_[i] = LOGICAL_ELT(it->value(), 0); + SET_STRING_ELT(names, i, Rf_mkCharCE(it->name(), CE_UTF8)); + } + UNPROTECT(n_protected); + }); + } catch (const unwind_exception& e) { + preserved.release(protect_); + UNPROTECT(n_protected); + throw e; + } +} + +template <> +inline void r_vector::reserve(R_xlen_t new_capacity) { + data_ = data_ == R_NilValue ? safe[Rf_allocVector](LGLSXP, new_capacity) + : safe[Rf_xlengthgets](data_, new_capacity); + SEXP old_protect = protect_; + protect_ = preserved.insert(data_); + + preserved.release(old_protect); + + data_p_ = LOGICAL(data_); + capacity_ = new_capacity; +} + +template <> +inline void r_vector::push_back(r_bool value) { + while (length_ >= capacity_) { + reserve(capacity_ == 0 ? 1 : capacity_ *= 2); + } + if (is_altrep_) { + SET_LOGICAL_ELT(data_, length_, value); + } else { + data_p_[length_] = value; + } + ++length_; +} + +typedef r_vector logicals; + +} // namespace writable + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/matrix.hpp b/src/vendor/cpp11/cpp11/matrix.hpp new file mode 100644 index 00000000..bcc2f1c4 --- /dev/null +++ b/src/vendor/cpp11/cpp11/matrix.hpp @@ -0,0 +1,229 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include +#include // for string + +#include "cpp11/R.hpp" // for SEXP, SEXPREC, R_xlen_t, INT... +#include "cpp11/r_bool.hpp" // for r_bool +#include "cpp11/r_string.hpp" // for r_string +#include "cpp11/r_vector.hpp" // for r_vector +#include "cpp11/sexp.hpp" // for sexp + +namespace cpp11 { + +// matrix dimensions +struct matrix_dims { + protected: + const int nrow_; + const int ncol_; + + public: + matrix_dims(SEXP data) : nrow_(Rf_nrows(data)), ncol_(Rf_ncols(data)) {} + matrix_dims(int nrow, int ncol) : nrow_(nrow), ncol_(ncol) {} + + int nrow() const { return nrow_; } + int ncol() const { return ncol_; } +}; + +// base type for dimension-wise matrix access specialization +struct matrix_slice {}; + +struct by_row : public matrix_slice {}; +struct by_column : public matrix_slice {}; + +// basic properties of matrix slices +template +struct matrix_slices : public matrix_dims { + public: + using matrix_dims::matrix_dims; + using matrix_dims::ncol; + using matrix_dims::nrow; + + int nslices() const; + int slice_size() const; + int slice_stride() const; + int slice_offset(int pos) const; +}; + +// basic properties of matrix row slices +template <> +struct matrix_slices : public matrix_dims { + public: + using matrix_dims::matrix_dims; + using matrix_dims::ncol; + using matrix_dims::nrow; + + int nslices() const { return nrow(); } + int slice_size() const { return ncol(); } + int slice_stride() const { return nrow(); } + int slice_offset(int pos) const { return pos; } +}; + +// basic properties of matrix column slices +template <> +struct matrix_slices : public matrix_dims { + public: + using matrix_dims::matrix_dims; + using matrix_dims::ncol; + using matrix_dims::nrow; + + int nslices() const { return ncol(); } + int slice_size() const { return nrow(); } + int slice_stride() const { return 1; } + int slice_offset(int pos) const { return pos * nrow(); } +}; + +template +class matrix : public matrix_slices { + private: + V vector_; + + public: + // matrix slice: row (if S=by_row) or a column (if S=by_column) + class slice { + private: + const matrix& parent_; + int index_; // slice index + int offset_; // index of the first slice element in parent_.vector_ + + public: + slice(const matrix& parent, int index) + : parent_(parent), index_(index), offset_(parent.slice_offset(index)) {} + + R_xlen_t stride() const { return parent_.slice_stride(); } + R_xlen_t size() const { return parent_.slice_size(); } + + bool operator==(const slice& rhs) const { + return (index_ == rhs.index_) && (parent_.data() == rhs.parent_.data()); + } + bool operator!=(const slice& rhs) const { return !operator==(rhs); } + + T operator[](int pos) const { return parent_.vector_[offset_ + stride() * pos]; } + + // iterates elements of a slice + class iterator { + private: + const slice& slice_; + int pos_; + + public: + using difference_type = std::ptrdiff_t; + using value_type = T; + using pointer = T*; + using reference = T&; + using iterator_category = std::forward_iterator_tag; + + iterator(const slice& slice, R_xlen_t pos) : slice_(slice), pos_(pos) {} + + iterator& operator++() { + ++pos_; + return *this; + } + + bool operator==(const iterator& rhs) const { + return (pos_ == rhs.pos_) && (slice_ == rhs.slice_); + } + bool operator!=(const iterator& rhs) const { return !operator==(rhs); } + + T operator*() const { return slice_[pos_]; }; + }; + + iterator begin() const { return {*this, 0}; } + iterator end() const { return {*this, size()}; } + }; + friend slice; + + // iterates slices (rows or columns -- depending on S template param) of a matrix + class slice_iterator { + private: + const matrix& parent_; + int pos_; + + public: + using difference_type = std::ptrdiff_t; + using value_type = slice; + using pointer = slice*; + using reference = slice&; + using iterator_category = std::forward_iterator_tag; + + slice_iterator(const matrix& parent, R_xlen_t pos) : parent_(parent), pos_(pos) {} + + slice_iterator& operator++() { + ++pos_; + return *this; + } + + bool operator==(const slice_iterator& rhs) const { + return (pos_ == rhs.pos_) && (parent_.data() == rhs.parent_.data()); + } + bool operator!=(const slice_iterator& rhs) const { return !operator==(rhs); } + + slice operator*() { return parent_[pos_]; }; + }; + + public: + matrix(SEXP data) : matrix_slices(data), vector_(data) {} + + template + matrix(const cpp11::matrix& rhs) : matrix_slices(rhs), vector_(rhs) {} + + matrix(int nrow, int ncol) + : matrix_slices(nrow, ncol), vector_(R_xlen_t(nrow * ncol)) { + vector_.attr(R_DimSymbol) = {nrow, ncol}; + } + + using matrix_slices::nrow; + using matrix_slices::ncol; + using matrix_slices::nslices; + using matrix_slices::slice_size; + using matrix_slices::slice_stride; + using matrix_slices::slice_offset; + + SEXP data() const { return vector_.data(); } + + R_xlen_t size() const { return vector_.size(); } + + operator SEXP() const { return SEXP(vector_); } + + // operator sexp() { return sexp(vector_); } + + sexp attr(const char* name) const { return SEXP(vector_.attr(name)); } + + sexp attr(const std::string& name) const { return SEXP(vector_.attr(name)); } + + sexp attr(SEXP name) const { return SEXP(vector_.attr(name)); } + + r_vector names() const { return r_vector(vector_.names()); } + + T operator()(int row, int col) const { return vector_[row + (col * nrow())]; } + + slice operator[](int index) const { return {*this, index}; } + + slice_iterator begin() const { return {*this, 0}; } + slice_iterator end() const { return {*this, nslices()}; } +}; + +template +using doubles_matrix = matrix, double, S>; +template +using integers_matrix = matrix, int, S>; +template +using logicals_matrix = matrix, r_bool, S>; +template +using strings_matrix = matrix, r_string, S>; + +namespace writable { +template +using doubles_matrix = matrix, r_vector::proxy, S>; +template +using integers_matrix = matrix, r_vector::proxy, S>; +template +using logicals_matrix = matrix, r_vector::proxy, S>; +template +using strings_matrix = matrix, r_vector::proxy, S>; +} // namespace writable + +// TODO: Add tests for Matrix class +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/named_arg.hpp b/src/vendor/cpp11/cpp11/named_arg.hpp new file mode 100644 index 00000000..8c19e931 --- /dev/null +++ b/src/vendor/cpp11/cpp11/named_arg.hpp @@ -0,0 +1,50 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for size_t + +#include // for initializer_list + +#include "cpp11/R.hpp" // for SEXP, SEXPREC, literals +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/sexp.hpp" // for sexp + +namespace cpp11 { +class named_arg { + public: + explicit named_arg(const char* name) : name_(name), value_(R_NilValue) {} + named_arg& operator=(std::initializer_list il) { + value_ = as_sexp(il); + return *this; + } + + template + named_arg& operator=(T rhs) { + value_ = as_sexp(rhs); + return *this; + } + + template + named_arg& operator=(std::initializer_list rhs) { + value_ = as_sexp(rhs); + return *this; + } + + const char* name() const { return name_; } + SEXP value() const { return value_; } + + private: + const char* name_; + sexp value_; +}; + +namespace literals { + +inline named_arg operator"" _nm(const char* name, std::size_t) { return named_arg(name); } + +} // namespace literals + +using namespace literals; + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/protect.hpp b/src/vendor/cpp11/cpp11/protect.hpp new file mode 100644 index 00000000..3c5f8b62 --- /dev/null +++ b/src/vendor/cpp11/cpp11/protect.hpp @@ -0,0 +1,328 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for longjmp, setjmp, jmp_buf +#include // for exception +#include // for std::runtime_error +#include // for string, basic_string +#include // for tuple, make_tuple + +// NB: cpp11/R.hpp must precede R_ext/Error.h to ensure R_NO_REMAP is defined +#include "cpp11/R.hpp" // for SEXP, SEXPREC, CDR, R_NilValue, CAR, R_Pres... + +#include "R_ext/Boolean.h" // for Rboolean +#include "R_ext/Error.h" // for Rf_error, Rf_warning +#include "R_ext/Print.h" // for REprintf +#include "R_ext/Utils.h" // for R_CheckUserInterrupt +#include "Rversion.h" // for R_VERSION, R_Version + +#if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0) +#define HAS_UNWIND_PROTECT +#endif + +#ifdef CPP11_USE_FMT +#define FMT_HEADER_ONLY +#include "fmt/core.h" +#endif + +namespace cpp11 { +class unwind_exception : public std::exception { + public: + SEXP token; + unwind_exception(SEXP token_) : token(token_) {} +}; + +#ifdef HAS_UNWIND_PROTECT + +/// Unwind Protection from C longjmp's, like those used in R error handling +/// +/// @param code The code to which needs to be protected, as a nullary callable +template ()()), SEXP>::value>::type> +SEXP unwind_protect(Fun&& code) { + static SEXP token = [] { + SEXP res = R_MakeUnwindCont(); + R_PreserveObject(res); + return res; + }(); + + std::jmp_buf jmpbuf; + if (setjmp(jmpbuf)) { + throw unwind_exception(token); + } + + SEXP res = R_UnwindProtect( + [](void* data) -> SEXP { + auto callback = static_cast(data); + return static_cast(*callback)(); + }, + &code, + [](void* jmpbuf, Rboolean jump) { + if (jump == TRUE) { + // We need to first jump back into the C++ stacks because you can't safely + // throw exceptions from C stack frames. + longjmp(*static_cast(jmpbuf), 1); + } + }, + &jmpbuf, token); + + // R_UnwindProtect adds the result to the CAR of the continuation token, + // which implicitly protects the result. However if there is no error and + // R_UwindProtect does a normal exit the memory shouldn't be protected, so we + // unset it here before returning the value ourselves. + SETCAR(token, R_NilValue); + + return res; +} + +template ()()), void>::value>::type> +void unwind_protect(Fun&& code) { + (void)unwind_protect([&] { + std::forward(code)(); + return R_NilValue; + }); +} + +template ()())> +typename std::enable_if::value && !std::is_same::value, + R>::type +unwind_protect(Fun&& code) { + R out; + (void)unwind_protect([&] { + out = std::forward(code)(); + return R_NilValue; + }); + return out; +} + +#else +// Don't do anything if we don't have unwind protect. This will leak C++ resources, +// including those held by cpp11 objects, but the other alternatives are also not great. +template +decltype(std::declval()()) unwind_protect(Fun&& code) { + return std::forward(code)(); +} +#endif + +namespace detail { + +template +struct index_sequence { + using type = index_sequence; +}; + +template +struct appended_sequence; + +template +struct appended_sequence, J> : index_sequence {}; + +template +struct make_index_sequence + : appended_sequence::type, N - 1> {}; + +template <> +struct make_index_sequence<0> : index_sequence<> {}; + +template +decltype(std::declval()(std::declval()...)) apply( + F&& f, std::tuple&& a, const index_sequence&) { + return std::forward(f)(std::get(std::move(a))...); +} + +template +decltype(std::declval()(std::declval()...)) apply(F&& f, + std::tuple&& a) { + return apply(std::forward(f), std::move(a), make_index_sequence{}); +} + +// overload to silence a compiler warning that the (empty) tuple parameter is set but +// unused +template +decltype(std::declval()()) apply(F&& f, std::tuple<>&&) { + return std::forward(f)(); +} + +template +struct closure { + decltype(std::declval()(std::declval()...)) operator()() && { + return apply(ptr_, std::move(arefs_)); + } + F* ptr_; + std::tuple arefs_; +}; + +} // namespace detail + +struct protect { + template + struct function { + template + decltype(std::declval()(std::declval()...)) operator()(A&&... a) const { + // workaround to support gcc4.8, which can't capture a parameter pack + return unwind_protect( + detail::closure{ptr_, std::forward_as_tuple(std::forward(a)...)}); + } + + F* ptr_; + }; + + /// May not be applied to a function bearing attributes, which interfere with linkage on + /// some compilers; use an appropriately attributed alternative. (For example, Rf_error + /// bears the [[noreturn]] attribute and must be protected with safe.noreturn rather + /// than safe.operator[]). + template + constexpr function operator[](F* raw) const { + return {raw}; + } + + template + struct noreturn_function { + template + void operator() [[noreturn]] (A&&... a) const { + // workaround to support gcc4.8, which can't capture a parameter pack + unwind_protect( + detail::closure{ptr_, std::forward_as_tuple(std::forward(a)...)}); + // Compiler hint to allow [[noreturn]] attribute; this is never executed since + // the above call will not return. + throw std::runtime_error("[[noreturn]]"); + } + F* ptr_; + }; + + template + constexpr noreturn_function noreturn(F* raw) const { + return {raw}; + } +}; +constexpr struct protect safe = {}; + +inline void check_user_interrupt() { safe[R_CheckUserInterrupt](); } + +#ifdef CPP11_USE_FMT +template +void stop [[noreturn]] (const char* fmt_arg, Args&&... args) { + std::string msg = fmt::format(fmt_arg, std::forward(args)...); + safe.noreturn(Rf_errorcall)(R_NilValue, "%s", msg.c_str()); +} + +template +void stop [[noreturn]] (const std::string& fmt_arg, Args&&... args) { + std::string msg = fmt::format(fmt_arg, std::forward(args)...); + safe.noreturn(Rf_errorcall)(R_NilValue, "%s", msg.c_str()); +} + +template +void warning(const char* fmt_arg, Args&&... args) { + std::string msg = fmt::format(fmt_arg, std::forward(args)...); + safe[Rf_warningcall](R_NilValue, "%s", msg.c_str()); +} + +template +void warning(const std::string& fmt_arg, Args&&... args) { + std::string msg = fmt::format(fmt_arg, std::forward(args)...); + safe[Rf_warningcall](R_NilValue, "%s", msg.c_str()); +} +#else +template +void stop [[noreturn]] (const char* fmt, Args... args) { + safe.noreturn(Rf_errorcall)(R_NilValue, fmt, args...); +} + +template +void stop [[noreturn]] (const std::string& fmt, Args... args) { + safe.noreturn(Rf_errorcall)(R_NilValue, fmt.c_str(), args...); +} + +template +void warning(const char* fmt, Args... args) { + safe[Rf_warningcall](R_NilValue, fmt, args...); +} + +template +void warning(const std::string& fmt, Args... args) { + safe[Rf_warningcall](R_NilValue, fmt.c_str(), args...); +} +#endif + +/// A doubly-linked list of preserved objects, allowing O(1) insertion/release of +/// objects compared to O(N preserved) with R_PreserveObject. +static struct { + SEXP insert(SEXP obj) { + if (obj == R_NilValue) { + return R_NilValue; + } + + PROTECT(obj); + + static SEXP list = get_preserve_list(); + + // Get references to the head of the precious list and the next element + // after the head + SEXP head = list; + SEXP next = CDR(list); + + // Add a new cell that points to the current head + next. + SEXP cell = PROTECT(Rf_cons(head, next)); + SET_TAG(cell, obj); + + // Update the head + next to point at the newly-created cell, + // effectively inserting that cell between the current head + next. + SETCDR(head, cell); + SETCAR(next, cell); + + UNPROTECT(2); + + return cell; + } + + void print() { + static SEXP list = get_preserve_list(); + for (SEXP cell = list; cell != R_NilValue; cell = CDR(cell)) { + REprintf("%x CAR: %x CDR: %x TAG: %x\n", cell, CAR(cell), CDR(cell), TAG(cell)); + } + REprintf("---\n"); + } + + void release(SEXP cell) { + if (cell == R_NilValue) { + return; + } + + // Get a reference to the cells before and after the token. + SEXP lhs = CAR(cell); + SEXP rhs = CDR(cell); + + // Remove the cell from the precious list -- effectively, we do this + // by updating the 'lhs' and 'rhs' references to point at each-other, + // effectively removing any references to the cell in the pairlist. + SETCDR(lhs, rhs); + SETCAR(rhs, lhs); + } + + private: + // Each compilation unit purposefully gets its own preserve list. + // This avoids issues with sharing preserve list state across compilation units + // and across packages, which has historically caused many issues (#330). + static SEXP get_preserve_list() { + static SEXP out = init_preserve_list(); + return out; + } + + static SEXP init_preserve_list() { + // Initialize the list exactly once per compilation unit, + // and let R manage its memory + SEXP out = new_preserve_list(); + R_PreserveObject(out); + return out; + } + + static SEXP new_preserve_list() { + return Rf_cons(R_NilValue, Rf_cons(R_NilValue, R_NilValue)); + } + +} preserved; + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/r_bool.hpp b/src/vendor/cpp11/cpp11/r_bool.hpp new file mode 100644 index 00000000..a5a898d5 --- /dev/null +++ b/src/vendor/cpp11/cpp11/r_bool.hpp @@ -0,0 +1,83 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for numeric_limits +#include +#include // for is_convertible, enable_if + +#include "R_ext/Boolean.h" // for Rboolean +#include "cpp11/R.hpp" // for SEXP, SEXPREC, ... +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/protect.hpp" // for unwind_protect, preserved +#include "cpp11/r_vector.hpp" +#include "cpp11/sexp.hpp" // for sexp + +namespace cpp11 { + +class r_bool { + public: + r_bool() = default; + + r_bool(SEXP data) { + if (Rf_isLogical(data)) { + if (Rf_xlength(data) == 1) { + value_ = static_cast(LOGICAL_ELT(data, 0)); + } + } + throw std::invalid_argument("Invalid r_bool value"); + } + + r_bool(bool value) : value_(value ? TRUE : FALSE) {} + r_bool(Rboolean value) : value_(value) {} + r_bool(int value) : value_(from_int(value)) {} + + operator bool() const { return value_ == TRUE; } + operator int() const { return value_; } + operator Rboolean() const { return value_ ? TRUE : FALSE; } + + bool operator==(r_bool rhs) const { return value_ == rhs.value_; } + bool operator==(bool rhs) const { return operator==(r_bool(rhs)); } + bool operator==(Rboolean rhs) const { return operator==(r_bool(rhs)); } + bool operator==(int rhs) const { return operator==(r_bool(rhs)); } + + private: + static constexpr int na = std::numeric_limits::min(); + + static int from_int(int value) { + if (value == static_cast(FALSE)) return FALSE; + if (value == static_cast(na)) return na; + return TRUE; + } + + int value_ = na; +}; + +inline std::ostream& operator<<(std::ostream& os, r_bool const& value) { + os << ((value == TRUE) ? "TRUE" : "FALSE"); + return os; +} + +template +using enable_if_r_bool = enable_if_t::value, R>; + +template +enable_if_r_bool as_sexp(T from) { + sexp res = Rf_allocVector(LGLSXP, 1); + unwind_protect([&] { SET_LOGICAL_ELT(res.data(), 0, from); }); + return res; +} + +template <> +inline r_bool na() { + return NA_LOGICAL; +} + +namespace traits { +template <> +struct get_underlying_type { + using type = int; +}; +} // namespace traits + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/r_string.hpp b/src/vendor/cpp11/cpp11/r_string.hpp new file mode 100644 index 00000000..1486f1dd --- /dev/null +++ b/src/vendor/cpp11/cpp11/r_string.hpp @@ -0,0 +1,105 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for string, basic_string, operator== +#include // for is_convertible, enable_if + +#include "R_ext/Memory.h" // for vmaxget, vmaxset +#include "cpp11/R.hpp" // for SEXP, SEXPREC, Rf_mkCharCE, Rf_translat... +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/protect.hpp" // for unwind_protect, protect, protect::function +#include "cpp11/sexp.hpp" // for sexp + +namespace cpp11 { + +class r_string { + public: + r_string() = default; + r_string(SEXP data) : data_(data) {} + r_string(const char* data) : data_(safe[Rf_mkCharCE](data, CE_UTF8)) {} + r_string(const std::string& data) + : data_(safe[Rf_mkCharLenCE](data.c_str(), data.size(), CE_UTF8)) {} + + operator SEXP() const { return data_; } + operator sexp() const { return data_; } + operator std::string() const { + std::string res; + res.reserve(size()); + + void* vmax = vmaxget(); + unwind_protect([&] { res.assign(Rf_translateCharUTF8(data_)); }); + vmaxset(vmax); + + return res; + } + + bool operator==(const r_string& rhs) const { return data_.data() == rhs.data_.data(); } + + bool operator==(const SEXP rhs) const { return data_.data() == rhs; } + + bool operator==(const char* rhs) const { + return static_cast(*this) == rhs; + } + + bool operator==(const std::string& rhs) const { + return static_cast(*this) == rhs; + } + + R_xlen_t size() const { return Rf_xlength(data_); } + + private: + sexp data_ = R_NilValue; +}; + +inline SEXP as_sexp(std::initializer_list il) { + R_xlen_t size = il.size(); + + sexp data; + unwind_protect([&] { + data = Rf_allocVector(STRSXP, size); + auto it = il.begin(); + for (R_xlen_t i = 0; i < size; ++i, ++it) { + if (*it == NA_STRING) { + SET_STRING_ELT(data, i, *it); + } else { + SET_STRING_ELT(data, i, Rf_mkCharCE(Rf_translateCharUTF8(*it), CE_UTF8)); + } + } + }); + return data; +} + +template +using enable_if_r_string = enable_if_t::value, R>; + +template +enable_if_r_string as_sexp(T from) { + r_string str(from); + sexp res; + unwind_protect([&] { + res = Rf_allocVector(STRSXP, 1); + + if (str == NA_STRING) { + SET_STRING_ELT(res, 0, str); + } else { + SET_STRING_ELT(res, 0, Rf_mkCharCE(Rf_translateCharUTF8(str), CE_UTF8)); + } + }); + + return res; +} + +template <> +inline r_string na() { + return NA_STRING; +} + +namespace traits { +template <> +struct get_underlying_type { + using type = SEXP; +}; +} // namespace traits + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/r_vector.hpp b/src/vendor/cpp11/cpp11/r_vector.hpp new file mode 100644 index 00000000..b79748a0 --- /dev/null +++ b/src/vendor/cpp11/cpp11/r_vector.hpp @@ -0,0 +1,1039 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for ptrdiff_t, size_t + +#include // for max +#include // for array +#include // for snprintf +#include // for exception +#include // for initializer_list +#include // for forward_iterator_tag, random_ac... +#include // for out_of_range +#include // for string, basic_string +#include // for decay, is_same, enable_if, is_c... +#include // for declval + +#include "cpp11/R.hpp" // for R_xlen_t, SEXP, SEXPREC, Rf_xle... +#include "cpp11/attribute_proxy.hpp" // for attribute_proxy +#include "cpp11/protect.hpp" // for preserved +#include "cpp11/r_string.hpp" // for r_string +#include "cpp11/sexp.hpp" // for sexp + +namespace cpp11 { + +using namespace cpp11::literals; + +class type_error : public std::exception { + public: + type_error(int expected, int actual) : expected_(expected), actual_(actual) {} + virtual const char* what() const noexcept override { + snprintf(str_, 64, "Invalid input type, expected '%s' actual '%s'", + Rf_type2char(expected_), Rf_type2char(actual_)); + return str_; + } + + private: + int expected_; + int actual_; + mutable char str_[64]; +}; + +// Forward Declarations +class named_arg; + +namespace writable { +template +class r_vector; +} // namespace writable + +// Declarations +template +class r_vector { + public: + typedef ptrdiff_t difference_type; + typedef size_t size_type; + typedef T value_type; + typedef T* pointer; + typedef T& reference; + + using underlying_type = typename traits::get_underlying_type::type; + + r_vector() noexcept = default; + + r_vector(SEXP data); + + r_vector(SEXP data, bool is_altrep); + +#ifdef LONG_VECTOR_SUPPORT + T operator[](const int pos) const; + T at(const int pos) const; +#endif + T operator[](const R_xlen_t pos) const; + T operator[](const size_type pos) const; + T operator[](const r_string& name) const; + + T at(const R_xlen_t pos) const; + T at(const size_type pos) const; + T at(const r_string& name) const; + + bool contains(const r_string& name) const; + + r_vector& operator=(const r_vector& rhs) { + SEXP old_protect = protect_; + + data_ = rhs.data_; + protect_ = preserved.insert(data_); + is_altrep_ = rhs.is_altrep_; + data_p_ = rhs.data_p_; + length_ = rhs.length_; + + preserved.release(old_protect); + + return *this; + }; + + r_vector(const r_vector& rhs) { + SEXP old_protect = protect_; + + data_ = rhs.data_; + protect_ = preserved.insert(data_); + is_altrep_ = rhs.is_altrep_; + data_p_ = rhs.data_p_; + length_ = rhs.length_; + + preserved.release(old_protect); + }; + + r_vector(const writable::r_vector& rhs) : r_vector(static_cast(rhs)) {} + r_vector(named_arg) = delete; + + bool is_altrep() const; + + bool named() const; + + R_xlen_t size() const; + + operator SEXP() const; + + operator sexp() const; + + bool empty() const; + + /// Provide access to the underlying data, mainly for interface + /// compatibility with std::vector + SEXP data() const; + + const sexp attr(const char* name) const { + return SEXP(attribute_proxy>(*this, name)); + } + + const sexp attr(const std::string& name) const { + return SEXP(attribute_proxy>(*this, name.c_str())); + } + + const sexp attr(SEXP name) const { + return SEXP(attribute_proxy>(*this, name)); + } + + r_vector names() const { + SEXP nms = SEXP(Rf_getAttrib(data_, R_NamesSymbol)); + if (nms == R_NilValue) { + return r_vector(); + } + + return r_vector(nms); + } + + class const_iterator { + public: + using difference_type = ptrdiff_t; + using value_type = T; + using pointer = T*; + using reference = T&; + using iterator_category = std::random_access_iterator_tag; + + const_iterator(const r_vector* data, R_xlen_t pos); + + inline const_iterator operator+(R_xlen_t pos); + inline ptrdiff_t operator-(const const_iterator& other) const; + + inline const_iterator& operator++(); + inline const_iterator& operator--(); + + inline const_iterator& operator+=(R_xlen_t pos); + inline const_iterator& operator-=(R_xlen_t pos); + + inline bool operator!=(const const_iterator& other) const; + inline bool operator==(const const_iterator& other) const; + + inline T operator*() const; + + friend class writable::r_vector::iterator; + + private: + const r_vector* data_; + void fill_buf(R_xlen_t pos); + + R_xlen_t pos_; + std::array buf_; + R_xlen_t block_start_ = 0; + R_xlen_t length_ = 0; + }; + + public: + const_iterator begin() const; + const_iterator end() const; + + const_iterator cbegin() const; + const_iterator cend() const; + + const_iterator find(const r_string& name) const; + + ~r_vector() { preserved.release(protect_); } + + private: + SEXP data_ = R_NilValue; + SEXP protect_ = R_NilValue; + bool is_altrep_ = false; + underlying_type* data_p_ = nullptr; + R_xlen_t length_ = 0; + + static underlying_type* get_p(bool is_altrep, SEXP data); + + static SEXP valid_type(SEXP data); + + friend class writable::r_vector; +}; + +namespace writable { + +template +using has_begin_fun = std::decay()))>; + +/// Read/write access to new or copied r_vectors +template +class r_vector : public cpp11::r_vector { + private: + SEXP protect_ = R_NilValue; + + // These are necessary because type names are not directly accessible in + // template inheritance + using typename cpp11::r_vector::underlying_type; + + using cpp11::r_vector::data_; + using cpp11::r_vector::data_p_; + using cpp11::r_vector::is_altrep_; + using cpp11::r_vector::length_; + + R_xlen_t capacity_ = 0; + + public: + class proxy { + private: + const SEXP data_; + const R_xlen_t index_; + underlying_type* const p_; + bool is_altrep_; + + public: + proxy(SEXP data, const R_xlen_t index, underlying_type* const p, bool is_altrep); + + proxy& operator=(const T& rhs); + proxy& operator+=(const T& rhs); + proxy& operator-=(const T& rhs); + proxy& operator*=(const T& rhs); + proxy& operator/=(const T& rhs); + proxy& operator++(int); + proxy& operator--(int); + + void operator++(); + void operator--(); + + operator T() const; + }; + + typedef ptrdiff_t difference_type; + typedef size_t size_type; + typedef proxy value_type; + typedef proxy* pointer; + typedef proxy& reference; + + class iterator : public cpp11::r_vector::const_iterator { + private: + const r_vector& data_; + using cpp11::r_vector::const_iterator::block_start_; + using cpp11::r_vector::const_iterator::pos_; + using cpp11::r_vector::const_iterator::buf_; + using cpp11::r_vector::const_iterator::length_; + using cpp11::r_vector::const_iterator::fill_buf; + + public: + using difference_type = ptrdiff_t; + using value_type = proxy; + using pointer = proxy*; + using reference = proxy&; + using iterator_category = std::forward_iterator_tag; + + iterator(const r_vector& data, R_xlen_t pos); + + inline iterator& operator++(); + + inline proxy operator*() const; + + using cpp11::r_vector::const_iterator::operator!=; + + inline iterator& operator+=(R_xlen_t rhs); + inline iterator operator+(R_xlen_t rhs); + }; + + r_vector() noexcept = default; + r_vector(const SEXP& data); + r_vector(SEXP&& data); + r_vector(const SEXP& data, bool is_altrep); + r_vector(SEXP&& data, bool is_altrep); + r_vector(std::initializer_list il); + r_vector(std::initializer_list il); + + template + r_vector(Iter first, Iter last); + + template > + r_vector(const V& obj); + + explicit r_vector(const R_xlen_t size); + + ~r_vector(); + + r_vector(const r_vector& rhs); + r_vector(r_vector&& rhs); + + r_vector(const cpp11::r_vector& rhs); + + r_vector& operator=(const r_vector& rhs); + r_vector& operator=(r_vector&& rhs); + +#ifdef LONG_VECTOR_SUPPORT + proxy operator[](const int pos) const; + proxy at(const int pos) const; +#endif + proxy operator[](const R_xlen_t pos) const; + proxy operator[](const size_type pos) const; + proxy operator[](const r_string& name) const; + + proxy at(const R_xlen_t pos) const; + proxy at(const size_type pos) const; + proxy at(const r_string& name) const; + + void push_back(T value); + void push_back(const named_arg& value); + void pop_back(); + + void resize(R_xlen_t count); + + void reserve(R_xlen_t new_capacity); + + iterator insert(R_xlen_t pos, T value); + iterator erase(R_xlen_t pos); + + void clear(); + + iterator begin() const; + iterator end() const; + + using cpp11::r_vector::cbegin; + using cpp11::r_vector::cend; + using cpp11::r_vector::size; + + iterator find(const r_string& name) const; + + attribute_proxy> attr(const char* name) const { + return attribute_proxy>(*this, name); + } + + attribute_proxy> attr(const std::string& name) const { + return attribute_proxy>(*this, name.c_str()); + } + + attribute_proxy> attr(SEXP name) const { + return attribute_proxy>(*this, name); + } + + attribute_proxy> names() const { + return attribute_proxy>(*this, R_NamesSymbol); + } + + operator SEXP() const; +}; +} // namespace writable + +// Implementations below + +template +inline r_vector::r_vector(const SEXP data) + : data_(valid_type(data)), + protect_(preserved.insert(data)), + is_altrep_(ALTREP(data)), + data_p_(get_p(ALTREP(data), data)), + length_(Rf_xlength(data)) {} + +template +inline r_vector::r_vector(const SEXP data, bool is_altrep) + : data_(valid_type(data)), + protect_(preserved.insert(data)), + is_altrep_(is_altrep), + data_p_(get_p(is_altrep, data)), + length_(Rf_xlength(data)) {} + +template +inline bool r_vector::is_altrep() const { + return is_altrep_; +} + +template +inline bool r_vector::named() const { + return Rf_getAttrib(data_, R_NamesSymbol) != R_NilValue; +} + +template +inline R_xlen_t r_vector::size() const { + return length_; +} + +template +inline r_vector::operator SEXP() const { + return data_; +} + +template +inline bool r_vector::empty() const { + return (!(this->size() > 0)); +} + +template +inline r_vector::operator sexp() const { + return data_; +} + +/// Provide access to the underlying data, mainly for interface +/// compatibility with std::vector +template +inline SEXP r_vector::data() const { + return data_; +} + +template +inline typename r_vector::const_iterator r_vector::begin() const { + return const_iterator(this, 0); +} + +template +inline typename r_vector::const_iterator r_vector::end() const { + return const_iterator(this, length_); +} + +template +inline typename r_vector::const_iterator r_vector::cbegin() const { + return const_iterator(this, 0); +} + +template +inline typename r_vector::const_iterator r_vector::cend() const { + return const_iterator(this, length_); +} + +template +r_vector::const_iterator::const_iterator(const r_vector* data, R_xlen_t pos) + : data_(data), pos_(pos), buf_() { + if (data_->is_altrep()) { + fill_buf(pos); + } +} + +template +inline typename r_vector::const_iterator& r_vector::const_iterator::operator++() { + ++pos_; + if (data_->is_altrep() && pos_ >= block_start_ + length_) { + fill_buf(pos_); + } + return *this; +} + +template +inline typename r_vector::const_iterator& r_vector::const_iterator::operator--() { + --pos_; + if (data_->is_altrep() && pos_ > 0 && pos_ < block_start_) { + fill_buf(std::max(0_xl, pos_ - 64)); + } + return *this; +} + +template +inline typename r_vector::const_iterator& r_vector::const_iterator::operator+=( + R_xlen_t i) { + pos_ += i; + if (data_->is_altrep() && pos_ >= block_start_ + length_) { + fill_buf(pos_); + } + return *this; +} + +template +inline typename r_vector::const_iterator& r_vector::const_iterator::operator-=( + R_xlen_t i) { + pos_ -= i; + if (data_->is_altrep() && pos_ >= block_start_ + length_) { + fill_buf(std::max(0_xl, pos_ - 64)); + } + return *this; +} + +template +inline bool r_vector::const_iterator::operator!=( + const r_vector::const_iterator& other) const { + return pos_ != other.pos_; +} + +template +inline bool r_vector::const_iterator::operator==( + const r_vector::const_iterator& other) const { + return pos_ == other.pos_; +} + +template +inline ptrdiff_t r_vector::const_iterator::operator-( + const r_vector::const_iterator& other) const { + return pos_ - other.pos_; +} + +template +inline typename r_vector::const_iterator r_vector::const_iterator::operator+( + R_xlen_t rhs) { + auto it = *this; + it += rhs; + return it; +} + +template +inline T cpp11::r_vector::at(R_xlen_t pos) const { + if (pos < 0 || pos >= length_) { + throw std::out_of_range("r_vector"); + } + + return operator[](pos); +} + +template +inline T cpp11::r_vector::at(size_type pos) const { + return at(static_cast(pos)); +} + +template +inline T cpp11::r_vector::operator[](const r_string& name) const { + SEXP names = this->names(); + R_xlen_t size = Rf_xlength(names); + + for (R_xlen_t pos = 0; pos < size; ++pos) { + auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos)); + if (name == cur) { + return operator[](pos); + } + } + + throw std::out_of_range("r_vector"); +} + +template +inline bool cpp11::r_vector::contains(const r_string& name) const { + SEXP names = this->names(); + R_xlen_t size = Rf_xlength(names); + + for (R_xlen_t pos = 0; pos < size; ++pos) { + auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos)); + if (name == cur) { + return true; + } + } + + return false; +} + +template +inline typename cpp11::r_vector::const_iterator cpp11::r_vector::find( + const r_string& name) const { + SEXP names = this->names(); + R_xlen_t size = Rf_xlength(names); + + for (R_xlen_t pos = 0; pos < size; ++pos) { + auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos)); + if (name == cur) { + return begin() + pos; + } + } + + return end(); +} + +template +inline T r_vector::const_iterator::operator*() const { + if (data_->is_altrep()) { + return static_cast(buf_[pos_ - block_start_]); + } else { + return static_cast(data_->data_p_[pos_]); + } +} + +#ifdef LONG_VECTOR_SUPPORT +template +inline T r_vector::operator[](const int pos) const { + return operator[](static_cast(pos)); +} + +template +inline T r_vector::at(const int pos) const { + return at(static_cast(pos)); +} +#endif + +template +inline T r_vector::operator[](size_type pos) const { + return operator[](static_cast(pos)); +} + +namespace writable { + +template +r_vector::proxy::proxy(SEXP data, const R_xlen_t index, + typename r_vector::underlying_type* const p, bool is_altrep) + : data_(data), index_(index), p_(p), is_altrep_(is_altrep) {} + +template +inline typename r_vector::proxy r_vector::iterator::operator*() const { + if (data_.is_altrep()) { + return proxy( + data_.data(), pos_, + const_cast::underlying_type*>(&buf_[pos_ - block_start_]), + true); + } else { + return proxy(data_.data(), pos_, + data_.data_p_ != nullptr ? &data_.data_p_[pos_] : nullptr, false); + } +} + +template +r_vector::iterator::iterator(const r_vector& data, R_xlen_t pos) + : r_vector::const_iterator(&data, pos), data_(data) {} + +template +inline typename r_vector::iterator& r_vector::iterator::operator++() { + ++pos_; + if (data_.is_altrep() && pos_ >= block_start_ + length_) { + fill_buf(pos_); + } + return *this; +} + +template +inline typename r_vector::iterator& r_vector::iterator::operator+=(R_xlen_t rhs) { + pos_ += rhs; + if (data_.is_altrep() && pos_ >= block_start_ + length_) { + fill_buf(pos_); + } + return *this; +} + +template +inline typename r_vector::iterator r_vector::iterator::operator+(R_xlen_t rhs) { + auto it = *this; + it += rhs; + return it; +} + +template +inline typename r_vector::iterator r_vector::begin() const { + return iterator(*this, 0); +} + +template +inline typename r_vector::iterator r_vector::end() const { + return iterator(*this, length_); +} + +template +inline r_vector::r_vector(const SEXP& data) + : cpp11::r_vector(safe[Rf_shallow_duplicate](data)), + protect_(preserved.insert(data_)), + capacity_(length_) {} + +template +inline r_vector::r_vector(const SEXP& data, bool is_altrep) + : cpp11::r_vector(safe[Rf_shallow_duplicate](data), is_altrep), + protect_(preserved.insert(data_)), + capacity_(length_) {} + +template +inline r_vector::r_vector(SEXP&& data) + : cpp11::r_vector(data), protect_(preserved.insert(data_)), capacity_(length_) {} + +template +inline r_vector::r_vector(SEXP&& data, bool is_altrep) + : cpp11::r_vector(data, is_altrep), + protect_(preserved.insert(data_)), + capacity_(length_) {} + +template +template +inline r_vector::r_vector(Iter first, Iter last) : r_vector() { + reserve(last - first); + while (first != last) { + push_back(*first); + ++first; + } +} + +template +template +inline r_vector::r_vector(const V& obj) : r_vector() { + auto first = obj.begin(); + auto last = obj.end(); + reserve(last - first); + while (first != last) { + push_back(*first); + ++first; + } +} + +template +inline r_vector::r_vector(const R_xlen_t size) : r_vector() { + resize(size); +} + +template +inline r_vector::~r_vector() { + preserved.release(protect_); +} + +#ifdef LONG_VECTOR_SUPPORT +template +inline typename r_vector::proxy r_vector::operator[](const int pos) const { + return operator[](static_cast(pos)); +} + +template +inline typename r_vector::proxy r_vector::at(const int pos) const { + return at(static_cast(pos)); +} +#endif + +template +inline typename r_vector::proxy r_vector::operator[](const R_xlen_t pos) const { + if (is_altrep_) { + return {data_, pos, nullptr, true}; + } + return {data_, pos, data_p_ != nullptr ? &data_p_[pos] : nullptr, false}; +} + +template +inline typename r_vector::proxy r_vector::operator[](size_type pos) const { + return operator[](static_cast(pos)); +} + +template +inline typename r_vector::proxy r_vector::at(const R_xlen_t pos) const { + if (pos < 0 || pos >= length_) { + throw std::out_of_range("r_vector"); + } + return operator[](static_cast(pos)); +} + +template +inline typename r_vector::proxy r_vector::at(size_type pos) const { + return at(static_cast(pos)); +} + +template +inline typename r_vector::proxy r_vector::operator[](const r_string& name) const { + SEXP names = PROTECT(this->names()); + R_xlen_t size = Rf_xlength(names); + + for (R_xlen_t pos = 0; pos < size; ++pos) { + auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos)); + if (name == cur) { + UNPROTECT(1); + return operator[](pos); + } + } + + UNPROTECT(1); + throw std::out_of_range("r_vector"); +} + +template +inline typename r_vector::proxy r_vector::at(const r_string& name) const { + return operator[](name); +} + +template +inline typename r_vector::iterator r_vector::find(const r_string& name) const { + SEXP names = PROTECT(this->names()); + R_xlen_t size = Rf_xlength(names); + + for (R_xlen_t pos = 0; pos < size; ++pos) { + auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos)); + if (name == cur) { + UNPROTECT(1); + return begin() + pos; + } + } + + UNPROTECT(1); + return end(); +} + +template +inline r_vector::r_vector(const r_vector& rhs) + : cpp11::r_vector(safe[Rf_shallow_duplicate](rhs)), + protect_(preserved.insert(data_)), + capacity_(rhs.capacity_) {} + +template +inline r_vector::r_vector(r_vector&& rhs) + : cpp11::r_vector(rhs), protect_(rhs.protect_), capacity_(rhs.capacity_) { + rhs.data_ = R_NilValue; + rhs.protect_ = R_NilValue; +} + +template +inline r_vector::r_vector(const cpp11::r_vector& rhs) + : cpp11::r_vector(safe[Rf_shallow_duplicate](rhs)), + protect_(preserved.insert(data_)), + capacity_(rhs.length_) {} + +// We don't release the old object until the end in case we throw an exception +// during the duplicate. +template +inline r_vector& r_vector::operator=(const r_vector& rhs) { + if (data_ == rhs.data_) { + return *this; + } + + cpp11::r_vector::operator=(rhs); + + auto old_protect = protect_; + + data_ = safe[Rf_shallow_duplicate](rhs.data_); + protect_ = preserved.insert(data_); + + preserved.release(old_protect); + + capacity_ = rhs.capacity_; + + return *this; +} + +template +inline r_vector& r_vector::operator=(r_vector&& rhs) { + if (data_ == rhs.data_) { + return *this; + } + + cpp11::r_vector::operator=(rhs); + + SEXP old_protect = protect_; + + data_ = rhs.data_; + protect_ = preserved.insert(data_); + + preserved.release(old_protect); + + capacity_ = rhs.capacity_; + + rhs.data_ = R_NilValue; + rhs.protect_ = R_NilValue; + + return *this; +} + +template +inline void r_vector::pop_back() { + --length_; +} + +template +inline void r_vector::resize(R_xlen_t count) { + reserve(count); + length_ = count; +} + +template +inline typename r_vector::iterator r_vector::insert(R_xlen_t pos, T value) { + push_back(value); + + R_xlen_t i = length_ - 1; + while (i > pos) { + operator[](i) = (T) operator[](i - 1); + --i; + }; + operator[](pos) = value; + + return begin() + pos; +} + +template +inline typename r_vector::iterator r_vector::erase(R_xlen_t pos) { + R_xlen_t i = pos; + while (i < length_ - 1) { + operator[](i) = (T) operator[](i + 1); + ++i; + } + pop_back(); + + return begin() + pos; +} + +template +inline void r_vector::clear() { + length_ = 0; +} + +inline SEXP truncate(SEXP x, R_xlen_t length, R_xlen_t capacity) { +#if R_VERSION >= R_Version(3, 4, 0) + SETLENGTH(x, length); + SET_TRUELENGTH(x, capacity); + SET_GROWABLE_BIT(x); +#else + x = safe[Rf_lengthgets](x, length); +#endif + return x; +} + +template +inline r_vector::operator SEXP() const { + auto* p = const_cast*>(this); + if (data_ == R_NilValue) { + p->resize(0); + return data_; + } + if (length_ < capacity_) { + p->data_ = truncate(p->data_, length_, capacity_); + SEXP nms = names(); + auto nms_size = Rf_xlength(nms); + if ((nms_size > 0) && (length_ < nms_size)) { + nms = truncate(nms, length_, capacity_); + names() = nms; + } + } + return data_; +} + +template +inline typename r_vector::proxy& r_vector::proxy::operator+=(const T& rhs) { + operator=(static_cast(*this) + rhs); + return *this; +} + +template +inline typename r_vector::proxy& r_vector::proxy::operator-=(const T& rhs) { + operator=(static_cast(*this) - rhs); + return *this; +} + +template +inline typename r_vector::proxy& r_vector::proxy::operator*=(const T& rhs) { + operator=(static_cast(*this) * rhs); + return *this; +} + +template +inline typename r_vector::proxy& r_vector::proxy::operator/=(const T& rhs) { + operator=(static_cast(*this) / rhs); + return *this; +} + +template +inline typename r_vector::proxy& r_vector::proxy::operator++(int) { + operator=(static_cast(*this) + 1); + return *this; +} + +template +inline typename r_vector::proxy& r_vector::proxy::operator--(int) { + operator=(static_cast(*this) - 1); + return *this; +} + +template +inline void r_vector::proxy::operator--() { + operator=(static_cast(*this) - 1); +} + +template +inline void r_vector::proxy::operator++() { + operator=(static_cast(*this) + 1); +} + +} // namespace writable + +// TODO: is there a better condition we could use, e.g. assert something true +// rather than three things false? +template +using is_container_but_not_sexp_or_string = typename std::enable_if< + !std::is_constructible::value && + !std::is_same::type, std::string>::value && + !std::is_same::type, std::string>::value, + typename std::decay::type>::type; + +template ::type::value_type> +// typename T = typename C::value_type> +is_container_but_not_sexp_or_string as_cpp(SEXP from) { + auto obj = cpp11::r_vector(from); + return {obj.begin(), obj.end()}; +} + +// TODO: could we make this generalize outside of std::string? +template +using is_vector_of_strings = typename std::enable_if< + std::is_same::type, std::string>::value, + typename std::decay::type>::type; + +template ::type::value_type> +// typename T = typename C::value_type> +is_vector_of_strings as_cpp(SEXP from) { + auto obj = cpp11::r_vector(from); + typename std::decay::type res; + auto it = obj.begin(); + while (it != obj.end()) { + r_string s = *it; + res.emplace_back(static_cast(s)); + ++it; + } + return res; +} + +template +bool operator==(const r_vector& lhs, const r_vector& rhs) { + if (lhs.size() != rhs.size()) { + return false; + } + + auto lhs_it = lhs.begin(); + auto rhs_it = rhs.begin(); + + auto end = lhs.end(); + while (lhs_it != end) { + if (!(*lhs_it == *rhs_it)) { + return false; + } + ++lhs_it; + ++rhs_it; + } + return true; +} + +template +bool operator!=(const r_vector& lhs, const r_vector& rhs) { + return !(lhs == rhs); +} + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/raws.hpp b/src/vendor/cpp11/cpp11/raws.hpp new file mode 100644 index 00000000..fe945f83 --- /dev/null +++ b/src/vendor/cpp11/cpp11/raws.hpp @@ -0,0 +1,158 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for min +#include // for array +#include // for uint8_t +#include // for initializer_list + +#include "cpp11/R.hpp" // for RAW, SEXP, SEXPREC, Rf_allocVector +#include "cpp11/attribute_proxy.hpp" // for attribute_proxy +#include "cpp11/named_arg.hpp" // for named_arg +#include "cpp11/protect.hpp" // for preserved +#include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy +#include "cpp11/sexp.hpp" // for sexp + +// Specializations for raws + +namespace cpp11 { + +namespace traits { +template <> +struct get_underlying_type { + using type = Rbyte; +}; +} // namespace traits + +template <> +inline SEXP r_vector::valid_type(SEXP data) { + if (data == nullptr) { + throw type_error(RAWSXP, NILSXP); + } + if (TYPEOF(data) != RAWSXP) { + throw type_error(RAWSXP, TYPEOF(data)); + } + return data; +} + +template <> +inline uint8_t r_vector::operator[](const R_xlen_t pos) const { + // NOPROTECT: likely too costly to unwind protect every elt + return is_altrep_ ? RAW_ELT(data_, pos) : data_p_[pos]; +} + +template <> +inline typename r_vector::underlying_type* r_vector::get_p( + bool is_altrep, SEXP data) { + if (is_altrep) { + return nullptr; + } else { + return RAW(data); + } +} + +template <> +inline void r_vector::const_iterator::fill_buf(R_xlen_t pos) { + using namespace cpp11::literals; + length_ = std::min(64_xl, data_->size() - pos); + unwind_protect([&] { RAW_GET_REGION(data_->data_, pos, length_, buf_.data()); }); + block_start_ = pos; +} + +typedef r_vector raws; + +namespace writable { + +template <> +inline typename r_vector::proxy& r_vector::proxy::operator=( + const uint8_t& rhs) { + if (is_altrep_) { + // NOPROTECT: likely too costly to unwind protect every set elt + RAW(data_)[index_] = rhs; + } else { + *p_ = rhs; + } + return *this; +} + +template <> +inline r_vector::proxy::operator uint8_t() const { + if (p_ == nullptr) { + // NOPROTECT: likely too costly to unwind protect every elt + return RAW(data_)[index_]; + } else { + return *p_; + } +} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(safe[Rf_allocVector](RAWSXP, il.size())), + capacity_(il.size()) { + protect_ = preserved.insert(data_); + auto it = il.begin(); + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + data_p_[i] = *it; + } +} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(safe[Rf_allocVector](RAWSXP, il.size())), + capacity_(il.size()) { + protect_ = preserved.insert(data_); + int n_protected = 0; + + try { + unwind_protect([&] { + Rf_setAttrib(data_, R_NamesSymbol, Rf_allocVector(STRSXP, capacity_)); + SEXP names = PROTECT(Rf_getAttrib(data_, R_NamesSymbol)); + ++n_protected; + + auto it = il.begin(); + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + data_p_[i] = RAW_ELT(it->value(), 0); + SET_STRING_ELT(names, i, Rf_mkCharCE(it->name(), CE_UTF8)); + } + UNPROTECT(n_protected); + }); + } catch (const unwind_exception& e) { + preserved.release(protect_); + UNPROTECT(n_protected); + throw e; + } +} + +template <> +inline void r_vector::reserve(R_xlen_t new_capacity) { + data_ = data_ == R_NilValue ? safe[Rf_allocVector](RAWSXP, new_capacity) + : safe[Rf_xlengthgets](data_, new_capacity); + + SEXP old_protect = protect_; + protect_ = preserved.insert(data_); + preserved.release(old_protect); + + data_p_ = RAW(data_); + capacity_ = new_capacity; +} + +template <> +inline void r_vector::push_back(uint8_t value) { + while (length_ >= capacity_) { + reserve(capacity_ == 0 ? 1 : capacity_ *= 2); + } + if (is_altrep_) { + // NOPROTECT: likely too costly to unwind protect every elt + RAW(data_)[length_] = value; + } else { + data_p_[length_] = value; + } + ++length_; +} + +typedef r_vector raws; + +} // namespace writable + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/sexp.hpp b/src/vendor/cpp11/cpp11/sexp.hpp new file mode 100644 index 00000000..57277c92 --- /dev/null +++ b/src/vendor/cpp11/cpp11/sexp.hpp @@ -0,0 +1,85 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for size_t + +#include // for string, basic_string + +#include "cpp11/R.hpp" // for SEXP, SEXPREC, REAL_ELT, R_NilV... +#include "cpp11/attribute_proxy.hpp" // for attribute_proxy +#include "cpp11/protect.hpp" // for preserved + +namespace cpp11 { + +/// Converting to SEXP +class sexp { + private: + SEXP data_ = R_NilValue; + SEXP preserve_token_ = R_NilValue; + + public: + sexp() = default; + + sexp(SEXP data) : data_(data), preserve_token_(preserved.insert(data_)) { + // REprintf("created %x %x : %i\n", data_, preserve_token_, protect_head_size()); + } + + sexp(const sexp& rhs) { + data_ = rhs.data_; + preserve_token_ = preserved.insert(data_); + // REprintf("copied %x new protect %x : %i\n", rhs.data_, preserve_token_, + // protect_head_size()); + } + + sexp(sexp&& rhs) { + data_ = rhs.data_; + preserve_token_ = rhs.preserve_token_; + + rhs.data_ = R_NilValue; + rhs.preserve_token_ = R_NilValue; + + // REprintf("moved %x : %i\n", rhs.data_, protect_head_size()); + } + + sexp& operator=(const sexp& rhs) { + preserved.release(preserve_token_); + + data_ = rhs.data_; + preserve_token_ = preserved.insert(data_); + // REprintf("assigned %x : %i\n", rhs.data_, protect_head_size()); + return *this; + } + + // void swap(sexp& rhs) { + // sexp tmp(rhs); + // rhs = *this; + //*this = tmp; + //} + + ~sexp() { preserved.release(preserve_token_); } + + attribute_proxy attr(const char* name) const { + return attribute_proxy(*this, name); + } + + attribute_proxy attr(const std::string& name) const { + return attribute_proxy(*this, name.c_str()); + } + + attribute_proxy attr(SEXP name) const { + return attribute_proxy(*this, name); + } + + attribute_proxy names() const { + return attribute_proxy(*this, R_NamesSymbol); + } + + operator SEXP() const { return data_; } + operator double() const { return REAL_ELT(data_, 0); } + operator size_t() const { return REAL_ELT(data_, 0); } + operator bool() const { return LOGICAL_ELT(data_, 0); } + SEXP data() const { return data_; } +}; + +} // namespace cpp11 diff --git a/src/vendor/cpp11/cpp11/strings.hpp b/src/vendor/cpp11/cpp11/strings.hpp new file mode 100644 index 00000000..e9b0f3c7 --- /dev/null +++ b/src/vendor/cpp11/cpp11/strings.hpp @@ -0,0 +1,183 @@ +// cpp11 version: 0.4.6 +// vendored on: 2023-11-08 +#pragma once + +#include // for initializer_list +#include // for string, basic_string + +#include "cpp11/R.hpp" // for SEXP, TYPEOF, SEXPREC, SET_STRI... +#include "cpp11/as.hpp" // for as_sexp +#include "cpp11/attribute_proxy.hpp" // for attribute_proxy +#include "cpp11/named_arg.hpp" // for named_arg +#include "cpp11/protect.hpp" // for preserved +#include "cpp11/r_string.hpp" // for r_string +#include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy +#include "cpp11/sexp.hpp" // for sexp + +// Specializations for strings + +namespace cpp11 { + +template <> +inline SEXP r_vector::valid_type(SEXP data) { + if (data == nullptr) { + throw type_error(STRSXP, NILSXP); + } + if (TYPEOF(data) != STRSXP) { + throw type_error(STRSXP, TYPEOF(data)); + } + return data; +} + +template <> +inline r_string r_vector::operator[](const R_xlen_t pos) const { + // NOPROTECT: likely too costly to unwind protect every elt + return STRING_ELT(data_, pos); +} + +template <> +inline typename r_vector::underlying_type* r_vector::get_p(bool, + SEXP) { + return nullptr; +} + +template <> +inline void r_vector::const_iterator::fill_buf(R_xlen_t) { + return; +} + +template <> +inline r_string r_vector::const_iterator::operator*() const { + return STRING_ELT(data_->data(), pos_); +} + +typedef r_vector strings; + +namespace writable { + +template <> +inline typename r_vector::proxy& r_vector::proxy::operator=( + const r_string& rhs) { + unwind_protect([&] { SET_STRING_ELT(data_, index_, rhs); }); + return *this; +} + +template <> +inline r_vector::proxy::operator r_string() const { + // NOPROTECT: likely too costly to unwind protect every elt + return STRING_ELT(data_, index_); +} + +inline bool operator==(const r_vector::proxy& lhs, r_string rhs) { + return static_cast(lhs).operator==(static_cast(rhs).c_str()); +} + +inline SEXP alloc_or_copy(const SEXP data) { + switch (TYPEOF(data)) { + case CHARSXP: + return cpp11::r_vector(safe[Rf_allocVector](STRSXP, 1)); + case STRSXP: + return safe[Rf_shallow_duplicate](data); + default: + throw type_error(STRSXP, TYPEOF(data)); + } +} + +inline SEXP alloc_if_charsxp(const SEXP data) { + switch (TYPEOF(data)) { + case CHARSXP: + return cpp11::r_vector(safe[Rf_allocVector](STRSXP, 1)); + case STRSXP: + return data; + default: + throw type_error(STRSXP, TYPEOF(data)); + } +} + +template <> +inline r_vector::r_vector(const SEXP& data) + : cpp11::r_vector(alloc_or_copy(data)), + protect_(preserved.insert(data_)), + capacity_(length_) { + if (TYPEOF(data) == CHARSXP) { + SET_STRING_ELT(data_, 0, data); + } +} + +template <> +inline r_vector::r_vector(SEXP&& data) + : cpp11::r_vector(alloc_if_charsxp(data)), + protect_(preserved.insert(data_)), + capacity_(length_) { + if (TYPEOF(data) == CHARSXP) { + SET_STRING_ELT(data_, 0, data); + } +} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(as_sexp(il)), capacity_(il.size()) {} + +template <> +inline r_vector::r_vector(std::initializer_list il) + : cpp11::r_vector(safe[Rf_allocVector](STRSXP, il.size())), + capacity_(il.size()) { + protect_ = preserved.insert(data_); + int n_protected = 0; + + try { + unwind_protect([&] { + Rf_setAttrib(data_, R_NamesSymbol, Rf_allocVector(STRSXP, capacity_)); + SEXP names = PROTECT(Rf_getAttrib(data_, R_NamesSymbol)); + ++n_protected; + auto it = il.begin(); + for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { + SET_STRING_ELT(data_, i, STRING_ELT(it->value(), 0)); + SET_STRING_ELT(names, i, Rf_mkCharCE(it->name(), CE_UTF8)); + } + UNPROTECT(n_protected); + }); + } catch (const unwind_exception& e) { + preserved.release(protect_); + UNPROTECT(n_protected); + throw e; + } +} + +template <> +inline void r_vector::reserve(R_xlen_t new_capacity) { + data_ = data_ == R_NilValue ? safe[Rf_allocVector](STRSXP, new_capacity) + : safe[Rf_xlengthgets](data_, new_capacity); + + SEXP old_protect = protect_; + protect_ = preserved.insert(data_); + preserved.release(old_protect); + + capacity_ = new_capacity; +} + +template <> +inline void r_vector::push_back(r_string value) { + while (length_ >= capacity_) { + reserve(capacity_ == 0 ? 1 : capacity_ *= 2); + } + unwind_protect([&] { SET_STRING_ELT(data_, length_, value); }); + ++length_; +} + +typedef r_vector strings; + +template +inline void r_vector::push_back(const named_arg& value) { + push_back(value.value()); + if (Rf_xlength(names()) == 0) { + cpp11::writable::strings new_nms(size()); + names() = new_nms; + } + cpp11::writable::strings nms(names()); + nms[size() - 1] = value.name(); +} + +} // namespace writable + +} // namespace cpp11 diff --git a/vscode-install.r b/vscode-install.r index 5e8292db..66fa2320 100644 --- a/vscode-install.r +++ b/vscode-install.r @@ -1,4 +1,76 @@ +# Dependencies ---- + if (!require(covr)) install.packages("covr") if (!require(DBItest)) install.packages("DBItest") +if (!require(devtools)) install.packages("devtools") +if (!require(cpp11)) install.packages("cpp11") + +# Vendoring ---- + +# Run only when we want to update the vendored code + +vendor_dir <- "./src/vendor/cpp11" + +if (dir.exists(vendor_dir)) { + unlink(vendor_dir, recursive = TRUE) +} + +cpp11::cpp_vendor(vendor_dir) + +try(dir.create(file.path(vendor_dir, "cpp11"), recursive = TRUE)) + +finp <- list.files(file.path(vendor_dir, "inst/include"), recursive = TRUE, full.names = TRUE) + +for (f in finp) { + # remove inst/include/ for each file + file.rename(f, gsub("inst/include/", "", f)) +} + +unlink(file.path(vendor_dir, "inst"), recursive = TRUE) + +# Pacha's note: We need to touch the Makefile +# the key line is PKG_CPPFLAGS += -I../inst/include + +# read Makevars +makevars <- readLines("src/Makevars.in") + +# if the "PKG_CPPFLAGS ..." line does not end with +vendor_line <- " -I../src/vendor/cpp11" + +# then add it at the end of the same line + +cppflags_line <- grep("^PKG_CPPFLAGS", makevars) + +if (!grepl(vendor_line, makevars[cppflags_line])) { + makevars[cppflags_line] <- paste0(makevars[cppflags_line], vendor_line) + writeLines(makevars, "src/Makevars.in") +} + +# same for Makevars.win +makevars_win <- readLines("src/Makevars.win") + +cppflags_line_win <- grep("^PKG_CPPFLAGS", makevars_win) + +if (!grepl(vendor_line, makevars_win[cppflags_line_win])) { + makevars_win[cppflags_line_win] <- paste0(makevars_win[cppflags_line_win], vendor_line) + writeLines(makevars_win, "src/Makevars.win") +} + +# also important: vendoring requires to remove the cpp11 line in LinkingTo +# in DESCRIPTION + +description <- readLines("DESCRIPTION") + +# if there is a line with "cpp11,", remove it +if ("cpp11," %in% description) { + description <- description[-grep("cpp11,", description)] + writeLines(description, "DESCRIPTION") +} + +# Install and check ---- + devtools::install(upgrade = "never") + +# for a full check +# apt install devscripts qpdf devtools::check()