Vendor cpp11 0.5.0

Author: krlmlr

inst/include/cpp11.hpp

@@ -1,5 +1,5 @@
-// cpp11 version: 0.4.7
-// vendored on: 2024-06-26
+// cpp11 version: 0.5.0
+// vendored on: 2024-09-24
 #pragma once
 
 #include "cpp11/R.hpp"

inst/include/cpp11/R.hpp

@@ -1,5 +1,5 @@
-// cpp11 version: 0.4.7
-// vendored on: 2024-06-26
+// cpp11 version: 0.5.0
+// vendored on: 2024-09-24
 #pragma once
 
 #ifdef R_INTERNALS_H_
@@ -12,7 +12,9 @@
 
 #define R_NO_REMAP
 #define STRICT_R_HEADERS
+#include "R_ext/Boolean.h"
 #include "Rinternals.h"
+#include "Rversion.h"
 
 // clang-format off
 #ifdef __clang__
@@ -29,6 +31,18 @@
 #include <type_traits>
 #include "cpp11/altrep.hpp"
 
+#if defined(R_VERSION) && R_VERSION >= R_Version(4, 4, 0)
+// Use R's new macro
+#define CPP11_PRIdXLEN_T R_PRIdXLEN_T
+#else
+// Recreate what new R does
+#ifdef LONG_VECTOR_SUPPORT
+#define CPP11_PRIdXLEN_T "td"
+#else
+#define CPP11_PRIdXLEN_T "d"
+#endif
+#endif
+
 namespace cpp11 {
 namespace literals {
 
@@ -43,6 +57,61 @@ struct get_underlying_type {
 };
 }  // namespace traits
 
+namespace detail {
+
+// Annoyingly, `TYPEOF()` returns an `int` rather than a `SEXPTYPE`,
+// which can throw warnings with `-Wsign-compare` on Windows.
+inline SEXPTYPE r_typeof(SEXP x) { return static_cast<SEXPTYPE>(TYPEOF(x)); }
+
+/// Get an object from an environment
+///
+/// SAFETY: Keep as a pure C function. Call like an R API function, i.e. wrap in `safe[]`
+/// as required.
+inline SEXP r_env_get(SEXP env, SEXP sym) {
+#if defined(R_VERSION) && R_VERSION >= R_Version(4, 5, 0)
+  const Rboolean inherits = FALSE;
+  return R_getVar(sym, env, inherits);
+#else
+  SEXP out = Rf_findVarInFrame3(env, sym, TRUE);
+
+  // Replicate the 3 checks from `R_getVar()` (along with exact error message):
+  // - Object must be found in the `env`
+  // - `R_MissingArg` can't leak from an `env` anymore
+  // - Promises can't leak from an `env` anymore
+
+  if (out == R_MissingArg) {
+    Rf_errorcall(R_NilValue, "argument \"%s\" is missing, with no default",
+                 CHAR(PRINTNAME(sym)));
+  }
+
+  if (out == R_UnboundValue) {
+    Rf_errorcall(R_NilValue, "object '%s' not found", CHAR(PRINTNAME(sym)));
+  }
+
+  if (r_typeof(out) == PROMSXP) {
+    PROTECT(out);
+    out = Rf_eval(out, env);
+    UNPROTECT(1);
+  }
+
+  return out;
+#endif
+}
+
+/// Check if an object exists in an environment
+///
+/// SAFETY: Keep as a pure C function. Call like an R API function, i.e. wrap in `safe[]`
+/// as required.
+inline bool r_env_has(SEXP env, SEXP sym) {
+#if R_VERSION >= R_Version(4, 2, 0)
+  return R_existsVarInFrame(env, sym);
+#else
+  return Rf_findVarInFrame3(env, sym, FALSE) != R_UnboundValue;
+#endif
+}
+
+}  // namespace detail
+
 template <typename T>
 inline T na();
 

inst/include/cpp11/altrep.hpp

@@ -1,5 +1,5 @@
-// cpp11 version: 0.4.7
-// vendored on: 2024-06-26
+// cpp11 version: 0.5.0
+// vendored on: 2024-09-24
 #pragma once
 
 #include "Rversion.h"

inst/include/cpp11/as.hpp

@@ -1,5 +1,5 @@
-// cpp11 version: 0.4.7
-// vendored on: 2024-06-26
+// cpp11 version: 0.5.0
+// vendored on: 2024-09-24
 #pragma once
 
 #include <cmath>             // for modf

inst/include/cpp11/attribute_proxy.hpp

@@ -1,5 +1,5 @@
-// cpp11 version: 0.4.7
-// vendored on: 2024-06-26
+// cpp11 version: 0.5.0
+// vendored on: 2024-09-24
 #pragma once
 
 #include <initializer_list>  // for initializer_list

inst/include/cpp11/data_frame.hpp

@@ -1,5 +1,5 @@
-// cpp11 version: 0.4.7
-// vendored on: 2024-06-26
+// cpp11 version: 0.5.0
+// vendored on: 2024-09-24
 #pragma once
 
 #include <cstdlib>  // for abs
@@ -38,12 +38,12 @@ class data_frame : public list {
     return R_NilValue;
   }
 
-  static int calc_nrow(SEXP x) {
+  static R_xlen_t 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]);
+      return static_cast<R_xlen_t>(abs(INTEGER(nms)[1]));
     }
 
     if (!Rf_isNull(nms)) {
@@ -69,7 +69,11 @@ 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<int>(calc_nrow(x))};
+    return set_data_frame_attributes(std::move(x), calc_nrow(x));
+  }
+
+  writable::list set_data_frame_attributes(writable::list&& x, R_xlen_t nrow) {
+    x.attr(R_RowNamesSymbol) = {NA_INTEGER, -static_cast<int>(nrow)};
     x.attr(R_ClassSymbol) = "data.frame";
     return std::move(x);
   }
@@ -78,6 +82,8 @@ class data_frame : public cpp11::data_frame {
   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(const SEXP data, bool is_altrep, R_xlen_t nrow)
+      : cpp11::data_frame(set_data_frame_attributes(data, nrow), is_altrep) {}
   data_frame(std::initializer_list<list> il)
       : cpp11::data_frame(set_data_frame_attributes(writable::list(il))) {}
   data_frame(std::initializer_list<named_arg> il)

inst/include/cpp11/declarations.hpp

@@ -1,5 +1,5 @@
-// cpp11 version: 0.4.7
-// vendored on: 2024-06-26
+// cpp11 version: 0.5.0
+// vendored on: 2024-09-24
 #pragma once
 
 #include <cstring>

inst/include/cpp11/doubles.hpp

@@ -1,38 +1,32 @@
-// cpp11 version: 0.4.7
-// vendored on: 2024-06-26
+// cpp11 version: 0.5.0
+// vendored on: 2024-09-24
 #pragma once
 
 #include <algorithm>         // for min, tranform
 #include <array>             // for array
 #include <initializer_list>  // 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
+#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/protect.hpp"   // for safe
+#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<double>::valid_type(SEXP data) {
-  if (data == nullptr) {
-    throw type_error(REALSXP, NILSXP);
-  }
-  if (TYPEOF(data) != REALSXP) {
-    throw type_error(REALSXP, TYPEOF(data));
-  }
-  return data;
+inline SEXPTYPE r_vector<double>::get_sexptype() {
+  return REALSXP;
 }
 
 template <>
-inline double r_vector<double>::operator[](const R_xlen_t pos) const {
+inline typename r_vector<double>::underlying_type r_vector<double>::get_elt(SEXP x,
+                                                                            R_xlen_t i) {
   // NOPROTECT: likely too costly to unwind protect every elt
-  return is_altrep_ ? REAL_ELT(data_, pos) : data_p_[pos];
+  return REAL_ELT(x, i);
 }
 
 template <>
@@ -46,91 +40,32 @@ inline typename r_vector<double>::underlying_type* r_vector<double>::get_p(bool
 }
 
 template <>
-inline void r_vector<double>::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;
+inline typename r_vector<double>::underlying_type const* r_vector<double>::get_const_p(
+    bool is_altrep, SEXP data) {
+  return REAL_OR_NULL(data);
 }
 
-typedef r_vector<double> doubles;
-
-namespace writable {
-
 template <>
-inline typename r_vector<double>::proxy& r_vector<double>::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;
-}
+inline void r_vector<double>::get_region(SEXP x, R_xlen_t i, R_xlen_t n,
+                                         typename r_vector::underlying_type* buf) {
+  // NOPROTECT: likely too costly to unwind protect here
+  REAL_GET_REGION(x, i, n, buf);
+};
 
 template <>
-inline r_vector<double>::proxy::operator double() const {
-  if (p_ == nullptr) {
-    // NOPROTECT: likely too costly to unwind protect every elt
-    return REAL_ELT(data_, index_);
-  } else {
-    return *p_;
-  }
+inline bool r_vector<double>::const_iterator::use_buf(bool is_altrep) {
+  return is_altrep;
 }
 
-template <>
-inline r_vector<double>::r_vector(std::initializer_list<double> il)
-    : cpp11::r_vector<double>(as_sexp(il)), capacity_(il.size()) {}
-
-template <>
-inline r_vector<double>::r_vector(std::initializer_list<named_arg> il)
-    : cpp11::r_vector<double>(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;
-  }
-}
+typedef r_vector<double> doubles;
 
-template <>
-inline void r_vector<double>::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;
-}
+namespace writable {
 
 template <>
-inline void r_vector<double>::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_;
+inline void r_vector<double>::set_elt(SEXP x, R_xlen_t i,
+                                      typename r_vector::underlying_type value) {
+  // NOPROTECT: Likely too costly to unwind protect every set elt
+  SET_REAL_ELT(x, i, value);
 }
 
 typedef r_vector<double> doubles;
@@ -140,11 +75,11 @@ typedef r_vector<double> doubles;
 typedef r_vector<int> integers;
 
 inline doubles as_doubles(SEXP x) {
-  if (TYPEOF(x) == REALSXP) {
+  if (detail::r_typeof(x) == REALSXP) {
     return doubles(x);
   }
 
-  else if (TYPEOF(x) == INTSXP) {
+  else if (detail::r_typeof(x) == INTSXP) {
     integers xn(x);
     size_t len = xn.size();
     writable::doubles ret(len);
@@ -154,7 +89,7 @@ inline doubles as_doubles(SEXP x) {
     return ret;
   }
 
-  throw type_error(REALSXP, TYPEOF(x));
+  throw type_error(REALSXP, detail::r_typeof(x));
 }
 
 template <>