vctrs

SEXP _r_pairlist(SEXP* tags, SEXP* cars) {
  if (!cars) {
    r_stop_internal("NULL `cars`.");
  }

  SEXP list = PROTECT(Rf_cons(R_NilValue, R_NilValue));
  SEXP node = list;

  while (*cars) {
    SEXP next_node = Rf_cons(*cars, R_NilValue);
    SETCDR(node, next_node);
    node = next_node;

    if (tags) {
      SET_TAG(next_node, *tags);
      ++tags;
    }

    ++cars;
  }

  UNPROTECT(1);
  return CDR(list);
}

static void abort_parse(r_obj* code, const char* why) {
  if (r_peek_option("rlang__verbose_errors") != r_null) {
    r_obj_print(code);
  }
  r_abort("Internal error: %s", why);
}

bool allow_null_as_bool(enum vctrs_allow_null allow_null) {
  return (bool) allow_null;
}

bool any_has_suffix(r_obj* names) {
  r_ssize n = r_length(names);
  r_obj* const * v_names = r_chr_cbegin(names);

  for (r_ssize i = 0; i < n; ++i) {
    if (suffix_pos(r_str_c_string(v_names[i])) >= 0) {
      return true;
    }
  }

  return false;
}

r_obj* apply_name_spec(r_obj* name_spec, r_obj* outer, r_obj* inner, r_ssize n) {
  if (r_inherits(name_spec, "rlang_zap")) {
    return r_null;
  }

  if (name_spec_is_inner(name_spec)) {
    // Ignore `outer` entirely
    return inner;
  }
  if (outer == r_null) {
    // `outer` doesn't exist, no need to apply `name_spec`
    return inner;
  }

  if (r_typeof(outer) != R_TYPE_string) {
    r_stop_internal("`outer` must be a scalar string.");
  }

  if (outer == strings_empty || outer == r_globals.na_str) {
    if (inner == r_null) {
      return chrs_empty;
    } else {
      return inner;
    }
  }

  if (r_is_empty_names(inner)) {
    if (n == 0) {
      return r_globals.empty_chr;
    }
    if (n == 1) {
      return r_str_as_character(outer);
    }
    inner = KEEP(r_seq(1, n + 1));
  } else {
    inner = KEEP(inner);
  }

  switch (r_typeof(name_spec)) {
  case R_TYPE_closure:
    break;
  case R_TYPE_character:
    name_spec = glue_as_name_spec(name_spec);
    break;
  default:
    name_spec = r_as_function(name_spec, ".name_spec");
    break;
  case R_TYPE_null: {
    const char* reason;
    if (n > 1) {
      reason = "a vector of length > 1";
    } else {
      reason = "a named vector";
    }
    r_abort("Can't merge the outer name `%s` with %s.\n"
            "Please supply a `.name_spec` specification.",
            r_str_c_string(outer),
            reason);
  }}
  KEEP(name_spec);

  r_obj* outer_chr = KEEP(r_str_as_character(outer));

  r_obj* out = KEEP(vctrs_dispatch2(syms_dot_name_spec, name_spec,
                                    syms_outer, outer_chr,
                                    syms_inner, inner));

  if (out != r_null) {
    if (r_typeof(out) != R_TYPE_character) {
      r_abort("`.name_spec` must return a character vector.");
    }
    vec_check_recyclable(out, n, VCTRS_ALLOW_NULL_no, vec_args.empty, r_lazy_null);
  }

  FREE(4);
  return out;
}

enum vctrs_allow_null arg_as_allow_null(r_obj* x, const char* arg) {
  return r_arg_as_bool(x, arg) ? VCTRS_ALLOW_NULL_yes : VCTRS_ALLOW_NULL_no;
}

r_obj* as_df_col(r_obj* x,
                 r_obj* outer,
                 bool* allow_pack,
                 struct r_lazy error_call) {
  if (is_data_frame(x)) {
    *allow_pack = true;
    return r_clone(x);
  }

  r_ssize ndim = vec_bare_dim_n(x);
  if (ndim > 2) {
    r_abort_lazy_call(error_call, "Can't bind arrays.");
  }
  if (ndim > 0) {
    *allow_pack = true;
    return shaped_as_df_col(x, outer);
  }

  *allow_pack = false;
  return vec_as_df_col(x, outer);
}

r_obj* as_df_row_impl(r_obj* x,
                      struct name_repair_opts* name_repair,
                      struct r_lazy error_call) {
  if (x == r_null) {
    return x;
  }
  if (is_data_frame(x)) {
    return df_repair_names(x, name_repair);
  }

  int nprot = 0;

  r_obj* dim = KEEP_N(vec_bare_dim(x), &nprot);
  r_ssize ndim = (dim == r_null) ? 1 : r_length(dim);

  if (ndim > 2) {
    r_abort_lazy_call(error_call, "Can't bind arrays.");
  }
  if (ndim == 2) {
    r_obj* out = KEEP_N(r_as_data_frame(x), &nprot);
    r_attrib_poke_names(out, vec_as_names(KEEP_N(colnames2(x), &nprot), name_repair));
    FREE(nprot);
    return out;
  }

  // Take names before removing dimensions so we get colnames if needed
  r_obj* nms = KEEP_N(vec_names2(x), &nprot);
  nms = KEEP_N(vec_as_names(nms, name_repair), &nprot);

  if (dim != r_null) {
    x = KEEP_N(r_clone_referenced(x), &nprot);
    r_attrib_poke(x, r_syms.dim, r_null);
    r_attrib_poke(x, r_syms.dim_names, r_null);
  }

  // Remove names first as they are promoted to data frame column names.
  // Can be a user side object, so use `VCTRS_OWNERSHIP_foreign`.
  x = KEEP_N(vec_set_names(x, r_null, VCTRS_OWNERSHIP_foreign), &nprot);

  x = KEEP_N(vec_chop_unsafe(x, r_null, r_null), &nprot);
  r_attrib_poke_names(x, nms);
  x = new_data_frame(x, 1);

  FREE(nprot);
  return x;
}

void attrib_append_row_names(r_obj* x, r_obj* row_names) {
#if R_VERSION >= R_Version(4, 6, 0)
  r_attrib_poke(x, r_syms.row_names, row_names);
#else
  r_obj* attrib = ATTRIB(x);
  attrib = KEEP(r_new_node(row_names, attrib));
  r_node_poke_tag(attrib, r_syms.row_names);
  SET_ATTRIB(x, attrib);
  FREE(1);
#endif
}

r_obj* base_c_invoke(
  r_obj* xs,
  r_obj* name_spec,
  struct r_lazy error_call
) {
  if (vctrs_debug_verbose) {
    r_obj* x = list_first_non_null(xs, NULL);
    r_printf(
      "Falling back to `base::c()` for class `%s`.\n",
      r_chr_get_c_string(r_class(x), 0)
    );
  }

  if (name_spec_is_inner(name_spec)) {
    // We don't support most `name_spec` options in the fallback,
    // but we do allow this one because it is extremely useful
    // and easy to implement
    name_spec = r_null;

    if (r_names(xs) != r_null) {
      // Remove outer names, but remember we likely don't own `xs`!
      xs = KEEP(r_clone_referenced(xs));
      r_attrib_poke_names(xs, r_null);
      FREE(1);
    }
  }
  KEEP(xs);

  if (name_spec != r_null) {
    stop_name_spec_in_fallback(xs, error_call);
  }

  r_obj* ffi_call = KEEP(r_call2(r_sym("base_c_invoke"), xs));
  r_obj* out = r_eval(ffi_call, vctrs_ns_env);

  FREE(2);
  return out;
}

r_obj* base_list_combine_fallback(
  r_obj* xs,
  bool has_indices,
  r_obj* indices,
  enum vctrs_index_style indices_style,
  r_ssize size,
  bool has_default,
  r_obj* default_,
  enum list_combine_multiple multiple,
  enum assignment_slice_value slice_xs,
  r_obj* name_spec,
  struct vctrs_arg* p_xs_arg,
  struct vctrs_arg* p_default_arg,
  struct r_lazy error_call
) {
  if (!has_indices) {
    // Sequential combination, nothing fancy here
    return base_c_invoke(xs, name_spec, error_call);
  }

  // Otherwise we have `indices`. We need to recreate a bunch of the "main" path
  // logic, and then combine all `xs` together and reorder using the `indices`.
  //
  // We end up doing something like:
  //
  // ```
  // vec_slice_fallback(base_c(!!!xs), order(vec_c(!!!indices)))
  // ```

  // Normalize `indices` to the location style, because that's what the fallback
  // is designed to handle. It's also the style we convert `default` to.
  switch (indices_style) {
  case VCTRS_INDEX_STYLE_location: {
    indices = list_location_to_location_indices(indices);
    break;
  }
  case VCTRS_INDEX_STYLE_condition: {
    indices_style = VCTRS_INDEX_STYLE_location;
    indices = list_condition_to_location_indices(indices);
    break;
  }
  default: r_stop_unreachable();
  }
  KEEP(indices);

  // Normalize and check `xs` sizes
  //
  // - If `slice_xs = no`, each `x` must be size 1 or the size of the `index`
  //   - Size 1 must be recycled up to the size of the `index`
  // - If `slice_xs = yes`, each `x` must be size 1 or size `size`
  //   - Size 1 must be recycled up to the size of the `index`
  //   - Size `size` must be sliced down to the size of the `index`
  switch (slice_xs) {
  case ASSIGNMENT_SLICE_VALUE_no: {
    xs = vec_recycle_xs_fallback(xs, indices, p_xs_arg, error_call);
    break;
  }
  case ASSIGNMENT_SLICE_VALUE_yes: {
    xs = vec_slice_xs_fallback(xs, indices, size, p_xs_arg, error_call);
    break;
  }
  default: r_stop_unreachable();
  }
  KEEP(xs);

  // Reverse `xs` and `indices` if required for `multiple`
  //
  // - Done after recycling/slicing of `xs` because `p_xs_arg` is used there
  //   and we need to generate correct index locations in errors.
  // - Done before `default` handling because `default` is always pushed
  //   at the end.
  switch (multiple) {
  case LIST_COMBINE_MULTIPLE_last: {
    // Nothing to do, this is the standard behavior
    break;
  }
  case LIST_COMBINE_MULTIPLE_first: {
    xs = KEEP(vec_reverse(xs));
    indices = KEEP(vec_reverse(indices));
    FREE(2);
    break;
  }
  }
  KEEP(xs);
  KEEP(indices);

  if (has_default) {
    // Materialize the `default`'s index in location style, as that is what
    // we normalized `indices` to.
    r_obj* default_index = KEEP(compute_default_index(indices, indices_style, size));
    default_index = KEEP(compact_condition_materialize_location(default_index));

    // `default` recycles against the output size
    const r_ssize default_size = vec_size(default_);
    const r_ssize default_index_size = r_length(default_index);

    // Other `xs` have been sliced already, we now need to sliced `default`,
    // which is always provided in `slice_xs = yes` style.
    if (default_size == 1) {
      // Recycle "up" to the size of the index
      default_ = vec_recycle_fallback(default_, default_index_size, p_default_arg, error_call);
    } else if (default_size == size) {
      // Slice "down" to the size of the index
      default_ = vec_slice_fallback(default_, default_index);
    } else {
      // `default` is the wrong size, error
      vec_check_recyclable(default_, size, VCTRS_ALLOW_NULL_no, p_default_arg, error_call);
    }
    KEEP(default_);

    // Append the default to `xs` and `indices` before the fallback
    xs = KEEP(push_default(xs, default_));
    indices = KEEP(push_default_index(indices, default_index));

    FREE(5);
  }
  KEEP(xs);
  KEEP(indices);

  // Remove all `NULL`s from `xs` and their corresponding slot in `indices`.
  //
  // `base_c_invoke()` does this as well, but we need to remove the `indices` slot
  // at the same time.
  //
  // - Done after `default_index` computation, so `default_index` doesn't capture
  //   dropped indices.
  // - Done after `vec_recycle_xs_fallback()` so we have correct indices in recycling
  //   error messages.
  if (vec_any_missing(xs)) {
    r_obj* complete = KEEP(vec_detect_complete(xs));
    complete = KEEP(r_lgl_which(complete, false));
    xs = KEEP(vec_slice_unsafe(xs, complete));
    indices = KEEP(vec_slice_unsafe(indices, complete));
    FREE(4);
  }
  KEEP(xs);
  KEEP(indices);

  r_obj* out = KEEP(base_c_invoke(xs, name_spec, error_call));

  r_obj* index = KEEP(build_fallback_index(indices, size, error_call));

  out = vec_slice_fallback(out, index);

  FREE(10);
  return out;
}

r_obj* c_data_frame_class(r_obj* cls) {
  if (r_typeof(cls) != R_TYPE_character) {
    r_abort_call(r_null, "`class` must be NULL or a character vector");
  }
  return chr_c(cls, classes_data_frame);
}

void check_condition_index(
  r_obj* x,
  struct vctrs_arg* p_x_arg,
  struct r_lazy call
) {
  if (!is_condition_index(x)) {
    r_abort_lazy_call(
      call,
      "%s must be a logical vector, not %s.",
      vec_arg_format(p_x_arg),
      r_obj_type_friendly(x)
    );
  }
}

void check_names(r_obj* x, r_obj* names) {
  if (names == r_null) {
    return;
  }

  if (r_typeof(names) != R_TYPE_character) {
    r_abort(
      "`names` must be a character vector, not a %s.",
      r_type_as_c_string(r_typeof(names))
    );
  }

  r_ssize x_size = vec_size(x);
  r_ssize names_size = vec_size(names);

  if (x_size != names_size) {
    r_abort(
      "The size of `names`, %i, must be the same as the size of `x`, %i.",
      names_size,
      x_size
    );
  }
}

void check_rcrd(SEXP x) {
  if (!Rf_isVectorList(x))
    Rf_errorcall(R_NilValue, "Corrupt rcrd: not a list");
  if (Rf_length(x) == 0)
    Rf_errorcall(R_NilValue, "Corrupt rcrd: length 0");
}

void check_recyclable_against_index(
  r_obj* value,
  r_obj* index,
  r_ssize size,
  enum assignment_slice_value slice_value,
  enum vctrs_index_style index_style,
  struct vctrs_arg* p_value_arg,
  struct r_lazy call
) {
  r_ssize check_size;

  switch (slice_value) {
  case ASSIGNMENT_SLICE_VALUE_no: {
    switch (index_style) {
    case VCTRS_INDEX_STYLE_location: check_size = vec_subscript_size(index); break;
    case VCTRS_INDEX_STYLE_condition: check_size = vec_condition_subscript_sum(index, true); break;
    default: r_stop_unreachable();
    }
    break;
  }
  case ASSIGNMENT_SLICE_VALUE_yes: check_size = size; break;
  default: r_stop_unreachable();
  }

  vec_check_recyclable(value, check_size, VCTRS_ALLOW_NULL_no, p_value_arg, call);
}

void check_rep_each_times(int times,
                          r_ssize i,
                          struct r_lazy call,
                          struct vctrs_arg* p_times_arg) {
  if (times < 0) {
    if (times == r_globals.na_int) {
      stop_rep_each_times_missing(i, call, p_times_arg);
    } else {
      stop_rep_each_times_negative(i, call, p_times_arg);
    }
  } else if (times_is_oob(times)) {
    stop_rep_each_times_oob(times, i, call, p_times_arg);
  }
}

void check_rep_times(int times,
                     struct r_lazy call,
                     struct vctrs_arg* p_times_arg) {
  if (times < 0) {
    if (times == r_globals.na_int) {
      stop_rep_times_missing(call, p_times_arg);
    } else {
      stop_rep_times_negative(call, p_times_arg);
    }
  } else if (times_is_oob(times)) {
    stop_rep_times_oob(times, call, p_times_arg);
  }
}

r_obj* check_unique_names(r_obj* names,
                          const struct name_repair_opts* opts) {
  r_obj* ffi_arg = KEEP(r_lazy_eval(opts->name_repair_arg));
  r_obj* ffi_call = KEEP(r_lazy_eval(opts->call));

  r_obj* out = KEEP(vctrs_dispatch3(syms_check_unique_names, fns_check_unique_names,
                                    syms_names, names,
                                    r_syms.arg, ffi_arg,
                                    syms_call, ffi_call));

  // Restore visibility
  r_eval(r_null, r_envs.empty);

  FREE(3);
  return out;
}

r_obj* chop_fallback_shaped(r_obj* x, struct vctrs_chop_indices* p_indices) {
  const r_ssize out_size = indices_out_size(p_indices, x);
  r_obj* out = KEEP(r_alloc_list(out_size));

  for (r_ssize i = 0; i < out_size; ++i) {
    r_obj* index = indices_next(p_indices);

    index = KEEP(vec_subscript_materialize(index));

    // `vec_slice_fallback()` will also `vec_restore()` for us
    r_obj* elt = vec_slice_fallback(x, index);
    r_list_poke(out, i, elt);

    FREE(1);
  }

  FREE(1);
  return out;
}

bool chr_all_same(
  const char** p_x,
  const r_ssize size
) {
  if (size == 0) {
    return true;
  }

  const char* first = p_x[0];

  for (r_ssize i = 1; i < size; ++i) {
    if (first != p_x[i]) {
      return false;
    }
  }

  return true;
}

bool chr_all_same_byte(
  const char** p_x,
  const r_ssize size
) {
  if (size == 0) {
    return true;
  }

  const uint8_t first = (uint8_t) *p_x[0];

  for (r_ssize i = 1; i < size; ++i) {
    const uint8_t this = (uint8_t) *p_x[i];

    if (this != first) {
      return false;
    }
  }

  return true;
}

SEXP chr_apply(SEXP x, SEXP chr_proxy_collate) {
  // Don't use vctrs dispatch utils because we match argument positionally
  SEXP call = PROTECT(Rf_lang2(syms_chr_proxy_collate, syms_x));

  SEXP mask = PROTECT(r_alloc_empty_environment(R_GlobalEnv));
  Rf_defineVar(syms_chr_proxy_collate, chr_proxy_collate, mask);
  Rf_defineVar(syms_x, x, mask);

  SEXP out = PROTECT(Rf_eval(call, mask));

  if (vec_typeof(out) != VCTRS_TYPE_character) {
    Rf_errorcall(
      R_NilValue,
      "`chr_proxy_collate` must return a character vector."
    );
  }

  R_len_t x_size = vec_size(x);
  R_len_t out_size = vec_size(out);

  if (x_size != out_size) {
    Rf_errorcall(
      R_NilValue,
      "`chr_proxy_collate` must return a vector of the same length (%i, not %i).",
      x_size,
      out_size
    );
  }

  UNPROTECT(3);
  return out;
}

r_obj* chr_assign(
  r_obj* x,
  r_obj* index,
  r_obj* value,
  enum vctrs_ownership ownership,
  enum assignment_slice_value slice_value,
  enum vctrs_index_style index_style
) {
  ASSIGN_BARRIER(r_obj*, r_chr_cbegin, r_chr_poke);
}

SEXP chr_c(SEXP x, SEXP y) {
  r_ssize x_n = r_length(x);
  r_ssize y_n = r_length(y);

  if (x_n == 0) {
    return y;
  }
  if (y_n == 0) {
    return x;
  }

  r_ssize out_n = r_ssize_add(x_n, y_n);
  SEXP out = PROTECT(r_alloc_vector(STRSXP, out_n));

  const SEXP* p_x = STRING_PTR_RO(x);
  const SEXP* p_y = STRING_PTR_RO(y);

  for (r_ssize i = 0; i < x_n; ++i) {
    SET_STRING_ELT(out, i, p_x[i]);
  }
  for (r_ssize i = 0, j = x_n; i < y_n; ++i, ++j) {
    SET_STRING_ELT(out, j, p_y[i]);
  }

  UNPROTECT(1);
  return out;
}

r_ssize chr_col_detect_missing(r_obj* x,
                               r_ssize* v_loc,
                               r_ssize loc_size) {
  COL_DETECT_MISSING(r_obj*, r_chr_cbegin, chr_is_missing);
}

void chr_col_detect_run_bounds_bool(r_obj* x, r_ssize size, enum vctrs_run_bound which, bool* v_out) {
  VEC_COL_DETECT_RUN_BOUNDS_BOOL(r_obj*, r_chr_cbegin, chr_equal_na_equal);
}

r_obj* chr_detect_missing(r_obj* x) {
  DETECT_MISSING(r_obj*, r_chr_cbegin, chr_is_missing);
}

void chr_detect_run_bounds_bool(r_obj* x, r_ssize size, enum vctrs_run_bound which, bool* v_out) {
  VEC_DETECT_RUN_BOUNDS_BOOL(r_obj*, r_chr_cbegin, chr_equal_na_equal);
}

uint32_t chr_dict_hash_scalar(struct dictionary* d, R_len_t i) {
  return chr_dict_hash_with(d, d, i);
}

uint32_t chr_dict_hash_with(struct dictionary* d, struct dictionary* x, R_len_t i) {
  DICT_HASH_WITH(p_chr_equal_na_equal);
}

bool chr_dict_is_incomplete(struct dictionary* d, R_len_t i) {
  return dict_hash_is_missing(d, i) && p_chr_is_incomplete(d->p_poly_vec->p_vec, i);
}

static inline int chr_equal_na_equal(SEXP x, SEXP y) {
  return x == y;
}

static inline int chr_equal_na_propagate(SEXP x, SEXP y) {
  if (chr_is_missing(x) || chr_is_missing(y)) {
    return NA_LOGICAL;
  } else {
    return chr_equal_na_equal(x, y);
  }
}

struct r_ssize_int_pair chr_extract_without_missings(
  r_ssize size,
  const SEXP* p_x,
  const char** p_x_strings
) {
  r_ssize n_missing = 0;
  int max_string_size = 0;

  r_ssize loc = 0;

  for (r_ssize i = 0; i < size; ++i) {
    SEXP elt = p_x[i];

    if (elt == NA_STRING) {
      ++n_missing;
    } else {
      const int elt_string_size = (int) Rf_length(elt);
      if (max_string_size < elt_string_size) {
        max_string_size = elt_string_size;
      }

      p_x_strings[loc] = CHAR(elt);
      ++loc;
    }
  }

  return (struct r_ssize_int_pair) {
    .x = n_missing,
    .y = max_string_size
  };
}

r_ssize chr_find_encoding_start(r_obj* x, r_ssize size) {
  r_obj* const* p_x = r_chr_cbegin(x);

  for (r_ssize i = 0; i < size; ++i) {
    r_obj* const elt = p_x[i];

    if (!str_is_ascii_or_utf8(elt)) {
      return i;
    }
  }

  return size;
}

r_ssize chr_first_missing(r_obj* x) {
  FIRST_MISSING(r_obj*, r_chr_cbegin, chr_is_missing);
}

void chr_handle_missings(
  r_ssize size,
  r_ssize n_missing,
  const bool na_last,
  const SEXP* p_x,
  int* p_o,
  int* p_o_aux
) {
  r_ssize loc_missing = na_last ? (size - n_missing) : 0;
  r_ssize loc_not_missing = na_last ? 0 : n_missing;

  for (r_ssize i = 0; i < size; ++i) {
    SEXP elt = p_x[i];

    if (elt == NA_STRING) {
      p_o_aux[loc_missing] = p_o[i];
      ++loc_missing;
    } else {
      p_o_aux[loc_not_missing] = p_o[i];
      ++loc_not_missing;
    }
  }

  // Copy back
  r_memcpy(p_o, p_o_aux, size * sizeof(*p_o_aux));
}

static inline uint32_t chr_hash(r_obj* x) {
  HASH(r_obj*, r_chr_cbegin, chr_hash_scalar);
}

static inline void chr_hash_fill_na_equal(r_obj* x, r_ssize size, uint32_t* v_out) {
  HASH_FILL(r_obj*, r_chr_cbegin, chr_hash_scalar);
}

static inline void chr_hash_fill_na_propagate(r_obj* x, r_ssize size, uint32_t* v_out) {
  HASH_FILL_NA_PROPAGATE(r_obj*, r_chr_cbegin, chr_hash_scalar, chr_is_missing);
}

static inline uint32_t chr_hash_scalar(r_obj* x) {
  return uint64_hash((uintptr_t) x);
}

bool chr_is_missing(r_obj* x) {
  return x == r_globals.na_str;
}

void chr_order_insertion(
  const r_ssize size,
  const bool decreasing,
  const char** p_x,
  int* p_o,
  struct group_infos* p_group_infos
) {
  // Don't think this can occur, but safer this way
  if (size == 0) {
    return;
  }

  const int direction = decreasing ? -1 : 1;

  for (r_ssize i = 1; i < size; ++i) {
    const char* elt = p_x[i];
    const int elt_o = p_o[i];

    r_ssize j = i - 1;

    while (j >= 0) {
      const char* cmp_elt = p_x[j];

      if (str_ge(elt, cmp_elt, direction)) {
        break;
      }

      // It seems to help performance to avoid loading this
      // before the if statement, since it often isn't needed
      const int cmp_elt_o = p_o[j];

      // Swap
      p_x[j + 1] = cmp_elt;
      p_o[j + 1] = cmp_elt_o;

      // Next
      --j;
    }

    // Place original elements in new location
    // closer to start of the vector
    p_x[j + 1] = elt;
    p_o[j + 1] = elt_o;
  }

  // We've ordered a small chunk, we need to push at least one group size.
  // Depends on the post-ordered results so we have to do this
  // in a separate loop.
  r_ssize group_size = 1;
  const char* previous = p_x[0];

  for (r_ssize i = 1; i < size; ++i) {
    const char* current = p_x[i];

    // Continue the current group run
    if (current == previous) {
      ++group_size;
      continue;
    }

    // Push current run size and reset size tracker
    groups_size_maybe_push(group_size, p_group_infos);
    group_size = 1;

    previous = current;
  }

  // Push final group run
  groups_size_maybe_push(group_size, p_group_infos);
}

void chr_order_radix(
  const r_ssize size,
  const bool decreasing,
  const int max_string_size,
  const char** p_x,
  int* p_o,
  const char** p_x_aux,
  int* p_o_aux,
  uint8_t* p_bytes,
  struct group_infos* p_group_infos
) {
  int pass = 0;

  // If `pass == max_string_size == 0`, we are already done!
  //
  // This is needed when a vector of `NA` followed by all `""` are passed in. The
  // `NA` make it look unsorted, but then the `NA` are removed, so we are left
  // with a vector of `""` with `max_string_size == 0`.
  //
  // Without this, we can infloop because the `next_pass == max_string_size`
  // exit never occurs because `next_pass` starts above `max_string_size`. We
  // have a test to make sure we return the correct result.
  if (pass == max_string_size) {
    groups_size_maybe_push(size, p_group_infos);
    return;
  }

  chr_order_radix_recurse(
    size,
    decreasing,
    pass,
    max_string_size,
    p_x,
    p_o,
    p_x_aux,
    p_o_aux,
    p_bytes,
    p_group_infos
  );
}

bool class_implements_base_c(r_obj* cls) {
  if (s3_class_find_method("c", cls, base_method_table) != r_null) {
    return true;
  }
  if (s4_class_find_method(cls, s4_c_method_table) != r_null) {
    return true;
  }
  return false;
}

enum vctrs_class_type class_type(r_obj* x) {
  if (!r_is_object(x)) {
    return VCTRS_CLASS_none;
  }

  r_obj* cls = KEEP(r_class(x));

  // Avoid corrupt objects where `x` is an object, but the class is NULL
  if (cls == r_null) {
    FREE(1);
    return VCTRS_CLASS_none;
  }

  enum vctrs_class_type type = class_type_impl(cls);

  FREE(1);
  return type;
}

enum vctrs_class_type class_type_impl(r_obj* cls) {
  int n = r_length(cls);
  r_obj* const* p = r_chr_cbegin(cls);

  // First check for bare types for which we know how many strings are
  // the classes composed of
  switch (n) {
  case 1: {
    r_obj* p0 = p[0];

    if (p0 == strings_data_frame) {
      return VCTRS_CLASS_bare_data_frame;
    } else if (p0 == strings_factor) {
      return VCTRS_CLASS_bare_factor;
    } else if (p0 == strings_date) {
      return VCTRS_CLASS_bare_date;
    } else if (p0 == strings.AsIs) {
      return VCTRS_CLASS_bare_asis;
    }

    break;
  }
  case 2: {
    r_obj* p0 = p[0];
    r_obj* p1 = p[1];

    if (p0 == strings_ordered &&
        p1 == strings_factor) {
      return VCTRS_CLASS_bare_ordered;
    }

    if (p1 == strings_posixt) {
      if (p0 == strings_posixct) {
        return VCTRS_CLASS_bare_posixct;
      } else if (p0 == strings_posixlt) {
        return VCTRS_CLASS_bare_posixlt;
      }
    }

    break;
  }
  case 3: {
    if (p[0] == strings_tbl_df &&
        p[1] == strings_tbl &&
        p[2] == strings_data_frame) {
      return VCTRS_CLASS_bare_tibble;
    }

    break;
  }}

  // Now check for inherited classes
  p = p + n - 1;
  r_obj* last = *p;

  if (last == strings_data_frame) {
    return VCTRS_CLASS_data_frame;
  } else if (last == strings_list) {
    return VCTRS_CLASS_list;
  }

  return VCTRS_CLASS_unknown;
}

bool class_type_is_data_frame(enum vctrs_class_type type) {
  switch (type) {
  case VCTRS_CLASS_data_frame:
  case VCTRS_CLASS_bare_data_frame:
  case VCTRS_CLASS_bare_tibble:
    return true;
  default:
    return false;
  }
}

void col_detect_complete_switch(SEXP x, R_len_t size, int* p_out) {
  switch (vec_proxy_typeof(x)) {
  case VCTRS_TYPE_logical: lgl_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_integer: int_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_double: dbl_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_complex: cpl_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_character: chr_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_raw: raw_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_list: list_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_dataframe: r_stop_internal("Data frame columns should have been flattened by now.");
  case VCTRS_TYPE_null: r_abort("Unexpected `NULL` column found in a data frame.");
  case VCTRS_TYPE_scalar: stop_scalar_type(x, vec_args.empty, r_lazy_null);
  default: stop_unimplemented_vctrs_type("vec_detect_complete", vec_proxy_typeof(x));
  }
}

r_ssize col_detect_missing(r_obj* x,
                           r_ssize* v_loc,
                           r_ssize loc_size) {
  const enum vctrs_type type = vec_proxy_typeof(x);

  switch (type) {
  case VCTRS_TYPE_logical: return lgl_col_detect_missing(x, v_loc, loc_size);
  case VCTRS_TYPE_integer: return int_col_detect_missing(x, v_loc, loc_size);
  case VCTRS_TYPE_double: return dbl_col_detect_missing(x, v_loc, loc_size);
  case VCTRS_TYPE_complex: return cpl_col_detect_missing(x, v_loc, loc_size);
  case VCTRS_TYPE_raw: return raw_col_detect_missing(x, v_loc, loc_size);
  case VCTRS_TYPE_character: return chr_col_detect_missing(x, v_loc, loc_size);
  case VCTRS_TYPE_list: return list_col_detect_missing(x, v_loc, loc_size);
  case VCTRS_TYPE_dataframe: r_stop_internal("Data frame columns should have been flattened by now.");
  case VCTRS_TYPE_null: r_abort("Unexpected `NULL` column found in a data frame.");
  case VCTRS_TYPE_scalar: stop_scalar_type(x, vec_args.empty, r_lazy_null);
  default: stop_unimplemented_vctrs_type("vec_detect_missing", type);
  }
}

void col_detect_run_bounds_bool(r_obj* x, r_ssize size, enum vctrs_run_bound which, bool* v_out) {
  switch (vec_proxy_typeof(x)) {
  case VCTRS_TYPE_logical: lgl_col_detect_run_bounds_bool(x, size, which, v_out); break;
  case VCTRS_TYPE_integer: int_col_detect_run_bounds_bool(x, size, which, v_out); break;
  case VCTRS_TYPE_double: dbl_col_detect_run_bounds_bool(x, size, which, v_out); break;
  case VCTRS_TYPE_complex: cpl_col_detect_run_bounds_bool(x, size, which, v_out); break;
  case VCTRS_TYPE_character: chr_col_detect_run_bounds_bool(x, size, which, v_out); break;
  case VCTRS_TYPE_raw: raw_col_detect_run_bounds_bool(x, size, which, v_out); break;
  case VCTRS_TYPE_list: list_col_detect_run_bounds_bool(x, size, which, v_out); break;
  case VCTRS_TYPE_dataframe: r_stop_internal("Data frame columns should be flattened.");
  case VCTRS_TYPE_scalar: r_abort("Can't compare scalars.");
  default: r_abort("Unimplemented type.");
  }
}

SEXP colnames(SEXP x) {
  return vctrs_dispatch1(syms_colnames, fns_colnames,
                         syms_x, x);
}

r_obj* colnames2(r_obj* x) {
  r_obj* names = colnames(x);
  if (names == r_null) {
    return r_alloc_character(Rf_ncols(x));
  } else {
    return names;
  }
}

bool* compact_condition_begin(r_obj* x) {
  return (bool*) r_raw_begin(x);
}

const bool* compact_condition_cbegin(r_obj* x) {
  return (const bool*) r_raw_cbegin(x);
}

r_obj* compact_condition_materialize(r_obj* x) {
  const bool* v_x = compact_condition_cbegin(x);
  const r_ssize size = compact_condition_size(x);

  r_obj* out = KEEP(r_alloc_logical(size));
  int* v_out = r_lgl_begin(out);

  for (r_ssize i = 0; i < size; ++i) {
    v_out[i] = v_x[i];
  }

  FREE(1);
  return out;
}

r_obj* compact_condition_materialize_location(r_obj* x) {
  const bool* v_x = compact_condition_cbegin(x);
  const r_ssize size = compact_condition_size(x);
  return p_bool_which(v_x, size);
}

r_ssize compact_condition_size(r_obj* x) {
  // Should always be the same as the length, but you never know
  return r_length(x) / sizeof(bool);
}

r_ssize compact_condition_sum(r_obj* x) {
  const bool* v_x = compact_condition_cbegin(x);
  const r_ssize size = compact_condition_size(x);
  return p_bool_sum(v_x, size);
}

SEXP compact_rep(R_len_t i, R_len_t n) {
  if (n < 0) {
    r_stop_internal("Negative `n` in `compact_rep()`.");
  }

  SEXP rep = PROTECT(Rf_allocVector(INTSXP, 2));

  int* p = INTEGER(rep);
  init_compact_rep(p, i, n);

  r_attrib_poke_class(rep, compact_rep_classes);

  UNPROTECT(1);
  return rep;
}

SEXP compact_rep_materialize(SEXP x) {
  int i = r_int_get(x, 0);
  int n = r_int_get(x, 1);

  SEXP out = PROTECT(Rf_allocVector(INTSXP, n));
  r_int_fill(out, i, n);

  UNPROTECT(1);
  return out;
}

r_ssize compact_rownames_length(r_obj* x) {
  return abs(r_int_get(x, 1));
}

SEXP compact_seq(R_len_t start, R_len_t size, bool increasing) {
  if (start < 0) {
    r_stop_internal("`start` must not be negative.");
  }

  if (size < 0) {
    r_stop_internal("`size` must not be negative.");
  }

  if (!increasing && size > start + 1) {
    r_stop_internal("`size` must not be larger than `start` for decreasing sequences.");
  }

  SEXP info = PROTECT(Rf_allocVector(INTSXP, 3));

  int* p = INTEGER(info);
  init_compact_seq(p, start, size, increasing);

  r_attrib_poke_class(info, compact_seq_classes);

  UNPROTECT(1);
  return info;
}

SEXP compact_seq_materialize(SEXP x) {
  int* p = INTEGER(x);
  R_len_t start = p[0] + 1;
  R_len_t size = p[1];
  R_len_t step = p[2];

  SEXP out = PROTECT(Rf_allocVector(INTSXP, size));
  int* out_data = INTEGER(out);

  for (R_len_t i = 0; i < size; ++i, ++out_data, start += step) {
    *out_data = start;
  }

  UNPROTECT(1);
  return out;
}

r_ssize compute_iter_loc(r_ssize size, enum vctrs_run_bound which) {
  switch (which) {
  case VCTRS_RUN_BOUND_start: return 0;
  case VCTRS_RUN_BOUND_end: return size - 1;
  default: r_stop_internal("Unknown `which` value.");
  }
}

r_ssize compute_iter_step(enum vctrs_run_bound which) {
  switch (which) {
  case VCTRS_RUN_BOUND_start: return 1;
  case VCTRS_RUN_BOUND_end: return -1;
  default: r_stop_internal("Unknown `which` value.");
  }
}

r_obj* compute_nesting_container_info(r_obj* haystack,
                                      r_ssize size_haystack,
                                      const enum vctrs_ops* v_ops) {
  int n_prot = 0;

  const r_ssize n_cols = r_length(haystack);

  // Outputs:
  // - `haystack` order
  // - Container id vector
  // - Number of containers as a scalar
  // - Boolean for if there are any-non-equi conditions
  r_obj* out = KEEP_N(r_alloc_list(4), &n_prot);

  bool any_non_equi = false;
  int first_non_equi = 0;
  for (r_ssize i = 0; i < n_cols; ++i) {
    const enum vctrs_ops op = v_ops[i];

    if (op != VCTRS_OPS_eq) {
      any_non_equi = true;
      first_non_equi = i;
      break;
    }
  }

  if (!any_non_equi) {
    // Container info isn't required for only `==`
    r_list_poke(out, 0, vec_order(haystack, chrs_asc, chrs_smallest, true, r_null));
    r_list_poke(out, 1, r_globals.empty_int);
    r_list_poke(out, 2, r_int(1));
    r_list_poke(out, 3, r_lgl(any_non_equi));
    FREE(n_prot);
    return out;
  }

  r_obj* info = KEEP_N(vec_order_info(
    haystack,
    chrs_asc,
    chrs_smallest,
    true,
    r_null
  ), &n_prot);

  r_obj* o_haystack = r_list_get(info, 0);
  const int* v_o_haystack = r_int_cbegin(o_haystack);

  r_obj* group_sizes = r_list_get(info, 1);
  const int* v_group_sizes = r_int_cbegin(group_sizes);
  const r_ssize n_groups = r_length(group_sizes);

  // This is the haystack we compute container ids with.
  // This is initially the whole `haystack`, but will be adjusted to contain
  // fewer columns if there are `==` conditions before the first non-equi
  // condition.
  r_keep_loc haystack_container_pi;
  r_obj* haystack_container = haystack;
  KEEP_HERE(haystack_container, &haystack_container_pi);
  ++n_prot;

  // If there are `==` conditions before the first non-equi condition,
  // we separate those columns from the haystack and compute their group sizes,
  // which are used for computing the container ids.
  bool has_outer_group_sizes = false;
  const int* v_outer_group_sizes = NULL;

  if (first_non_equi != 0) {
    // We have equality comparisons before the first non-equi comparison.
    // In this case, we can skip nested containment ordering for the equality
    // comparisons before the first non-equi comparison if we pass on the
    // group sizes of the ordered equality columns as `v_outer_group_sizes`.
    r_obj* const* v_haystack = r_list_cbegin(haystack);
    r_obj* const* v_haystack_names = r_chr_cbegin(r_names(haystack));

    // "Outer" data frame columns before the first non-equi condition
    r_obj* haystack_outer = KEEP_N(r_alloc_list(first_non_equi), &n_prot);
    r_obj* haystack_outer_names = r_alloc_character(first_non_equi);
    r_attrib_poke_names(haystack_outer, haystack_outer_names);
    r_init_data_frame(haystack_outer, size_haystack);
    for (r_ssize i = 0; i < first_non_equi; ++i) {
      r_list_poke(haystack_outer, i, v_haystack[i]);
      r_chr_poke(haystack_outer_names, i, v_haystack_names[i]);
    }

    // "Inner" data frame columns at and after the first non-equi condition
    r_obj* haystack_inner = KEEP_N(r_alloc_list(n_cols - first_non_equi), &n_prot);
    r_obj* haystack_inner_names = r_alloc_character(n_cols - first_non_equi);
    r_attrib_poke_names(haystack_inner, haystack_inner_names);
    r_init_data_frame(haystack_inner, size_haystack);
    for (r_ssize i = first_non_equi, j = 0; i < n_cols; ++i, ++j) {
      r_list_poke(haystack_inner, j, v_haystack[i]);
      r_chr_poke(haystack_inner_names, j, v_haystack_names[i]);
    }

    // Compute the order info of the outer columns, just to pluck off the
    // group sizes. These automatically create a set of groups that
    // "surround" the non-equi columns.
    r_obj* info = vec_order_info(
      haystack_outer,
      chrs_asc,
      chrs_smallest,
      true,
      r_null
    );
    r_obj* outer_group_sizes = KEEP_N(r_list_get(info, 1), &n_prot);
    v_outer_group_sizes = r_int_cbegin(outer_group_sizes);
    has_outer_group_sizes = true;

    // Inner columns become the new container haystack
    haystack_container = haystack_inner;
    KEEP_AT(haystack_container, haystack_container_pi);
  }

  r_obj* container_ids_info = KEEP_N(compute_nesting_container_ids(
    haystack_container,
    v_o_haystack,
    v_group_sizes,
    v_outer_group_sizes,
    size_haystack,
    n_groups,
    has_outer_group_sizes
  ), &n_prot);

  const int n_containers = r_as_int(r_list_get(container_ids_info, 1));

  if (n_containers == 1) {
    // If only a single container exists at this point, either there was
    // only 1 non-equi column which must already be in order, or we hit the
    // somewhat rare case of having a >1 col `haystack_container` data frame
    // that is already in nested containment order. In that case, original
    // haystack ordering is sufficient and we don't need the ids.
    r_list_poke(out, 0, o_haystack);
    r_list_poke(out, 1, r_globals.empty_int);
    r_list_poke(out, 2, r_int(1));
    r_list_poke(out, 3, r_lgl(any_non_equi));
    FREE(n_prot);
    return out;
  }

  // Otherwise, we need to recompute the haystack ordering accounting for
  // `container_ids`. One way to do this is to append `container_ids` to the
  // front of the `haystack` data frame and recompute the order, but since
  // we already have `o_haystack` and `group_sizes`, we can build a simpler
  // proxy for `haystack` that orders the exact same, but faster. So we end
  // up with a two column data frame of `container_ids` and `haystack_proxy`
  // to compute the new order for.
  r_obj* container_ids = r_list_get(container_ids_info, 0);

  r_obj* haystack_proxy = KEEP_N(r_alloc_integer(size_haystack), &n_prot);
  int* v_haystack_proxy = r_int_begin(haystack_proxy);

  r_ssize loc_o_haystack = 0;

  // Insert group number as the proxy value
  for (r_ssize i = 0; i < n_groups; ++i) {
    const r_ssize group_size = v_group_sizes[i];
    for (r_ssize j = 0; j < group_size; ++j) {
      v_haystack_proxy[v_o_haystack[loc_o_haystack] - 1] = i;
      ++loc_o_haystack;
    }
  }

  r_obj* df = KEEP_N(r_alloc_list(2), &n_prot);
  r_list_poke(df, 0, container_ids);
  r_list_poke(df, 1, haystack_proxy);

  r_obj* df_names = r_alloc_character(2);
  r_attrib_poke_names(df, df_names);
  r_chr_poke(df_names, 0, r_str("container_ids"));
  r_chr_poke(df_names, 1, r_str("haystack_proxy"));

  r_init_data_frame(df, size_haystack);

  o_haystack = KEEP_N(vec_order(
    df,
    chrs_asc,
    chrs_smallest,
    true,
    r_null
  ), &n_prot);

  r_list_poke(out, 0, o_haystack);
  r_list_poke(out, 1, container_ids);
  r_list_poke(out, 2, r_int(n_containers));
  r_list_poke(out, 3, r_lgl(any_non_equi));

  FREE(n_prot);
  return out;
}

r_ssize compute_size(r_ssize size, r_obj* conditions) {
  if (size != -1) {
    return size;
  }

  if (r_length(conditions) == 0) {
    return 0;
  }

  return r_length(r_list_get(conditions, 0));
}

void counters_increment(struct counters* counters) {
  ++(counters->next);
}

uint32_t cpl_dict_hash_scalar(struct dictionary* d, R_len_t i) {
  return cpl_dict_hash_with(d, d, i);
}

uint32_t cpl_dict_hash_with(struct dictionary* d, struct dictionary* x, R_len_t i) {
  DICT_HASH_WITH(p_cpl_equal_na_equal);
}

bool cpl_dict_is_incomplete(struct dictionary* d, R_len_t i) {
  return dict_hash_is_missing(d, i) && p_cpl_is_incomplete(d->p_poly_vec->p_vec, i);
}

static inline int cpl_equal_na_equal(Rcomplex x, Rcomplex y) {
  return dbl_equal_na_equal(x.r, y.r) && dbl_equal_na_equal(x.i, y.i);
}

static inline uint32_t cpl_hash_scalar(r_complex x) {
  uint32_t hash = 0;
  hash = hash_combine(hash, dbl_hash_scalar(x.r));
  hash = hash_combine(hash, dbl_hash_scalar(x.i));
  return hash;
}

bool cpl_is_missing(r_complex x) {
  return dbl_is_missing(x.r) || dbl_is_missing(x.i);
}

r_complex cpl_normalise_missing(r_complex x) {
  const double na = r_globals.na_dbl;
  const double nan = R_NaN;

  const enum vctrs_dbl r_type = dbl_classify(x.r);
  const enum vctrs_dbl i_type = dbl_classify(x.i);

  switch (r_type) {
  case VCTRS_DBL_number:
    switch (i_type) {
    case VCTRS_DBL_number: return x;
    case VCTRS_DBL_missing: return (r_complex) { .r = na, .i = na};
    case VCTRS_DBL_nan: return (r_complex) { .r = nan, .i = nan};
    }
  case VCTRS_DBL_missing:
    switch (i_type) {
    case VCTRS_DBL_number: return (r_complex) { .r = na, .i = na};
    case VCTRS_DBL_missing: return x;
    case VCTRS_DBL_nan: return x;
    }
  case VCTRS_DBL_nan:
    switch (i_type) {
    case VCTRS_DBL_number: return (r_complex) { .r = nan, .i = nan};
    case VCTRS_DBL_missing: return x;
    case VCTRS_DBL_nan: return x;
    }
  }

  never_reached("cpl_normalise_missing");
}

SEXP date_as_date(SEXP x) {
  return date_validate(x);
}

SEXP date_as_posixct(SEXP x, SEXP to) {
  SEXP tzone = PROTECT(tzone_get(to));

  // Date -> character -> POSIXct
  // This is the only way to retain the same clock time
  SEXP out = PROTECT(r_date_as_character(x));
  out = PROTECT(r_chr_date_as_posixct(out, tzone));

  UNPROTECT(3);
  return out;
}

SEXP date_as_posixlt(SEXP x, SEXP to) {
  SEXP tzone = PROTECT(tzone_get(to));

  // Date -> character -> POSIXlt
  // This is the only way to retain the same clock time
  SEXP out = PROTECT(r_date_as_character(x));
  out = PROTECT(r_chr_date_as_posixlt(out, tzone));

  UNPROTECT(3);
  return out;
}

SEXP date_datetime_ptype2(SEXP x, SEXP y) {
  SEXP x_class = PROTECT(Rf_getAttrib(x, R_ClassSymbol));
  SEXP x_first_class = STRING_ELT(x_class, 0);

  SEXP tzone = (x_first_class == strings_date) ? tzone_get(y) : tzone_get(x);
  PROTECT(tzone);

  SEXP out = new_empty_datetime(tzone);

  UNPROTECT(2);
  return out;
}

static SEXP date_validate(SEXP x) {
  switch (TYPEOF(x)) {
  case REALSXP:
    return x;
  case INTSXP:
    // Keeps attributes
    return Rf_coerceVector(x, REALSXP);
  default:
    r_stop_internal("Corrupt `Date` with unknown type %s.",
                    Rf_type2char(TYPEOF(x)));
  }
}

static SEXP datetime_validate_type(SEXP x) {
  switch (TYPEOF(x)) {
  case REALSXP:
    return x;
  case INTSXP:
    // Keeps attributes
    return Rf_coerceVector(x, REALSXP);
  default:
    r_stop_internal("Corrupt `POSIXct` with unknown type %s.",
                    Rf_type2char(TYPEOF(x)));
  }

  never_reached("datetime_validate_type");
}

static SEXP datetime_validate_tzone(SEXP x) {
  SEXP tzone = Rf_getAttrib(x, syms_tzone);

  if (tzone != R_NilValue) {
    return x;
  }

  x = PROTECT(r_clone_referenced(x));

  Rf_setAttrib(x, syms_tzone, chrs_empty);

  UNPROTECT(1);
  return x;
}

void dbl_adjust_nan_distinct(
  const bool decreasing,
  const bool na_last,
  const r_ssize size,
  double* p_x_dbl,
  uint64_t* p_x_u64
) {
  const int direction = decreasing ? -1 : 1;
  const uint64_t na_u64 = na_last ? UINT64_MAX : 0;
  const uint64_t nan_u64 = na_last ? UINT64_MAX - 1 : 1;

  for (r_ssize i = 0; i < size; ++i) {
    double elt = p_x_dbl[i];
    const enum vctrs_dbl type = dbl_classify(elt);

    switch (type) {
    case VCTRS_DBL_number: {
      elt = elt * direction;
      p_x_u64[i] = dbl_map_to_uint64(elt);
      break;
    }
    case VCTRS_DBL_missing: {
      p_x_u64[i] = na_u64;
      break;
    }
    case VCTRS_DBL_nan: {
      p_x_u64[i] = nan_u64;
      break;
    }
    }
  }
}

void dbl_adjust_nan_identical(
  const bool decreasing,
  const bool na_last,
  const r_ssize size,
  double* p_x_dbl,
  uint64_t* p_x_u64
) {
  const int direction = decreasing ? -1 : 1;
  const uint64_t na_u64 = na_last ? UINT64_MAX : 0;

  for (r_ssize i = 0; i < size; ++i) {
    double elt = p_x_dbl[i];

    if (isnan(elt)) {
      p_x_u64[i] = na_u64;
      continue;
    }

    elt = elt * direction;
    p_x_u64[i] = dbl_map_to_uint64(elt);
  }
}

r_obj* dbl_as_integer(r_obj* x, bool* lossy) {
  double* data = r_dbl_begin(x);
  r_ssize n = r_length(x);

  r_obj* out = KEEP(r_alloc_integer(n));
  int* out_data = r_int_begin(out);

  for (r_ssize i = 0; i < n; ++i, ++data, ++out_data) {
    double elt = *data;

    if (elt <= INT_MIN || elt >= INT_MAX + 1.0) {
      *lossy = true;
      FREE(1);
      return r_null;
    }

    if (isnan(elt)) {
      *out_data = r_globals.na_int;
      continue;
    }

    int value = (int) elt;

    if (value != elt) {
      *lossy = true;
      FREE(1);
      return r_null;
    }

    *out_data = value;
  }

  FREE(1);
  return out;
}

r_obj* dbl_as_location(r_obj* subscript,
                       r_ssize n,
                       const struct location_opts* opts) {
  subscript = KEEP(vec_cast(subscript,
                            r_globals.empty_int,
                            vec_args.empty,
                            vec_args.empty,
                            r_lazy_null));
  subscript = int_as_location(subscript, n, opts);

  FREE(1);
  return subscript;
}

r_obj* dbl_as_logical(r_obj* x, bool* lossy) {
  double* data = r_dbl_begin(x);
  r_ssize n = r_length(x);

  r_obj* out = KEEP(r_alloc_logical(n));
  int* out_data = r_lgl_begin(out);

  for (r_ssize i = 0; i < n; ++i, ++data, ++out_data) {
    double elt = *data;

    if (isnan(elt)) {
      *out_data = r_globals.na_lgl;
      continue;
    }

    if (elt != 0 && elt != 1) {
      *lossy = true;
      FREE(1);
      return r_null;
    }

    *out_data = (int) elt;
  }

  FREE(1);
  return out;
}

r_obj* dbl_cast_subscript(r_obj* subscript,
                          const struct subscript_opts* opts,
                          ERR* err) {
  double* p = r_dbl_begin(subscript);
  r_ssize n = r_length(subscript);

  r_obj* out = KEEP(r_alloc_integer(n));
  int* out_p = r_int_begin(out);

  for (r_ssize i = 0; i < n; ++i) {
    double elt = p[i];

    // Generally `(int) nan` results in the correct `na_int` value,
    // but this is not guaranteed, so we have to explicitly check for it.
    // https://stackoverflow.com/questions/10366485/problems-casting-nan-floats-to-int
    if (isnan(elt)) {
      out_p[i] = r_globals.na_int;
      continue;
    }

    if (!isfinite(elt) || elt <= INT_MIN || elt > INT_MAX) {
      // Once we throw lazy errors from the cast method, we should
      // throw the error here as well
      FREE(1);
      return dbl_cast_subscript_fallback(subscript, opts, err);
    }

    int elt_int = (int) elt;

    if (elt != elt_int) {
      FREE(1);
      return dbl_cast_subscript_fallback(subscript, opts, err);
    }

    out_p[i] = elt_int;
  }

  FREE(1);
  return out;
}

r_obj* dbl_cast_subscript_fallback(r_obj* subscript,
                                   const struct subscript_opts* opts,
                                   ERR* err) {
  struct cast_opts cast_opts = {
    .x = subscript,
    .to = r_globals.empty_int,
    opts->subscript_arg
  };
  r_obj* out = KEEP(vec_cast_e(&cast_opts, err));
  if (*err) {
    r_obj* err_obj = KEEP(*err);

    r_obj* body = KEEP(vctrs_eval_mask1(syms_new_dbl_cast_subscript_body,
                                        syms_lossy_err, err_obj));

    *err = new_error_subscript_type(subscript, opts, body);
    FREE(3);
    return r_null;
  }

  FREE(1);
  return out;
}

enum vctrs_dbl dbl_classify(double x) {
  if (!isnan(x)) {
    return VCTRS_DBL_number;
  }

  union vctrs_dbl_indicator indicator;
  indicator.value = x;

  if (indicator.key[vctrs_indicator_pos] == 1954) {
    return VCTRS_DBL_missing;
  } else {
    return VCTRS_DBL_nan;
  }
}

int dbl_cmp(double x,
            double y,
            enum vctrs_dbl x_type,
            enum vctrs_dbl y_type,
            int direction,
            int na_order,
            int na_nan_order) {
  switch (x_type) {
  case VCTRS_DBL_number:
    switch (y_type) {
    case VCTRS_DBL_number: return dbl_cmp_numbers(x, y, direction);
    case VCTRS_DBL_missing: return -na_order;
    case VCTRS_DBL_nan: return -na_order;
    }
  case VCTRS_DBL_missing:
    switch (y_type) {
    case VCTRS_DBL_number: return na_order;
    case VCTRS_DBL_missing: return 0;
    case VCTRS_DBL_nan: return na_nan_order;
    }
  case VCTRS_DBL_nan:
    switch (y_type) {
    case VCTRS_DBL_number: return na_order;
    case VCTRS_DBL_missing: return -na_nan_order;
    case VCTRS_DBL_nan: return 0;
    }
  }
  never_reached("dbl_cmp");
}

int dbl_cmp_numbers(double x, double y, int direction) {
  const int cmp = (x > y) - (x < y);
  return cmp * direction;
}

int dbl_compare_na_equal(double x, double y) {
  enum vctrs_dbl x_class = dbl_classify(x);
  enum vctrs_dbl y_class = dbl_classify(y);

  switch (x_class) {
  case VCTRS_DBL_number: {
    switch (y_class) {
    case VCTRS_DBL_number: return dbl_compare_scalar(x, y);
    case VCTRS_DBL_missing: return 1;
    case VCTRS_DBL_nan: return 1;
    }
  }
  case VCTRS_DBL_missing: {
    switch (y_class) {
    case VCTRS_DBL_number: return -1;
    case VCTRS_DBL_missing: return 0;
    case VCTRS_DBL_nan: return 1;
    }
  }
  case VCTRS_DBL_nan: {
    switch (y_class) {
    case VCTRS_DBL_number: return -1;
    case VCTRS_DBL_missing: return -1;
    case VCTRS_DBL_nan: return 0;
    }
  }
  }

  r_stop_unreachable();
}

int dbl_compare_scalar(double x, double y) {
  return (x > y) - (x < y);
}

uint8_t dbl_compute_skips(const uint64_t* p_x, r_ssize size, bool* p_skips) {
  uint8_t radix_start = PASS_TO_RADIX(0, DBL_MAX_RADIX_PASS);
  uint8_t shift_start = radix_start * 8;

  for (uint8_t i = 0; i < DBL_MAX_RADIX_PASS; ++i) {
    p_skips[i] = true;
  }

  uint8_t p_bytes[DBL_MAX_RADIX_PASS];
  const uint64_t elt0 = p_x[0];

  // Get bytes of first element in MSD->LSD order.
  // Placed in `p_bytes` in a way that aligns with the `pass` variable
  for (uint8_t pass = 0, shift = shift_start;
       pass < DBL_MAX_RADIX_PASS;
       ++pass, shift += SHIFT_ADJUSTMENT) {
    p_bytes[pass] = dbl_extract_uint64_byte(elt0, shift);
  }

  // Check to see which passes are skippable
  for (r_ssize i = 1; i < size; ++i) {
    uint8_t n_skips = DBL_MAX_RADIX_PASS;
    const uint64_t elt = p_x[i];

    for (uint8_t pass = 0, shift = shift_start;
         pass < DBL_MAX_RADIX_PASS;
         ++pass, shift += SHIFT_ADJUSTMENT) {
      bool skip = p_skips[pass];

      if (skip) {
        p_skips[pass] = (p_bytes[pass] == dbl_extract_uint64_byte(elt, shift));
      } else {
        --n_skips;
      }
    }

    // No passes are skippable
    if (n_skips == 0) {
      break;
    }
  }

  uint8_t pass = 0;

  // Shift forward to the first pass with varying bytes
  while (pass < DBL_MAX_RADIX_PASS && p_skips[pass]) {
    ++pass;
  }

  return pass;
}

uint32_t dbl_dict_hash_scalar(struct dictionary* d, R_len_t i) {
  return dbl_dict_hash_with(d, d, i);
}

uint32_t dbl_dict_hash_with(struct dictionary* d, struct dictionary* x, R_len_t i) {
  DICT_HASH_WITH(p_dbl_equal_na_equal);
}

bool dbl_dict_is_incomplete(struct dictionary* d, R_len_t i) {
  return dict_hash_is_missing(d, i) && p_dbl_is_incomplete(d->p_poly_vec->p_vec, i);
}

static inline int dbl_equal_na_equal(double x, double y) {
  switch (dbl_classify(x)) {
  case VCTRS_DBL_number: return isnan(y) ? false : x == y;
  case VCTRS_DBL_missing: return dbl_classify(y) == VCTRS_DBL_missing;
  case VCTRS_DBL_nan: return dbl_classify(y) == VCTRS_DBL_nan;
  default: r_stop_unreachable();
  }
}

static inline int dbl_equal_na_propagate(double x, double y) {
  if (dbl_is_missing(x) || dbl_is_missing(y)) {
    return NA_LOGICAL;
  } else {
    // Faster than `dbl_equal_na_equal()`,
    // which has unneeded missing value checks
    return x == y;
  }
}

uint64_t dbl_flip_uint64(uint64_t x) {
  const uint64_t mask = (x & HEX_UINT64_SIGN) ? HEX_UINT64_ONES : HEX_UINT64_SIGN;
  return x ^ mask;
}

static inline uint32_t dbl_hash_scalar(double x) {
  // Seems like something designed specifically for doubles should work better
  // but I haven't been able to find anything

  // Hash all NAs and NaNs to same value (i.e. ignoring significand)
  double value;
  switch (dbl_classify(x)) {
  case VCTRS_DBL_number: value = x; break;
  case VCTRS_DBL_missing: value = NA_REAL; break;
  case VCTRS_DBL_nan: value = R_NaN; break;
  default: r_stop_unreachable();
  }

  // Treat positive/negative 0 as equivalent
  if (value == 0.0) {
    value = 0.0;
  }

  union {
    double d;
    uint64_t i;
  } value_union;

  value_union.d = value;
  return uint64_hash(value_union.i);
}

bool dbl_is_missing(double x) {
  return isnan(x);
}

void dbl_order(
  SEXP x,
  bool decreasing,
  bool na_last,
  bool nan_distinct,
  r_ssize size,
  struct order* p_order,
  struct lazy_raw* p_lazy_x_chunk,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  const double* p_x = REAL_RO(x);

  dbl_order_impl(
    p_x,
    decreasing,
    na_last,
    nan_distinct,
    size,
    true,
    p_order,
    p_lazy_x_chunk,
    p_lazy_x_aux,
    p_lazy_o_aux,
    p_lazy_bytes,
    p_lazy_counts,
    p_group_infos
  );
}

void dbl_order_chunk(
  bool decreasing,
  bool na_last,
  bool nan_distinct,
  r_ssize size,
  int* p_o,
  struct lazy_raw* p_lazy_x_chunk,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  void* p_x_chunk = p_lazy_x_chunk->p_data;

  dbl_order_chunk_impl(
    decreasing,
    na_last,
    nan_distinct,
    size,
    p_x_chunk,
    p_o,
    p_lazy_x_aux,
    p_lazy_o_aux,
    p_lazy_bytes,
    p_lazy_counts,
    p_group_infos
  );
}

void dbl_order_chunk_impl(
  bool decreasing,
  bool na_last,
  bool nan_distinct,
  r_ssize size,
  void* p_x,
  int* p_o,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  const enum vctrs_sortedness sortedness = dbl_sortedness(
    p_x,
    size,
    decreasing,
    na_last,
    nan_distinct,
    p_group_infos
  );

  if (sortedness != VCTRS_SORTEDNESS_unsorted) {
    ord_resolve_sortedness_chunk(sortedness, size, p_o);
    return;
  }

  dbl_adjust(decreasing, na_last, nan_distinct, size, p_x);

  if (size <= ORDER_INSERTION_BOUNDARY) {
    dbl_order_insertion(size, p_x, p_o, p_group_infos);
    return;
  }

  uint64_t* p_x_aux = (uint64_t*) init_lazy_raw(p_lazy_x_aux);

  int* p_o_aux = (int*) init_lazy_raw(p_lazy_o_aux);

  uint8_t* p_bytes = (uint8_t*) init_lazy_raw(p_lazy_bytes);

  r_ssize* p_counts = (r_ssize*) init_lazy_raw(p_lazy_counts);
  r_memset(p_counts, 0, p_lazy_counts->size);

  dbl_order_radix(
    size,
    p_x,
    p_o,
    p_x_aux,
    p_o_aux,
    p_bytes,
    p_counts,
    p_group_infos
  );
}

void dbl_order_impl(
  const double* p_x,
  bool decreasing,
  bool na_last,
  bool nan_distinct,
  r_ssize size,
  bool copy,
  struct order* p_order,
  struct lazy_raw* p_lazy_x_chunk,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  const enum vctrs_sortedness sortedness = dbl_sortedness(
    p_x,
    size,
    decreasing,
    na_last,
    nan_distinct,
    p_group_infos
  );

  // Handle sorted cases and set ordering to initialized
  if (sortedness != VCTRS_SORTEDNESS_unsorted) {
    int* p_o = p_order->p_data;
    ord_resolve_sortedness(sortedness, size, p_o);
    p_order->initialized = true;
    return;
  }

  int* p_o = init_order(p_order);

  void* p_x_chunk;
  if (copy) {
    p_x_chunk = init_lazy_raw(p_lazy_x_chunk);
    r_memcpy(p_x_chunk, p_x, size * sizeof(*p_x));
  } else {
    p_x_chunk = p_lazy_x_chunk->p_data;
  }

  dbl_adjust(decreasing, na_last, nan_distinct, size, p_x_chunk);

  if (size <= ORDER_INSERTION_BOUNDARY) {
    dbl_order_insertion(size, p_x_chunk, p_o, p_group_infos);
    return;
  }

  uint64_t* p_x_aux = (uint64_t*) init_lazy_raw(p_lazy_x_aux);

  int* p_o_aux = (int*) init_lazy_raw(p_lazy_o_aux);

  uint8_t* p_bytes = (uint8_t*) init_lazy_raw(p_lazy_bytes);

  r_ssize* p_counts = (r_ssize*) init_lazy_raw(p_lazy_counts);
  r_memset(p_counts, 0, p_lazy_counts->size);

  dbl_order_radix(
    size,
    p_x_chunk,
    p_o,
    p_x_aux,
    p_o_aux,
    p_bytes,
    p_counts,
    p_group_infos
  );
}

void dbl_order_insertion(
  const r_ssize size,
  uint64_t* p_x,
  int* p_o,
  struct group_infos* p_group_infos
) {
  // Don't think this can occur, but safer this way
  if (size == 0) {
    return;
  }

  for (r_ssize i = 1; i < size; ++i) {
    const uint64_t x_elt = p_x[i];
    const int o_elt = p_o[i];

    r_ssize j = i - 1;

    while (j >= 0) {
      const uint64_t x_cmp_elt = p_x[j];

      if (x_elt >= x_cmp_elt) {
        break;
      }

      int o_cmp_elt = p_o[j];

      // Swap
      p_x[j + 1] = x_cmp_elt;
      p_o[j + 1] = o_cmp_elt;

      // Next
      --j;
    }

    // Place original elements in new location
    // closer to start of the vector
    p_x[j + 1] = x_elt;
    p_o[j + 1] = o_elt;
  }

  // We've ordered a small chunk, we need to push at least one group size.
  // Depends on the post-ordered results so we have to do this
  // in a separate loop.
  r_ssize group_size = 1;
  uint64_t previous = p_x[0];

  for (r_ssize i = 1; i < size; ++i) {
    const uint64_t current = p_x[i];

    // Continue the current group run
    if (current == previous) {
      ++group_size;
      continue;
    }

    // Push current run size and reset size tracker
    groups_size_maybe_push(group_size, p_group_infos);
    group_size = 1;

    previous = current;
  }

  // Push final group run
  groups_size_maybe_push(group_size, p_group_infos);
}

void dbl_order_radix(
  const r_ssize size,
  uint64_t* p_x,
  int* p_o,
  uint64_t* p_x_aux,
  int* p_o_aux,
  uint8_t* p_bytes,
  r_ssize* p_counts,
  struct group_infos* p_group_infos
) {
  bool p_skips[DBL_MAX_RADIX_PASS];

  uint8_t pass = dbl_compute_skips(p_x, size, p_skips);

  // Skipped all passes - Happens when `x` is 1 value repeated
  if (pass == DBL_MAX_RADIX_PASS) {
    groups_size_maybe_push(size, p_group_infos);
    return;
  }

  dbl_order_radix_recurse(
    size,
    pass,
    p_x,
    p_o,
    p_x_aux,
    p_o_aux,
    p_bytes,
    p_counts,
    p_skips,
    p_group_infos
  );
}

r_obj* df_assign(r_obj* x,
                 r_obj* index,
                 r_obj* value,
                 const struct vec_proxy_assign_opts* p_opts) {
  r_obj* out = KEEP(vec_clone_referenced(x, p_opts->ownership));

  r_ssize n = r_length(out);

  if (r_length(value) != n) {
    r_stop_internal("Can't assign %d columns to df of length %d.",
                    r_length(value),
                    n);
  }

  // During assignment, if we have deep ownership over `x` we can
  // propagate that ownership to the columns, otherwise we have no
  // known ownership over the columns
  enum vctrs_ownership col_ownership;
  switch (p_opts->ownership) {
  case VCTRS_OWNERSHIP_foreign: col_ownership = VCTRS_OWNERSHIP_foreign; break;
  case VCTRS_OWNERSHIP_shallow: col_ownership = VCTRS_OWNERSHIP_foreign; break;
  case VCTRS_OWNERSHIP_deep: col_ownership = VCTRS_OWNERSHIP_deep; break;
  default: r_stop_unreachable();
  }

  const struct vec_proxy_assign_opts col_proxy_assign_opts = {
    .assign_names = p_opts->assign_names,
    .ignore_outer_names = p_opts->ignore_outer_names,
    .slice_value = p_opts->slice_value,
    .call = p_opts->call,
    .x_arg = p_opts->x_arg,
    .value_arg = p_opts->value_arg,
    .index_style = p_opts->index_style,
    .ownership = col_ownership,
    .recursively_proxied = p_opts->recursively_proxied
  };

  for (r_ssize i = 0; i < n; ++i) {
    r_obj* out_elt = r_list_get(out, i);
    r_obj* value_elt = r_list_get(value, i);

    // No need to cast or recycle because those operations are
    // recursive and have already been performed. However, proxy and
    // restore are not necessarily recursive and we might need to
    // proxy each element we recurse into.
    //
    // NOTE: `vec_proxy_assign_opts()` proxies `value_elt`.
    r_obj* proxy_elt = KEEP(p_opts->recursively_proxied ? out_elt : vec_proxy(out_elt));

    r_obj* assigned_elt = KEEP(vec_proxy_assign_opts(proxy_elt, index, value_elt, &col_proxy_assign_opts));

    if (!p_opts->recursively_proxied) {
      const struct vec_restore_opts col_restore_opts = {
        .ownership = col_ownership,
        .recursively_proxied = false
      };
      assigned_elt = vec_restore_opts(assigned_elt, out_elt, &col_restore_opts);
    }

    r_list_poke(out, i, assigned_elt);
    FREE(2);
  }

  FREE(1);
  return out;
}

r_obj* df_cast_loop(const struct cast_opts* opts, r_obj* names) {
  r_obj* x = opts->x;
  r_obj* to = opts->to;

  r_ssize len = r_length(names);

  r_obj* out = KEEP(r_alloc_list(len));
  r_attrib_poke(out, r_syms.names, names);

  r_ssize size = df_size(x);

  r_ssize i = 0;
  struct vctrs_arg* named_x_arg = new_subscript_arg(opts->p_x_arg, names, len, &i);
  KEEP(named_x_arg->shelter);

  struct vctrs_arg* named_to_arg = new_subscript_arg(opts->p_to_arg, names, len, &i);
  KEEP(named_to_arg->shelter);

  for (; i < len; ++i) {
    struct cast_opts col_opts = {
      .x = r_list_get(x, i),
      .to = r_list_get(to, i),
      .p_x_arg = named_x_arg,
      .p_to_arg = named_to_arg,
      .call = opts->call,
      .s3_fallback = opts->s3_fallback
    };
    r_obj* col = vec_cast_opts(&col_opts);

    r_list_poke(out, i, col);
  }

  // Restore data frame size before calling `vec_restore()`. `x` and
  // `to` might not have any columns to compute the original size.
  init_data_frame(out, size);
  r_attrib_poke(out, r_syms.row_names, df_rownames(x));

  FREE(3);
  return out;
}

r_obj* df_cast_opts(const struct cast_opts* opts) {
  r_obj* x_names = KEEP(r_names(opts->x));
  r_obj* to_names = KEEP(r_names(opts->to));

  if (x_names == r_null || to_names == r_null) {
    r_stop_internal("Data frame must have names.");
  }

  r_obj* out = r_null;

  if (obj_equal(x_names, to_names)) {
    out = df_cast_loop(opts, x_names);
  } else {
    out = df_cast_match(opts, x_names, to_names);
  }

  FREE(2);
  return out;
}

void df_detect_run_bounds_bool(r_obj* x, r_ssize size, enum vctrs_run_bound which, bool* v_out) {
  if (size == 0) {
    // Algorithm requires at least 1 value
    return;
  }

  const r_ssize n_col = r_length(x);
  r_obj* const* v_x = r_list_cbegin(x);

  r_ssize loc = compute_iter_loc(size, which);
  const r_ssize step = compute_iter_step(which);

  // `v_out` will eventually be `true` if we are in a run
  // continuation, and `false` if we are starting a new run.
  v_out[loc] = false;
  loc += step;

  for (r_ssize i = 1; i < size; ++i) {
    v_out[loc] = true;
    loc += step;
  }

  for (r_ssize i = 0; i < n_col; ++i) {
    col_detect_run_bounds_bool(v_x[i], size, which, v_out);
  }

  // Now invert to detect the bounds
  for (r_ssize i = 0; i < size; ++i) {
    v_out[i] = !v_out[i];
  }
}

uint32_t df_dict_hash_scalar(struct dictionary* d, R_len_t i) {
  return df_dict_hash_with(d, d, i);
}

uint32_t df_dict_hash_with(struct dictionary* d, struct dictionary* x, R_len_t i) {
  DICT_HASH_WITH(p_df_equal_na_equal);
}

bool df_dict_is_incomplete(struct dictionary* d, R_len_t i) {
  return dict_hash_is_missing(d, i) && p_df_is_incomplete(d->p_poly_vec->p_vec, i);
}

SEXP df_expand_args(SEXP x, SEXP args) {
  SEXP decreasing = VECTOR_ELT(args, 0);
  SEXP na_largest = VECTOR_ELT(args, 1);

  r_ssize n_decreasing = r_length(decreasing);
  r_ssize n_na_largest = r_length(na_largest);
  r_ssize n_cols = r_length(x);

  // They will be recycled correctly even if columns get flattened
  if (n_decreasing == 1 && n_na_largest == 1) {
    return args;
  }

  // Must start out with the same length as the number of columns
  if (n_decreasing != 1 && n_decreasing != n_cols) {
    Rf_errorcall(
      R_NilValue,
      "`direction` should have length 1 or length equal to the number of "
      "columns of `x` when `x` is a data frame."
    );
  }

  if (n_na_largest != 1 && n_na_largest != n_cols) {
    Rf_errorcall(
      R_NilValue,
      "`na_value` should have length 1 or length equal to the number of "
      "columns of `x` when `x` is a data frame."
    );
  }

  SEXP expansions = PROTECT(Rf_allocVector(INTSXP, n_cols));
  int* p_expansions = INTEGER(expansions);

  int size = 0;
  bool needs_expansion = false;

  // Compute expansion factor
  for (r_ssize i = 0; i < n_cols; ++i) {
    SEXP col = VECTOR_ELT(x, i);
    int expansion = vec_decreasing_expansion(col);

    if (expansion != 1) {
      needs_expansion = true;
    }

    p_expansions[i] = expansion;
    size += expansion;
  }

  if (!needs_expansion) {
    UNPROTECT(1);
    return args;
  }

  decreasing = expand_arg(decreasing, p_expansions, n_decreasing, size);
  SET_VECTOR_ELT(args, 0, decreasing);

  na_largest = expand_arg(na_largest, p_expansions, n_na_largest, size);
  SET_VECTOR_ELT(args, 1, na_largest);

  UNPROTECT(1);
  return args;
}

r_ssize df_first_missing(r_obj* x) {
  const r_ssize n_cols = r_length(x);
  const r_ssize size = vec_size(x);

  r_ssize i = 0;

  if (n_cols > 0) {
    // First perform a very cheap check to see if there is at least 1 missing
    // value in the first column. If not, then we are done. If there is at least
    // 1 missing value, we start the loop below from there by updating `i`. This
    // avoids the more expensive rowwise poly-op loop when there aren't any
    // missing values.
    r_obj* col = r_list_get(x, 0);
    i = vec_first_missing(col);

    if (i == size) {
      return size;
    }
  }

  int n_prot = 0;

  struct poly_vec* p_poly_x = new_poly_vec(x, VCTRS_TYPE_dataframe);
  KEEP_N(p_poly_x->shelter, &n_prot);
  const void* v_x = p_poly_x->p_vec;

  r_ssize out = size;

  for (; i < size; ++i) {
    if (p_df_is_missing(v_x, i)) {
      out = i;
      break;
    }
  }

  FREE(n_prot);
  return out;
}

r_ssize df_raw_size(r_obj* x) {
  r_ssize n = df_rownames_size(x);
  if (n >= 0) {
    return n;
  }

  return df_raw_size_from_list(x);
}

r_obj* df_repair_names(r_obj* x, struct name_repair_opts* name_repair) {
  r_obj* nms = KEEP(r_names(x));
  r_obj* repaired = KEEP(vec_as_names(nms, name_repair));

  // Should this go through proxy and restore so that classes can
  // update metadata and check invariants when special columns are
  // renamed?
  if (nms != repaired) {
    x = KEEP(r_clone_referenced(x));
    r_attrib_poke_names(x, repaired);
    FREE(1);
  }

  FREE(2);
  return x;
}

r_obj* df_rownames(r_obj* x) {
  return r_attrib_get(x, R_RowNamesSymbol);
}

r_obj* df_rownames_size_cb(r_obj* tag, r_obj* value, void* _data) {
  if (tag == r_syms.row_names) {
    // Found row names
    return value;
  } else {
    // Continue iterating
    return NULL;
  }
}

r_ssize df_size_from_n(r_obj* n) {
  if (r_typeof(n) != R_TYPE_integer || r_length(n) != 1) {
    r_abort("`n` must be an integer of size 1.");
  }

  r_ssize out = r_int_get(n, 0);

  if (out == r_globals.na_int) {
    r_abort("`n` can't be missing.");
  }
  if (out < 0) {
    r_abort("`n` can't be negative.");
  }

  return out;
}

bool dict_hash_is_missing(struct dictionary* d, R_len_t i) {
  return d->hash[i] == HASH_MISSING;
}

int dim2(
  int x_dimension,
  int y_dimension,
  int axis,
  r_obj* x,
  r_obj* y,
  struct vctrs_arg* p_x_arg,
  struct vctrs_arg* p_y_arg
) {
  if (x_dimension == y_dimension) {
    return x_dimension;
  } else if (x_dimension == 1) {
    return y_dimension;
  } else if (y_dimension == 1) {
    return x_dimension;
  } else {
    stop_incompatible_shape(x, y, x_dimension, y_dimension, axis, p_x_arg, p_y_arg);
  }
}

r_obj* dims_shape2(
  r_obj* x_dimensions,
  r_obj* y_dimensions,
  r_obj* x,
  r_obj* y,
  struct vctrs_arg* p_x_arg,
  struct vctrs_arg* p_y_arg
) {
  r_ssize x_dimensionality = r_length(x_dimensions);
  r_ssize y_dimensionality = r_length(y_dimensions);

  r_obj* max_dimensions;
  r_ssize max_dimensionality;
  r_ssize min_dimensionality;

  if (x_dimensionality >= y_dimensionality) {
    max_dimensions = x_dimensions;
    max_dimensionality = x_dimensionality;
    min_dimensionality = y_dimensionality;
  } else {
    max_dimensions = y_dimensions;
    max_dimensionality = y_dimensionality;
    min_dimensionality = x_dimensionality;
  }

  // Sanity check, should never be true
  if (max_dimensionality == 0) {
    r_stop_internal("`max_dimensionality` must have length.");
  }

  const int* p_x_dimensions = r_int_cbegin(x_dimensions);
  const int* p_y_dimensions = r_int_cbegin(y_dimensions);
  const int* p_max_dimensions = r_int_cbegin(max_dimensions);

  r_obj* out = KEEP(r_alloc_integer(max_dimensionality));
  int* p_out = r_int_begin(out);

  // Set the first axis to zero
  p_out[0] = 0;

  // Start loop at the second axis
  r_ssize i = 1;

  for (; i < min_dimensionality; ++i) {
    const int axis = i + 1;
    const int x_dimension = p_x_dimensions[i];
    const int y_dimension = p_y_dimensions[i];

    p_out[i] = dim2(x_dimension, y_dimension, axis, x, y, p_x_arg, p_y_arg);
  }

  for (; i < max_dimensionality; ++i) {
    p_out[i] = p_max_dimensions[i];
  }

  FREE(1);
  return out;
}

bool duplicated_any_loop(struct dictionary* d, R_len_t n) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: DUPLICATED_ANY_LOOP(nil_dict_hash_scalar); break;
  case VCTRS_TYPE_logical: DUPLICATED_ANY_LOOP(lgl_dict_hash_scalar); break;
  case VCTRS_TYPE_integer: DUPLICATED_ANY_LOOP(int_dict_hash_scalar); break;
  case VCTRS_TYPE_double: DUPLICATED_ANY_LOOP(dbl_dict_hash_scalar); break;
  case VCTRS_TYPE_complex: DUPLICATED_ANY_LOOP(cpl_dict_hash_scalar); break;
  case VCTRS_TYPE_character: DUPLICATED_ANY_LOOP(chr_dict_hash_scalar); break;
  case VCTRS_TYPE_raw: DUPLICATED_ANY_LOOP(raw_dict_hash_scalar); break;
  case VCTRS_TYPE_list: DUPLICATED_ANY_LOOP(list_dict_hash_scalar); break;
  case VCTRS_TYPE_dataframe: DUPLICATED_ANY_LOOP(df_dict_hash_scalar); break;
  default: stop_unimplemented_vctrs_type("duplicated_any_loop", d->p_poly_vec->type);
  }
}

bool equal_string(SEXP x, const char** x_utf8, SEXP y) {
  // Try fast pointer comparison
  if (x == y)
    return true;

  if (*x_utf8 == NULL)
    *x_utf8 = Rf_translateCharUTF8(x);

  // Try slower conversion to common encoding
  const char* y_utf = Rf_translateCharUTF8(y);
  return (strcmp(y_utf, *x_utf8) == 0);
}

SEXP expand_arg(
  SEXP arg,
  const int* p_expansions,
  r_ssize n_arg,
  r_ssize size
) {
  if (n_arg == 1) {
    return arg;
  }

  SEXP out = PROTECT(Rf_allocVector(LGLSXP, size));
  int* p_out = LOGICAL(out);

  int* p_arg = LOGICAL(arg);

  int k = 0;

  // Fill `out` with repeated `arg` values to match expanded size
  for (r_ssize i = 0; i < n_arg; ++i) {
    int col_arg = p_arg[i];
    int expansion = p_expansions[i];

    for (r_ssize j = 0; j < expansion; ++j) {
      p_out[k] = col_arg;
      ++k;
    }
  }

  UNPROTECT(1);
  return out;
}

static inline SEXP expr_protect(SEXP x) {
  switch (TYPEOF(x)) {
  case SYMSXP:
  case LANGSXP:
    return Rf_lang2(fns_quote, x);
  default:
    return x;
  }
}

SEXP fct_as_character(SEXP x, struct vctrs_arg* x_arg) {
  SEXP levels = PROTECT(Rf_getAttrib(x, R_LevelsSymbol));

  if (TYPEOF(levels) != STRSXP) {
    stop_corrupt_factor_levels(x, x_arg);
  }

  UNPROTECT(1);
  return Rf_asCharacterFactor(x);
}

SEXP fct_as_factor(SEXP x,
                   SEXP to,
                   bool* lossy,
                   struct vctrs_arg* x_arg,
                   struct vctrs_arg* to_arg) {

  SEXP x_levels = PROTECT(Rf_getAttrib(x, R_LevelsSymbol));
  SEXP to_levels = PROTECT(Rf_getAttrib(to, R_LevelsSymbol));

  if (TYPEOF(x_levels) != STRSXP) {
    stop_corrupt_factor_levels(x, x_arg);
  }

  if (TYPEOF(to_levels) != STRSXP) {
    stop_corrupt_factor_levels(to, to_arg);
  }

  SEXP out = fct_as_factor_impl(x, x_levels, to_levels, lossy, false);

  UNPROTECT(2);
  return out;
}

r_obj* ffi_altrep_lazy_character_is_materialized(r_obj* x) {
  return r_lgl(R_altrep_data2(x) != r_null);
}

r_obj* ffi_as_df_col(r_obj* x, r_obj* outer, r_obj* frame) {
  struct r_lazy error_call = { .x = frame, .env = r_null };
  bool allow_pack;
  return as_df_col(x, r_chr_get(outer, 0), &allow_pack, error_call);
}

r_obj* ffi_as_minimal_names(r_obj* names) {
  if (r_typeof(names) != R_TYPE_character) {
    r_abort("`names` must be a character vector");
  }

  r_ssize i = 0;
  r_ssize n = r_length(names);
  r_obj* const * v_names = r_chr_cbegin(names);

  for (; i < n; ++i) {
    if (v_names[i] == r_globals.na_str) {
      break;
    }
  }
  if (i == n) {
    return names;
  }

  names = KEEP(r_clone(names));

  for (; i < n; ++i) {
    if (v_names[i] == r_globals.na_str) {
      r_chr_poke(names, i, strings_empty);
    }
  }

  FREE(1);
  return names;
}

r_obj* ffi_as_not_s4(r_obj* x) {
  return r_as_not_s4(x);
}

r_obj* ffi_cast(r_obj* x,
                r_obj* to,
                r_obj* frame) {
  struct r_lazy x_arg_ = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_);

  struct r_lazy to_arg_ = { .x = syms.to_arg, .env = frame };
  struct vctrs_arg to_arg = new_lazy_arg(&to_arg_);

  struct r_lazy call = { .x = syms_call, .env = frame };

  return vec_cast(x, to, &x_arg, &to_arg, call);
}

r_obj* ffi_chr_is_ascii_or_utf8(r_obj* x) {
  const r_ssize size = r_length(x);
  r_obj* const* v_x = r_chr_cbegin(x);

  r_obj* out = KEEP(r_alloc_logical(size));
  int* v_out = r_lgl_begin(out);

  for (r_ssize i = 0; i < size; ++i) {
    v_out[i] = str_is_ascii_or_utf8(v_x[i]);
  }

  FREE(1);
  return out;
}

r_obj* ffi_compute_nesting_container_info(r_obj* haystack, r_obj* condition) {
  r_ssize n_cols = r_length(haystack);
  enum vctrs_ops* v_ops = (enum vctrs_ops*) R_alloc(n_cols, sizeof(enum vctrs_ops));
  parse_condition(condition, n_cols, v_ops);
  const r_ssize size_haystack = vec_size(haystack);
  return compute_nesting_container_info(haystack, size_haystack, v_ops);
}

r_obj* ffi_data_frame(r_obj* x,
                      r_obj* size,
                      r_obj* name_repair,
                      r_obj* frame) {
  struct r_lazy error_call = { .x = syms.dot_error_call, .env = frame };

  struct name_repair_opts name_repair_opts = new_name_repair_opts(name_repair,
                                                                  lazy_args.dot_name_repair,
                                                                  false,
                                                                  error_call);
  KEEP(name_repair_opts.shelter);

  r_ssize c_size = 0;
  if (size == r_null) {
    c_size = vec_size_common(x, 0, vec_args.empty, error_call);
  } else {
    c_size = vec_as_short_length(size, vec_args.dot_size, error_call);
  }

  r_obj* out = data_frame(x, c_size, &name_repair_opts, error_call);

  FREE(1);
  return out;
}

r_obj* ffi_df_ptype2_opts(r_obj* x, r_obj* y, r_obj* opts, r_obj* frame) {
  struct r_lazy x_arg_ = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_);

  struct r_lazy y_arg_ = { .x = syms.y_arg, .env = frame };
  struct vctrs_arg y_arg = new_lazy_arg(&y_arg_);

  struct r_lazy call = { .x = r_syms.call, .env = frame };

  const enum s3_fallback s3_fallback = s3_fallback_from_opts(opts);

  return df_ptype2(
    x,
    y,
    &x_arg,
    &y_arg,
    call,
    s3_fallback
  );
}

r_obj* ffi_interval_complement(r_obj* start,
                               r_obj* end,
                               r_obj* lower,
                               r_obj* upper) {
  return vec_interval_complement(start, end, lower, upper);
}

r_obj* ffi_interval_locate_containers(r_obj* start, r_obj* end) {
  return vec_interval_locate_containers(start, end);
}

r_obj* ffi_list_sizes(r_obj* x, r_obj* frame) {
  struct r_lazy call = { .x = frame, .env = r_null };
  return list_sizes(x, vec_args.x, call);
}

r_obj* ffi_obj_check_vector(r_obj* x, r_obj* frame) {
  struct r_lazy call = { .x = r_syms.call, .env = frame };

  struct r_lazy arg_lazy = { .x = r_syms.arg, .env = frame };
  struct vctrs_arg arg = new_lazy_arg(&arg_lazy);

  // Not exposed at the R level for single vector checks
  const enum vctrs_allow_null allow_null = VCTRS_ALLOW_NULL_no;

  obj_check_vector(x, allow_null, &arg, call);

  return r_null;
}

SEXP ffi_obj_encode_utf8(SEXP x) {
  return obj_encode_utf8(x);
}

r_obj* ffi_obj_equal(r_obj* x, r_obj* y) {
  return r_lgl(obj_equal(x, y));
}

r_obj* ffi_obj_is_list(r_obj* x) {
  return r_lgl(obj_is_list(x));
}

r_obj* ffi_obj_is_vector(r_obj* x) {
  // Not exposed at the R level for single vector checks
  const enum vctrs_allow_null allow_null = VCTRS_ALLOW_NULL_no;
  return r_lgl(obj_is_vector(x, allow_null));
}

r_obj* ffi_ptype(r_obj* x, r_obj* x_arg_ffi, r_obj* frame) {
  struct vctrs_arg x_arg = vec_as_arg(x_arg_ffi);
  struct r_lazy call = { .x = r_syms.call, .env = frame };
  return vec_ptype(x, &x_arg, call);
}

r_obj* ffi_ptype2(r_obj* x,
                  r_obj* y,
                  r_obj* frame) {
  struct r_lazy x_arg_ = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_);

  struct r_lazy y_arg_ = { .x = syms.y_arg, .env = frame };
  struct vctrs_arg y_arg = new_lazy_arg(&y_arg_);

  struct r_lazy call = { .x = syms_call, .env = frame };

  int _;
  return vec_ptype2(
    x,
    y,
    &x_arg,
    &y_arg,
    call,
    S3_FALLBACK_false,
    &_
  );
}

r_obj* ffi_ptype2_opts(r_obj* x,
                       r_obj* y,
                       r_obj* ffi_opts,
                       r_obj* frame) {
  struct r_lazy x_arg_ = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_);

  struct r_lazy y_arg_ = { .x = syms.y_arg, .env = frame };
  struct vctrs_arg y_arg = new_lazy_arg(&y_arg_);

  struct r_lazy call = { .x = r_syms.call, .env = frame, };

  enum s3_fallback s3_fallback = s3_fallback_from_opts(ffi_opts);

  int _;
  return vec_ptype2(
    x,
    y,
    &x_arg,
    &y_arg,
    call,
    s3_fallback,
    &_
  );
}

r_obj* ffi_recycle(r_obj* x,
                   r_obj* size_obj,
                   r_obj* frame) {
  if (x == r_null || size_obj == r_null) {
    return r_null;
  }

  struct r_lazy recycle_call = { .x = frame, .env = r_null };

  size_obj = KEEP(vec_cast(size_obj,
                           r_globals.empty_int,
                           vec_args.empty,
                           vec_args.empty,
                           recycle_call));
  R_len_t size = r_int_get(size_obj, 0);
  FREE(1);

  struct r_lazy x_arg_ = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_);

  struct r_lazy call = { .x = syms_call, .env = frame };

  return vec_recycle(x, size, &x_arg, call);
}

r_obj* ffi_size(r_obj* x, r_obj* frame) {
  struct r_lazy call = { .x = frame, .env = r_null };
  return r_len(vec_size_params(x, vec_args.x, call));
}

r_obj* ffi_typeof2(r_obj* x, r_obj* y) {
  enum vctrs_type2 type = vec_typeof2(x, y);
  return r_chr(vctrs_type2_as_str(type));
}

r_obj* ffi_typeof2_s3(r_obj* x, r_obj* y) {
  enum vctrs_type2_s3 type = vec_typeof2_s3(x, y);
  return r_chr(vctrs_type2_s3_as_str(type));
}

r_obj* ffi_vec_any_missing(r_obj* x) {
  return r_lgl(vec_any_missing(x));
}

r_obj* ffi_vec_bare_df_restore(r_obj* x, r_obj* to) {
  // Never own user objects
  const struct vec_restore_opts opts = {
    .ownership = VCTRS_OWNERSHIP_foreign,
    .recursively_proxied = false
  };
  return vec_bare_df_restore(x, to, &opts);
}

r_obj* ffi_vec_check_recyclable(r_obj* x, r_obj* ffi_size, r_obj* frame) {
  struct r_lazy call = { .x = r_syms.call, .env = frame };
  struct r_lazy arg_lazy = { .x = r_syms.arg, .env = frame };
  struct vctrs_arg arg = new_lazy_arg(&arg_lazy);

  const r_ssize size = r_arg_as_ssize(ffi_size, "size");

  // Not exposed at the R level for single vector checks
  const enum vctrs_allow_null allow_null = VCTRS_ALLOW_NULL_no;

  vec_check_recyclable(x, size, allow_null, &arg, call);

  return r_null;
}

r_obj* ffi_vec_check_size(r_obj* x, r_obj* ffi_size, r_obj* frame) {
  struct r_lazy call = { .x = r_syms.call, .env = frame };
  struct r_lazy arg_lazy = { .x = r_syms.arg, .env = frame };
  struct vctrs_arg arg = new_lazy_arg(&arg_lazy);

  const r_ssize size = r_arg_as_ssize(ffi_size, "size");

  // Not exposed at the R level for single vector checks
  const enum vctrs_allow_null allow_null = VCTRS_ALLOW_NULL_no;

  vec_check_size(x, size, allow_null, &arg, call);

  return r_null;
}

r_obj* ffi_vec_chop(r_obj* x, r_obj* indices, r_obj* sizes) {
  return vec_chop(x, indices, sizes);
}

r_obj* ffi_vec_detect_missing(r_obj* x) {
  return vec_detect_missing(x);
}

r_obj* ffi_vec_detect_run_bounds(r_obj* x, r_obj* ffi_start, r_obj* frame) {
  struct r_lazy error_call = { .x = frame, .env = r_null };
  const enum vctrs_run_bound which = as_run_bound(ffi_start, error_call);
  return vec_detect_run_bounds(x, which, error_call);
}

r_obj* ffi_vec_expand_grid(r_obj* xs,
                           r_obj* ffi_vary,
                           r_obj* ffi_name_repair,
                           r_obj* frame) {
  struct r_lazy error_call = { .x = syms.dot_error_call, .env = frame };

  enum vctrs_expand_vary vary = parse_vary(ffi_vary);

  struct name_repair_opts name_repair_opts = new_name_repair_opts(
    ffi_name_repair,
    lazy_args.dot_name_repair,
    false,
    error_call
  );
  KEEP(name_repair_opts.shelter);

  r_obj* out = vec_expand_grid(xs, vary, &name_repair_opts, error_call);

  FREE(1);
  return out;
}

r_obj* ffi_vec_identify_runs(r_obj* x, r_obj* frame) {
  struct r_lazy error_call = { .x = frame, .env = r_null };
  return vec_identify_runs(x, error_call);
}

r_obj* ffi_vec_pall(r_obj* ffi_xs, r_obj* ffi_missing, r_obj* ffi_size, r_obj* ffi_frame) {
  struct r_lazy xs_arg_lazy = { .x = syms.dot_arg, .env = ffi_frame };
  struct vctrs_arg xs_arg = new_lazy_arg(&xs_arg_lazy);

  const struct r_lazy error_call = { .x = syms.dot_error_call, .env = ffi_frame };

  const enum vec_parallel_missing missing = parse_vec_parallel_missing(ffi_missing, error_call);
  const r_ssize size = (ffi_size == r_null) ? -1 : r_arg_as_ssize(ffi_size, ".size");

  return vec_pall(ffi_xs, missing, size, &xs_arg, error_call);
}

r_obj* ffi_vec_pany(r_obj* ffi_xs, r_obj* ffi_missing, r_obj* ffi_size, r_obj* ffi_frame) {
  struct r_lazy xs_arg_lazy = { .x = syms.dot_arg, .env = ffi_frame };
  struct vctrs_arg xs_arg = new_lazy_arg(&xs_arg_lazy);

  const struct r_lazy error_call = { .x = syms.dot_error_call, .env = ffi_frame };

  const enum vec_parallel_missing missing = parse_vec_parallel_missing(ffi_missing, error_call);
  const r_ssize size = (ffi_size == r_null) ? -1 : r_arg_as_ssize(ffi_size, ".size");

  return vec_pany(ffi_xs, missing, size, &xs_arg, error_call);
}

r_obj* ffi_vec_rep_each(r_obj* x, r_obj* times, r_obj* frame) {
  struct r_lazy error_call = { .x = r_syms.error_call, .env = frame };

  struct r_lazy x_arg_lazy = { .x = syms.times_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_lazy);

  struct r_lazy times_arg_lazy = { .x = syms.times_arg, .env = frame };
  struct vctrs_arg times_arg = new_lazy_arg(&times_arg_lazy);

  return vec_rep_each(x, times, error_call, &x_arg, &times_arg);
}

r_obj* ffi_vec_restore(r_obj* x, r_obj* to) {
  // Never own user objects, so foreign ownership.
  // Hooked to `vec_restore()`, which is called after an R level non-recursive
  // `vec_proxy()`, so not recursively proxied.
  struct vec_restore_opts opts = {
    .ownership = VCTRS_OWNERSHIP_foreign,
    .recursively_proxied = false
  };
  return vec_restore_opts(x, to, &opts);
}

r_obj* ffi_vec_restore_default(r_obj* x, r_obj* to) {
  // Never own user objects
  return vec_restore_default(x, to, VCTRS_OWNERSHIP_foreign);
}

r_obj* ffi_vec_restore_recurse(r_obj* x, r_obj* to) {
  // Never own user objects, but we are restoring recursively here for testing purposes
  struct vec_restore_opts opts = {
    .ownership = VCTRS_OWNERSHIP_foreign,
    .recursively_proxied = true
  };
  return vec_restore_opts(x, to, &opts);
}

r_obj* ffi_vec_run_sizes(r_obj* x, r_obj* frame) {
  struct r_lazy error_call = { .x = frame, .env = r_null };
  return vec_run_sizes(x, error_call);
}

r_obj* ffi_vec_set_difference(r_obj* x,
                              r_obj* y,
                              r_obj* ptype,
                              r_obj* frame) {
  struct r_lazy call = { .x = r_syms.error_call, .env = frame };

  struct r_lazy x_arg_lazy = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_lazy);

  struct r_lazy y_arg_lazy = { .x = syms.y_arg, .env = frame };
  struct vctrs_arg y_arg = new_lazy_arg(&y_arg_lazy);

  return vec_set_difference(x, y, ptype, &x_arg, &y_arg, call);
}

r_obj* ffi_vec_set_intersect(r_obj* x,
                             r_obj* y,
                             r_obj* ptype,
                             r_obj* frame) {
  struct r_lazy call = { .x = r_syms.error_call, .env = frame };

  struct r_lazy x_arg_lazy = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_lazy);

  struct r_lazy y_arg_lazy = { .x = syms.y_arg, .env = frame };
  struct vctrs_arg y_arg = new_lazy_arg(&y_arg_lazy);

  return vec_set_intersect(x, y, ptype, &x_arg, &y_arg, call);
}

r_obj* ffi_vec_set_names(r_obj* x, r_obj* names) {
  // Comes from the R side, so `VCTRS_OWNERSHIP_foreign`
  return vec_set_names(x, names, VCTRS_OWNERSHIP_foreign);
}

r_obj* ffi_vec_set_symmetric_difference(r_obj* x,
                                        r_obj* y,
                                        r_obj* ptype,
                                        r_obj* frame) {
  struct r_lazy call = { .x = r_syms.error_call, .env = frame };

  struct r_lazy x_arg_lazy = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_lazy);

  struct r_lazy y_arg_lazy = { .x = syms.y_arg, .env = frame };
  struct vctrs_arg y_arg = new_lazy_arg(&y_arg_lazy);

  return vec_set_symmetric_difference(x, y, ptype, &x_arg, &y_arg, call);
}

r_obj* ffi_vec_set_union(r_obj* x,
                         r_obj* y,
                         r_obj* ptype,
                         r_obj* frame) {
  struct r_lazy call = { .x = r_syms.error_call, .env = frame };

  struct r_lazy x_arg_lazy = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_lazy);

  struct r_lazy y_arg_lazy = { .x = syms.y_arg, .env = frame };
  struct vctrs_arg y_arg = new_lazy_arg(&y_arg_lazy);

  return vec_set_union(x, y, ptype, &x_arg, &y_arg, call);
}

r_obj* ffi_vec_shape2(r_obj* x, r_obj* y, r_obj* frame) {
  struct r_lazy x_arg_ = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_);

  struct r_lazy y_arg_ = { .x = syms.y_arg, .env = frame };
  struct vctrs_arg y_arg = new_lazy_arg(&y_arg_);

  return vec_shape2(x, y, &x_arg, &y_arg);
}

r_obj* ffi_vec_shaped_ptype(r_obj* ptype, r_obj* x, r_obj* y, r_obj* frame) {
  struct r_lazy x_arg_ = { .x = syms.x_arg, .env = frame };
  struct vctrs_arg x_arg = new_lazy_arg(&x_arg_);

  struct r_lazy y_arg_ = { .x = syms.y_arg, .env = frame };
  struct vctrs_arg y_arg = new_lazy_arg(&y_arg_);

  return vec_shaped_ptype(ptype, x, y, &x_arg, &y_arg);
}

r_obj* ffi_vec_unrep(r_obj* x, r_obj* frame) {
  struct r_lazy error_call = { .x = frame, .env = r_null };
  return vec_unrep(x, error_call);
}

int fill_arg_buffer(struct vctrs_arg* arg,
                    char* buf,
                    r_ssize cur_size,
                    r_ssize tot_size) {
  if (arg->parent) {
    cur_size = fill_arg_buffer(arg->parent, buf, cur_size, tot_size);

    if (cur_size < 0) {
      return cur_size;
    }
  }

  r_ssize written = arg->fill(arg->data, buf + cur_size, tot_size - cur_size);

  if (written < 0) {
    return written;
  } else {
    return cur_size + written;
  }
}

static r_obj* generate_sys_call(const char* name, int** n_addr) {
  r_obj* sys_n = KEEP(r_int(0));
  *n_addr = r_int_begin(sys_n);

  r_obj* sys_args = KEEP(r_new_node(sys_n, r_null));
  r_obj* sys_call = KEEP(r_new_call(r_base_ns_get(name), sys_args));
  r_preserve(sys_call);

  FREE(3);
  return sys_call;
}

static inline SEXP get_opts_action(const struct subscript_opts* opts) {
  switch (opts->action) {
  case SUBSCRIPT_ACTION_DEFAULT: return R_NilValue;
  case SUBSCRIPT_ACTION_SUBSET: return chrs_subset;
  case SUBSCRIPT_ACTION_EXTRACT: return chrs_extract;
  case SUBSCRIPT_ACTION_ASSIGN: return chrs_assign;
  case SUBSCRIPT_ACTION_RENAME: return chrs_rename;
  case SUBSCRIPT_ACTION_REMOVE: return chrs_remove;
  case SUBSCRIPT_ACTION_NEGATE: return chrs_negate;
  }
  never_reached("get_opts_action");
}

r_obj* glue_as_name_spec(r_obj* spec) {
  if (!r_is_string(spec)) {
    r_abort("Glue specification in `.name_spec` must be a single string.");
  }
  return vctrs_dispatch1(syms_glue_as_name_spec, fns_glue_as_name_spec,
                         syms_internal_spec, spec);
}

struct group_info* groups_current(struct group_infos* p_group_infos) {
  return p_group_infos->p_p_group_info[p_group_infos->current];
}

r_ssize groups_realloc_size(r_ssize data_size, r_ssize max_data_size) {
  uint64_t new_data_size;

  if (data_size == 0) {
    // First allocation
    new_data_size = GROUP_DATA_SIZE_DEFAULT;
  } else {
    // Avoid potential overflow when doubling size
    new_data_size = ((uint64_t) data_size) * 2;
  }

  // Clamp maximum allocation size to the size of the input
  if (new_data_size > max_data_size) {
    return max_data_size;
  }

  // Can now safely cast back to `r_ssize`
  return (r_ssize) new_data_size;
}

void groups_size_maybe_push(r_ssize size, struct group_infos* p_group_infos) {
  if (p_group_infos->ignore_groups) {
    return;
  } else {
    groups_size_push(size, p_group_infos);
  }
}

void groups_size_push(r_ssize size, struct group_infos* p_group_infos) {
  if (size == 0) {
    Rf_errorcall(R_NilValue, "Internal error: Group `size` to push should never be zero.");
  }

  struct group_info* p_group_info = groups_current(p_group_infos);

  // Extend `data` as required - reprotects itself
  if (p_group_info->data_size == p_group_info->n_groups) {
    r_ssize new_data_size = groups_realloc_size(
      p_group_info->data_size,
      p_group_infos->max_data_size
    );

    group_realloc(new_data_size, p_group_info);
  }

  // Push group size
  p_group_info->p_data[p_group_info->n_groups] = size;

  // Bump number of groups
  ++p_group_info->n_groups;

  // Update max group size
  if (p_group_info->max_group_size < size) {
    p_group_info->max_group_size = size;
  }
}

void groups_swap(struct group_infos* p_group_infos) {
  if (p_group_infos->ignore_groups) {
    return;
  }

  struct group_info* p_group_info_pre = groups_current(p_group_infos);

  // Make the swap
  p_group_infos->current = 1 - p_group_infos->current;

  struct group_info* p_group_info_post = groups_current(p_group_infos);

  // Clear the info from last time the swap was made
  p_group_info_post->max_group_size = 0;
  p_group_info_post->n_groups = 0;

  // Ensure the new group info is at least as big as the old group info
  if (p_group_info_post->data_size < p_group_info_pre->data_size) {
    r_ssize new_data_size = p_group_info_pre->data_size;
    group_realloc(new_data_size, p_group_info_post);
  }
}

SEXP growable_values(struct growable* g) {
  return Rf_lengthgets(g->x, g->n);
}

r_ssize indices_out_size(struct vctrs_chop_indices* p_indices, r_obj* x) {
  if (p_indices->has_indices) {
    return r_length(p_indices->indices);
  } else if (p_indices->has_sizes) {
    return r_length(p_indices->sizes);
  } else {
    return vec_size(x);
  }
}

void init_bare_data_frame(r_obj* x, r_ssize n) {
  if (r_length(x) == 0) {
    r_attrib_poke(x, r_syms.names, r_globals.empty_chr);
  }

  init_compact_rownames(x, n);
}

void init_chr_poly_vec(struct poly_vec* p_poly_vec) {
  p_poly_vec->p_vec = (const void*) r_chr_cbegin(p_poly_vec->vec);
}

void init_compact_rep(int* p, R_len_t i, R_len_t n) {
  p[0] = i;
  p[1] = n;
}

void init_compact_rownames(r_obj* x, r_ssize n_rows) {
  r_obj* rn = KEEP(new_compact_rownames(n_rows));
  r_attrib_poke(x, r_syms.row_names, rn);
  FREE(1);
}

void init_compact_seq(int* p, R_len_t start, R_len_t size, bool increasing) {
  int step = increasing ? 1 : -1;

  p[0] = start;
  p[1] = size;
  p[2] = step;
}

void init_cpl_poly_vec(struct poly_vec* p_poly_vec) {
  p_poly_vec->p_vec = (const void*) r_cpl_cbegin(p_poly_vec->vec);
}

void init_data_frame(r_obj* x, r_ssize n) {
  r_attrib_poke(x, r_syms.class_, classes_data_frame);
  init_bare_data_frame(x, n);
}

void init_dbl_poly_vec(struct poly_vec* p_poly_vec) {
  p_poly_vec->p_vec = (const void*) r_dbl_cbegin(p_poly_vec->vec);
}

void init_df_poly_vec(struct poly_vec* p_poly_vec) {
  r_obj* df = p_poly_vec->vec;
  r_ssize n_col = r_length(df);

  r_obj* shelter = KEEP(r_alloc_list(4));

  r_list_poke(shelter, 0, p_poly_vec->shelter);
  p_poly_vec->shelter = shelter;

  r_obj* data_handle = KEEP(r_alloc_raw(sizeof(struct poly_df_data)));
  struct poly_df_data* data = (struct poly_df_data*) r_raw_begin(data_handle);
  r_list_poke(shelter, 1, data_handle);

  r_obj* col_type_handle = KEEP(r_alloc_raw(n_col * sizeof(enum vctrs_type)));
  enum vctrs_type* v_col_type = (enum vctrs_type*) r_raw_begin(col_type_handle);
  r_list_poke(shelter, 2, col_type_handle);

  r_obj* col_ptr_handle = KEEP(r_alloc_raw(n_col * sizeof(void*)));
  const void** v_col_ptr = (const void**) r_raw_begin(col_ptr_handle);
  r_list_poke(shelter, 3, col_ptr_handle);

  for (r_ssize i = 0; i < n_col; ++i) {
    r_obj* col = r_list_get(df, i);
    v_col_type[i] = vec_proxy_typeof(col);
    v_col_ptr[i] = r_vec_cbegin(col);
  }

  data->v_col_type = v_col_type;
  data->v_col_ptr = v_col_ptr;
  data->n_col = n_col;

  p_poly_vec->p_vec = (void*) data;

  FREE(4);
}

static void init_factor(SEXP x, SEXP levels) {
  if (TYPEOF(x) != INTSXP) {
    r_stop_internal("Only integers can be made into factors.");
  }

  Rf_setAttrib(x, R_LevelsSymbol, levels);
  Rf_setAttrib(x, R_ClassSymbol, classes_factor);
}

void init_int_poly_vec(struct poly_vec* p_poly_vec) {
  p_poly_vec->p_vec = (const void*) r_int_cbegin(p_poly_vec->vec);
}

void* init_lazy_raw(struct lazy_raw* p_x) {
  if (p_x->data != R_NilValue) {
    return p_x->p_data;
  }

  p_x->data = Rf_allocVector(RAWSXP, p_x->size);
  REPROTECT(p_x->data, p_x->data_pi);

  p_x->p_data = (void*) RAW(p_x->data);

  return p_x->p_data;
}

void init_lgl_poly_vec(struct poly_vec* p_poly_vec) {
  p_poly_vec->p_vec = (const void*) r_lgl_cbegin(p_poly_vec->vec);
}

void init_list_poly_vec(struct poly_vec* p_poly_vec) {
  p_poly_vec->p_vec = (const void*) r_list_cbegin(p_poly_vec->vec);
}

void init_nil_poly_vec(struct poly_vec* p_poly_vec) {
  p_poly_vec->p_vec = NULL;
}

int* init_order(struct order* p_order) {
  if (p_order->initialized) {
    return p_order->p_data;
  }

  // Initialize `x` with sequential 1-based ordering
  for (r_ssize i = 0; i < p_order->size; ++i) {
    p_order->p_data[i] = i + 1;
  }

  p_order->initialized = true;

  return p_order->p_data;
}

static void init_ordered(SEXP x, SEXP levels) {
  if (TYPEOF(x) != INTSXP) {
    r_stop_internal("Only integers can be made into ordered factors.");
  }

  Rf_setAttrib(x, R_LevelsSymbol, levels);
  Rf_setAttrib(x, R_ClassSymbol, classes_ordered);
}

void init_raw_poly_vec(struct poly_vec* p_poly_vec) {
  p_poly_vec->p_vec = (const void*) r_raw_cbegin(p_poly_vec->vec);
}

void int64_unpack(int64_t x, r_ssize i, double* v_left, double* v_right) {
  const uint64_t x_u64 = ((uint64_t) x) - INT64_MIN;

  const uint32_t left_u32 = (uint32_t) (x_u64 >> 32);
  const uint32_t right_u32 = (uint32_t) x_u64;

  v_left[i] = (double) left_u32;
  v_right[i] = (double) right_u32;
}

void int_adjust(
  const bool decreasing,
  const bool na_last,
  const r_ssize size,
  void* p_x
) {
  const int direction = decreasing ? -1 : 1;
  const uint32_t na_u32 = na_last ? UINT32_MAX : 0;
  const int na_shift = na_last ? -1 : 0;

  const int* p_x_int = (const int*) p_x;
  uint32_t* p_x_u32 = (uint32_t*) p_x;

  for (r_ssize i = 0; i < size; ++i) {
    int elt = p_x_int[i];

    if (elt == NA_INTEGER) {
      p_x_u32[i] = na_u32;
      continue;
    }

    elt = elt * direction + na_shift;

    p_x_u32[i] = int_map_to_uint32(elt);
  }
}

r_obj* int_as_double(r_obj* x, bool* lossy) {
  int* data = r_int_begin(x);
  r_ssize n = r_length(x);

  r_obj* out = KEEP(r_alloc_double(n));
  double* out_data = r_dbl_begin(out);

  for (r_ssize i = 0; i < n; ++i, ++data, ++out_data) {
    int elt = *data;
    *out_data = (elt == r_globals.na_int) ? r_globals.na_dbl : elt;
  }

  FREE(1);
  return out;
}

r_obj* int_as_logical(r_obj* x, bool* lossy) {
  int* data = r_int_begin(x);
  r_ssize n = r_length(x);

  r_obj* out = KEEP(r_alloc_logical(n));
  int* out_data = r_lgl_begin(out);

  for (r_ssize i = 0; i < n; ++i, ++data, ++out_data) {
    int elt = *data;

    if (elt == r_globals.na_int) {
      *out_data = r_globals.na_lgl;
      continue;
    }

    if (elt != 0 && elt != 1) {
      *lossy = true;
      FREE(1);
      return r_null;
    }

    *out_data = elt;
  }

  FREE(1);
  return out;
}

int int_cmp(int x, int y, const int direction, const int na_order) {
  if (x == NA_INTEGER) {
    if (y == NA_INTEGER) {
      return 0;
    } else {
      return na_order;
    }
  }

  if (y == NA_INTEGER) {
    return -na_order;
  }

  int cmp = (x > y) - (x < y);

  return cmp * direction;
}

int int_compare_na_equal(int x, int y) {
  return int_compare_scalar(x, y);
}

int int_compare_scalar(int x, int y) {
  return (x > y) - (x < y);
}

uint8_t int_compute_skips(const uint32_t* p_x, r_ssize size, bool* p_skips) {
  uint8_t radix_start = PASS_TO_RADIX(0, INT_MAX_RADIX_PASS);
  uint8_t shift_start = radix_start * 8;

  for (uint8_t i = 0; i < INT_MAX_RADIX_PASS; ++i) {
    p_skips[i] = true;
  }

  uint8_t p_bytes[INT_MAX_RADIX_PASS];
  const uint32_t elt0 = p_x[0];

  // Get bytes of first element in MSD->LSD order.
  // Placed in `p_bytes` in a way that aligns with the `pass` variable
  for (uint8_t pass = 0, shift = shift_start;
       pass < INT_MAX_RADIX_PASS;
       ++pass, shift += SHIFT_ADJUSTMENT) {
    p_bytes[pass] = int_extract_uint32_byte(elt0, shift);
  }

  // Check to see which passes are skippable
  for (r_ssize i = 1; i < size; ++i) {
    uint8_t n_skips = INT_MAX_RADIX_PASS;
    const uint32_t elt = p_x[i];

    for (uint8_t pass = 0, shift = shift_start;
         pass < INT_MAX_RADIX_PASS;
         ++pass, shift += SHIFT_ADJUSTMENT) {
      bool skip = p_skips[pass];

      if (skip) {
        p_skips[pass] = (p_bytes[pass] == int_extract_uint32_byte(elt, shift));
      } else {
        --n_skips;
      }
    }

    // No passes are skippable
    if (n_skips == 0) {
      break;
    }
  }

  uint8_t pass = 0;

  // Shift forward to the first pass with varying bytes
  while (pass < INT_MAX_RADIX_PASS && p_skips[pass]) {
    ++pass;
  }

  return pass;
}

uint32_t int_dict_hash_scalar(struct dictionary* d, R_len_t i) {
  return int_dict_hash_with(d, d, i);
}

uint32_t int_dict_hash_with(struct dictionary* d, struct dictionary* x, R_len_t i) {
  DICT_HASH_WITH(p_int_equal_na_equal);
}

bool int_dict_is_incomplete(struct dictionary* d, R_len_t i) {
  return dict_hash_is_missing(d, i) && p_int_is_incomplete(d->p_poly_vec->p_vec, i);
}

static inline int int_equal_na_equal(int x, int y) {
  return x == y;
}

static inline int int_equal_na_propagate(int x, int y) {
  if (int_is_missing(x) || int_is_missing(y)) {
    return NA_LOGICAL;
  } else {
    return int_equal_na_equal(x, y);
  }
}

r_obj* int_filter_missing(r_obj* subscript, r_ssize n_missing) {
  return int_filter(subscript, n_missing, r_globals.na_int);
}

r_obj* int_filter_zero(r_obj* subscript, r_ssize n_zero) {
  return int_filter(subscript, n_zero, 0);
}

static inline uint32_t int_hash_scalar(int x) {
  return uint32_hash(x);
}

void int_incr(r_ssize size, int* p_x) {
  for (r_ssize i = 0; i < size; ++i) {
    p_x[i] = i + 1;
  }
}

bool int_is_missing(int x) {
  return x == r_globals.na_int;
}

static inline uint32_t int_map_to_uint32(int x) {
  return ((uint32_t) x) ^ HEX_UINT32_SIGN_BIT;
}

void int_order(
  SEXP x,
  bool decreasing,
  bool na_last,
  r_ssize size,
  struct order* p_order,
  struct lazy_raw* p_lazy_x_chunk,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  const int* p_x = INTEGER_RO(x);

  const enum vctrs_sortedness sortedness = int_sortedness(
    p_x,
    size,
    decreasing,
    na_last,
    p_group_infos
  );

  // Handle sorted cases and set ordering to initialized
  if (sortedness != VCTRS_SORTEDNESS_unsorted) {
    int* p_o = p_order->p_data;
    ord_resolve_sortedness(sortedness, size, p_o);
    p_order->initialized = true;
    return;
  }

  if (size <= ORDER_INSERTION_BOUNDARY) {
    int* p_o = init_order(p_order);

    void* p_x_chunk = init_lazy_raw(p_lazy_x_chunk);
    r_memcpy(p_x_chunk, p_x, size * sizeof(*p_x));

    int_adjust(decreasing, na_last, size, p_x_chunk);

    int_order_insertion(size, p_x_chunk, p_o, p_group_infos);

    return;
  }

  uint32_t range;
  int x_min;

  int_compute_range(p_x, size, &x_min, &range);

  /*
   * If in counting order range and on the first column / single vector,
   * `p_o_aux` won't be used, so no need to initialize it.
   *
   * Also, `p_o` will be filled directly, so for performance we don't
   * initialize its order.
   */
  if (range < INT_ORDER_COUNTING_RANGE_BOUNDARY) {
    const bool initialized = false;

    int* p_o = p_order->p_data;
    int* p_o_aux = NULL;

    int_order_counting(
      p_x,
      size,
      x_min,
      range,
      initialized,
      decreasing,
      na_last,
      p_o,
      p_o_aux,
      p_group_infos
    );

    p_order->initialized = true;
    return;
  }

  int* p_o = init_order(p_order);

  int* p_o_aux = (int*) init_lazy_raw(p_lazy_o_aux);

  uint32_t* p_x_aux = (uint32_t*) init_lazy_raw(p_lazy_x_aux);

  uint8_t* p_bytes = (uint8_t*) init_lazy_raw(p_lazy_bytes);

  r_ssize* p_counts = (r_ssize*) init_lazy_raw(p_lazy_counts);
  r_memset(p_counts, 0, p_lazy_counts->size);

  // Copy `x` so we can modify in place
  void* p_x_chunk = init_lazy_raw(p_lazy_x_chunk);
  r_memcpy(p_x_chunk, p_x, size * sizeof(*p_x));

  int_adjust(decreasing, na_last, size, p_x_chunk);

  int_order_radix(
    size,
    p_x_chunk,
    p_o,
    p_x_aux,
    p_o_aux,
    p_bytes,
    p_counts,
    p_group_infos
  );
}

void int_order_chunk(
  bool decreasing,
  bool na_last,
  r_ssize size,
  int* p_o,
  struct lazy_raw* p_lazy_x_chunk,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  void* p_x_chunk = p_lazy_x_chunk->p_data;

  const enum vctrs_sortedness sortedness = int_sortedness(
    p_x_chunk,
    size,
    decreasing,
    na_last,
    p_group_infos
  );

  if (sortedness != VCTRS_SORTEDNESS_unsorted) {
    ord_resolve_sortedness_chunk(sortedness, size, p_o);
    return;
  }

  if (size <= ORDER_INSERTION_BOUNDARY) {
    int_adjust(decreasing, na_last, size, p_x_chunk);
    int_order_insertion(size, p_x_chunk, p_o, p_group_infos);
    return;
  }

  int* p_o_aux = (int*) init_lazy_raw(p_lazy_o_aux);

  uint32_t range;
  int x_min;

  int_compute_range(p_x_chunk, size, &x_min, &range);

  /*
   * If in counting order range and on the second or higher column, we will
   * need `p_o_aux` as working memory. At this point, `p_o` will have been
   * initialized from ordering the first column.
   */
  if (range < INT_ORDER_COUNTING_RANGE_BOUNDARY) {
    const bool initialized = true;

    int_order_counting(
      p_x_chunk,
      size,
      x_min,
      range,
      initialized,
      decreasing,
      na_last,
      p_o,
      p_o_aux,
      p_group_infos
    );

    return;
  }

  uint32_t* p_x_aux = (uint32_t*) init_lazy_raw(p_lazy_x_aux);

  uint8_t* p_bytes = (uint8_t*) init_lazy_raw(p_lazy_bytes);

  r_ssize* p_counts = (r_ssize*) init_lazy_raw(p_lazy_counts);
  r_memset(p_counts, 0, p_lazy_counts->size);

  int_adjust(decreasing, na_last, size, p_x_chunk);

  int_order_radix(
    size,
    p_x_chunk,
    p_o,
    p_x_aux,
    p_o_aux,
    p_bytes,
    p_counts,
    p_group_infos
  );
}

void int_order_insertion(
  const r_ssize size,
  uint32_t* p_x,
  int* p_o,
  struct group_infos* p_group_infos
) {
  // Don't think this can occur, but safer this way
  if (size == 0) {
    return;
  }

  for (r_ssize i = 1; i < size; ++i) {
    const uint32_t x_elt = p_x[i];
    const int o_elt = p_o[i];

    r_ssize j = i - 1;

    while (j >= 0) {
      const uint32_t x_cmp_elt = p_x[j];

      if (x_elt >= x_cmp_elt) {
        break;
      }

      int o_cmp_elt = p_o[j];

      // Swap
      p_x[j + 1] = x_cmp_elt;
      p_o[j + 1] = o_cmp_elt;

      // Next
      --j;
    }

    // Place original elements in new location
    // closer to start of the vector
    p_x[j + 1] = x_elt;
    p_o[j + 1] = o_elt;
  }

  // We've ordered a small chunk, we need to push at least one group size.
  // Depends on the post-ordered results so we have to do this
  // in a separate loop.
  r_ssize group_size = 1;
  uint32_t previous = p_x[0];

  for (r_ssize i = 1; i < size; ++i) {
    const uint32_t current = p_x[i];

    // Continue the current group run
    if (current == previous) {
      ++group_size;
      continue;
    }

    // Push current run size and reset size tracker
    groups_size_maybe_push(group_size, p_group_infos);
    group_size = 1;

    previous = current;
  }

  // Push final group run
  groups_size_maybe_push(group_size, p_group_infos);
}

void int_order_radix(
  const r_ssize size,
  uint32_t* p_x,
  int* p_o,
  uint32_t* p_x_aux,
  int* p_o_aux,
  uint8_t* p_bytes,
  r_ssize* p_counts,
  struct group_infos* p_group_infos
) {
  bool p_skips[INT_MAX_RADIX_PASS];

  uint8_t pass = int_compute_skips(p_x, size, p_skips);

  // Skipped all passes - Happens when `x` is 1 value repeated
  if (pass == INT_MAX_RADIX_PASS) {
    groups_size_maybe_push(size, p_group_infos);
    return;
  }

  int_order_radix_recurse(
    size,
    pass,
    p_x,
    p_o,
    p_x_aux,
    p_o_aux,
    p_bytes,
    p_counts,
    p_skips,
    p_group_infos
  );
}

r_obj* interval_order(r_obj* start,
                      r_obj* end,
                      r_obj* direction,
                      r_obj* na_value,
                      r_ssize size) {
  // Put them in a data frame to compute joint ordering
  r_obj* df = KEEP(r_new_list(2));
  r_list_poke(df, 0, start);
  r_list_poke(df, 1, end);

  r_obj* df_names = r_new_character(2);
  r_attrib_poke_names(df, df_names);
  r_chr_poke(df_names, 0, r_str("start"));
  r_chr_poke(df_names, 1, r_str("end"));

  r_init_data_frame(df, size);

  const bool nan_distinct = false;
  r_obj* chr_proxy_collate = r_null;

  r_obj* out = vec_order(
    df,
    direction,
    na_value,
    nan_distinct,
    chr_proxy_collate
  );

  FREE(1);
  return out;
}

bool is_bare_data_frame(r_obj* x) {
  return class_type(x) == VCTRS_CLASS_bare_data_frame;
}

bool is_compact_condition(r_obj* x) {
  return r_inherits(x, compact_condition_class_string);
}

bool is_compact_rep(SEXP x) {
  return r_inherits(x, compact_rep_class_string);
}

bool is_compact_seq(SEXP x) {
  return r_inherits(x, compact_seq_class_string);
}

bool is_condition_index(r_obj* index) {
  if (r_typeof(index) != R_TYPE_logical) {
    return false;
  }
  if (has_dim(index)) {
    return false;
  }
  if (r_is_object(index)) {
    return false;
  }
  return true;
}

bool is_data_frame(r_obj* x) {
  return
    r_typeof(x) == R_TYPE_list &&
    class_type_is_data_frame(class_type(x));
}

bool is_integer64(SEXP x) {
  return TYPEOF(x) == REALSXP && Rf_inherits(x, "integer64");
}

bool is_unique_names(r_obj* names) {
  if (r_typeof(names) != R_TYPE_character) {
    r_abort("`names` must be a character vector");
  }

  r_ssize n = r_length(names);
  r_obj* const * v_names = r_chr_cbegin(names);

  if (duplicated_any(names)) {
    return false;
  }

  for (r_ssize i = 0; i < n; ++i) {
    if (needs_suffix(v_names[i])) {
      return false;
    }
  }

  return true;
}

bool lgl_any_na(SEXP x) {
  R_xlen_t size = Rf_xlength(x);
  const int* p_x = LOGICAL_RO(x);

  for (R_xlen_t i = 0; i < size; ++i) {
    if (p_x[i] == NA_LOGICAL) {
      return true;
    }
  }

  return false;
}

r_obj* lgl_as_double(r_obj* x, bool* lossy) {
  int* data = r_lgl_begin(x);
  r_ssize n = r_length(x);

  r_obj* out = KEEP(r_alloc_double(n));
  double* out_data = r_dbl_begin(out);

  for (r_ssize i = 0; i < n; ++i, ++data, ++out_data) {
    int elt = *data;
    *out_data = (elt == r_globals.na_lgl) ? r_globals.na_dbl : elt;
  }

  FREE(1);
  return out;
}

r_obj* lgl_as_integer(r_obj* x, bool* lossy) {
  return Rf_coerceVector(x, INTSXP);
}

r_obj* lgl_as_location(r_obj* subscript,
                       r_ssize n,
                       const struct location_opts* opts) {
  r_ssize subscript_n = r_length(subscript);

  if (subscript_n == n) {
    bool na_propagate = false;

    switch (opts->missing) {
    case SUBSCRIPT_MISSING_PROPAGATE: na_propagate = true; break;
    case SUBSCRIPT_MISSING_REMOVE: break;
    case SUBSCRIPT_MISSING_ERROR: {
      if (lgl_any_na(subscript)) {
        stop_subscript_missing(subscript, opts);
      }
      break;
    }
    }

    return r_lgl_which(subscript, na_propagate);
  }

  /* A single `TRUE` or `FALSE` index is recycled to the full vector
   * size. This means `TRUE` is synonym for missing index (subscript.e. no
   * subsetting) and `FALSE` is synonym for empty index.
   *
   * We could return the missing argument as sentinel to avoid
   * materialising the index vector for the `TRUE` case but this would
   * make `vec_as_location()` an option type just to optimise a rather
   * uncommon case.
   */
  if (subscript_n == 1) {
    int elt = r_lgl_get(subscript, 0);

    r_ssize recycle_size = n;

    r_obj* out = r_null;
    r_keep_loc out_shelter;
    KEEP_HERE(out, &out_shelter);

    if (elt == r_globals.na_lgl) {
      switch (opts->missing) {
      case SUBSCRIPT_MISSING_PROPAGATE: {
        out = r_alloc_integer(n);
        KEEP_AT(out, out_shelter);
        r_int_fill(out, r_globals.na_int, n);
        break;
      }
      case SUBSCRIPT_MISSING_REMOVE: {
        out = r_copy(r_globals.empty_int);
        KEEP_AT(out, out_shelter);
        recycle_size = 0;
        break;
      }
      case SUBSCRIPT_MISSING_ERROR: {
        stop_subscript_missing(subscript, opts);
      }
      }
    } else if (elt) {
      out = r_alloc_integer(n);
      KEEP_AT(out, out_shelter);
      r_int_fill_seq(out, 1, n);
    } else {
      out = r_copy(r_globals.empty_int);
      KEEP_AT(out, out_shelter);
      recycle_size = 0;
    }

    r_obj* nms = KEEP(r_names(subscript));
    if (nms != R_NilValue) {
      r_obj* recycled_nms = r_alloc_character(recycle_size);
      r_attrib_poke_names(out, recycled_nms);
      r_chr_fill(recycled_nms, r_chr_get(nms, 0), recycle_size);
    }

    FREE(2);
    return out;
  }

  r_obj* n_obj = KEEP(r_int(n));
  stop_indicator_size(subscript, n_obj, opts);

  r_stop_unreachable();
}

int lgl_compare_na_equal(int x, int y) {
  return int_compare_scalar(x, y);
}

uint32_t lgl_dict_hash_scalar(struct dictionary* d, R_len_t i) {
  return lgl_dict_hash_with(d, d, i);
}

uint32_t lgl_dict_hash_with(struct dictionary* d, struct dictionary* x, R_len_t i) {
  DICT_HASH_WITH(p_lgl_equal_na_equal);
}

bool lgl_dict_is_incomplete(struct dictionary* d, R_len_t i) {
  return dict_hash_is_missing(d, i) && p_lgl_is_incomplete(d->p_poly_vec->p_vec, i);
}

static inline int lgl_equal_na_equal(int x, int y) {
  return x == y;
}

static inline int lgl_equal_na_propagate(int x, int y) {
  if (lgl_is_missing(x) || lgl_is_missing(y)) {
    return NA_LOGICAL;
  } else {
    return lgl_equal_na_equal(x, y);
  }
}

static inline uint32_t lgl_hash_scalar(int x) {
  return uint32_hash(x);
}

bool lgl_is_missing(int x) {
  return x == r_globals.na_int;
}

bool lgl_is_unspecified(SEXP x) {
  const r_ssize size = r_length(x);

  if (size == 0) {
    // We declare `logical()` to be <logical>, not <unspecified>
    return false;
  }

  const int* p_x = r_lgl_cbegin(x);

  for (r_ssize i = 0; i < size; ++i) {
    if (p_x[i] != r_globals.na_lgl) {
      return false;
    }
  }

  return true;
}

void lgl_order(
  SEXP x,
  bool decreasing,
  bool na_last,
  r_ssize size,
  struct order* p_order,
  struct lazy_raw* p_lazy_x_chunk,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  int_order(
    x,
    decreasing,
    na_last,
    size,
    p_order,
    p_lazy_x_chunk,
    p_lazy_x_aux,
    p_lazy_o_aux,
    p_lazy_bytes,
    p_lazy_counts,
    p_group_infos
  );
}

void lgl_order_chunk(
  bool decreasing,
  bool na_last,
  r_ssize size,
  int* p_o,
  struct lazy_raw* p_lazy_x_chunk,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  int_order_chunk(
    decreasing,
    na_last,
    size,
    p_o,
    p_lazy_x_chunk,
    p_lazy_x_aux,
    p_lazy_o_aux,
    p_lazy_bytes,
    p_lazy_counts,
    p_group_infos
  );
}

r_obj* list_assign(
  r_obj* x,
  r_obj* index,
  r_obj* value,
  enum vctrs_ownership ownership,
  enum assignment_slice_value slice_value,
  enum vctrs_index_style index_style
) {
  ASSIGN_BARRIER(r_obj*, r_list_cbegin, r_list_poke);
}

r_ssize list_col_detect_missing(r_obj* x,
                                r_ssize* v_loc,
                                r_ssize loc_size) {
  COL_DETECT_MISSING(r_obj*, r_list_cbegin, list_is_missing);
}

void list_col_detect_run_bounds_bool(r_obj* x, r_ssize size, enum vctrs_run_bound which, bool* v_out) {
  VEC_COL_DETECT_RUN_BOUNDS_BOOL(r_obj*, r_list_cbegin, list_equal_na_equal);
}

r_obj* list_combine_for_list_unchop(
  r_obj* xs,
  r_obj* indices,
  r_obj* ptype,
  r_obj* name_spec,
  const struct name_repair_opts* p_name_repair_opts,
  struct vctrs_arg* p_xs_arg,
  struct r_lazy error_call
) {
  const enum s3_fallback s3_fallback = r_is_true(r_peek_option("vctrs:::base_c_in_progress")) ?
      S3_FALLBACK_false :
      S3_FALLBACK_true;

  bool has_indices = indices != r_null;
  struct vctrs_arg* p_indices_arg = vec_args.indices;

  // If `!has_indices`, `list_combine()` will compute the size from the sizes of
  // `xs` and will ignore whatever we put here.
  r_ssize size = 0;

  if (has_indices) {
    // Sums the length of each `index` to compute the `size`
    //
    // This was the way that `list_unchop()` would compute the output size when
    // `indices` were provided. In `list_combine()`, the `size` is explicitly
    // required to account for a few edge cases and to work well with `default`.
    //
    // Note that `list_as_locations()` in `list_combine()` isn't allowed to
    // change the `index` size, which is the only reason this works from a
    // theoretical point of view.
    obj_check_list(indices, p_indices_arg, error_call);

    r_obj* const* v_indices = r_list_cbegin(indices);
    r_ssize indices_size = vec_size(indices);

    for (r_ssize i = 0; i < indices_size; ++i) {
      size += r_length(v_indices[i]);
    }
  }

  bool has_default = false;
  r_obj* default_ = r_null;
  struct vctrs_arg* p_default_arg = vec_args.empty;

  enum list_combine_unmatched unmatched = LIST_COMBINE_UNMATCHED_default;
  enum list_combine_multiple multiple = LIST_COMBINE_MULTIPLE_last;
  const enum assignment_slice_value slice_xs = ASSIGNMENT_SLICE_VALUE_no;
  const enum vctrs_index_style indices_style = VCTRS_INDEX_STYLE_location;

  r_obj* out = KEEP(list_combine_impl(
    xs,
    has_indices,
    indices,
    indices_style,
    size,
    has_default,
    default_,
    unmatched,
    multiple,
    slice_xs,
    ptype,
    name_spec,
    p_name_repair_opts,
    p_xs_arg,
    p_indices_arg,
    p_default_arg,
    error_call,
    s3_fallback
  ));

  if (vec_is_unspecified(out) && r_is_object(out)) {
    // The following `list_c()` and `list_unchop()` cases historically return
    // `NULL` because they don't have a `size` argument to maintain an invariant
    // for. `list_combine()` returns `unspecified` for these, because there
    // could be a `size > 0` argument supplied and we need to retain the size
    // invariant. We rectify the difference here.
    //
    // ```
    // vec_c()
    // vec_c(NULL)
    // list_unchop(list())
    // list_unchop(list(), indices = list())
    // list_unchop(list(NULL))
    // list_unchop(list(NULL), indices = list(integer()))
    // ```
    //
    // This is an ambiguous edge case that we've currently defined as also
    // returning `NULL`. `list_combine()` returns `unspecified[2]` here, but
    // that's clearer because `size` has to be explicitly provided.
    //
    // ```
    // list_unchop(list(NULL), indices = list(1:2))
    // ```
    //
    // We still want these cases to return `NA` even though they are technically
    // "unspecified" outputs, so we explicitly check if the output is an S3 object
    // as well, i.e. its an explicit `"vctrs_unspecified"` and not just a logical
    // vector of `NA`s.
    //
    // ```
    // vec_c(NA)
    // list_unchop(list(NA), indices = list(1))
    // ```
    out = r_null;
  }

  FREE(1);
  return out;
}

r_obj* list_combine_for_vec_c(
  r_obj* xs,
  r_obj* ptype,
  r_obj* name_spec,
  const struct name_repair_opts* p_name_repair_opts,
  struct vctrs_arg* p_xs_arg,
  struct r_lazy error_call
) {
  r_obj* indices = r_null;

  return list_combine_for_list_unchop(
    xs,
    indices,
    ptype,
    name_spec,
    p_name_repair_opts,
    p_xs_arg,
    error_call
  );
}

r_obj* list_combine_homogeneous_fallback(
  r_obj* xs,
  bool has_indices,
  r_obj* indices,
  enum vctrs_index_style indices_style,
  r_ssize size,
  bool has_default,
  r_obj* default_,
  enum list_combine_multiple multiple,
  enum assignment_slice_value slice_xs,
  r_obj* name_spec,
  struct vctrs_arg* p_xs_arg,
  struct vctrs_arg* p_default_arg,
  struct r_lazy error_call
) {
  return base_list_combine_fallback(
    xs,
    has_indices,
    indices,
    indices_style,
    size,
    has_default,
    default_,
    multiple,
    slice_xs,
    name_spec,
    p_xs_arg,
    p_default_arg,
    error_call
  );
}

r_obj* list_combine_impl(
  r_obj* xs,
  bool has_indices,
  r_obj* indices,
  enum vctrs_index_style indices_style,
  r_ssize size,
  bool has_default,
  r_obj* default_,
  enum list_combine_unmatched unmatched,
  enum list_combine_multiple multiple,
  enum assignment_slice_value slice_xs,
  r_obj* ptype,
  r_obj* name_spec,
  const struct name_repair_opts* p_name_repair_opts,
  struct vctrs_arg* p_xs_arg,
  struct vctrs_arg* p_indices_arg,
  struct vctrs_arg* p_default_arg,
  struct r_lazy error_call,
  enum s3_fallback s3_fallback
) {
  int n_protect = 0;

  obj_check_list(xs, p_xs_arg, error_call);

  r_obj* const* v_xs = r_list_cbegin(xs);
  r_ssize xs_size = vec_size(xs);

  // This is impossible with the exposed API, but let's sanity check
  if (!has_indices) {
    switch (multiple) {
    case LIST_COMBINE_MULTIPLE_last: break;
    case LIST_COMBINE_MULTIPLE_first: r_stop_internal("`multiple = 'first'` can't be set with sequential combination."); break;
    default: r_stop_unreachable();
    }
  }

  if (has_indices) {
    // Apply size/type checking to `indices` before possibly early exiting from
    // needing to apply a fallback
    obj_check_list(indices, p_indices_arg, error_call);
    vec_check_size(indices, xs_size, VCTRS_ALLOW_NULL_no, p_indices_arg, error_call);
  }

  // Sizes are reused by the sequential path when advancing the compact-seq index.
  // It's more efficient to build them once even though it requires an allocation.
  r_obj* xs_sizes = NULL;
  r_ssize* v_xs_sizes = NULL;

  if (!has_indices) {
    // Infer `size` from `xs` for `vec_c()` and `list_unchop(indices = NULL)`
    // sequential approach
    size = 0;

    xs_sizes = KEEP_N(r_alloc_raw(xs_size * sizeof(r_ssize)), &n_protect);
    v_xs_sizes = r_raw_begin(xs_sizes);

    for (r_ssize i = 0; i < xs_size; ++i) {
      r_obj* x = v_xs[i];
      r_ssize x_size = vec_size(x);
      size += x_size;
      v_xs_sizes[i] = x_size;
    }
  }

  if (has_indices && indices_style == VCTRS_INDEX_STYLE_location) {
    // Validate and convert `indices` if they exist.
    //
    // Note that we don't allow an individual `index` vector to change size
    // during validation. This is the only reason we can "infer" the output
    // size from the sum of the lengths of the `indices` before doing validation
    // and conversion. In particular:
    // - `NULL` indices become `integer()` (both size `0`).
    // - We don't allow character or logical indices.
    // - We don't allow negative or zero indices (these change the size).
    // - We don't allow oob indices (makes no sense since we inferred the size from lengths).
    // - Numeric `NA` propagates.
    //
    // Note that `compact_seq()` objects are valid `index` values for
    // `list_combine()`. We have tests to ensure it can handle them!
    //
    // There is nothing to validate for condition indices, they are logical vectors
    // where all 3 possible values are handled and we've already checked their sizes
    // match `size` in `compute_indices_style()`.
    const bool allow_compact = true;
    indices = KEEP_N(list_as_locations(indices, size, r_null, allow_compact), &n_protect);
  }

  // Perform `unmatched` check
  // (before fallback cases!)
  switch (unmatched) {
  case LIST_COMBINE_UNMATCHED_default: {
    // Will use `default` in unmatched locations
    break;
  }
  case LIST_COMBINE_UNMATCHED_error: {
    if (default_ != r_null) {
      r_abort_lazy_call(
        error_call,
        "Can't set %s when `unmatched = \"error\"`.",
        vec_arg_format(p_default_arg)
      );
    }
    if (!has_indices) {
      r_stop_internal("`indices` should have been required if `unmatched` was set.");
    }
    check_any_unmatched(indices, indices_style, size, error_call);
    break;
  }
  default: {
    r_stop_unreachable();
  }
  }

  ptype = KEEP_N(
    ptype_common_with_default(
      ptype,
      xs,
      has_default,
      default_,
      p_xs_arg,
      p_default_arg,
      error_call,
      s3_fallback
    ),
    &n_protect
  );

  if (needs_list_combine_common_class_fallback(ptype)) {
    r_obj* out = list_combine_common_class_fallback(
      xs,
      has_indices,
      indices,
      indices_style,
      size,
      has_default,
      default_,
      multiple,
      slice_xs,
      ptype,
      name_spec,
      p_name_repair_opts,
      p_xs_arg,
      p_indices_arg,
      p_default_arg,
      error_call
    );
    FREE(n_protect);
    return out;
  }

  if (needs_list_combine_homogeneous_fallback(xs, has_default, default_, ptype)) {
    r_obj* out = list_combine_homogeneous_fallback(
      xs,
      has_indices,
      indices,
      indices_style,
      size,
      has_default,
      default_,
      multiple,
      slice_xs,
      name_spec,
      p_xs_arg,
      p_default_arg,
      error_call
    );
    FREE(n_protect);
    return out;
  }

  if (ptype == r_null) {
    // Even when there are no inputs and we can't determine a `ptype`, the user
    // will have supplied a `size`, so as an invariant we should return
    // something with this `size`. Our size preserving identity type is
    // `<unspecified[size]>`, so we use that.
    //
    // We catch `<unspecified[0]>` in `vec_c()` and `list_unchop()` and return
    // `NULL` in those cases instead, because that is what they have historically
    // returned and you can't supply `size` there, so this only happens in the
    // empty input cases of those functions.
    //
    // Assuming `NULL` is roughly equivalent to `unspecified(0)`, this gives us:
    //
    // ```
    // vec_c()
    // #> NULL
    // list_unchop(list(), indices = list())
    // #> NULL
    // list_combine(list(), indices = list(), size = 0)
    // #> unspecified[0] # Consistent with size != 0 case.
    // list_combine(list(), indices = list(), size = 5)
    // #> unspecified[5] # Preserves size, good.
    // ```
    //
    // The most theoretically correct thing may be to return `unspecified(0)`
    // from `vec_c()` and `list_unchop()` as well, but we make a concious effort
    // to avoid exposing this type to users when we can. Since those functions
    // don't have the `size` invariant issue, `NULL` seems to be a good
    // alternative.
    // https://github.com/r-lib/vctrs/issues/1980
    ptype = vctrs_shared_empty_uns;
  }

  const bool assign_names = !r_inherits(name_spec, "rlang_zap");
  r_obj* xs_names = KEEP_N(r_names(xs), &n_protect);
  const bool xs_is_named = xs_names != r_null && !is_data_frame(ptype);

  r_keep_loc out_pi;
  r_obj* out = vec_init(ptype, size);
  KEEP_HERE(out, &out_pi);
  ++n_protect;

  out = vec_proxy_recurse(out);
  KEEP_AT(out, out_pi);

  // - We own the `proxy` container
  // - We own `proxy` recursively
  // - We call `vec_proxy_recurse()` so must restore recursively
  const struct vec_restore_opts restore_opts = {
    .ownership = VCTRS_OWNERSHIP_deep,
    .recursively_proxied = true
  };
 const struct vec_proxy_assign_opts proxy_assign_opts = {
    .ownership = VCTRS_OWNERSHIP_deep,
    .recursively_proxied = true,
    .slice_value = slice_xs,
    .index_style = indices_style,
    .assign_names = assign_names,
    .ignore_outer_names = true,
    .call = error_call
  };

  r_keep_loc out_names_pi;
  r_obj* out_names = r_null;
  KEEP_HERE(out_names, &out_names_pi);
  ++n_protect;

  r_ssize xs_i = 0;

  struct vctrs_arg* p_x_arg = new_subscript_arg(
    p_xs_arg,
    xs_names,
    xs_size,
    &xs_i
  );
  KEEP_N(p_x_arg->shelter, &n_protect);

  struct cast_opts cast_opts = {
    .to = ptype,
    .p_x_arg = p_x_arg,
    .call = error_call,
    .s3_fallback = s3_fallback
  };

  r_keep_loc x_pi;
  r_obj* x = r_null;
  KEEP_HERE(x, &x_pi);
  ++n_protect;

  r_keep_loc index_pi;
  r_obj* index = r_null;
  KEEP_HERE(index, &index_pi);
  ++n_protect;

  // For the sequential path
  r_ssize start = 0;
  int* v_index = NULL;

  if (!has_indices) {
    // Sequential path reuses the same compact sequence `index`
    index = compact_seq(0, 0, true);
    KEEP_AT(index, index_pi);
    v_index = r_int_begin(index);
  }

  for (r_ssize i = 0; i < xs_size; ++i) {
    switch (multiple) {
    case LIST_COMBINE_MULTIPLE_last: xs_i = i; break;
    case LIST_COMBINE_MULTIPLE_first: xs_i = xs_size - 1 - i; break;
    default: r_stop_unreachable();
    }

    x = v_xs[xs_i];

    if (x == r_null) {
      continue;
    }

    r_ssize index_size;

    // Advance `index`
    if (has_indices) {
      index = r_list_get(indices, xs_i);
      index_size = vec_subscript_size(index);
    } else {
      index_size = v_xs_sizes[xs_i];
      init_compact_seq(v_index, start, index_size, true);
    }

    // When we have `indices`, `x`'s size must be compatible with the `index`'s
    // size. This is dependent on `slice_xs` and `indices_style`.
    //
    // When we don't have `indices`, we derive the index sizes from
    // `x` itself so there is no reason to recheck the size.
    //
    // We don't actually recycle `x` because both `vec_proxy_assign_opts()` and
    // `chr_assign()` efficiently recycle size 1 inputs.
    if (has_indices) {
      check_recyclable_against_index(
        x,
        index,
        size,
        slice_xs,
        indices_style,
        p_x_arg,
        error_call
      );
    }

    // Handle optional names assignment
    if (assign_names) {
      r_obj* outer = xs_is_named ? r_chr_get(xs_names, xs_i) : r_null;
      r_obj* inner = KEEP(vec_names(x));
      r_obj* x_names = KEEP(apply_name_spec(name_spec, outer, inner, index_size));

      if (has_indices && x_names == r_null && out_names != r_null) {
        // We don't have names on this element, but `out_names` will exist.
        // Someone before us may have written to `out_names` at this `index` by
        // providing an overlapping `index`, so we must clear that.
        x_names = r_chrs.empty_string;
      }

      if (x_names != r_null) {
        R_LAZY_ALLOC(out_names, out_names_pi, R_TYPE_character, size);
        out_names = chr_assign(
          out_names,
          index,
          x_names,
          VCTRS_OWNERSHIP_deep,
          slice_xs,
          indices_style
        );
        KEEP_AT(out_names, out_names_pi);
      }

      FREE(2);
    }

    cast_opts.x = x;
    x = vec_cast_opts(&cast_opts);
    KEEP_AT(x, x_pi);

    out = vec_proxy_assign_opts(out, index, x, &proxy_assign_opts);
    KEEP_AT(out, out_pi);

    if (!has_indices) {
      start += index_size;
    }
  }

  if (has_default) {
    // `default` uses a slightly modified form of `proxy_assign_opts` and
    // `cast_opts`
    // - `default` is size 1 or size of the output, so uses
    //   `ASSIGNMENT_SLICE_VALUE_yes`.
    // - `default`'s index is always built using a special compact condition
    //   vector, so uses `VCTRS_INDEX_STYLE_condition`.
    // - `default` has its own special `p_default_arg`.
    struct vec_proxy_assign_opts default_proxy_assign_opts = proxy_assign_opts;
    default_proxy_assign_opts.index_style = VCTRS_INDEX_STYLE_condition;
    default_proxy_assign_opts.slice_value = ASSIGNMENT_SLICE_VALUE_yes;

    struct cast_opts default_cast_opts = cast_opts;
    default_cast_opts.p_x_arg = p_default_arg;

    // Compute `default` compact condition index
    index = compute_default_index(indices, indices_style, size);
    KEEP_AT(index, index_pi);

    // `default` recycles against the output size, not the `index`
    vec_check_recyclable(default_, size, VCTRS_ALLOW_NULL_no, p_default_arg, error_call);

    // Handle optional names assignment
    if (assign_names) {
      // `outer` names don't exist, but `name_spec` could still `zap()` any `inner` names
      r_obj* outer = r_null;
      r_obj* inner = KEEP(vec_names(default_));
      r_obj* x_names = KEEP(apply_name_spec(name_spec, outer, inner, size));

      if (x_names != r_null) {
        R_LAZY_ALLOC(out_names, out_names_pi, R_TYPE_character, size);
        out_names = chr_assign(
          out_names,
          index,
          x_names,
          VCTRS_OWNERSHIP_deep,
          default_proxy_assign_opts.slice_value,
          default_proxy_assign_opts.index_style
        );
        KEEP_AT(out_names, out_names_pi);
      }

      FREE(2);
    }

    default_cast_opts.x = default_;
    x = vec_cast_opts(&default_cast_opts);
    KEEP_AT(x, x_pi);

    out = vec_proxy_assign_opts(out, index, x, &default_proxy_assign_opts);
    KEEP_AT(out, out_pi);
  }

  if (
    s3_fallback == S3_FALLBACK_true &&
      is_data_frame(out) &&
      needs_df_list_combine_common_class_fallback(out)
  ) {
    // Perform the common class fallback on any columns of the
    // data frame that require it
    df_list_combine_common_class_fallback(
      out,
      xs,
      has_indices,
      indices,
      indices_style,
      size,
      has_default,
      default_,
      multiple,
      slice_xs,
      ptype,
      name_spec,
      p_name_repair_opts,
      p_indices_arg,
      error_call
    );
  }

  out = vec_restore_opts(out, ptype, &restore_opts);
  KEEP_AT(out, out_pi);

  if (out_names != r_null) {
    out_names = KEEP(vec_as_names(out_names, p_name_repair_opts));
    out = vec_set_names(out, out_names, restore_opts.ownership);
    FREE(1);
  } else if (!assign_names) {
    // FIXME: `vec_ptype2()` doesn't consistently zaps names, so `out`
    // might have been initialised with names. This branch can be
    // removed once #1020 is resolved.
    out = vec_set_names(out, r_null, restore_opts.ownership);
  }

  FREE(n_protect);
  return out;
}

r_obj* list_detect_missing(r_obj* x) {
  DETECT_MISSING(r_obj*, r_list_cbegin, list_is_missing);
}

void list_detect_run_bounds_bool(r_obj* x, r_ssize size, enum vctrs_run_bound which, bool* v_out) {
  VEC_DETECT_RUN_BOUNDS_BOOL(r_obj*, r_list_cbegin, list_equal_na_equal);
}

uint32_t list_dict_hash_scalar(struct dictionary* d, R_len_t i) {
  return list_dict_hash_with(d, d, i);
}

uint32_t list_dict_hash_with(struct dictionary* d, struct dictionary* x, R_len_t i) {
  DICT_HASH_WITH(p_list_equal_na_equal);
}

bool list_dict_is_incomplete(struct dictionary* d, R_len_t i) {
  return dict_hash_is_missing(d, i) && p_list_is_incomplete(d->p_poly_vec->p_vec, i);
}

r_obj* list_drop_empty(r_obj* x) {
  if (!obj_is_list(x)) {
    r_abort("`x` must be a list.");
  }

  r_ssize i = 0;
  const r_ssize size = vec_size(x);

  r_obj* const* v_x = r_list_cbegin(x);

  // Locate first element to drop
  for (; i < size; ++i) {
    if (vec_size(v_x[i]) == 0) {
      break;
    }
  }

  if (i == size) {
    // Nothing to drop
    return x;
  }

  r_obj* keep = KEEP(r_alloc_logical(size));
  int* v_keep = r_lgl_begin(keep);

  for (r_ssize j = 0; j < i; ++j) {
    // Keep everything before first element to drop
    v_keep[j] = true;
  }

  // `i` should be dropped so handle that here
  v_keep[i] = false;
  ++i;

  for (; i < size; ++i) {
    v_keep[i] = vec_size(v_x[i]) != 0;
  }

  r_obj* out = vec_slice(x, keep);

  FREE(1);
  return out;
}

r_obj* list_encode_utf8(r_obj* x) {
  bool owned = false;

  r_keep_loc pi;
  KEEP_HERE(x, &pi);

  r_ssize size = r_length(x);
  r_obj* const* p_x = r_list_cbegin(x);

  for (r_ssize i = 0; i < size; ++i) {
    r_obj* const elt_old = p_x[i];

    r_obj* const elt_new = obj_encode_utf8(elt_old);
    if (elt_old == elt_new) {
      continue;
    }
    KEEP(elt_new);

    if (!owned) {
      x = r_clone(x);
      KEEP_AT(x, pi);
      p_x = r_list_cbegin(x);
      owned = true;
    }

    r_list_poke(x, i, elt_new);
    FREE(1);
  }

  FREE(1);
  return x;
}

static inline int list_equal_na_equal(SEXP x, SEXP y) {
  return obj_equal_utf8(x, y);
}

static inline int list_equal_na_propagate(SEXP x, SEXP y) {
  if (list_is_missing(x) || list_is_missing(y)) {
    return NA_LOGICAL;
  } else {
    return list_equal_na_equal(x, y);
  }
}

r_ssize list_first_missing(r_obj* x) {
  FIRST_MISSING(r_obj*, r_list_cbegin, list_is_missing);
}

SEXP list_first_non_null(SEXP xs, R_len_t* non_null_i) {
  SEXP x = R_NilValue;
  R_len_t n = Rf_length(xs);

  R_len_t i = 0;
  for (; i < n; ++i) {
    x = VECTOR_ELT(xs, i);
    if (x != R_NilValue) {
      break;
    }
  }

  if (non_null_i) {
    *non_null_i = i;
  }
  return x;
}

static inline void list_hash_fill_na_equal(r_obj* x, r_ssize size, uint32_t* v_out) {
  HASH_FILL(r_obj*, r_list_cbegin, list_hash_scalar);
}

static inline void list_hash_fill_na_propagate(r_obj* x, r_ssize size, uint32_t* v_out) {
  HASH_FILL_NA_PROPAGATE(r_obj*, r_list_cbegin, list_hash_scalar, list_is_missing);
}

static inline uint32_t list_hash_scalar(r_obj* x) {
  return obj_hash(x);
}

bool list_is_missing(r_obj* x) {
  return x == r_null;
}

void load_with_haystack(struct dictionary* d, R_len_t n_haystack) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: LOAD_WITH_HAYSTACK(nil_dict_hash_scalar); break;
  case VCTRS_TYPE_logical: LOAD_WITH_HAYSTACK(lgl_dict_hash_scalar); break;
  case VCTRS_TYPE_integer: LOAD_WITH_HAYSTACK(int_dict_hash_scalar); break;
  case VCTRS_TYPE_double: LOAD_WITH_HAYSTACK(dbl_dict_hash_scalar); break;
  case VCTRS_TYPE_complex: LOAD_WITH_HAYSTACK(cpl_dict_hash_scalar); break;
  case VCTRS_TYPE_character: LOAD_WITH_HAYSTACK(chr_dict_hash_scalar); break;
  case VCTRS_TYPE_raw: LOAD_WITH_HAYSTACK(raw_dict_hash_scalar); break;
  case VCTRS_TYPE_list: LOAD_WITH_HAYSTACK(list_dict_hash_scalar); break;
  case VCTRS_TYPE_dataframe: LOAD_WITH_HAYSTACK(df_dict_hash_scalar); break;
  default: stop_unimplemented_vctrs_type("vec_match_loop", d->p_poly_vec->type);
  }
}

SEXP map(SEXP x, SEXP (*fn)(SEXP)) {
  R_len_t n = Rf_length(x);
  SEXP out = PROTECT(Rf_allocVector(VECSXP, n));

  for (R_len_t i = 0; i < n; ++i) {
    SET_VECTOR_ELT(out, i, fn(VECTOR_ELT(x, i)));
  }

  SEXP nms = PROTECT(Rf_getAttrib(x, R_NamesSymbol));
  Rf_setAttrib(out, R_NamesSymbol, nms);

  UNPROTECT(2);
  return out;
}

bool multiply_would_overflow(r_ssize x, r_ssize y) {
  return (double) x * y > R_LEN_T_MAX;
}

const char* name_repair_arg_as_c_string(enum name_repair_type type) {
  switch (type) {
  case NAME_REPAIR_none: return "none";
  case NAME_REPAIR_minimal: return "minimal";
  case NAME_REPAIR_unique: return "unique";
  case NAME_REPAIR_universal: return "universal";
  case NAME_REPAIR_check_unique: return "check_unique";
  case NAME_REPAIR_custom: return "custom";
  }
  r_stop_unreachable();
}

bool name_spec_is_inner(r_obj* name_spec) {
  if (!r_is_string(name_spec)) {
    return false;
  }

  const char* name_spec_c_string = r_chr_get_c_string(name_spec, 0);

  return !strcmp(name_spec_c_string, "inner");
}

r_obj* names_iota(r_ssize n) {
  char buf[MAX_IOTA_SIZE];
  r_obj* nms = r_chr_iota(n, buf, MAX_IOTA_SIZE, "...");

  if (nms == r_null) {
    r_abort("Too many names to repair.");
  }

  return nms;
}

bool needs_list_combine_common_class_fallback(r_obj* ptype) {
  if (!vec_is_common_class_fallback(ptype)) {
    return false;
  }

  // Suboptimal: Prevent infinite recursion through `vctrs_vctr` method
  r_obj* cls = r_attrib_get(ptype, syms_fallback_class);
  cls = r_chr_get(cls, r_length(cls) - 1);

  return cls != strings_vctrs_vctr;
}

bool needs_list_combine_homogeneous_fallback(
  r_obj* xs,
  bool has_default,
  r_obj* default_,
  r_obj* ptype
) {
  r_obj* first = list_first_non_null(xs, NULL);

  if (first == r_null && has_default) {
    // i.e. `list_combine(x = list(), default = foobar(1))`
    first = default_;
  }

  if (!obj_is_vector(first, VCTRS_ALLOW_NULL_no)) {
    return false;
  }

  // Never fall back for `vctrs_vctr` classes to avoid infinite
  // recursion through `c.vctrs_vctr()`
  if (r_inherits(first, "vctrs_vctr")) {
    return false;
  }

  r_obj* ptype_class = KEEP(r_class(ptype));

  if (!obj_has_class(first, ptype_class)) {
    // Cheap test before consulting `vec_ptype2()` and `c()` methods
    FREE(1);
    return false;
  }

  bool out = !vec_implements_ptype2(first) &&
    list_all_have_class(xs, ptype_class) &&
    (has_default ? obj_has_class(default_, ptype_class) : true) &&
    vec_implements_base_c(first);

  FREE(1);
  return out;
}

static bool needs_suffix(r_obj* str) {
  return
    str == r_globals.na_str ||
    str == strings_dots ||
    str == strings_empty ||
    is_dotdotint(r_str_c_string(str));
}

inline void never_reached(const char* fn) {
  Rf_error("Internal error in `%s()`: Reached the unreachable.", fn);
}

struct vctrs_chop_indices* new_chop_indices(r_obj* x, r_obj* indices, r_obj* sizes) {
  r_obj* shelter = KEEP(r_alloc_list(4));

  r_obj* self = r_alloc_raw(sizeof(struct vctrs_chop_indices));
  r_list_poke(shelter, 0, self);

  struct vctrs_chop_indices* p_indices = r_raw_begin(self);
  p_indices->shelter = shelter;

  p_indices->indices = indices;
  r_list_poke(p_indices->shelter, 1, p_indices->indices);
  p_indices->has_indices = p_indices->indices != r_null;

  p_indices->sizes = sizes;
  r_list_poke(p_indices->shelter, 2, p_indices->sizes);
  p_indices->has_sizes = p_indices->sizes != r_null;

  if (p_indices->has_indices) {
    p_indices->v_indices = r_list_cbegin(p_indices->indices);
    p_indices->v_sizes = NULL;
    p_indices->index = r_null;
    r_list_poke(p_indices->shelter, 3, p_indices->index);
    p_indices->p_index = NULL;
  } else if (p_indices->has_sizes) {
    p_indices->v_indices = NULL;
    p_indices->v_sizes = r_int_cbegin(p_indices->sizes);
    p_indices->index = compact_seq(0, 0, true);
    r_list_poke(p_indices->shelter, 3, p_indices->index);
    p_indices->p_index = r_int_begin(p_indices->index);
  } else {
    p_indices->v_indices = NULL;
    p_indices->v_sizes = NULL;
    p_indices->index = r_int(0);
    r_list_poke(p_indices->shelter, 3, p_indices->index);
    p_indices->p_index = r_int_begin(p_indices->index);
  }

  p_indices->loc = 0;

  FREE(1);
  return p_indices;
}

r_obj* new_compact_condition(R_xlen_t size) {
  if (size < 0) {
    r_stop_internal("Negative `size` in `compact_condition()`.");
  }

  r_obj* out = KEEP(r_alloc_raw(size * sizeof(bool)));

  r_attrib_poke_class(out, compact_condition_classes);

  FREE(1);
  return out;
}

r_obj* new_compact_rownames(r_ssize n_rows) {
  if (n_rows <= 0) {
    return r_globals.empty_int;
  }

  r_obj* out = r_alloc_integer(2);
  int* p_out = r_int_begin(out);
  p_out[0] = r_globals.na_int;
  p_out[1] = -n_rows;

  return out;
}

struct vctrs_arg new_counter_arg(struct vctrs_arg* parent,
                                 struct arg_data_counter* data) {
  return (struct vctrs_arg) {
    .parent = parent,
    .fill = &counter_arg_fill,
    .data = (void*) data
  };
}

struct arg_data_counter new_counter_arg_data(struct vctrs_arg* p_parent,
                                             r_ssize* i,
                                             r_obj** names) {
  return (struct arg_data_counter) {
    .p_parent = p_parent,
    .i = i,
    .names = names
  };
}

struct counters* new_counters(r_obj* names,
                              struct vctrs_arg* p_curr_arg,
                              struct vctrs_arg* p_parent_arg) {
  // This protects `shelter` and `names`
  r_obj* shelter = KEEP(r_alloc_list(COUNTERS_SHELTER_N));

  r_obj* data_shelter = r_alloc_raw(sizeof(struct counters));
  r_list_poke(shelter, COUNTERS_SHELTER_data, data_shelter);

  // `names` probably don't need to be protected, but we do so to be safe
  // (We used to use splice boxes, and `names` needed to be protected then,
  // but we no longer do as of #1578)
  r_list_poke(shelter, COUNTERS_SHELTER_names, names);

  struct counters* p_counters = r_raw_begin(data_shelter);
  p_counters->shelter = shelter;

  p_counters->curr = 0;
  p_counters->next = 0;

  p_counters->names = names;

  p_counters->curr_counter_arg_data = new_counter_arg_data(p_parent_arg,
                                                           &p_counters->curr,
                                                           &p_counters->names);
  p_counters->next_counter_arg_data = new_counter_arg_data(p_parent_arg,
                                                           &p_counters->next,
                                                           &p_counters->names);

  p_counters->curr_counter = new_counter_arg(p_parent_arg, (void*) &p_counters->curr_counter_arg_data);
  p_counters->next_counter = new_counter_arg(p_parent_arg, (void*) &p_counters->next_counter_arg_data);

  p_counters->curr_arg = p_curr_arg;
  p_counters->next_arg = (struct vctrs_arg*) &p_counters->next_counter;

  FREE(1);
  return p_counters;
}

r_obj* new_data_frame(r_obj* x, r_ssize n) {
  x = KEEP(r_clone_referenced(x));
  init_data_frame(x, n);

  FREE(1);
  return x;
}

static SEXP new_date(SEXP x) {
  if (TYPEOF(x) != REALSXP) {
    Rf_errorcall(R_NilValue, "`x` must be a double vector.");
  }

  SEXP names = PROTECT(r_names(x));

  SEXP out = PROTECT(r_clone_referenced(x));

  r_attrib_zap_all(out);
  r_attrib_poke_names(out, names);
  r_attrib_poke_class(out, classes_date);

  UNPROTECT(2);
  return out;
}

static SEXP new_datetime(SEXP x, SEXP tzone) {
  if (TYPEOF(x) != REALSXP) {
    Rf_errorcall(R_NilValue, "`x` must be a double vector.");
  }

  // Convenience special case where we allow a
  // null `tzone` to represent local time
  if (tzone == R_NilValue) {
    tzone = chrs_empty;
  }

  if (TYPEOF(tzone) != STRSXP) {
    Rf_errorcall(R_NilValue, "`tzone` must be a character vector or `NULL`.");
  }

  SEXP names = PROTECT(r_names(x));

  SEXP out = PROTECT(r_clone_referenced(x));

  r_attrib_zap_all(out);
  r_attrib_poke_names(out, names);
  r_attrib_poke_class(out, classes_posixct);
  r_attrib_poke(out, syms_tzone, tzone);

  UNPROTECT(2);
  return out;
}

static inline struct df_short_circuit_info new_df_short_circuit_info(R_len_t size, bool lazy) {
  SEXP row_known;
  bool* p_row_known;

  if (lazy) {
    row_known = PROTECT(R_NilValue);
    p_row_known = NULL;
  } else {
    row_known = PROTECT(Rf_allocVector(RAWSXP, size * sizeof(bool)));
    p_row_known = (bool*) RAW(row_known);

    // To begin with, no rows have a known comparison value
    r_memset(p_row_known, false, size * sizeof(bool));
  }

  struct df_short_circuit_info info = {
    .row_known = row_known,
    .p_row_known = p_row_known,
    .remaining = size,
    .size = size
  };

  UNPROTECT(1);
  return info;
}

struct dictionary* new_dictionary(SEXP x) {
  struct dictionary_opts opts = {
    .partial = false,
    .na_equal = true
  };
  return new_dictionary_opts(x, &opts);
}

static struct dictionary* new_dictionary_opts(SEXP x, struct dictionary_opts* opts) {
  int nprot = 0;

  SEXP out = PROTECT_N(Rf_allocVector(RAWSXP, sizeof(struct dictionary)), &nprot);
  struct dictionary* d = (struct dictionary*) RAW(out);

  d->protect = out;

  enum vctrs_type type = vec_proxy_typeof(x);

  struct poly_vec* p_poly_vec = new_poly_vec(x, type);
  KEEP_N(p_poly_vec->shelter, &nprot);
  d->p_poly_vec = p_poly_vec;

  d->used = 0;

  if (opts->partial) {
    d->key = NULL;
    d->size = 0;
  } else {
    uint32_t size = dict_key_size(x);

    d->key = (R_len_t*) R_alloc(size, sizeof(R_len_t));

    for (uint32_t i = 0; i < size; ++i) {
      d->key[i] = DICT_EMPTY;
    }

    d->size = size;
  }

  R_len_t n = vec_size(x);
  if (n) {
    d->hash = (uint32_t*) R_alloc(n, sizeof(uint32_t));

    if (!(d->hash)) {
      Rf_errorcall(R_NilValue, "Can't allocate hash lookup table. Please free memory.");
    }

    r_memset(d->hash, 0, n * sizeof(uint32_t));
    vec_hash_fill(x, n, opts->na_equal, d->hash);
  } else {
    d->hash = NULL;
  }

  UNPROTECT(nprot);
  return d;
}

static struct dictionary* new_dictionary_params(SEXP x, bool partial, bool na_equal) {
  struct dictionary_opts opts;
  opts.partial = partial;
  opts.na_equal = na_equal;
  return new_dictionary_opts(x, &opts);
}

struct dictionary* new_dictionary_partial(SEXP x) {
  struct dictionary_opts opts = {
    .partial = true,
    .na_equal = true
  };
  return new_dictionary_opts(x, &opts);
}

SEXP new_empty_factor(SEXP levels) {
  if (TYPEOF(levels) != STRSXP) {
    r_stop_internal("`level` must be a character vector.");
  }

  SEXP out = PROTECT(Rf_allocVector(INTSXP, 0));

  Rf_setAttrib(out, R_LevelsSymbol, levels);
  Rf_setAttrib(out, R_ClassSymbol, classes_factor);

  UNPROTECT(1);
  return out;
}

SEXP new_empty_ordered(SEXP levels) {
  SEXP out = PROTECT(Rf_allocVector(INTSXP, 0));

  Rf_setAttrib(out, R_LevelsSymbol, levels);
  Rf_setAttrib(out, R_ClassSymbol, classes_ordered);

  UNPROTECT(1);
  return out;
}

r_obj* new_error_subscript_type(r_obj* subscript,
                                const struct subscript_opts* opts,
                                r_obj* body) {
  r_obj* logical = subscript_type_action_chr(opts->logical);
  r_obj* numeric = subscript_type_action_chr(opts->numeric);
  r_obj* character = subscript_type_action_chr(opts->character);

  subscript = KEEP(expr_protect(subscript));
  r_obj* subscript_arg = KEEP(vctrs_arg(opts->subscript_arg));
  r_obj* ffi_call = r_lazy_eval_protect(opts->call);

  r_obj* syms[] = {
    syms_i,
    syms_subscript_arg,
    syms_subscript_action,
    syms_call,
    syms_logical,
    syms_numeric,
    syms_character,
    syms_body,
    NULL
  };
  r_obj* args[] = {
    subscript,
    subscript_arg,
    get_opts_action(opts),
    ffi_call,
    logical,
    numeric,
    character,
    body,
    NULL
  };

  r_obj* call = KEEP(r_call_n(syms_new_error_subscript_type, syms, args));
  r_obj* out = r_eval(call, vctrs_ns_env);

  FREE(3);
  return out;
}

struct group_info* new_group_info(void) {
  SEXP self = PROTECT(r_new_raw(sizeof(struct group_info)));
  struct group_info* p_group_info = (struct group_info*) RAW(self);

  p_group_info->self = self;
  p_group_info->data_size = 0;
  p_group_info->data = r_globals.empty_int;
  p_group_info->n_groups = 0;
  p_group_info->max_group_size = 0;

  UNPROTECT(1);
  return p_group_info;
}

struct group_infos* new_group_infos(struct group_info* p_group_info0,
                                    struct group_info* p_group_info1,
                                    r_ssize max_data_size,
                                    bool force_groups,
                                    bool ignore_groups) {
  SEXP self = PROTECT(r_new_raw(sizeof(struct group_infos)));
  struct group_infos* p_group_infos = (struct group_infos*) RAW(self);

  SEXP p_p_group_info_data = PROTECT(r_new_raw(2 * sizeof(struct group_info*)));
  struct group_info** p_p_group_info = (struct group_info**) RAW(p_p_group_info_data);

  p_p_group_info[0] = p_group_info0;
  p_p_group_info[1] = p_group_info1;

  p_group_infos->self = self;
  p_group_infos->p_p_group_info_data = p_p_group_info_data;
  p_group_infos->p_p_group_info = p_p_group_info;
  p_group_infos->max_data_size = max_data_size;
  p_group_infos->current = 0;
  p_group_infos->force_groups = force_groups;
  p_group_infos->ignore_groups = ignore_groups;

  UNPROTECT(2);
  return p_group_infos;
}

SEXP new_group_rle(SEXP g, SEXP l, R_len_t n) {
  SEXP out = PROTECT(Rf_allocVector(VECSXP, 2));

  SET_VECTOR_ELT(out, 0, g);
  SET_VECTOR_ELT(out, 1, l);

  SEXP names = PROTECT(Rf_allocVector(STRSXP, 2));
  SET_STRING_ELT(names, 0, strings_group);
  SET_STRING_ELT(names, 1, strings_length);
  Rf_setAttrib(out, R_NamesSymbol, names);

  SEXP n_groups = PROTECT(Rf_ScalarInteger(n));
  Rf_setAttrib(out, syms_n, n_groups);

  Rf_setAttrib(out, R_ClassSymbol, classes_vctrs_group_rle);

  UNPROTECT(3);
  return out;
}

struct growable new_growable(SEXPTYPE type, int capacity) {
  struct growable g;

  g.x = Rf_allocVector(type, capacity);
  g.type = type;
  g.array = r_vec_unwrap(type, g.x);
  g.n = 0;
  g.capacity = capacity;

  return g;
}

struct vctrs_arg new_lazy_arg(struct r_lazy* arg) {
  return (struct vctrs_arg) {
    .parent = NULL,
    .fill = &lazy_arg_fill,
    .data = arg
  };
}

struct lazy_raw* new_lazy_raw(r_ssize size, size_t n_bytes) {
  SEXP self = PROTECT(r_new_raw(sizeof(struct lazy_raw)));
  struct lazy_raw* p_out = (struct lazy_raw*) RAW(self);

  p_out->self = self;
  p_out->data = R_NilValue;
  p_out->size = size * n_bytes;

  UNPROTECT(1);
  return p_out;
}

struct location_opts new_location_opts_assign(void) {
  return (struct location_opts) {
    .subscript_opts = new_subscript_opts_assign()
  };
}

struct order* new_order(r_ssize size) {
  SEXP self = PROTECT(r_new_raw(sizeof(struct order)));
  struct order* p_order = (struct order*) RAW(self);

  SEXP data = PROTECT(Rf_allocVector(INTSXP, size));
  int* p_data = INTEGER(data);

  p_order->self = self;
  p_order->data = data;
  p_order->p_data = p_data;
  p_order->size = size;
  p_order->initialized = false;

  UNPROTECT(2);
  return p_order;
}

struct poly_vec* new_poly_vec(r_obj* proxy, enum vctrs_type type) {
  r_obj* shelter = KEEP(r_alloc_list(2));

  r_obj* self = r_alloc_raw(sizeof(struct poly_vec));
  r_list_poke(shelter, 0, self);
  r_list_poke(shelter, 1, proxy);

  struct poly_vec* p_poly_vec = r_raw_begin(self);

  p_poly_vec->shelter = shelter;
  p_poly_vec->vec = proxy;
  p_poly_vec->type = type;

  switch (type) {
  case VCTRS_TYPE_null: init_nil_poly_vec(p_poly_vec); break;
  case VCTRS_TYPE_logical: init_lgl_poly_vec(p_poly_vec); break;
  case VCTRS_TYPE_integer: init_int_poly_vec(p_poly_vec); break;
  case VCTRS_TYPE_double: init_dbl_poly_vec(p_poly_vec); break;
  case VCTRS_TYPE_complex: init_cpl_poly_vec(p_poly_vec); break;
  case VCTRS_TYPE_character: init_chr_poly_vec(p_poly_vec); break;
  case VCTRS_TYPE_raw: init_raw_poly_vec(p_poly_vec); break;
  case VCTRS_TYPE_list: init_list_poly_vec(p_poly_vec); break;
  case VCTRS_TYPE_dataframe: init_df_poly_vec(p_poly_vec); break;
  default: stop_unimplemented_vctrs_type("new_poly_vec", type);
  }

  FREE(1);
  return p_poly_vec;
}

struct repair_error_info new_repair_error_info(struct name_repair_opts* p_opts) {
  struct repair_error_info out;

  out.shelter = r_new_list(4);
  KEEP(out.shelter);

  out.repair_arg = r_lazy_eval(p_opts->name_repair_arg);
  r_list_poke(out.shelter, 0, out.repair_arg);

  out.call = r_lazy_eval(p_opts->call);
  r_list_poke(out.shelter, 1, out.call);

  // If this is NULL, the `repair` value has been hard-coded by the
  // frontend. Input errors are internal, and we provide no
  // recommendation to fix user errors by providing a different value
  // for `repair`.
  if (out.repair_arg == r_null) {
    out.input_error_repair_arg = chrs.repair;
    r_list_poke(out.shelter, 2, out.input_error_repair_arg);

    out.input_error_call = r_call(r_sym("vec_as_names"));
    r_list_poke(out.shelter, 3, out.input_error_call);
  } else {
    out.input_error_repair_arg = r_lazy_eval(p_opts->name_repair_arg);
    r_list_poke(out.shelter, 2, out.input_error_repair_arg);

    out.input_error_call = r_lazy_eval(p_opts->call);
    r_list_poke(out.shelter, 3, out.input_error_call);
  }

  FREE(1);
  return out;
}

struct vctrs_arg* new_subscript_arg_vec(struct vctrs_arg* parent,
                                        r_obj* x,
                                        r_ssize* p_i) {
  r_obj* names = KEEP(vec_names(x));
  struct vctrs_arg* p_arg = new_subscript_arg(parent,
                                              names,
                                              vec_size(x),
                                              p_i);
  FREE(1);
  return p_arg;
}

struct vctrs_arg new_wrapper_arg(struct vctrs_arg* parent,
                                 const char* arg) {
  return (struct vctrs_arg) {
    .parent = parent,
    .fill = &wrapper_arg_fill,
    .data = (void*) arg
  };
}

uint32_t nil_dict_hash_scalar(struct dictionary* d, R_len_t i) {
  return nil_dict_hash_with(d, d, i);
}

uint32_t nil_dict_hash_with(struct dictionary* d, struct dictionary* x, R_len_t i) {
  DICT_HASH_WITH(p_nil_equal_na_equal);
}

bool nil_dict_is_incomplete(struct dictionary* d, R_len_t i) {
  return dict_hash_is_missing(d, i) && p_nil_is_incomplete(d->p_poly_vec->p_vec, i);
}

r_obj* obj_attrib_encode_utf8(r_obj* x, bool owned) {
  // `out` pointer may be updated in place by callback
  r_obj* out = x;

  r_keep_loc shelter;
  KEEP_HERE(out, &shelter);

  struct cb_data data = {
    .p_out = &out,
    .shelter = shelter,
    .p_owned = &owned
  };

  r_attrib_map(x, obj_attrib_encode_utf8_cb, &data);

  FREE(1);
  return out;
}

r_obj* obj_cast_subscript(r_obj* subscript,
                          const struct subscript_opts* opts,
                          ERR* err) {
  struct vctrs_arg* p_subscript_arg = opts->subscript_arg;
  struct r_lazy call = opts->call;
  const enum s3_fallback s3_fallback = S3_FALLBACK_false;

  struct cast_opts cast_opts = {
    .x = subscript,
    .to = r_null,
    .p_x_arg = p_subscript_arg
  };

  cast_opts.to = r_globals.empty_lgl;
  if (vec_is_coercible(
    subscript,
    cast_opts.to,
    p_subscript_arg,
    vec_args.empty,
    call,
    s3_fallback
  )) {
    return vec_cast_opts(&cast_opts);
  }

  cast_opts.to = r_globals.empty_int;
  if (vec_is_coercible(
    subscript,
    cast_opts.to,
    p_subscript_arg,
    vec_args.empty,
    call,
    s3_fallback
  )) {
    return vec_cast_opts(&cast_opts);
  }

  cast_opts.to = r_globals.empty_chr;
  if (vec_is_coercible(
    subscript,
    cast_opts.to,
    p_subscript_arg,
    vec_args.empty,
    call,
    s3_fallback
  )) {
    return vec_cast_opts(&cast_opts);
  }

  *err = new_error_subscript_type(subscript, opts, r_null);
  return r_null;
}

void obj_check_list(
  r_obj* x,
  struct vctrs_arg* p_x_arg,
  struct r_lazy call
) {
  if (!obj_is_list(x)) {
    stop_non_list_type(x, p_x_arg, call);
  }
}

void obj_check_vector(
  r_obj* x,
  enum vctrs_allow_null allow_null,
  struct vctrs_arg* p_x_arg,
  struct r_lazy call
) {
  if (!obj_is_vector(x, allow_null)) {
    stop_scalar_type(x, p_x_arg, call);
  }
}

r_obj* obj_encode_utf8(r_obj* x) {
  r_obj* out;

  switch (r_typeof(x)) {
  case R_TYPE_character: out = chr_encode_utf8(x); break;
  case R_TYPE_list: out = list_encode_utf8(x); break;
  default: out = x; break;
  }

  if (r_attrib_has_any(out)) {
    // Only `KEEP()` if there are attributes
    KEEP(out);
    // Pass down ownership to avoid a reclone if attributes change
    bool owned = x != out;
    out = obj_attrib_encode_utf8(out, owned);
    FREE(1);
  }

  return out;
}

bool obj_equal(r_obj* x, r_obj* y) {
  x = KEEP(obj_encode_utf8(x));
  y = KEEP(obj_encode_utf8(y));

  const bool out = obj_equal_utf8(x, y);

  FREE(2);
  return out;
}

uint32_t obj_hash(r_obj* x) {
  uint32_t hash = sexp_hash(x);

  if (r_attrib_has_any(x)) {
    hash = hash_combine(hash, attrib_hash(x));
  }

  return hash;
}

bool obj_is_list(r_obj* x) {
  // Require `x` to be a list internally
  if (r_typeof(x) != R_TYPE_list) {
    return false;
  }

  // List arrays are not lists for vctrs purposes. We have pretty deep
  // assumptions that if an object is a list, then `r_length(x) == vec_size(x)`.
  // See `list_drop_empty()` and `list_combine()` for examples of
  // implementations that would be broken if this wasn't true.
  if (has_dim(x)) {
    return false;
  }

  // Unclassed R_TYPE_list are lists
  if (!r_is_object(x)) {
    return true;
  }

  const enum vctrs_class_type type = class_type(x);

  // Classed R_TYPE_list are only lists if the last class is explicitly `"list"`
  // or if it is a bare "AsIs" type
  return (type == VCTRS_CLASS_list) || (type == VCTRS_CLASS_bare_asis);
}

bool obj_is_vector(r_obj* x, enum vctrs_allow_null allow_null) {
  if (x == r_null) {
    return allow_null_as_bool(allow_null);
  }
  struct vctrs_proxy_info info = vec_proxy_info(x);
  return info.type != VCTRS_TYPE_scalar;
}

static inline bool obj_vec_equal(r_obj* x, r_obj* y, enum r_type type) {
  const r_ssize n = r_length(x);

  // Length check
  if (n != r_length(y)) {
    return false;
  }

  // Attribute check
  if (!obj_attrib_equal(x, y)) {
    return false;
  }

  // Data check
  switch (type) {
  case R_TYPE_logical: OBJ_VEC_EQUAL(int, r_lgl_cbegin, lgl_equal_na_equal);
  case R_TYPE_integer: OBJ_VEC_EQUAL(int, r_int_cbegin, int_equal_na_equal);
  case R_TYPE_double: OBJ_VEC_EQUAL(double, r_dbl_cbegin, dbl_equal_na_equal);
  case R_TYPE_character: OBJ_VEC_EQUAL(r_obj*, r_chr_cbegin, chr_equal_na_equal);
  case R_TYPE_raw: OBJ_VEC_EQUAL(Rbyte, r_raw_cbegin, raw_equal_na_equal);
  case R_TYPE_complex: OBJ_VEC_EQUAL(r_complex, r_cpl_cbegin, cpl_equal_na_equal);
  case R_TYPE_list: OBJ_VEC_EQUAL(r_obj*, r_list_cbegin, list_equal_na_equal);
  default: r_stop_unreachable();
  }
}

SEXP ord_as_character(SEXP x, struct vctrs_arg* x_arg) {
  return fct_as_character(x, x_arg);
}

r_obj* ord_ptype2(
  r_obj* x,
  r_obj* y,
  struct vctrs_arg* p_x_arg,
  struct vctrs_arg* p_y_arg,
  struct r_lazy call,
  enum s3_fallback s3_fallback
) {
  r_obj* x_levels = PROTECT(Rf_getAttrib(x, R_LevelsSymbol));
  r_obj* y_levels = PROTECT(Rf_getAttrib(y, R_LevelsSymbol));

  SEXP out;
  if (ord_ptype2_validate(x_levels, y_levels, x, y, p_x_arg, p_y_arg)) {
    out = new_empty_ordered(x_levels);
  } else {
    out = vec_ptype2_default(
      x,
      y,
      p_x_arg,
      p_y_arg,
      call,
      s3_fallback
    );
  }

  UNPROTECT(2);
  return out;
}

bool ord_ptype2_validate(
  r_obj* x_levels,
  r_obj* y_levels,
  r_obj* x,
  r_obj* y,
  struct vctrs_arg* p_x_arg,
  struct vctrs_arg* p_y_arg
) {
  if (TYPEOF(x_levels) != STRSXP) {
    stop_corrupt_ordered_levels(x, p_x_arg);
  }
  if (TYPEOF(y_levels) != STRSXP) {
    stop_corrupt_ordered_levels(y, p_y_arg);
  }

  return obj_equal(x_levels, y_levels);
}

void ord_resolve_sortedness(enum vctrs_sortedness sortedness,
                            r_ssize size,
                            int* p_o) {
  switch (sortedness) {
  case VCTRS_SORTEDNESS_sorted: int_incr(size, p_o); return;
  case VCTRS_SORTEDNESS_reversed: ord_reverse(size, p_o); return;
  case VCTRS_SORTEDNESS_unsorted: Rf_errorcall(R_NilValue, "Internal error: Unsorted case should be handled elsewhere.");
  }

  never_reached("ord_resolve_sortedness");
}

void ord_resolve_sortedness_chunk(enum vctrs_sortedness sortedness,
                                  r_ssize size,
                                  int* p_o) {
  switch (sortedness) {
  case VCTRS_SORTEDNESS_sorted: return;
  case VCTRS_SORTEDNESS_reversed: ord_reverse_chunk(size, p_o); return;
  case VCTRS_SORTEDNESS_unsorted: Rf_errorcall(R_NilValue, "Internal error: Unsorted case should be handled elsewhere.");
  }

  never_reached("ord_resolve_sortedness_chunk");
}

void ord_reverse(r_ssize size, int* p_o) {
  const r_ssize half = size / 2;

  for (r_ssize i = 0; i < half; ++i) {
    r_ssize swap = size - 1 - i;
    p_o[i] = swap + 1;
    p_o[swap] = i + 1;
  }

  // Initialize center value if odd number
  if (size % 2 != 0) {
    p_o[half] = half + 1;
  }
}

void ord_reverse_chunk(r_ssize size, int* p_o) {
  const r_ssize half = size / 2;

  for (r_ssize i = 0; i < half; ++i) {
    r_ssize swap = size - 1 - i;

    const int temp = p_o[i];

    p_o[i] = p_o[swap];
    p_o[swap] = temp;
  }
}

r_obj* outer_names(r_obj* names, r_obj* outer, r_ssize n) {
  if (outer == r_null) {
    return names;
  }
  if (r_typeof(outer) != R_TYPE_string) {
    r_stop_internal("`outer` must be a scalar string.");
  }

  if (outer == strings_empty || outer == r_globals.na_str) {
    return names;
  }

  if (r_is_empty_names(names)) {
    if (n == 1) {
      return r_str_as_character(outer);
    } else {
      return r_seq_chr(r_str_c_string(outer), n);
    }
  } else {
    return r_chr_paste_prefix(names, r_str_c_string(outer), "..");
  }
}

bool p_bool_any(const bool* v_x, r_ssize size) {
  for (r_ssize i = 0; i < size; ++i) {
    if (v_x[i]) {
      return true;
    }
  }

  return false;
}

void p_bool_fill(bool* v_x, r_ssize size, bool value) {
  for (r_ssize i = 0; i < size; ++i) {
    v_x[i] = value;
  }
}

r_ssize p_bool_sum(const bool* v_x, r_ssize size) {
  r_ssize out = 0;

  for (r_ssize i = 0; i < size; ++i) {
    out += v_x[i];
  }

  return out;
}

r_obj* p_bool_which(const bool* v_x, r_ssize size) {
  const r_ssize out_size = p_bool_sum(v_x, size);

  r_obj* out = KEEP(r_alloc_integer(out_size));
  int* v_out = r_int_begin(out);

  for (r_ssize i = 0, j = 0; i < size && j < out_size; ++i) {
    v_out[j] = i + 1;
    j += v_x[i];
  }

  FREE(1);
  return out;
}

int p_chr_compare_na_equal(const void* p_x, r_ssize i, const void* p_y, r_ssize j) {
  P_COMPARE_NA_EQUAL(r_obj*, chr_compare_na_equal);
}

bool p_chr_is_incomplete(const void* p_x, r_ssize i) {
  return p_chr_is_missing(p_x, i);
}

bool p_chr_is_missing(const void* p_x, r_ssize i) {
  P_IS_MISSING(r_obj*, chr_is_missing);
}

int p_col_compare_na_equal(
  const void* p_x,
  r_ssize i,
  const void* p_y,
  r_ssize j,
  const enum vctrs_type type
) {
  switch (type) {
  case VCTRS_TYPE_null: return p_nil_compare_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_logical: return p_lgl_compare_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_integer: return p_int_compare_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_double: return p_dbl_compare_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_complex: return p_cpl_compare_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_character: return p_chr_compare_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_raw: return p_raw_compare_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_list: return p_list_compare_na_equal(p_x, i, p_y, j);
  default: stop_unimplemented_vctrs_type("p_col_compare_na_equal", type);
  }
}

bool p_col_equal_na_equal(
  const void* p_x,
  r_ssize i,
  const void* p_y,
  r_ssize j,
  const enum vctrs_type type
) {
  switch (type) {
  case VCTRS_TYPE_logical: return p_lgl_equal_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_integer: return p_int_equal_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_double: return p_dbl_equal_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_complex: return p_cpl_equal_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_character: return p_chr_equal_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_raw: return p_raw_equal_na_equal(p_x, i, p_y, j);
  case VCTRS_TYPE_list: return p_list_equal_na_equal(p_x, i, p_y, j);
  default: stop_unimplemented_vctrs_type("p_col_equal_na_equal", type);
  }
}

bool p_col_is_missing(
  const void* p_x,
  r_ssize i,
  const enum vctrs_type type
) {
  switch (type) {
  case VCTRS_TYPE_logical: return p_lgl_is_missing(p_x, i);
  case VCTRS_TYPE_integer: return p_int_is_missing(p_x, i);
  case VCTRS_TYPE_double: return p_dbl_is_missing(p_x, i);
  case VCTRS_TYPE_complex: return p_cpl_is_missing(p_x, i);
  case VCTRS_TYPE_character: return p_chr_is_missing(p_x, i);
  case VCTRS_TYPE_raw: return p_raw_is_missing(p_x, i);
  case VCTRS_TYPE_list: return p_list_is_missing(p_x, i);
  default: stop_unimplemented_vctrs_type("p_col_is_missing", type);
  }
}

bool p_cpl_is_incomplete(const void* p_x, r_ssize i) {
  return p_cpl_is_missing(p_x, i);
}

bool p_dbl_is_incomplete(const void* p_x, r_ssize i) {
  return p_dbl_is_missing(p_x, i);
}

bool p_df_is_incomplete(const void* p_x, r_ssize i) {
  struct poly_df_data* p_x_data = (struct poly_df_data*) p_x;

  enum vctrs_type* v_col_type = p_x_data->v_col_type;
  const void** v_col_ptr = p_x_data->v_col_ptr;
  r_ssize n_col = p_x_data->n_col;

  // df-cols should already be flattened,
  // so we only need missingness of each column, not completeness
  for (r_ssize col = 0; col < n_col; ++col) {
    if (p_col_is_missing(v_col_ptr[col], i, v_col_type[col])) {
      return true;
    }
  }

  return false;
}

bool p_int_is_incomplete(const void* p_x, r_ssize i) {
  return p_int_is_missing(p_x, i);
}

bool p_lgl_is_incomplete(const void* p_x, r_ssize i) {
  return p_lgl_is_missing(p_x, i);
}

int p_list_compare_na_equal(const void* p_x, r_ssize i, const void* p_y, r_ssize j) {
  P_COMPARE_NA_EQUAL(r_obj*, list_compare_na_equal);
}

bool p_list_is_incomplete(const void* p_x, r_ssize i) {
  return p_list_is_missing(p_x, i);
}

bool p_list_is_missing(const void* p_x, r_ssize i) {
  P_IS_MISSING(r_obj*, list_is_missing);
}

bool p_nesting_container_df_compare_fully_ge_na_equal(const void* x,
                                                      r_ssize i,
                                                      const void* y,
                                                      r_ssize j) {
  // Checks if EVERY column of `x` is `>=` `y`.
  // Assumes original input that `x` and `y` came from is ordered, and that
  // `x` comes after `y` in terms of row location in that original input. This
  // means that the first column of `x` is always `>=` the first column of `y`,
  // so we can ignore it in the comparison.
  // Iterates backwards to (ideally) maximize chance of hitting the fastest
  // varying column.
  // All columns are integer vectors (ranks).

  const struct poly_df_data* x_data = (const struct poly_df_data*) x;
  const struct poly_df_data* y_data = (const struct poly_df_data*) y;

  const r_ssize n_col = x_data->n_col;

  const void** v_x_col_ptr = x_data->v_col_ptr;
  const void** v_y_col_ptr = y_data->v_col_ptr;

  for (r_ssize col = n_col - 1; col > 0; --col) {
    if (p_int_compare_na_equal(v_x_col_ptr[col], i, v_y_col_ptr[col], j) < 0) {
      return false;
    }
  }

  return true;
}

int p_nil_compare_na_equal(const void* p_x, r_ssize i, const void* p_y, r_ssize j) {
  P_COMPARE_NA_EQUAL(r_obj*, nil_compare_na_equal);
}

bool p_nil_is_incomplete(const void* p_x, r_ssize i) {
  p_nil_is_missing(p_x, i);
}

bool p_raw_is_incomplete(const void* p_x, r_ssize i) {
  return p_raw_is_missing(p_x, i);
}

bool p_raw_is_missing(const void* p_x, r_ssize i) {
  P_IS_MISSING(unsigned char, raw_is_missing);
}

void parse_condition(r_obj* condition, r_ssize n_cols, enum vctrs_ops* v_ops) {
  if (r_typeof(condition) != R_TYPE_character) {
    r_abort("`condition` must be a character vector.");
  }

  r_obj* const* v_condition = r_chr_cbegin(condition);
  r_ssize size_condition = vec_size(condition);

  if (size_condition == 1) {
    const char* elt = r_str_c_string(v_condition[0]);
    enum vctrs_ops op = parse_condition_one(elt);

    for (r_ssize i = 0; i < n_cols; ++i) {
      v_ops[i] = op;
    }

    return;
  }

  if (size_condition == n_cols) {
    for (r_ssize i = 0; i < n_cols; ++i) {
      const char* elt = r_str_c_string(v_condition[i]);
      v_ops[i] = parse_condition_one(elt);
    }

    return;
  }

  r_abort(
    "`condition` must be length 1, or the same "
    "length as the number of columns of the input."
  );
}

enum vctrs_ops parse_condition_one(const char* condition) {
  if (!strcmp(condition, "==")) { return VCTRS_OPS_eq; }
  if (!strcmp(condition, ">"))  { return VCTRS_OPS_gt; }
  if (!strcmp(condition, ">=")) { return VCTRS_OPS_gte; }
  if (!strcmp(condition, "<"))  { return VCTRS_OPS_lt; }
  if (!strcmp(condition, "<=")) { return VCTRS_OPS_lte; }

  r_abort("`condition` must only contain \"==\", \">\", \">=\", \"<\", or \"<=\".");
}

void parse_direction(SEXP x, bool* p_down, bool* p_leading) {
  if (TYPEOF(x) != STRSXP || Rf_length(x) == 0) {
    stop_bad_direction();
  }

  const char* str = CHAR(STRING_ELT(x, 0));

  if (!strcmp(str, "down")) {
    *p_down = true;
    *p_leading = false;
    return;
  }
  if (!strcmp(str, "up")) {
    *p_down = false;
    *p_leading = false;
    return;
  }
  if (!strcmp(str, "downup")) {
    *p_down = true;
    *p_leading = true;
    return;
  }
  if (!strcmp(str, "updown")) {
    *p_down = false;
    *p_leading = true;
    return;
  }

  stop_bad_direction();
  never_reached("parse_direction");
}

int parse_direction_one(SEXP x) {
  if (x == NA_STRING) {
    Rf_errorcall(R_NilValue, "`direction` can't be missing.");
  }

  const char* c_x = CHAR(x);

  if (!strcmp(c_x, "asc")) return 0;
  if (!strcmp(c_x, "desc")) return 1;

  Rf_errorcall(
    R_NilValue,
    "`direction` must contain only \"asc\" or \"desc\"."
  );
}

int parse_max_fill(r_obj* x) {
  if (x == R_NilValue) {
    return INFINITE_FILL;
  }

  x = KEEP(vec_cast(x,
                    r_globals.empty_int,
                    vec_args.max_fill,
                    vec_args.empty,
                    r_lazy_null));

  if (!r_is_positive_number(x)) {
    r_abort("`max_fill` must be `NULL` or a single positive integer.");
  }

  int out = r_int_get(x, 0);

  FREE(1);
  return out;
}

enum vctrs_interval_missing parse_missing(r_obj* missing) {
  if (!r_is_string(missing)) {
    r_abort("`missing` must be a string.");
  }

  const char* c_missing = r_chr_get_c_string(missing, 0);

  if (!strcmp(c_missing, "group")) return VCTRS_INTERVAL_MISSING_group;
  if (!strcmp(c_missing, "drop")) return VCTRS_INTERVAL_MISSING_drop;

  r_abort("`missing` must be either \"group\" or \"drop\".");
}

SEXP parse_na_value(SEXP na_value) {
  // Don't care about length here, checked later
  if (TYPEOF(na_value) != STRSXP) {
    Rf_errorcall(R_NilValue, "`na_value` must be a character vector.");
  }

  R_len_t size = Rf_length(na_value);
  const SEXP* p_na_value = STRING_PTR_RO(na_value);

  SEXP na_largest = PROTECT(Rf_allocVector(LGLSXP, size));
  int* p_na_largest = LOGICAL(na_largest);

  for (R_len_t i = 0; i < size; ++i) {
    p_na_largest[i] = parse_na_value_one(p_na_value[i]);
  }

  UNPROTECT(1);
  return na_largest;
}

int parse_na_value_one(SEXP x) {
  if (x == NA_STRING) {
    Rf_errorcall(R_NilValue, "`na_value` can't be missing.");
  }

  const char* c_x = CHAR(x);

  if (!strcmp(c_x, "largest")) return 1;
  if (!strcmp(c_x, "smallest")) return 0;

  Rf_errorcall(
    R_NilValue,
    "`na_value` must contain only \"largest\" or \"smallest\"."
  );
}

bool parse_nan_distinct(SEXP nan_distinct) {
  if (TYPEOF(nan_distinct) != LGLSXP) {
    Rf_errorcall(R_NilValue, "`nan_distinct` must be a logical vector.");
  }
  if (Rf_length(nan_distinct) != 1) {
    Rf_errorcall(R_NilValue, "`nan_distinct` must be length 1.");
  }

  int c_nan_distinct = LOGICAL_RO(nan_distinct)[0];

  if (c_nan_distinct == NA_LOGICAL) {
    Rf_errorcall(R_NilValue, "`nan_distinct` can't be missing.");
  }

  return (bool) c_nan_distinct;
}

bool plus_would_overflow(r_ssize x, r_ssize y) {
  return x > R_LEN_T_MAX - y;
}

poly_binary_int_fn* poly_p_compare_na_equal(enum vctrs_type type) {
  switch (type) {
  case VCTRS_TYPE_null: return p_nil_compare_na_equal;
  case VCTRS_TYPE_logical: return p_lgl_compare_na_equal;
  case VCTRS_TYPE_integer: return p_int_compare_na_equal;
  case VCTRS_TYPE_double: return p_dbl_compare_na_equal;
  case VCTRS_TYPE_complex: return p_cpl_compare_na_equal;
  case VCTRS_TYPE_character: return p_chr_compare_na_equal;
  case VCTRS_TYPE_raw: return p_raw_compare_na_equal;
  case VCTRS_TYPE_list: return p_list_compare_na_equal;
  case VCTRS_TYPE_dataframe: return p_df_compare_na_equal;
  default: stop_unimplemented_vctrs_type("poly_p_compare_na_equal", type);
  }
}

poly_unary_bool_fn* poly_p_is_missing(enum vctrs_type type) {
  switch (type) {
  case VCTRS_TYPE_null: return p_nil_is_missing;
  case VCTRS_TYPE_logical: return p_lgl_is_missing;
  case VCTRS_TYPE_integer: return p_int_is_missing;
  case VCTRS_TYPE_double: return p_dbl_is_missing;
  case VCTRS_TYPE_complex: return p_cpl_is_missing;
  case VCTRS_TYPE_character: return p_chr_is_missing;
  case VCTRS_TYPE_raw: return p_raw_is_missing;
  case VCTRS_TYPE_list: return p_list_is_missing;
  case VCTRS_TYPE_dataframe: return p_df_is_missing;
  default: stop_unimplemented_vctrs_type("poly_p_is_missing", type);
  }
}

SEXP posixct_as_date(SEXP x, bool* lossy) {
  SEXP ct = PROTECT(datetime_validate(x));

  SEXP tzone = PROTECT(tzone_get(ct));
  SEXP lt = PROTECT(posixct_as_posixlt_impl(ct, tzone));

  SEXP out = posixt_as_date(ct, lt, lossy);

  UNPROTECT(3);
  return out;
}

SEXP posixct_as_posixct(SEXP x, SEXP to) {
  SEXP tzone = PROTECT(tzone_get(to));
  SEXP out = posixct_as_posixct_impl(x, tzone);
  UNPROTECT(1);
  return out;
}

static SEXP posixct_as_posixct_impl(SEXP x, SEXP tzone) {
  x = PROTECT(datetime_validate(x));
  SEXP out = datetime_rezone(x, tzone);
  UNPROTECT(1);
  return out;
}

SEXP posixct_as_posixlt(SEXP x, SEXP to) {
  SEXP tzone = PROTECT(tzone_get(to));
  SEXP out = posixct_as_posixlt_impl(x, tzone);
  UNPROTECT(1);
  return out;
}

static SEXP posixct_as_posixlt_impl(SEXP x, SEXP tzone) {
  return r_as_posixlt(x, tzone);
}

SEXP posixlt_as_date(SEXP x, bool* lossy) {
  SEXP lt = x;

  SEXP tzone = PROTECT(tzone_get(lt));
  SEXP ct = PROTECT(posixlt_as_posixct_impl(lt, tzone));

  SEXP out = posixt_as_date(ct, lt, lossy);

  UNPROTECT(2);
  return out;
}

SEXP posixlt_as_posixct(SEXP x, SEXP to) {
  SEXP tzone = PROTECT(tzone_get(to));
  SEXP out = posixlt_as_posixct_impl(x, tzone);
  UNPROTECT(1);
  return out;
}

static SEXP posixlt_as_posixct_impl(SEXP x, SEXP tzone) {
  SEXP x_tzone = PROTECT(tzone_get(x));
  x = PROTECT(r_as_posixct(x, x_tzone));

  SEXP out = posixct_as_posixct_impl(x, tzone);

  UNPROTECT(2);
  return out;
}

SEXP proxy_apply_chr_proxy_collate(SEXP proxy, SEXP chr_proxy_collate) {
  if (chr_proxy_collate == r_null) {
    return proxy;
  }

  chr_proxy_collate = PROTECT(r_as_function(chr_proxy_collate, "chr_proxy_collate"));

  SEXP out;

  switch (vec_proxy_typeof(proxy)) {
  case VCTRS_TYPE_character: out = chr_apply(proxy, chr_proxy_collate); break;
  case VCTRS_TYPE_dataframe: out = df_apply(proxy, chr_proxy_collate); break;
  default: out = proxy;
  }

  UNPROTECT(1);
  return out;
}

r_obj* proxy_detect_missing(r_obj* proxy) {
  const enum vctrs_type type = vec_proxy_typeof(proxy);

  switch (type) {
  case VCTRS_TYPE_logical: return lgl_detect_missing(proxy);
  case VCTRS_TYPE_integer: return int_detect_missing(proxy);
  case VCTRS_TYPE_double: return dbl_detect_missing(proxy);
  case VCTRS_TYPE_complex: return cpl_detect_missing(proxy);
  case VCTRS_TYPE_raw: return raw_detect_missing(proxy);
  case VCTRS_TYPE_character: return chr_detect_missing(proxy);
  case VCTRS_TYPE_list: return list_detect_missing(proxy);
  case VCTRS_TYPE_dataframe: return df_detect_missing(proxy);
  case VCTRS_TYPE_null: return r_globals.empty_lgl;
  case VCTRS_TYPE_scalar: stop_scalar_type(proxy, vec_args.empty, r_lazy_null);
  default: stop_unimplemented_vctrs_type("vec_detect_missing", type);
  }

  r_stop_unreachable();
}

r_ssize proxy_first_missing(r_obj* proxy) {
  const enum vctrs_type type = vec_proxy_typeof(proxy);

  switch (type) {
  case VCTRS_TYPE_logical: return lgl_first_missing(proxy);
  case VCTRS_TYPE_integer: return int_first_missing(proxy);
  case VCTRS_TYPE_double: return dbl_first_missing(proxy);
  case VCTRS_TYPE_complex: return cpl_first_missing(proxy);
  case VCTRS_TYPE_raw: return raw_first_missing(proxy);
  case VCTRS_TYPE_character: return chr_first_missing(proxy);
  case VCTRS_TYPE_list: return list_first_missing(proxy);
  case VCTRS_TYPE_dataframe: return df_first_missing(proxy);
  case VCTRS_TYPE_null: return 0;
  case VCTRS_TYPE_scalar: stop_scalar_type(proxy, vec_args.empty, r_lazy_null);
  default: stop_unimplemented_vctrs_type("vec_first_missing", type);
  }

  r_stop_unreachable();
}

r_obj* ptype_common_with_default(
  r_obj* ptype,
  r_obj* xs,
  bool has_default,
  r_obj* default_,
  struct vctrs_arg* p_xs_arg,
  struct vctrs_arg* p_default_arg,
  struct r_lazy error_call,
  enum s3_fallback s3_fallback
) {
  if (ptype != r_null) {
    // Performs scalar checks and whatnot
    return vec_ptype_final(ptype, vec_args.ptype, error_call);
  }

  // Okay `ptype` is `NULL`. We determine it from `xs` and `default`.

  // Use only `xs` and `p_xs_arg` first for best errors.
  // Not finalising `ptype` yet in case we need to incorporate `default`!
  ptype = KEEP(vec_ptype_common(
    xs,
    ptype,
    PTYPE_FINALISE_false,
    s3_fallback,
    p_xs_arg,
    error_call
  ));

  // Now incorporate `default` and `p_default_arg` if required
  if (has_default) {
    int _;
    ptype = vec_ptype2(
      ptype,
      default_,
      vec_args.empty,
      p_default_arg,
      error_call,
      s3_fallback,
      &_
    );
  }
  KEEP(ptype);

  // Now finalise after incorporating `default`
  ptype = KEEP(vec_ptype_finalise(ptype));

  FREE(3);
  return ptype;
}

int qsort_int_compare_scalar(const void* x, const void* y) {
  return int_compare_scalar(*((int*) x), *((int*) y));
}

r_ssize r__dyn_increment(struct r_dyn_array* p_arr) {
  r_ssize loc = p_arr->count++;

  if (p_arr->count > p_arr->capacity) {
    r_ssize new_capacity = r_ssize_mult(p_arr->capacity, p_arr->growth_factor);
    r_dyn_resize(p_arr, new_capacity);
  }

  return loc;
}

r_obj* r_alloc_character(r_ssize n) {
#if R_VERSION >= R_Version(4, 6, 0)
  return R_allocResizableVector(R_TYPE_character, n);
#else
  return Rf_allocVector(R_TYPE_character, n);
#endif
}

r_obj* r_alloc_complex(r_ssize n) {
#if R_VERSION >= R_Version(4, 6, 0)
  return R_allocResizableVector(R_TYPE_complex, n);
#else
  return Rf_allocVector(R_TYPE_complex, n);
#endif
}

r_obj* r_alloc_df_list(r_ssize n_rows,
                       r_obj* names,
                       const enum r_type* v_types,
                       r_ssize types_size) {
  r_obj* out = KEEP(r_alloc_list(types_size));

  if (r_typeof(names) != R_TYPE_character) {
    r_abort("`names` must be a character vector.");
  }
  if (r_length(names) != types_size) {
    r_abort("`names` must match the number of columns.");
  }
  r_attrib_poke_names(out, names);

  for (r_ssize i = 0; i < types_size; ++i) {
    // A nil type stands for no column allocation
    enum r_type type = v_types[i];
    if (type != R_TYPE_null) {
      r_obj* col = r_alloc_vector(type, n_rows);
      r_list_poke(out, i, col);
    }
  }

  FREE(1);
  return out;
}

r_obj* r_alloc_double(r_ssize n) {
#if R_VERSION >= R_Version(4, 6, 0)
  return R_allocResizableVector(R_TYPE_double, n);
#else
  return Rf_allocVector(R_TYPE_double, n);
#endif
}

r_obj* r_alloc_empty_environment(r_obj* parent) {
  // Non-hashed environment.
  // Very fast and useful when you aren't getting/setting from the result.
#if R_VERSION >= R_Version(4, 1, 0)
  const int hash = 0;
  const int size = 0; // Not used when `hash = 0`
  return R_NewEnv(parent, hash, size);
#else
  r_obj* env = Rf_allocSExp(R_TYPE_environment);
  SET_ENCLOS(env, parent);
  return env;
#endif
}

r_obj* r_alloc_environment(r_ssize size, r_obj* parent) {
#if R_VERSION < R_Version(4, 1, 0)
  parent = parent ? parent : r_envs.empty;
  r_node_poke_car(new_env__parent_node, parent);

  size = size ? size : 29;
  r_node_poke_car(new_env__size_node, r_int(size));

  r_obj* env = r_eval(new_env_call, r_envs.base);

  // Free for gc
  r_node_poke_car(new_env__parent_node, r_null);

  return env;
#else
  const int hash = 1;
  return R_NewEnv(parent, hash, size);
#endif
}

r_obj* r_alloc_integer(r_ssize n) {
#if R_VERSION >= R_Version(4, 6, 0)
  return R_allocResizableVector(R_TYPE_integer, n);
#else
  return Rf_allocVector(R_TYPE_integer, n);
#endif
}

r_obj* r_alloc_list(r_ssize n) {
#if R_VERSION >= R_Version(4, 6, 0)
  return R_allocResizableVector(R_TYPE_list, n);
#else
  return Rf_allocVector(R_TYPE_list, n);
#endif
}

r_obj* r_alloc_logical(r_ssize n) {
#if R_VERSION >= R_Version(4, 6, 0)
  return R_allocResizableVector(R_TYPE_logical, n);
#else
  return Rf_allocVector(R_TYPE_logical, n);
#endif
}

r_obj* r_alloc_raw(r_ssize n) {
#if R_VERSION >= R_Version(4, 6, 0)
  return R_allocResizableVector(R_TYPE_raw, n);
#else
  return Rf_allocVector(R_TYPE_raw, n);
#endif
}

bool r_arg_as_bool(r_obj* x, const char* arg) {
  if (!r_is_bool(x)) {
    r_abort("`%s` must be `TRUE` or `FALSE`.", arg);
  }
  return r_lgl_get(x, 0);
}

int r_arg_as_int(r_obj* x, const char* arg) {
  if (!r_is_int(x)) {
    r_abort("`%s` must be a single integer value.", arg);
  }
  return r_int_get(x, 0);
}

SEXP r_as_data_frame(SEXP x) {
  if (is_bare_data_frame(x)) {
    return x;
  } else {
    return vctrs_dispatch1(syms_as_data_frame2, fns_as_data_frame2, syms_x, x);
  }
}

static SEXP r_as_date(SEXP x) {
  return vctrs_dispatch1(syms_as_date, fns_as_date, syms_x, x);
}

r_obj* r_as_function(r_obj* x, const char* arg) {
  switch (r_typeof(x)) {
  case R_TYPE_closure:
  case R_TYPE_builtin:
  case R_TYPE_special:
    return x;

  case R_TYPE_call:
    if (r_node_car(x) == r_syms.tilde && r_node_cddr(x) == r_null) {
      r_obj* env = r_attrib_get(x, r_syms.dot_environment);
      if (env == r_null) {
        r_abort("Can't transform formula to function because it doesn't have an environment.");
      }

      return r_new_function(rlang_formula_formals, r_node_cadr(x), env);
    }
    // else fallthrough;
  default:
    r_abort("Can't convert `%s` to a function", arg);
  }
}

int r_as_int(r_obj* x) {
  return r_arg_as_int(x, "x");
}

static SEXP r_as_posixct(SEXP x, SEXP tzone) {
  return vctrs_dispatch2(syms_as_posixct, fns_as_posixct, syms_x, x, syms_tz, tzone);
}

static SEXP r_as_posixlt(SEXP x, SEXP tzone) {
  return vctrs_dispatch2(syms_as_posixlt, fns_as_posixlt, syms_x, x, syms_tz, tzone);
}

void r_attrib_clone_from(r_obj* to, r_obj* from) {
  SHALLOW_DUPLICATE_ATTRIB(to, from);
}

static r_obj* r_attrib_get_cb(r_obj* tag, r_obj* val, void* data) {
  if (tag == *(r_obj**) data) {
    return val;
  }
  return NULL;
}

bool r_attrib_has_any(r_obj* x) {
  return ANY_ATTRIB(x);
}

r_obj* r_attrib_map(r_obj* x, r_attrib_map_fn* fn, void* data) {
  return R_mapAttrib(x, fn, data);
}

void r_attrib_zap_all(r_obj* x) {
  CLEAR_ATTRIB(x);
}

int r_bool_as_int(SEXP x) {
  if (!r_is_bool(x)) {
    Rf_errorcall(R_NilValue, "Input must be a single `TRUE` or `FALSE`.");
  }
  return LOGICAL(x)[0];
}

const char* r_c_str_format_error_arg(const char* x) {
  r_obj* ffi_x = KEEP(r_chr(x));
  const char* out = r_format_error_arg(ffi_x);
  FREE(1);
  return out;
}

r_obj* r_chr(const char* c_string) {
  r_obj* out = KEEP(r_alloc_character(1));
  r_chr_poke(out, 0, r_str(c_string));
  FREE(1);
  return out;
}

r_obj* const * r_chr_cbegin(r_obj* x) {
  return STRING_PTR_RO(x);
}

static SEXP r_chr_date_as_posixct(SEXP x, SEXP tzone) {
  return vctrs_dispatch2(syms_chr_date_as_posixct, fns_chr_date_as_posixct, syms_x, x, syms_tzone, tzone);
}

static SEXP r_chr_date_as_posixlt(SEXP x, SEXP tzone) {
  return vctrs_dispatch2(syms_chr_date_as_posixlt, fns_chr_date_as_posixlt, syms_x, x, syms_tzone, tzone);
}

void r_chr_fill(r_obj* chr, r_obj* value, r_ssize n) {
  for (r_ssize i = 0; i < n; ++i) {
    r_chr_poke(chr, i, value);
  }
}

r_obj* r_chr_get(r_obj* x, r_ssize i) {
  return STRING_ELT(x, i);
}

const char* r_chr_get_c_string(r_obj* x, r_ssize i) {
  return CHAR(r_chr_get(x, i));
}

bool r_chr_has_string(SEXP x, SEXP str) {
  R_len_t n = Rf_length(x);
  const SEXP* xp = STRING_PTR_RO(x);

  for (R_len_t i = 0; i < n; ++i, ++xp) {
    if (*xp == str) {
      return true;
    }
  }

  return false;
}

int r_chr_max_len(SEXP x) {
  R_len_t n = Rf_length(x);
  SEXP const* p = STRING_PTR_RO(x);

  int max = 0;
  for (R_len_t i = 0; i < n; ++i, ++p) {
    int len = strlen(CHAR(*p));
    max = len > max ? len : max;
  }

  return max;
}

r_obj* r_chr_n(const char* const * strings, r_ssize n) {
  r_obj* out = KEEP(r_alloc_character(n));

  for (r_ssize i = 0; i < n; ++i) {
    r_chr_poke(out, i, r_str(strings[i]));
  }

  FREE(1);
  return out;
}

void r_chr_poke(r_obj* x, r_ssize i, r_obj* y) {
  SET_STRING_ELT(x, i, y);
}

r_obj* r_class(r_obj* x) {
  return r_attrib_get(x, r_syms.class_);
}

r_obj* r_clone(r_obj* x) {
  return Rf_shallow_duplicate(x);
}

SEXP r_clone_referenced(SEXP x) {
  if (MAYBE_REFERENCED(x)) {
    return Rf_shallow_duplicate(x);
  } else {
    return x;
  }
}

void r_cnd_signal(r_obj* cnd) {
  r_eval_with_x(cnd_signal_call, cnd, r_envs.base);
}

r_obj* r_copy(r_obj* x) {
  return Rf_duplicate(x);
}

r_complex* r_cpl_begin(r_obj* x) {
  return COMPLEX(x);
}

const r_complex* r_cpl_cbegin(r_obj* x) {
  return (const r_complex*) COMPLEX(x);
}

static SEXP r_date_as_character(SEXP x) {
  return vctrs_dispatch1(syms_date_as_character, fns_date_as_character, syms_x, x);
}

r_obj* r_dbl(double x) {
  return Rf_ScalarReal(x);
}

double* r_dbl_begin(r_obj* x) {
  return REAL(x);
}

const double* r_dbl_cbegin(r_obj* x) {
  return (const double*) REAL(x);
}

double r_dbl_get(r_obj* x, r_ssize i) {
  return REAL(x)[i];
}

r_obj* r_dim(r_obj* x) {
  return r_attrib_get(x, r_syms.dim);
}

r_obj* r_dim_names(r_obj* x) {
  return r_attrib_get(x, r_syms.dim_names);
}

int r_dyn_int_get(struct r_dyn_array* p_vec, r_ssize i) {
  return ((const int*) p_vec->v_data_const)[i];
}

void r_dyn_int_poke(struct r_dyn_array* p_vec, r_ssize i, int value) {
  ((int*) p_vec->v_data)[i] = value;
}

void r_dyn_int_push_back(struct r_dyn_array* p_vec, int elt) {
  r_ssize loc = r__dyn_increment(p_vec);
  r_dyn_int_poke(p_vec, loc, elt);
}

void* r_dyn_last(struct r_dyn_array* p_arr) {
  return r_dyn_pointer(p_arr, p_arr->count - 1);
}

void r_dyn_list_poke(struct r_dyn_array* p_vec, r_ssize i, r_obj* value) {
  r_list_poke(p_vec->data, i, value);
}

void r_dyn_list_push_back(struct r_dyn_array* p_vec, r_obj* elt) {
  KEEP(elt);
  r_ssize loc = r__dyn_increment(p_vec);
  r_dyn_list_poke(p_vec, loc, elt);
  FREE(1);
}

void* r_dyn_pointer(struct r_dyn_array* p_arr, r_ssize i) {
  if (p_arr->barrier_set) {
    r_abort("Can't take mutable pointer of barrier vector.");
  }
  r_ssize offset = i * p_arr->elt_byte_size;
  return ((unsigned char*) p_arr->v_data) + offset;
}

void r_dyn_push_back(struct r_dyn_array* p_arr,
                     const void* p_elt) {
  r_ssize loc = r__dyn_increment(p_arr);

  if (p_arr->barrier_set) {
    r_obj* value = *((r_obj* const *) p_elt);
    p_arr->barrier_set(p_arr->data, loc, value);
  } else if (p_elt) {
    r_memcpy(r_dyn_last(p_arr), p_elt, p_arr->elt_byte_size);
  } else {
    r_memset(r_dyn_last(p_arr), 0, p_arr->elt_byte_size);
  }
}

r_obj* r_dyn_unwrap(struct r_dyn_array* p_arr) {
  if (p_arr->type == R_TYPE_raw) {
    return r_raw_resize(p_arr->data, p_arr->count * p_arr->elt_byte_size);
  } else {
    return r_vec_resize0(p_arr->type, p_arr->data, p_arr->count);
  }
}

void r_env_bind(r_obj* env, r_obj* sym, r_obj* value) {
  // See rchk concerns in https://github.com/r-lib/rlang/commit/28ce7b01
  KEEP(value);
  Rf_defineVar(sym, value, env);
  FREE(1);
}

enum r_env_binding_type r_env_binding_type(r_obj* env, r_obj* sym) {
#if RLANG_HAS_R_BINDING_API
  switch (R_GetBindingType(sym, env)) {
  case R_BindingTypeUnbound: return R_ENV_BINDING_TYPE_unbound;
  case R_BindingTypeValue:   return R_ENV_BINDING_TYPE_value;
  case R_BindingTypeMissing: return R_ENV_BINDING_TYPE_missing;
  case R_BindingTypeDelayed: return R_ENV_BINDING_TYPE_delayed;
  case R_BindingTypeForced:  return R_ENV_BINDING_TYPE_forced;
  case R_BindingTypeActive:  return R_ENV_BINDING_TYPE_active;
  }
  r_stop_unreachable();
#else
  // Active binding check must come first since `r_env_find()` triggers them
  if (R_BindingIsActive(sym, env)) {
    return R_ENV_BINDING_TYPE_active;
  }

  r_obj* value = env_find(env, sym);

  if (value == R_UnboundValue) {
    return R_ENV_BINDING_TYPE_unbound;
  }

  if (value == r_missing_arg) {
    return R_ENV_BINDING_TYPE_missing;
  }

  if (r_typeof(value) == R_TYPE_promise) {
    bool forced;
    rlang_promise_unwrap(value, &forced);
    if (forced) {
      return R_ENV_BINDING_TYPE_forced;
    }

    return R_ENV_BINDING_TYPE_delayed;
  }

  return R_ENV_BINDING_TYPE_value;
#endif
}

r_obj* r_env_get(r_obj* env, r_obj* sym) {
  enum r_env_binding_type type = r_env_binding_type(env, sym);

  if (type == R_ENV_BINDING_TYPE_unbound) {
    r_abort("object '%s' not found", r_sym_c_string(sym));
  }
  if (type == R_ENV_BINDING_TYPE_missing) {
    return r_missing_arg;
  }

#if R_VERSION >= R_Version(4, 5, 0)
  return R_getVar(sym, env, FALSE);
#else
  r_obj* value = env_find(env, sym);
  if (r_typeof(value) == R_TYPE_dots) {
    return value;
  }

  // Handles value, delayed, forced, and active bindings
  return Rf_eval(sym, env);
#endif
}

r_obj* r_eval(r_obj* expr, r_obj* env) {
  return Rf_eval(expr, env);
}

r_obj* r_exec_mask_n(r_obj* fn_sym,
                     r_obj* fn,
                     const struct r_pair* args,
                     int n,
                     r_obj* parent) {
  r_obj* mask = KEEP(r_alloc_environment(n + 1, parent));
  r_obj* call = KEEP(r_exec_mask_n_call_poke(fn_sym, fn, args, n, mask));

  r_obj* out = r_eval(call, mask);

  FREE(2);
  return out;
}

r_obj* r_exec_n(r_obj* fn_sym,
                r_obj* fn,
                const struct r_pair* args,
                int n,
                r_obj* env) {
  r_obj* call = KEEP(r_exec_mask_n_call_poke(fn_sym, fn, args, n, env));
  r_obj* out = r_eval(call, env);

  FREE(1);
  return out;
}

r_obj* r_expr_protect(r_obj* x) {
  switch (r_typeof(x)) {
  case R_TYPE_symbol:
  case R_TYPE_call:
  case R_TYPE_promise:
    return r_call2(quote_prim, x);
  default:
    return x;
  }
}

r_obj* r_fn_body(r_obj* fn) {
  return R_ClosureExpr(fn);
}

r_obj* r_fn_env(r_obj* fn) {
#if R_VERSION >= R_Version(4, 5, 0)
  return R_ClosureEnv(fn);
#else
  return CLOENV(fn);
#endif
}

r_obj* r_fn_formals(r_obj* fn) {
#if R_VERSION >= R_Version(4, 5, 0)
  return R_ClosureFormals(fn);
#else
  return FORMALS(fn);
#endif
}

bool r_inherits(r_obj* x, const char* tag) {
  return Rf_inherits(x, tag);
}

void r_init_data_frame(r_obj* x, r_ssize n_rows) {
  init_compact_rownames(x, n_rows);
  r_attrib_poke(x, r_syms.class_, r_classes.data_frame);
}

void r_init_library_arg(void) {
  r_arg_match = (int (*)(r_obj*, r_obj*, struct r_lazy, struct r_lazy))
    r_peek_c_callable("rlang", "rlang_arg_match_2");
}

void r_init_library_call(void) {
  quote_prim = r_base_ns_get("quote");
}

void r_init_library_cnd(void) {
  msg_call = r_parse("message(x)");
  r_preserve(msg_call);

  wng_call = r_parse("warning(x, call. = FALSE)");
  r_preserve(wng_call);

  err_call = r_parse("rlang::abort(x)");
  r_preserve(err_call);

  cnd_signal_call = r_parse("rlang::cnd_signal(x)");
  r_preserve(cnd_signal_call);

  // Silence "'noreturn' attribute does not apply to types warning".
  // It seems like GCC doesn't handle attributes in casts so we need
  // to cast through a typedef.
  // https://stackoverflow.com/questions/9441262/function-pointer-to-attribute-const-function
  typedef r_no_return void (*r_stop_internal_t)(const char*,
                                                int,
                                                r_obj*,
                                                const char* fmt,
                                                ...);
  r_stop_internal = (r_stop_internal_t) R_GetCCallable("rlang", "rlang_stop_internal2");

  r_format_error_arg = (const char* (*)(r_obj*)) r_peek_c_callable("rlang", "rlang_format_error_arg");
  r_obj_type_friendly_full = (const char* (*)(r_obj*, bool, bool)) r_peek_c_callable("rlang", "rlang_obj_type_friendly_full");
}

void r_init_library_dyn_array(void) {
  r_preserve_global(dyn_array_class = r_chr("rlang_dyn_array"));
}

void r_init_library_env(void) {
#if R_VERSION < R_Version(4, 1, 0)
  new_env_call = r_parse_eval("as.call(list(new.env, TRUE, NULL, NULL))", r_envs.base);
  r_preserve(new_env_call);

  new_env__parent_node = r_node_cddr(new_env_call);
  new_env__size_node = r_node_cdr(new_env__parent_node);
#endif

  missing_prim = r_parse_eval("missing", r_envs.base);

  env2list_call = r_parse("as.list.environment(x, all.names = TRUE)");
  r_preserve(env2list_call);

  list2env_call = r_parse("list2env(x, envir = NULL, parent = y, hash = TRUE)");
  r_preserve(list2env_call);

  exists_call = r_parse("exists(y, envir = x, inherits = z)");
  r_preserve(exists_call);

  remove_call = r_parse("remove(list = y, envir = x, inherits = z)");
  r_preserve(remove_call);

  r_methods_ns_env = r_parse_eval("asNamespace('methods')", r_envs.base);
}

void r_init_library_eval(void) {
  r_lazy_missing_arg = (struct r_lazy) { .x = r_missing_arg, .env = r_null };
}

void r_init_library_fn(void) {
  const char* formals_code = "formals(function(..., .x = ..1, .y = ..2, . = ..1) NULL)";
  rlang_formula_formals = r_parse_eval(formals_code, r_envs.base);
  r_preserve_global(rlang_formula_formals);
}

void r_init_library_obj(r_obj* ns) {
  p_precious_dict = r_new_dict(PRECIOUS_DICT_INIT_SIZE);
  KEEP(p_precious_dict->shelter);
  r_env_bind(ns,
             r_sym(".__rlang_lib_precious_dict__."),
             p_precious_dict->shelter);
  FREE(1);

  // The Microsoft C library doesn't implement the hexadecimal
  // formatter correctly
  const char* null_addr = r_str_c_string(r_obj_address(r_null));
  if (null_addr[0] != '0' || null_addr[1] != 'x') {
    obj_address_formatter = "0x%p";
  }

  r_obj_encode_utf8 = (r_obj* (*)(r_obj*)) r_peek_c_callable("rlang", "rlang_obj_encode_utf8");

  as_label_call = r_parse("as_label(x)");
  r_preserve_global(as_label_call);
}

void r_init_library_quo(void) {
  r_quo_get_expr = (r_obj* (*)(r_obj*)) r_peek_c_callable("rlang", "rlang_quo_get_expr");
  r_quo_set_expr = (r_obj* (*)(r_obj*, r_obj*)) r_peek_c_callable("rlang", "rlang_quo_set_expr");
  r_quo_get_env = (r_obj* (*)(r_obj*)) r_peek_c_callable("rlang", "rlang_quo_get_env");
  r_quo_set_env = (r_obj* (*)(r_obj*, r_obj*)) r_peek_c_callable("rlang", "rlang_quo_set_env");
}

void r_init_library_session(void) {
  is_installed_call = r_parse("requireNamespace(x, quietly = TRUE)");
  r_preserve(is_installed_call);

  has_colour_call = r_parse("crayon::has_color()");
  r_preserve(has_colour_call);
}

void r_init_library_stack(void) {
  // `sys.frame(sys.nframe())` doesn't work because `sys.nframe()`
  // returns the number of the frame in which evaluation occurs. It
  // doesn't return the number of frames on the stack. So we'd need
  // to evaluate it in the last frame on the stack which is what we
  // are looking for to begin with. We use instead this workaround:
  // Call `sys.frame()` from a closure to push a new frame on the
  // stack, and use negative indexing to get the previous frame.
  r_obj* current_frame_body = KEEP(r_parse("sys.frame(-1)"));
  r_obj* current_frame_fn = KEEP(r_new_function(r_null, current_frame_body, r_envs.base));
  peek_frame_call = r_new_call(current_frame_fn, r_null);
  r_preserve(peek_frame_call);
  FREE(2);

  sys_frame_call = generate_sys_call("sys.frame", &sys_frame_n_addr);
  sys_call_call = generate_sys_call("sys.call", &sys_call_n_addr);

  caller_env_call = r_parse("parent.frame()");
  r_preserve_global(caller_env_call);
}

void r_init_library_sym(void) {
  r_sym_as_utf8_character = (r_obj* (*)(r_obj*)) r_peek_c_callable("rlang", "rlang_sym_as_character");
  r_sym_as_utf8_string = (r_obj* (*)(r_obj*)) r_peek_c_callable("rlang", "rlang_sym_as_string");
}

void r_init_library_vendor(void) {
  r_xxh3_64bits = (uint64_t (*)(const void*, size_t)) r_peek_c_callable("rlang", "rlang_xxh3_64bits");
}

void r_init_rlang_ns_env(void) {
  rlang_ns_env = r_ns_env("rlang");
}

r_obj* r_int(int x) {
  return Rf_ScalarInteger(x);
}

int* r_int_begin(r_obj* x) {
  return INTEGER(x);
}

const int* r_int_cbegin(r_obj* x) {
  return (const int*) INTEGER(x);
}

void r_int_fill(SEXP x, int value, R_len_t n) {
  r_p_int_fill(INTEGER(x), value, n);
}

void r_int_fill_seq(SEXP x, int start, R_len_t n) {
  int* data = INTEGER(x);

  for (R_len_t i = 0; i < n; ++i, ++data, ++start) {
    *data = start;
  }
}

int r_int_get(r_obj* x, r_ssize i) {
  return INTEGER(x)[i];
}

bool r_is_bool(r_obj* x) {
  return
    r_typeof(x) == R_TYPE_logical &&
    r_length(x) == 1 &&
    r_lgl_get(x, 0) != r_globals.na_lgl;
}

bool r_is_empty_names(SEXP x) {
  if (TYPEOF(x) != STRSXP) {
    if (x == R_NilValue) {
      return true;
    } else {
      return false;
    }
  }

  R_len_t n = Rf_length(x);
  const SEXP* p = STRING_PTR_RO(x);

  for (R_len_t i = 0; i < n; ++i, ++p) {
    SEXP elt = *p;
    if (elt != NA_STRING && elt != strings_empty) {
      return false;
    }
  }

  return true;
}

bool r_is_function(r_obj* x) {
  switch (r_typeof(x)) {
  case R_TYPE_closure:
  case R_TYPE_builtin:
  case R_TYPE_special:
    return true;
  default:
    return false;
  }
}

bool r_is_int(r_obj* x) {
  return
    r_typeof(x) == R_TYPE_integer &&
    r_length(x) == 1 &&
    r_int_get(x, 0) != r_globals.na_int;
}

bool r_is_minimal_names(SEXP x) {
  if (TYPEOF(x) != STRSXP) {
    return false;
  }

  R_len_t n = Rf_length(x);
  const SEXP* p = STRING_PTR_RO(x);

  for (R_len_t i = 0; i < n; ++i, ++p) {
    SEXP elt = *p;
    if (elt == NA_STRING || elt == strings_empty) {
      return false;
    }
  }

  return true;
}

bool r_is_number(SEXP x) {
  return TYPEOF(x) == INTSXP &&
    Rf_length(x) == 1 &&
    INTEGER(x)[0] != NA_INTEGER;
}

bool r_is_object(r_obj* x) {
  return Rf_isObject(x);
}

bool r_is_positive_number(SEXP x) {
  return r_is_number(x) && INTEGER(x)[0] > 0;
}

static inline bool r_is_s4(SEXP x) {
  return Rf_isS4(x);
}

bool r_is_scalar_logical(r_obj* x) {
  return r_typeof(x) == R_TYPE_logical && r_length(x) == 1;
}

bool r_is_string(r_obj* x) {
  return
    r_typeof(x) == R_TYPE_character &&
    r_length(x) == 1 &&
    r_chr_get(x, 0) != R_NaString;
}

r_ssize r_length(r_obj* x) {
  return Rf_xlength(x);
}

r_obj* r_lgl(bool x) {
  return Rf_ScalarLogical(x);
}

int* r_lgl_begin(r_obj* x) {
  return LOGICAL(x);
}

const int* r_lgl_cbegin(r_obj* x) {
  return (const int*) LOGICAL(x);
}

void r_lgl_fill(SEXP x, int value, R_len_t n) {
  r_p_lgl_fill(LOGICAL(x), value, n);
}

int r_lgl_get(r_obj* x, r_ssize i) {
  return LOGICAL(x)[i];
}

r_ssize r_lgl_sum(r_obj* x, bool na_true) {
  if (r_typeof(x) != R_TYPE_logical) {
    r_abort("Internal error: Excepted logical vector in `r_lgl_sum()`");
  }

  const r_ssize n = r_length(x);
  const int* v_x = r_lgl_cbegin(x);

  // This can't overflow since `sum` is necessarily smaller or equal
  // to the vector length expressed in `r_ssize`
  r_ssize sum = 0;

  if (na_true) {
    for (r_ssize i = 0; i < n; ++i) {
      sum += (bool) v_x[i];
    }
  } else {
    for (r_ssize i = 0; i < n; ++i) {
      sum += (v_x[i] == 1);
    }
  }

  return sum;
}

r_obj* const * r_list_cbegin(r_obj* x) {
#if (R_VERSION >= R_Version(4, 5, 0))
  return VECTOR_PTR_RO(x);
#else
  return ((r_obj* const *) DATAPTR_RO(x));
#endif
}

r_obj* r_list_get(r_obj* x, r_ssize i) {
  return VECTOR_ELT(x, i);
}

void r_list_poke(r_obj* x, r_ssize i, r_obj* y) {
  SET_VECTOR_ELT(x, i, y);
}

void r_mark_shared(r_obj* x) {
  MARK_NOT_MUTABLE(x);
}

void r_memcpy(void* dest, const void* src, size_t count) {
  if (count) {
    memcpy(dest, src, count);
  }
}

void r_memset(void* dest, int value, size_t count) {
  if (count) {
    memset(dest, value, count);
  }
}

r_obj* r_names(r_obj* x) {
  return r_attrib_get(x, r_syms.names);
}

SEXP r_new_character(R_len_t n) {
  return Rf_allocVector(STRSXP, n);
}

struct r_dyn_array* r_new_dyn_vector(enum r_type type,
                                     r_ssize capacity) {
  r_obj* shelter = KEEP(r_alloc_list(2));
  r_attrib_poke_class(shelter, dyn_array_class);

  r_obj* vec_raw = r_alloc_raw(sizeof(struct r_dyn_array));
  r_list_poke(shelter, 0, vec_raw);

  r_obj* vec_data = r_alloc_vector(type, capacity);
  r_list_poke(shelter, 1, vec_data);

  struct r_dyn_array* p_vec = r_raw_begin(vec_raw);
  p_vec->shelter = shelter;
  p_vec->count = 0;
  p_vec->capacity = capacity;
  p_vec->growth_factor = R_DYN_ARRAY_GROWTH_FACTOR;
  p_vec->type = type;
  p_vec->elt_byte_size = r_vec_elt_sizeof0(type);
  p_vec->data = vec_data;

  switch (type) {
  case R_TYPE_character:
    p_vec->v_data = NULL;
    p_vec->barrier_set = &r_chr_poke;
    break;
  case R_TYPE_list:
    p_vec->v_data = NULL;
    p_vec->barrier_set = &r_list_poke;
    break;
  default:
    p_vec->barrier_set = NULL;
    p_vec->v_data = r_vec_begin0(type, vec_data);
    break;
  }
  p_vec->v_data_const = r_vec_cbegin0(type, vec_data);

  FREE(1);
  return p_vec;
}

r_obj* r_new_function(r_obj* formals, r_obj* body, r_obj* env) {
#if R_VERSION >= R_Version(4, 5, 0)
  return R_mkClosure(formals, body, env);
#else
  SEXP fn = Rf_allocSExp(R_TYPE_closure);
  SET_FORMALS(fn, formals);
  SET_BODY(fn, body);
  SET_CLOENV(fn, env);
  return fn;
#endif
}

SEXP r_new_integer(R_len_t n) {
  return Rf_allocVector(INTSXP, n);
}

SEXP r_new_list(R_len_t n) {
  return Rf_allocVector(VECSXP, n);
}

SEXP r_new_logical(R_len_t n) {
  return Rf_allocVector(LGLSXP, n);
}

r_obj* r_new_node(r_obj* car, r_obj* cdr) {
  return Rf_cons(car, cdr);
}

SEXP r_new_raw(R_len_t n) {
  return Rf_allocVector(RAWSXP, n);
}

SEXP r_new_shared_character(const char* name) {
  SEXP out = Rf_mkString(name);
  R_PreserveObject(out);
  MARK_NOT_MUTABLE(out);
  return out;
}

SEXP r_new_shared_vector(SEXPTYPE type, R_len_t n) {
  SEXP out = Rf_allocVector(type, n);
  R_PreserveObject(out);
  MARK_NOT_MUTABLE(out);
  return out;
}

struct r_vector_bool* r_new_vector_bool(r_ssize n) {
  r_obj* shelter = KEEP(r_alloc_list(2));

  r_obj* vec = r_alloc_raw(sizeof(struct r_vector_bool));
  r_list_poke(shelter, 0, vec);

  r_obj* data = r_alloc_raw(n * sizeof(bool));
  r_list_poke(shelter, 1, data);

  struct r_vector_bool* p_vec = r_raw_begin(vec);
  p_vec->shelter = shelter;
  p_vec->data = data;
  p_vec->v_data = r_raw_begin(data);
  p_vec->n = n;

  FREE(1);
  return p_vec;
}

static inline r_obj* r_node_cadr(r_obj* x) { return CADR(x); }

static inline r_obj* r_node_car(r_obj* x) { return CAR(x); }

static inline r_obj* r_node_cddr(r_obj* x) { return CDDR(x); }

static inline r_obj* r_node_cdr(r_obj* x) { return CDR(x); }

static inline void r_node_poke_car(r_obj* x, r_obj* newcar) { SETCAR(x, newcar); }

static inline void r_node_poke_cdr(r_obj* x, r_obj* newcdr) { SETCDR(x, newcdr); }

static inline void r_node_poke_tag(r_obj* x, r_obj* tag) { SET_TAG(x, tag); }

static inline r_obj* r_node_tag(r_obj* x) { return TAG(x); }

r_obj* r_ns_env(const char* pkg) {
  r_obj* pkg_str = KEEP(r_chr(pkg));
  r_obj* ns = R_FindNamespace(pkg_str);
  FREE(1);
  return ns;
}

r_obj* r_obj_address(r_obj* x) {
  static char buf[1000];
  snprintf(buf, 1000, obj_address_formatter, (void*) x);
  return Rf_mkChar(buf);
}

void r_obj_print(r_obj* x) {
  Rf_PrintValue(x);
}

const char* r_obj_type_friendly(r_obj* x) {
  return r_obj_type_friendly_full(x, true, false);
}

r_obj* r_parse(const char* str) {
  r_obj* str_ = KEEP(r_chr(str));

  ParseStatus status;
  r_obj* out = KEEP(R_ParseVector(str_, -1, &status, r_null));
  if (status != PARSE_OK) {
    abort_parse(str_, "Parsing failed");
  }
  if (r_length(out) != 1) {
    abort_parse(str_, "Expected a single expression");
  }

  out = r_list_get(out, 0);

  FREE(2);
  return out;
}

r_obj* r_parse_eval(const char* str, r_obj* env) {
  r_obj* out = r_eval(KEEP(r_parse(str)), env);
  FREE(1);
  return out;
}

r_void_fn r_peek_c_callable(const char* pkg, const char* callable) {
  return R_GetCCallable(pkg, callable);
}

r_obj* r_peek_frame(void) {
  return r_eval(peek_frame_call, r_envs.base);
}

r_obj* r_peek_option(const char* name) {
  return Rf_GetOption1(Rf_install(name));
}

SEXP r_protect(SEXP x) {
  return Rf_lang2(fns_quote, x);
}

void* r_raw_begin(r_obj* x) {
  return RAW(x);
}

const void* r_raw_cbegin(r_obj* x) {
  return (const void*) RAW(x);
}

r_obj* r_seq_chr(const char* prefix, r_ssize n) {
  int total_len = 24 + strlen(prefix) + 1;

  R_CheckStack2(total_len);
  char buf[total_len];

  return r_chr_iota(n, buf, total_len, prefix);
}

r_ssize r_ssize_max(r_ssize x, r_ssize y) {
  return (y < x) ? x : y;
}

r_ssize r_ssize_min(r_ssize x, r_ssize y) {
  return (y < x) ? y : x;
}

r_ssize r_ssize_mult(r_ssize x, r_ssize y) {
  if (x > 0) {
    if (y > 0) {
      if (x > (R_SSIZE_MAX / y)) {
        goto error;
      }
    } else {
      if (y < (R_SSIZE_MIN / x)) {
        goto error;
      }
    }
  } else {
    if (y > 0) {
      if (x < (R_SSIZE_MIN / y)) {
        goto error;
      }
    } else {
      if ( (x != 0) && (y < (R_SSIZE_MAX / x))) {
        goto error;
      }
    }
  }

  return x * y;

 error:
  r_stop_internal("Result too large for an `r_ssize`.");
}

r_obj* r_str(const char* c_string) {
  return Rf_mkCharCE(c_string, CE_UTF8);
}

r_obj* r_str_as_character(r_obj* x) {
  return Rf_ScalarString(x);
}

const char* r_str_c_string(r_obj* str) {
  return CHAR(str);
}

r_obj* r_sym(const char* c_string) {
  return Rf_install(c_string);
}

const char* r_sym_c_string(r_obj* sym) {
  return CHAR(PRINTNAME(sym));
}

r_obj* r_sym_string(r_obj* sym) {
  return PRINTNAME(sym);
}

ERR r_try_catch(void (*fn)(void*),
                void* fn_data,
                SEXP cnd_sym,
                void (*hnd)(void*),
                void* hnd_data) {

  struct r_try_catch_data data = {
    .fn = fn,
    .fn_data = fn_data,
    .cnd_sym = cnd_sym,
    .hnd = hnd,
    .hnd_data = hnd_data,
    .err = NULL
  };
  SEXP xptr = PROTECT(R_MakeExternalPtr(&data, R_NilValue, R_NilValue));
  SEXP hnd_fn = PROTECT(try_catch_hnd(xptr));

  SEXP syms[3] = {
    syms_data,
    cnd_sym,
    NULL
  };
  SEXP args[3] = {
    xptr,
    hnd_fn,
    NULL
  };

  SEXP call = PROTECT(r_call_n(syms_try_catch_impl, syms, args));
  Rf_eval(call, vctrs_ns_env);

  UNPROTECT(3);
  return data.err;
}

enum r_type r_typeof(r_obj* x) {
  return (enum r_type) TYPEOF(x);
}

void* r_vec_begin0(enum r_type type, r_obj* x) {
  switch (type) {
  case R_TYPE_logical: return r_lgl_begin(x);
  case R_TYPE_integer: return r_int_begin(x);
  case R_TYPE_double: return r_dbl_begin(x);
  case R_TYPE_complex: return r_cpl_begin(x);
  case R_TYPE_raw: return r_raw_begin(x);
  default: r_stop_unimplemented_type(type);
  }
}

const void* r_vec_cbegin0(enum r_type type, r_obj* x) {
  switch (type) {
  case R_TYPE_logical: return r_lgl_cbegin(x);
  case R_TYPE_integer: return r_int_cbegin(x);
  case R_TYPE_double: return r_dbl_cbegin(x);
  case R_TYPE_complex: return r_cpl_cbegin(x);
  case R_TYPE_raw: return r_raw_cbegin(x);
  case R_TYPE_character: return r_chr_cbegin(x);
  case R_TYPE_list: return r_list_cbegin(x);
  default: r_stop_unimplemented_type(type);
  }
}

int r_vec_elt_sizeof0(enum r_type type) {
  switch (type) {
  case R_TYPE_logical: return sizeof(int);
  case R_TYPE_integer: return sizeof(int);
  case R_TYPE_double: return sizeof(double);
  case R_TYPE_complex: return sizeof(r_complex);
  case R_TYPE_raw: return sizeof(char);
  case R_TYPE_character: return sizeof(r_obj*);
  case R_TYPE_list: return sizeof(r_obj*);
  default: r_stop_unimplemented_type(type);
  }
}

r_obj* r_vec_resize0(enum r_type type, r_obj* x, r_ssize new_size) {
  switch (type) {
  case R_TYPE_logical: return r_lgl_resize(x, new_size);
  case R_TYPE_integer: return r_int_resize(x, new_size);
  case R_TYPE_double: return r_dbl_resize(x, new_size);
  case R_TYPE_complex: return r_cpl_resize(x, new_size);
  case R_TYPE_raw: return r_raw_resize(x, new_size);
  case R_TYPE_character: return r_chr_resize(x, new_size);
  case R_TYPE_list: return r_list_resize(x, new_size);
  default: r_stop_unimplemented_type(type);
  }
}

static inline void* r_vec_unwrap(SEXPTYPE type, SEXP x) {
  switch (type) {
  case INTSXP: return (void*) INTEGER(x);
  default: stop_unimplemented_type("r_vec_unwrap", type);
  }
}

bool* r_vector_bool_begin(struct r_vector_bool* p_vec) {
  return p_vec->v_data;
}

const bool* r_vector_bool_cbegin(struct r_vector_bool* p_vec) {
  return (const bool*) p_vec->v_data;
}

r_ssize r_vector_bool_length(struct r_vector_bool* p_vec) {
  return p_vec->n;
}

r_ssize raw_col_detect_missing(r_obj* x,
                               r_ssize* v_loc,
                               r_ssize loc_size) {
  COL_DETECT_MISSING(unsigned char, r_uchar_cbegin, raw_is_missing);
}

void raw_detect_complete(SEXP x, R_len_t size, int* p_out) {
  VEC_DETECT_COMPLETE(unsigned char, RAW_RO, raw_is_missing);
}

r_obj* raw_detect_missing(r_obj* x) {
  DETECT_MISSING(unsigned char, r_uchar_cbegin, raw_is_missing);
}

uint32_t raw_dict_hash_scalar(struct dictionary* d, R_len_t i) {
  return raw_dict_hash_with(d, d, i);
}

uint32_t raw_dict_hash_with(struct dictionary* d, struct dictionary* x, R_len_t i) {
  DICT_HASH_WITH(p_raw_equal_na_equal);
}

bool raw_dict_is_incomplete(struct dictionary* d, R_len_t i) {
  return dict_hash_is_missing(d, i) && p_raw_is_incomplete(d->p_poly_vec->p_vec, i);
}

static inline int raw_equal_na_equal(Rbyte x, Rbyte y) {
  return x == y;
}

static inline int raw_equal_na_propagate(Rbyte x, Rbyte y) {
  return raw_equal_na_equal(x, y);
}

r_ssize raw_first_missing(r_obj* x) {
  FIRST_MISSING(unsigned char, r_uchar_cbegin, raw_is_missing);
}

static inline uint32_t raw_hash_scalar(Rbyte x) {
  return uint32_hash(x);
}

bool raw_is_missing(unsigned char x) {
  return false;
}

r_ssize rownames_size(r_obj* rn) {
  switch (rownames_type(rn)) {
  case ROWNAMES_TYPE_identifiers:
  case ROWNAMES_TYPE_automatic:
    return r_length(rn);
  case ROWNAMES_TYPE_automatic_compact:
    return compact_rownames_length(rn);
  }

  never_reached("rownames_size");
}

SEXP s3_bare_class(SEXP x) {
  switch (TYPEOF(x)) {
  case NILSXP: return chrs_null;
  case LGLSXP: return chrs_logical;
  case INTSXP: return chrs_integer;
  case REALSXP: return chrs_double;
  case CPLXSXP: return chrs_complex;
  case STRSXP: return chrs_character;
  case RAWSXP: return chrs_raw;
  case VECSXP: return chrs_list;
  case EXPRSXP: return chrs_expression;
  case CLOSXP:
  case SPECIALSXP:
  case BUILTINSXP: return chrs_function;
  default: stop_unimplemented_vctrs_type("base_dispatch_class_str", vec_typeof(x));
  }
}

SEXP s3_class_find_method(const char* generic, SEXP cls, SEXP table) {
  // Avoid corrupt objects where `x` passes `r_is_object()`, but the class is NULL
  if (cls == R_NilValue) {
    return R_NilValue;
  }

  SEXP const* p_cls = STRING_PTR_RO(cls);
  int n_cls = Rf_length(cls);

  for (int i = 0; i < n_cls; ++i) {
    SEXP method = s3_get_method(generic, CHAR(p_cls[i]), table);
    if (method != R_NilValue) {
      return method;
    }
  }

  return R_NilValue;
}

enum s3_fallback s3_fallback_from_opts(r_obj* opts) {
  return (enum s3_fallback) r_int_get(r_list_get(opts, 0), 0);
}

SEXP s3_find_method(const char* generic, SEXP x, SEXP table) {
  if (!r_is_object(x)) {
    return R_NilValue;
  }

  SEXP cls = PROTECT(Rf_getAttrib(x, R_ClassSymbol));
  SEXP method = s3_class_find_method(generic, cls, table);

  UNPROTECT(1);
  return method;
}

SEXP s3_get_method(const char* generic, const char* cls, SEXP table) {
  SEXP sym = s3_paste_method_sym(generic, cls);
  return s3_sym_get_method(sym, table);
}

static inline SEXP s3_get_table(SEXP env) {
  if (r_env_has(env, syms_s3_methods_table)) {
    return r_env_get(env, syms_s3_methods_table);
  } else {
    return r_null;
  }
}

SEXP s4_class_find_method(SEXP cls, SEXP table) {
  // Avoid corrupt objects where `x` passes `r_is_object()`, but the class is NULL
  if (cls == R_NilValue) {
    return R_NilValue;
  }

  SEXP const* p_class = STRING_PTR_RO(cls);
  int n_class = Rf_length(cls);

  for (int i = 0; i < n_class; ++i) {
    SEXP method = s4_get_method(CHAR(p_class[i]), table);
    if (method != R_NilValue) {
      return method;
    }
  }

  return R_NilValue;
}

SEXP s4_find_method(SEXP x, SEXP table) {
  if (!r_is_s4(x)) {
    return R_NilValue;
  }

  SEXP cls = PROTECT(Rf_getAttrib(x, R_ClassSymbol));
  SEXP out = s4_class_find_method(cls, table);

  UNPROTECT(1);
  return out;
}

r_obj* set_names_dispatch(r_obj* x, r_obj* names) {
  return vctrs_dispatch2(syms_set_names_dispatch, fns_set_names_dispatch,
                         syms_x, x,
                         syms_names, names);
}

r_obj* set_rownames_dispatch(r_obj* x, r_obj* names) {
  return vctrs_dispatch2(syms_set_rownames_dispatch, fns_set_rownames_dispatch,
                         syms_x, x,
                         syms_names, names);
}

static inline uint32_t sexp_hash(r_obj* x) {
  switch (TYPEOF(x)) {
  // `NULL`
  case NILSXP: return 0;

  // Atomics
  case LGLSXP: return lgl_hash(x);
  case INTSXP: return int_hash(x);
  case REALSXP: return dbl_hash(x);
  case CPLXSXP: return cpl_hash(x);
  case RAWSXP: return raw_hash(x);
  case STRSXP: return chr_hash(x);
  case VECSXP: return list_hash(x);

  // Expressions
  case EXPRSXP: return expr_hash(x);

  // Node-like
  case DOTSXP:
  case LANGSXP:
  case LISTSXP:
  case BCODESXP: return node_hash(x);

  // Functions
  case CLOSXP: return fn_hash(x);

  // Pointer based hashing
  case SYMSXP:
  case SPECIALSXP:
  case BUILTINSXP:
  case ENVSXP:
  case EXTPTRSXP: return uint64_hash((uintptr_t) x);

  default: Rf_errorcall(R_NilValue, "Unsupported type %s", Rf_type2char(TYPEOF(x)));
  }
}

r_obj* shaped_as_df_col(r_obj* x, r_obj* outer) {
  // If packed, store array as a column
  if (outer != strings_empty) {
    return x;
  }

  // If unpacked, transform to data frame first. We repair names
  // after unpacking and concatenation.
  r_obj* out = KEEP(r_as_data_frame(x));

  // Remove names if they were repaired by `as.data.frame()`
  if (colnames(x) == r_null) {
    r_attrib_poke_names(out, r_null);
  }

  FREE(1);
  return out;
}

bool should_finalise(enum ptype_finalise finalise) {
  return finalise == PTYPE_FINALISE_true;
}

r_obj* size2_common(
  r_obj* x,
  r_obj* y,
  struct counters* counters,
  void* data
) {
  struct size_common_reduce_opts* reduce_opts = data;

  const r_ssize x_size = reduce_opts->current_size;
  const r_ssize y_size = vec_size_params(y, counters->next_arg, reduce_opts->call);

  int left = -1;

  r_obj* out = vec_size2_impl(
    x,
    y,
    x_size,
    y_size,
    counters->curr_arg,
    counters->next_arg,
    reduce_opts->call,
    &left
  );

  if (!left) {
    counters_shift(counters);
    reduce_opts->current_size = y_size;
  }

  return out;
}

size_t size_round_power_2(size_t size) {
    size_t out = 1;
    while (out < size) {
      out <<= 1;
    }
    return out;
}

r_obj* slice_names(r_obj* names, r_obj* subscript) {
  if (names == r_null) {
    return names;
  } else {
    // Ensures `NA_integer_` subscripts utilize `""` as the name
    return chr_names_slice(names, subscript, VCTRS_MATERIALIZE_false);
  }
}

r_obj* slice_rownames(r_obj* names, r_obj* subscript) {
  if (names == r_null) {
    return names;
  }

  names = KEEP(chr_slice(names, subscript, VCTRS_MATERIALIZE_false));

  // Rownames can't contain `NA` or duplicates
  names = vec_as_unique_names(names, true);

  FREE(1);
  return names;
}

void stop_bad_direction(void) {
  r_abort("`direction` must be one of \"down\", \"up\", \"downup\", or \"updown\".");
}

void stop_combine_unmatched(r_obj* loc, struct r_lazy error_call) {
  r_obj* syms[3] = {
    syms_loc,
    syms_call,
    NULL
  };
  r_obj* args[3] = {
    loc,
    KEEP(r_lazy_eval_protect(error_call)),
    NULL
  };

  r_obj* ffi_call = KEEP(r_call_n(syms_stop_combine_unmatched, syms, args));
  Rf_eval(ffi_call, vctrs_ns_env);

  never_reached("stop_combine_unmatched");
}

void stop_corrupt_factor_levels(SEXP x, struct vctrs_arg* arg) {
  SEXP call = PROTECT(Rf_lang3(Rf_install("stop_corrupt_factor_levels"),
                               PROTECT(r_protect(x)),
                               PROTECT(vctrs_arg(arg))));
  Rf_eval(call, vctrs_ns_env);
  never_reached("stop_corrupt_factor_levels");
}

void stop_corrupt_ordered_levels(SEXP x, struct vctrs_arg* arg) {
  SEXP call = PROTECT(Rf_lang3(Rf_install("stop_corrupt_ordered_levels"),
                               PROTECT(r_protect(x)),
                               PROTECT(vctrs_arg(arg))));
  Rf_eval(call, vctrs_ns_env);
  never_reached("stop_corrupt_ordered_levels");
}

void stop_incompatible_size(r_obj* x,
                            r_obj* y,
                            r_ssize x_size,
                            r_ssize y_size,
                            struct vctrs_arg* x_arg,
                            struct vctrs_arg* y_arg,
                            struct r_lazy call) {
  r_obj* syms[8] = {
    syms_x,
    syms_y,
    syms_x_size,
    syms_y_size,
    syms_x_arg,
    syms_y_arg,
    r_syms.call,
    NULL
  };
  r_obj* args[8] = {
    KEEP(r_protect(x)),
    KEEP(r_protect(y)),
    KEEP(r_int(x_size)),
    KEEP(r_int(y_size)),
    KEEP(vctrs_arg(x_arg)),
    KEEP(vctrs_arg(y_arg)),
    KEEP(r_lazy_eval_protect(call)),
    NULL
  };

  r_obj* ffi_call = KEEP(r_call_n(syms_stop_incompatible_size,
                                  syms,
                                  args));
  r_eval(ffi_call, vctrs_ns_env);

  r_stop_unreachable();
}

void stop_indicator_size(r_obj* i,
                         r_obj* n,
                         const struct location_opts* opts) {
  r_obj* arg = KEEP(vctrs_arg(opts->subscript_opts.subscript_arg));
  r_obj* call = KEEP(r_lazy_eval(opts->subscript_opts.call));
  vctrs_eval_mask5(r_sym("stop_indicator_size"),
                   syms_i, i,
                   syms_n, n,
                   syms_subscript_action, get_opts_action(&opts->subscript_opts),
                   syms_subscript_arg, arg,
                   syms_call, call);
  r_stop_unreachable();
}

static void stop_large_name(void) {
  r_abort("Can't tidy up name because it is too large.");
}

void stop_location_negative(r_obj* i,
                            const struct location_opts* opts) {
  r_obj* arg = KEEP(vctrs_arg(opts->subscript_opts.subscript_arg));
  r_obj* call = KEEP(r_lazy_eval(opts->subscript_opts.call));
  vctrs_eval_mask4(r_sym("stop_location_negative"),
                   syms_i, i,
                   syms_subscript_action, get_opts_action(&opts->subscript_opts),
                   syms_subscript_arg, arg,
                   syms_call, call);
  r_stop_unreachable();
}

void stop_location_negative_missing(r_obj* i,
                                    const struct location_opts* opts) {
  r_obj* arg = KEEP(vctrs_arg(opts->subscript_opts.subscript_arg));
  r_obj* call = KEEP(r_lazy_eval(opts->subscript_opts.call));
  vctrs_eval_mask4(r_sym("stop_location_negative_missing"),
                   syms_i, i,
                   syms_subscript_arg, arg,
                   syms_call, call,
                   syms_subscript_action, get_opts_action(&opts->subscript_opts));
  r_stop_unreachable();
}

void stop_location_negative_positive(r_obj* i,
                                     const struct location_opts* opts) {
  r_obj* arg = KEEP(vctrs_arg(opts->subscript_opts.subscript_arg));
  r_obj* call = KEEP(r_lazy_eval(opts->subscript_opts.call));
  vctrs_eval_mask4(r_sym("stop_location_negative_positive"),
                   syms_i, i,
                   syms_subscript_arg, arg,
                   syms_call, call,
                   syms_subscript_action, get_opts_action(&opts->subscript_opts));
  r_stop_unreachable();
}

void stop_location_oob_non_consecutive(r_obj* i,
                                       r_ssize size,
                                       const struct location_opts* opts) {
  r_obj* size_obj = KEEP(r_int(size));
  r_obj* arg = KEEP(vctrs_arg(opts->subscript_opts.subscript_arg));
  r_obj* call = KEEP(r_lazy_eval(opts->subscript_opts.call));
  vctrs_eval_mask5(r_sym("stop_location_oob_non_consecutive"),
                   syms_i, i,
                   syms_size, size_obj,
                   syms_subscript_action, get_opts_action(&opts->subscript_opts),
                   syms_subscript_arg, arg,
                   syms_call, call);

  FREE(1);
  r_stop_unreachable();
}

void stop_location_zero(r_obj* i,
                        const struct location_opts* opts) {
  r_obj* arg = KEEP(vctrs_arg(opts->subscript_opts.subscript_arg));
  r_obj* call = KEEP(r_lazy_eval(opts->subscript_opts.call));
  vctrs_eval_mask4(r_sym("stop_location_zero"),
                   syms_i, i,
                   syms_subscript_action, get_opts_action(&opts->subscript_opts),
                   syms_subscript_arg, arg,
                   syms_call, call);
  r_stop_unreachable();
}

void stop_name_repair(struct name_repair_opts* p_opts) {
  struct repair_error_info info = new_repair_error_info(p_opts);
  KEEP(info.shelter);

  r_abort_call(info.input_error_call,
               "%s must be a string or a function. See `?vctrs::vec_as_names`.",
               r_format_error_arg(info.input_error_repair_arg));
}

void stop_non_list_type(
  r_obj* x,
  struct vctrs_arg* arg,
  struct r_lazy call
) {
  r_eval_with_xyz(KEEP(r_parse("stop_non_list_type(x, y, z)")),
                  x,
                  KEEP(vctrs_arg(arg)),
                  KEEP(r_lazy_eval(call)),
                  vctrs_ns_env);
  r_stop_unreachable();
}

void stop_recycle_incompatible_size(r_ssize x_size,
                                    r_ssize size,
                                    struct vctrs_arg* x_arg,
                                    struct r_lazy call) {
  r_obj* syms[5] = {
    r_sym("x_size"),
    r_sym("size"),
    r_sym("x_arg"),
    syms_call,
    NULL
  };
  r_obj* args[5] = {
    KEEP(r_int(x_size)),
    KEEP(r_int(size)),
    KEEP(vctrs_arg(x_arg)),
    KEEP(r_lazy_eval_protect(call)),
    NULL
  };

  r_obj* stop_call = KEEP(r_call_n(r_sym("stop_recycle_incompatible_size"), syms, args));
  r_eval(stop_call, vctrs_ns_env);

  never_reached("stop_recycle_incompatible_size");
}

void stop_rep_each_times_missing(r_ssize i, struct r_lazy call, struct vctrs_arg* p_times_arg) {
  r_abort_lazy_call(call,
                    "%s can't be missing. Location %i is missing.",
                    vec_arg_format(p_times_arg),
                    i);
}

void stop_rep_each_times_negative(r_ssize i, struct r_lazy call, struct vctrs_arg* p_times_arg) {
  r_abort_lazy_call(call,
                    "%s must be a vector of positive numbers. Location %i is negative.",
                    vec_arg_format(p_times_arg),
                    i);
}

void stop_rep_each_times_oob(int times, r_ssize i, struct r_lazy call, struct vctrs_arg* p_times_arg) {
  r_abort_lazy_call(
    call,
    "%s must be less than %i, not %i. ",
    "Location %i is too large.",
    vec_arg_format(p_times_arg),
    R_LEN_T_MAX,
    times,
    i
  );
}

void stop_rep_size_oob(struct r_lazy call) {
  r_abort_lazy_call(
    call,
    "Long vectors are not yet supported. "
    "Requested output size must be less than %i.",
    R_LEN_T_MAX
  );
}

void stop_rep_times_missing(struct r_lazy call, struct vctrs_arg* p_times_arg) {
  r_abort_lazy_call(call,
                    "%s can't be missing.",
                    vec_arg_format(p_times_arg));
}

void stop_rep_times_negative(struct r_lazy call, struct vctrs_arg* p_times_arg) {
  r_abort_lazy_call(call,
                    "%s must be a positive number.",
                    vec_arg_format(p_times_arg));
}

void stop_rep_times_oob(int times, struct r_lazy call, struct vctrs_arg* p_times_arg) {
  r_abort_lazy_call(
    call,
    "%s must be less than %i, not %i.",
    vec_arg_format(p_times_arg),
    R_LEN_T_MAX,
    times
  );
}

void stop_rep_times_size(struct r_lazy call,
                         struct vctrs_arg* p_times_arg) {
  r_abort_lazy_call(call,
                    "%s must be a single number.",
                    vec_arg_format(p_times_arg));
}

void stop_subscript_empty(r_obj* i,
                          const struct location_opts* opts) {
  r_obj* call = KEEP(r_lazy_eval(opts->subscript_opts.call));
  vctrs_eval_mask2(r_sym("stop_subscript_empty"),
                   syms_i, i,
                   syms_call, call);
  r_stop_unreachable();
}

void stop_subscript_missing(r_obj* i,
                            const struct location_opts* opts) {
  r_obj* call = KEEP(r_lazy_eval(opts->subscript_opts.call));
  vctrs_eval_mask2(r_sym("stop_subscript_missing"),
                   syms_i, i,
                   syms_call, call);
  r_stop_unreachable();
}

void stop_subscript_negative_oob_location(r_obj* i,
                                          r_ssize size,
                                          const struct location_opts* opts) {
  struct location_opts error_opts = *opts;
  error_opts.subscript_opts.action = SUBSCRIPT_ACTION_NEGATE;
  stop_subscript_oob_location(i, size, &error_opts);
}

void stop_subscript_oob_location(r_obj* i,
                                 r_ssize size,
                                 const struct location_opts* opts) {
  r_obj* size_obj = KEEP(r_int(size));
  r_obj* arg = KEEP(vctrs_arg(opts->subscript_opts.subscript_arg));
  r_obj* call = KEEP(r_lazy_eval(opts->subscript_opts.call));
  vctrs_eval_mask6(r_sym("stop_subscript_oob"),
                   syms_i, i,
                   syms_subscript_type, chrs_numeric,
                   syms_size, size_obj,
                   syms_subscript_action, get_opts_action(&opts->subscript_opts),
                   syms_subscript_arg, arg,
                   syms_call, call);
  r_stop_unreachable();
}

void stop_subscript_oob_name(r_obj* i,
                             r_obj* names,
                             const struct location_opts* opts) {
  r_obj* arg = KEEP(vctrs_arg(opts->subscript_opts.subscript_arg));
  r_obj* call = KEEP(r_lazy_eval(opts->subscript_opts.call));
  vctrs_eval_mask6(r_sym("stop_subscript_oob"),
                   syms_i, i,
                   syms_subscript_type, chrs_character,
                   syms_names, names,
                   syms_subscript_action, get_opts_action(&opts->subscript_opts),
                   syms_subscript_arg, arg,
                   syms_call, call);
  r_stop_unreachable();
}

static inline r_obj* str_as_utf8(r_obj* x) {
  return Rf_mkCharCE(Rf_translateCharUTF8(x), CE_UTF8);
}

int str_cmp(
  const char* x,
  const char* y,
  const int direction
) {
  // Same pointer
  // In our research it seems like `strcmp()` doesn't optimize this check,
  // since it would be rare for most `strcmp()` usage. But for R's interned
  // strings it definitely matters for us.
  if (x == y) {
    return 0;
  } else {
    return direction * strcmp(x, y);
  }
}

 int str_cmp_maybe_na(
  SEXP x,
  SEXP y,
  const char* x_string,
  const char* y_string,
  const int direction,
  const int na_order
) {
  // Same pointer - including `NA`s
  if (x == y) {
    return 0;
  }

  if (x == NA_STRING) {
    return na_order;
  }

  if (y == NA_STRING) {
    return -na_order;
  }

  return direction * strcmp(x_string, y_string);
}

bool str_ge(
  const char* x,
  const char* y,
  const int direction
) {
  return str_cmp(x, y, direction) >= 0;
}

static inline bool str_is_ascii_or_utf8(r_obj* x) {
#if (R_VERSION >= R_Version(4, 5, 0))
  return Rf_charIsASCII(x) || (Rf_getCharCE(x) == CE_UTF8) || (x == r_globals.na_str);
#else
  const int mask_ascii = 8;
  const int mask_utf8 = 64;
  const int levels = LEVELS(x);
  return (levels & mask_ascii) || (levels & mask_utf8) || (x == r_globals.na_str);
#endif
}

static inline SEXP subscript_type_action_chr(enum subscript_type_action action) {
  switch (action) {
  case SUBSCRIPT_TYPE_ACTION_CAST: return chrs_cast;
  case SUBSCRIPT_TYPE_ACTION_ERROR: return chrs_error;
  }
  never_reached("subscript_type_action_chr");
}

ptrdiff_t suffix_pos(const char* name) {
  int n = strlen(name);

  const char* suffix_end = NULL;
  int in_dots = 0;
  bool in_digits = false;

  for (const char* ptr = name + n - 1; ptr >= name; --ptr) {
    char c = *ptr;

    if (in_digits) {
      if (c == '.') {
        in_digits = false;
        in_dots = 1;
        continue;
      }

      if (isdigit(c)) {
        continue;
      }

      goto done;
    }

    switch (in_dots) {
    case 0:
      if (isdigit(c)) {
        in_digits = true;
        continue;
      }
      goto done;
    case 1:
    case 2:
      if (c == '.') {
        ++in_dots;
        continue;
      }
      goto done;
    case 3:
      suffix_end = ptr + 1;
      if (isdigit(c)) {
        in_dots = 0;
        in_digits = true;
        continue;
      }
      goto done;

    default:
      r_stop_internal("Unexpected state.");
    }}

 done:
  if (suffix_end) {
    return suffix_end - name;
  } else {
    return -1;
  }
}

SEXP tib_cast(const struct cast_opts* opts) {
  SEXP out = PROTECT(df_cast_opts(opts));

  Rf_setAttrib(out, R_ClassSymbol, classes_tibble);

  UNPROTECT(1);
  return out;
}

r_obj* tib_ptype2(
  r_obj* x,
  r_obj* y,
  struct vctrs_arg* p_x_arg,
  struct vctrs_arg* p_y_arg,
  struct r_lazy call,
  enum s3_fallback s3_fallback
) {
  r_obj* out = KEEP(df_ptype2(
    x,
    y,
    p_x_arg,
    p_y_arg,
    call,
    s3_fallback
  ));
  r_attrib_poke_class(out, classes_tibble);
  FREE(1);
  return out;
}

bool times_is_oob(int times) {
  return times > R_LEN_T_MAX;
}

static inline SEXP try_catch_hnd(SEXP ptr) {
  SEXP call = PROTECT(Rf_lang2(syms_try_catch_hnd, ptr));
  SEXP out = Rf_eval(call, vctrs_ns_env);
  UNPROTECT(1);
  return out;
}

static bool tzone_equal(SEXP x_tzone, SEXP y_tzone) {
  // Equal objects?
  if (x_tzone == y_tzone) {
    return true;
  }

  // Equal CHARSXPs?
  SEXP x_string = STRING_ELT(x_tzone, 0);
  SEXP y_string = STRING_ELT(y_tzone, 0);

  if (x_string == y_string) {
    return true;
  }

  // Equal C char?
  const char* x_tzone_char = CHAR(x_string);
  const char* y_tzone_char = CHAR(y_string);

  return !strcmp(x_tzone_char, y_tzone_char);
}

static inline bool tzone_is_local(SEXP tzone) {
  return STRING_ELT(tzone, 0) == strings_empty;
}

static SEXP tzone_union(SEXP x_tzone, SEXP y_tzone) {
  if (tzone_is_local(x_tzone)) {
    return y_tzone;
  } else {
    return x_tzone;
  }
}

r_obj* vctrs_arg(struct vctrs_arg* arg) {
  if (!arg) {
    return chrs_empty;
  }

  r_ssize next_size = DEFAULT_ARG_BUF_SIZE;
  r_ssize size;

  r_obj* buf_holder = KEEP(r_null);
  char* buf;

  do {
    size = next_size;

    FREE(1);
    buf_holder = KEEP(r_alloc_raw(size));
    buf = (char*) r_raw_begin(buf_holder);

    // Reallocate a larger buffer at the next iteration if the current
    // buffer turns out too small
    next_size *= 1.5;
  } while (fill_arg_buffer(arg, buf, 0, size) < 0);

  r_obj* out = r_chr(buf);

  FREE(1);
  return out;
}

void vctrs_count_loop(struct dictionary* d, R_len_t n, int* p_count) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VCTRS_COUNT_LOOP(nil_dict_hash_scalar); break;
  case VCTRS_TYPE_logical: VCTRS_COUNT_LOOP(lgl_dict_hash_scalar); break;
  case VCTRS_TYPE_integer: VCTRS_COUNT_LOOP(int_dict_hash_scalar); break;
  case VCTRS_TYPE_double: VCTRS_COUNT_LOOP(dbl_dict_hash_scalar); break;
  case VCTRS_TYPE_complex: VCTRS_COUNT_LOOP(cpl_dict_hash_scalar); break;
  case VCTRS_TYPE_character: VCTRS_COUNT_LOOP(chr_dict_hash_scalar); break;
  case VCTRS_TYPE_raw: VCTRS_COUNT_LOOP(raw_dict_hash_scalar); break;
  case VCTRS_TYPE_list: VCTRS_COUNT_LOOP(list_dict_hash_scalar); break;
  case VCTRS_TYPE_dataframe: VCTRS_COUNT_LOOP(df_dict_hash_scalar); break;
  default: stop_unimplemented_vctrs_type("vctrs_count_loop", d->p_poly_vec->type);
  }
}

SEXP vctrs_date_validate(SEXP x) {
  return date_validate(x);
}

SEXP vctrs_datetime_validate(SEXP x) {
  return datetime_validate(x);
}

SEXP vctrs_detect_complete(SEXP x) {
  return vec_detect_complete(x);
}

SEXP vctrs_dim(SEXP x) {
  return vec_dim(x);
}

SEXP vctrs_dim_n(SEXP x) {
  return r_int(vec_dim_n(x));
}

SEXP vctrs_duplicated_any(SEXP x) {
  bool out = duplicated_any(x);
  return Rf_ScalarLogical(out);
}

void vctrs_duplicated_loop(struct dictionary* d, R_len_t n, uint32_t* p_hashes, int* p_out) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VCTRS_DUPLICATED_LOOP(nil_dict_hash_scalar); break;
  case VCTRS_TYPE_logical: VCTRS_DUPLICATED_LOOP(lgl_dict_hash_scalar); break;
  case VCTRS_TYPE_integer: VCTRS_DUPLICATED_LOOP(int_dict_hash_scalar); break;
  case VCTRS_TYPE_double: VCTRS_DUPLICATED_LOOP(dbl_dict_hash_scalar); break;
  case VCTRS_TYPE_complex: VCTRS_DUPLICATED_LOOP(cpl_dict_hash_scalar); break;
  case VCTRS_TYPE_character: VCTRS_DUPLICATED_LOOP(chr_dict_hash_scalar); break;
  case VCTRS_TYPE_raw: VCTRS_DUPLICATED_LOOP(raw_dict_hash_scalar); break;
  case VCTRS_TYPE_list: VCTRS_DUPLICATED_LOOP(list_dict_hash_scalar); break;
  case VCTRS_TYPE_dataframe: VCTRS_DUPLICATED_LOOP(df_dict_hash_scalar); break;
  default: stop_unimplemented_vctrs_type("vctrs_duplicated_loop", d->p_poly_vec->type);
  }
}

SEXP vctrs_eval_mask_n(SEXP fn, SEXP* syms, SEXP* args) {
  return vctrs_eval_mask_n_impl(R_NilValue, fn, syms, args, vctrs_ns_env);
}

static SEXP vctrs_eval_mask_n_impl(SEXP fn_sym, SEXP fn, SEXP* syms, SEXP* args, SEXP env) {
  SEXP mask = PROTECT(r_alloc_empty_environment(env));

  if (fn_sym != R_NilValue) {
    Rf_defineVar(fn_sym, fn, mask);
    fn = fn_sym;
  }

  SEXP body = PROTECT(r_call_n(fn, syms, syms));
  SEXP call_fn = PROTECT(r_new_function(R_NilValue, body, mask));
  SEXP call = PROTECT(Rf_lang1(call_fn));

  while (*syms) {
    Rf_defineVar(*syms, *args, mask);
    ++syms; ++args;
  }

  SEXP out = Rf_eval(call, env);

  UNPROTECT(4);
  return out;
}

SEXP vctrs_fast_c(SEXP x, SEXP y) {
  SEXPTYPE x_type = TYPEOF(x);

  if (x_type != TYPEOF(y)) {
    Rf_error("`x` and `y` must have the same types.");
  }

  switch (x_type) {
  case STRSXP: return chr_c(x, y);
  default: stop_unimplemented_type("vctrs_fast_c", x_type);
  }
}

SEXP vctrs_field_get(SEXP x, SEXP index) {
  check_rcrd(x);
  return vctrs_list_get(x, index);
}

SEXP vctrs_field_set(SEXP x, SEXP index, SEXP value) {
  check_rcrd(x);

  if (!obj_is_vector(value, VCTRS_ALLOW_NULL_no)) {
    Rf_errorcall(R_NilValue, "Invalid value: not a vector.");
  }

  if (vec_size(value) != vec_size(x)) {
    Rf_errorcall(R_NilValue, "Invalid value: incorrect length.");
  }

  return vctrs_list_set(x, index, value);
}

SEXP vctrs_fields(SEXP x) {
  check_rcrd(x);

  return Rf_getAttrib(x, R_NamesSymbol);
}

SEXP vctrs_fill_missing(SEXP x, SEXP direction, SEXP max_fill) {
  bool down;
  bool leading;
  parse_direction(direction, &down, &leading);

  int c_max_fill = parse_max_fill(max_fill);

  return vec_fill_missing(x, down, leading, c_max_fill);
}

void vctrs_group_id_loop(struct dictionary* d, R_len_t n, int* p_out) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VCTRS_GROUP_ID_LOOP(nil_dict_hash_scalar); break;
  case VCTRS_TYPE_logical: VCTRS_GROUP_ID_LOOP(lgl_dict_hash_scalar); break;
  case VCTRS_TYPE_integer: VCTRS_GROUP_ID_LOOP(int_dict_hash_scalar); break;
  case VCTRS_TYPE_double: VCTRS_GROUP_ID_LOOP(dbl_dict_hash_scalar); break;
  case VCTRS_TYPE_complex: VCTRS_GROUP_ID_LOOP(cpl_dict_hash_scalar); break;
  case VCTRS_TYPE_character: VCTRS_GROUP_ID_LOOP(chr_dict_hash_scalar); break;
  case VCTRS_TYPE_raw: VCTRS_GROUP_ID_LOOP(raw_dict_hash_scalar); break;
  case VCTRS_TYPE_list: VCTRS_GROUP_ID_LOOP(list_dict_hash_scalar); break;
  case VCTRS_TYPE_dataframe: VCTRS_GROUP_ID_LOOP(df_dict_hash_scalar); break;
  default: stop_unimplemented_vctrs_type("vctrs_group_id_loop", d->p_poly_vec->type);
  }
}

R_len_t vctrs_group_rle_loop(struct dictionary* d, R_len_t n, int* p_g, int* p_l) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VCTRS_GROUP_RLE_LOOP(nil_dict_hash_scalar, p_nil_equal_na_equal); break;
  case VCTRS_TYPE_logical: VCTRS_GROUP_RLE_LOOP(lgl_dict_hash_scalar, p_lgl_equal_na_equal); break;
  case VCTRS_TYPE_integer: VCTRS_GROUP_RLE_LOOP(int_dict_hash_scalar, p_int_equal_na_equal); break;
  case VCTRS_TYPE_double: VCTRS_GROUP_RLE_LOOP(dbl_dict_hash_scalar, p_dbl_equal_na_equal); break;
  case VCTRS_TYPE_complex: VCTRS_GROUP_RLE_LOOP(cpl_dict_hash_scalar, p_cpl_equal_na_equal); break;
  case VCTRS_TYPE_character: VCTRS_GROUP_RLE_LOOP(chr_dict_hash_scalar, p_chr_equal_na_equal); break;
  case VCTRS_TYPE_raw: VCTRS_GROUP_RLE_LOOP(raw_dict_hash_scalar, p_raw_equal_na_equal); break;
  case VCTRS_TYPE_list: VCTRS_GROUP_RLE_LOOP(list_dict_hash_scalar, p_list_equal_na_equal); break;
  case VCTRS_TYPE_dataframe: VCTRS_GROUP_RLE_LOOP(df_dict_hash_scalar, p_df_equal_na_equal); break;
  default: stop_unimplemented_vctrs_type("vctrs_group_rle_loop", d->p_poly_vec->type);
  }
}

SEXP vctrs_has_dim(SEXP x) {
  return r_lgl(has_dim(x));
}

void vctrs_id_loop(struct dictionary* d, R_len_t n, int* p_out) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VCTRS_ID_LOOP(nil_dict_hash_scalar); break;
  case VCTRS_TYPE_logical: VCTRS_ID_LOOP(lgl_dict_hash_scalar); break;
  case VCTRS_TYPE_integer: VCTRS_ID_LOOP(int_dict_hash_scalar); break;
  case VCTRS_TYPE_double: VCTRS_ID_LOOP(dbl_dict_hash_scalar); break;
  case VCTRS_TYPE_complex: VCTRS_ID_LOOP(cpl_dict_hash_scalar); break;
  case VCTRS_TYPE_character: VCTRS_ID_LOOP(chr_dict_hash_scalar); break;
  case VCTRS_TYPE_raw: VCTRS_ID_LOOP(raw_dict_hash_scalar); break;
  case VCTRS_TYPE_list: VCTRS_ID_LOOP(list_dict_hash_scalar); break;
  case VCTRS_TYPE_dataframe: VCTRS_ID_LOOP(df_dict_hash_scalar); break;
  default: stop_unimplemented_vctrs_type("vctrs_id_loop", d->p_poly_vec->type);
  }
}

SEXP vctrs_implements_ptype2(SEXP x) {
  return r_lgl(vec_implements_ptype2(x));
}

void vctrs_init_bind(r_obj* ns) {
  syms_vec_cbind_frame_ptype = r_sym("vec_cbind_frame_ptype");
  fns_vec_cbind_frame_ptype = r_env_get(ns, syms_vec_cbind_frame_ptype);
}

void vctrs_init_cast(r_obj* ns) {
  syms.vec_default_cast = r_sym("vec_default_cast");
}

void vctrs_init_data(r_obj* ns) {
  syms_vec_proxy = r_sym("vec_proxy");

  syms_vec_proxy_equal = r_sym("vec_proxy_equal");
  syms_vec_proxy_equal_array = r_sym("vec_proxy_equal.array");

  syms_vec_proxy_compare = r_sym("vec_proxy_compare");
  syms_vec_proxy_compare_array = r_sym("vec_proxy_compare.array");

  syms_vec_proxy_order = r_sym("vec_proxy_order");
  syms_vec_proxy_order_array = r_sym("vec_proxy_order.array");

  fns_vec_proxy_equal_array = r_env_get(ns, syms_vec_proxy_equal_array);
  fns_vec_proxy_compare_array = r_env_get(ns, syms_vec_proxy_compare_array);
  fns_vec_proxy_order_array = r_env_get(ns, syms_vec_proxy_order_array);
}

void vctrs_init_dictionary(SEXP ns) {
  args_needles = new_wrapper_arg(NULL, "needles");
  args_haystack = new_wrapper_arg(NULL, "haystack");
}

void vctrs_init_globals(r_obj* ns) {
  size_t n_strings = sizeof(struct lazy_calls) / sizeof(struct r_lazy);
  size_t n_lazy_calls = sizeof(struct strings) / sizeof(r_obj*);
  size_t n_globals = n_strings + n_lazy_calls;

  globals_shelter = r_new_dyn_vector(R_TYPE_list, n_globals);
  r_preserve(globals_shelter->shelter);

  // Symbols -----------------------------------------------------------
  syms.arg = r_sym("arg");
  syms.condition_arg = r_sym("condition_arg");
  syms.conditions_arg = r_sym("conditions_arg");
  syms.default_arg = r_sym("default_arg");
  syms.dot_arg = r_sym(".arg");
  syms.dot_call = r_sym(".call");
  syms.dot_error_arg = r_sym(".error_arg");
  syms.dot_error_call = r_sym(".error_call");
  syms.false_arg = r_sym("false_arg");
  syms.from_arg = r_sym("from_arg");
  syms.haystack_arg = r_sym("haystack_arg");
  syms.missing_arg = r_sym("missing_arg");
  syms.indices_arg = r_sym("indices_arg");
  syms.needles_arg = r_sym("needles_arg");
  syms.recurse = r_sym("recurse");
  syms.repair_arg = r_sym("repair_arg");
  syms.times_arg = r_sym("times_arg");
  syms.to_arg = r_sym("to_arg");
  syms.true_arg = r_sym("true_arg");
  syms.value_arg = r_sym("value_arg");
  syms.values_arg = r_sym("values_arg");
  syms.x_arg = r_sym("x_arg");
  syms.y_arg = r_sym("y_arg");

  // Strings and characters --------------------------------------------
  INIT_STRING(AsIs);
  INIT_STRING(repair);
  INIT_STRING(location);
  INIT_STRING(condition);

  // Args --------------------------------------------------------------
  INIT_ARG2(dot_name_repair, ".name_repair");
  INIT_ARG2(dot_ptype, ".ptype");
  INIT_ARG2(dot_size, ".size");
  INIT_ARG2(empty, "");
  INIT_ARG(i);
  INIT_ARG(max_fill);
  INIT_ARG(n);
  INIT_ARG(value);
  INIT_ARG(x);
  INIT_ARG(y);
  INIT_ARG(indices);
  INIT_ARG(sizes);
  INIT_ARG(ptype);
  INIT_ARG(size);

  // Lazy args ---------------------------------------------------------
  INIT_LAZY_ARG_2(dot_name_repair, ".name_repair");

  // Calls -------------------------------------------------------------
  INIT_CALL(vec_assign);
  INIT_CALL(vec_assign_seq);
  INIT_CALL(vec_init);
  INIT_CALL(vec_ptype_finalise);
  INIT_CALL(vec_recycle);
  INIT_CALL(vec_size);
}

void vctrs_init_interval(r_obj* ns) {
  args_start_ = new_wrapper_arg(NULL, "start");
  args_end_ = new_wrapper_arg(NULL, "end");
  args_lower_ = new_wrapper_arg(NULL, "lower");
  args_upper_ = new_wrapper_arg(NULL, "upper");
}

r_obj* vctrs_init_library(r_obj* ns) {
  r_init_library(ns);

  vctrs_init_bind(ns);
  vctrs_init_cast(ns);
  vctrs_init_data(ns);
  vctrs_init_dictionary(ns);
  vctrs_init_interval(ns);
  vctrs_init_match(ns);
  vctrs_init_names(ns);
  vctrs_init_proxy_restore(ns);
  vctrs_init_slice(ns);
  vctrs_init_slice_assign(ns);
  vctrs_init_subscript(ns);
  vctrs_init_subscript_loc(ns);
  vctrs_init_ptype(ns);
  vctrs_init_ptype2(ns);
  vctrs_init_ptype2_dispatch(ns);
  vctrs_init_rep(ns);
  vctrs_init_type_data_frame(ns);
  vctrs_init_type_date_time(ns);
  vctrs_init_type_info(ns);
  vctrs_init_unspecified(ns);
  vctrs_init_utils(ns);
  vctrs_init_globals(ns);

  return r_null;
}

void vctrs_init_match(r_obj* ns) {
  args_incomplete_ = new_wrapper_arg(NULL, "incomplete");
  args_no_match_ = new_wrapper_arg(NULL, "no_match");
  args_remaining_ = new_wrapper_arg(NULL, "remaining");
}

void vctrs_init_names(r_obj* ns) {
  syms_set_rownames_dispatch = r_sym("set_rownames_dispatch");
  syms_set_names_dispatch = r_sym("set_names_dispatch");
  syms_as_universal_names = r_sym("as_universal_names");
  syms_check_unique_names = r_sym("validate_unique");

  fns_set_rownames_dispatch = r_env_get(ns, syms_set_rownames_dispatch);
  fns_set_names_dispatch = r_env_get(ns, syms_set_names_dispatch);
  fns_as_universal_names = r_env_get(ns, syms_as_universal_names);
  fns_check_unique_names = r_env_get(ns, syms_check_unique_names);

  syms_glue_as_name_spec = r_sym("glue_as_name_spec");
  fns_glue_as_name_spec = r_env_get(ns, syms_glue_as_name_spec);
  syms_internal_spec = r_sym("_spec");

  name_spec_inner = r_chr("inner");
  r_preserve(name_spec_inner);

  unique_repair_default_opts.type = NAME_REPAIR_unique;
  unique_repair_default_opts.fn = r_null;
  unique_repair_default_opts.quiet = false;

  unique_repair_silent_opts.type = NAME_REPAIR_unique;
  unique_repair_silent_opts.fn = r_null;
  unique_repair_silent_opts.quiet = true;

  no_repair_opts.type = NAME_REPAIR_none;
  no_repair_opts.fn = r_null;
  no_repair_opts.quiet = true;
}

void vctrs_init_proxy_restore(r_obj* ns) {
  syms_vec_restore_dispatch = r_sym("vec_restore_dispatch");
  fns_vec_restore_dispatch = r_eval(syms_vec_restore_dispatch, ns);
}

void vctrs_init_ptype(r_obj* ns) {
  syms_vec_ptype = r_sym("vec_ptype");
}

void vctrs_init_ptype2(r_obj* ns) { }

void vctrs_init_ptype2_dispatch(r_obj* ns) {
  syms_vec_ptype2_default = r_sym("vec_default_ptype2");
}

void vctrs_init_rep(r_obj* ns) { }

void vctrs_init_slice(r_obj* ns) {
  syms.vec_slice_altrep = r_sym("vec_slice_altrep");
  syms.vec_slice_dispatch_integer64 = r_sym("vec_slice_dispatch_integer64");
  syms.vec_slice_fallback = r_sym("vec_slice_fallback");
  syms.vec_slice_fallback_integer64 = r_sym("vec_slice_fallback_integer64");

  fns.vec_slice_altrep = r_eval(syms.vec_slice_altrep, ns);
  fns.vec_slice_dispatch_integer64 = r_eval(syms.vec_slice_dispatch_integer64, ns);
  fns.vec_slice_fallback = r_eval(syms.vec_slice_fallback, ns);
  fns.vec_slice_fallback_integer64 = r_eval(syms.vec_slice_fallback_integer64, ns);
}

void vctrs_init_slice_assign(r_obj* ns) {
  syms_vec_assign_fallback = r_sym("vec_assign_fallback");
  fns_vec_assign_fallback = r_eval(syms_vec_assign_fallback, ns);
}

void vctrs_init_subscript(r_obj* ns) {
  syms_new_error_subscript_type = r_sym("new_error_subscript_type");
  syms_new_dbl_cast_subscript_body = r_sym("new_cnd_bullets_subscript_lossy_cast");
  syms_lossy_err = r_sym("lossy_err");

  fns_cnd_body_subscript_dim = r_eval(r_sym("cnd_body_subscript_dim"), ns);
}

void vctrs_init_subscript_loc(r_obj* ns) { }

void vctrs_init_type_data_frame(r_obj* ns) {
  syms_df_lossy_cast = r_sym("df_lossy_cast");
  fns_df_lossy_cast = r_eval(syms_df_lossy_cast, ns);
}

void vctrs_init_type_date_time(SEXP ns) {
  syms_tz = Rf_install("tz");

  syms_as_date = Rf_install("as.Date");
  syms_as_posixct = Rf_install("as.POSIXct");
  syms_as_posixlt = Rf_install("as.POSIXlt");
  syms_date_as_character = Rf_install("date_as_character");
  syms_chr_date_as_posixct = Rf_install("chr_date_as_posixct");
  syms_chr_date_as_posixlt = Rf_install("chr_date_as_posixlt");

  fns_as_date = r_env_get(R_BaseEnv, syms_as_date);
  fns_as_posixct = r_env_get(R_BaseEnv, syms_as_posixct);
  fns_as_posixlt = r_env_get(R_BaseEnv, syms_as_posixlt);
  fns_date_as_character = r_env_get(ns, syms_date_as_character);
  fns_chr_date_as_posixct = r_env_get(ns, syms_chr_date_as_posixct);
  fns_chr_date_as_posixlt = r_env_get(ns, syms_chr_date_as_posixlt);
}

void vctrs_init_type_info(r_obj* ns) {

}

void vctrs_init_unspecified(SEXP ns) {
  {
    vctrs_unspecified_class = Rf_allocVector(STRSXP, 1);
    R_PreserveObject(vctrs_unspecified_class);
    SET_STRING_ELT(vctrs_unspecified_class, 0, Rf_mkChar("vctrs_unspecified"));
  }

  vctrs_shared_empty_uns = vec_unspecified(0);
  R_PreserveObject(vctrs_shared_empty_uns);
  MARK_NOT_MUTABLE(vctrs_shared_empty_uns);

  syms_vec_ptype_finalise_dispatch = r_sym("vec_ptype_finalise_dispatch");
  fns_vec_ptype_finalise_dispatch = r_eval(syms_vec_ptype_finalise_dispatch, ns);
}

void vctrs_init_utils(SEXP ns) {
  vctrs_ns_env = ns;

  vctrs_debug_verbose = r_is_true(Rf_GetOption1(Rf_install("vctrs:::debug")));

  vctrs_method_table = r_env_get(ns, Rf_install(".__S3MethodsTable__."));
  base_method_table = r_env_get(R_BaseNamespace, Rf_install(".__S3MethodsTable__."));

  s4_c_method_table = r_parse_eval("environment(methods::getGeneric('c'))$.MTable", R_GlobalEnv);
  R_PreserveObject(s4_c_method_table);

  vctrs_shared_empty_str = Rf_mkString("");
  R_PreserveObject(vctrs_shared_empty_str);


  // Holds the CHARSXP objects because unlike symbols they can be
  // garbage collected
  strings2 = r_new_shared_vector(STRSXP, 25);

  strings_dots = Rf_mkChar("...");
  SET_STRING_ELT(strings2, 0, strings_dots);

  strings_empty = Rf_mkChar("");
  SET_STRING_ELT(strings2, 1, strings_empty);

  strings_date = Rf_mkChar("Date");
  SET_STRING_ELT(strings2, 2, strings_date);

  strings_posixct = Rf_mkChar("POSIXct");
  SET_STRING_ELT(strings2, 3, strings_posixct);

  strings_posixlt = Rf_mkChar("POSIXlt");
  SET_STRING_ELT(strings2, 4, strings_posixlt);

  strings_posixt = Rf_mkChar("POSIXt");
  SET_STRING_ELT(strings2, 5, strings_posixt);

  strings_none = Rf_mkChar("none");
  SET_STRING_ELT(strings2, 6, strings_none);

  strings_minimal = Rf_mkChar("minimal");
  SET_STRING_ELT(strings2, 7, strings_minimal);

  strings_unique = Rf_mkChar("unique");
  SET_STRING_ELT(strings2, 8, strings_unique);

  strings_universal = Rf_mkChar("universal");
  SET_STRING_ELT(strings2, 9, strings_universal);

  strings_check_unique = Rf_mkChar("check_unique");
  SET_STRING_ELT(strings2, 10, strings_check_unique);

  strings_unique_quiet = Rf_mkChar("unique_quiet");
  SET_STRING_ELT(strings2, 23, strings_unique_quiet);

  strings_universal_quiet = Rf_mkChar("universal_quiet");
  SET_STRING_ELT(strings2, 24, strings_universal_quiet);

  strings_key = Rf_mkChar("key");
  SET_STRING_ELT(strings2, 11, strings_key);

  strings_loc = Rf_mkChar("loc");
  SET_STRING_ELT(strings2, 12, strings_loc);

  strings_val = Rf_mkChar("val");
  SET_STRING_ELT(strings2, 13, strings_val);

  strings_group = Rf_mkChar("group");
  SET_STRING_ELT(strings2, 14, strings_group);

  strings_length = Rf_mkChar("length");
  SET_STRING_ELT(strings2, 15, strings_length);

  strings_factor = Rf_mkChar("factor");
  SET_STRING_ELT(strings2, 16, strings_factor);

  strings_ordered = Rf_mkChar("ordered");
  SET_STRING_ELT(strings2, 17, strings_ordered);

  strings_list = Rf_mkChar("list");
  SET_STRING_ELT(strings2, 18, strings_list);

  strings_vctrs_vctr = Rf_mkChar("vctrs_vctr");
  SET_STRING_ELT(strings2, 19, strings_vctrs_vctr);

  strings_times = Rf_mkChar("times");
  SET_STRING_ELT(strings2, 20, strings_times);

  strings_needles = Rf_mkChar("needles");
  SET_STRING_ELT(strings2, 21, strings_needles);

  strings_haystack = Rf_mkChar("haystack");
  SET_STRING_ELT(strings2, 22, strings_haystack);


  classes_data_frame = r_new_shared_vector(STRSXP, 1);
  strings_data_frame = Rf_mkChar("data.frame");
  SET_STRING_ELT(classes_data_frame, 0, strings_data_frame);

  classes_factor = r_new_shared_vector(STRSXP, 1);
  SET_STRING_ELT(classes_factor, 0, strings_factor);

  classes_ordered = r_new_shared_vector(STRSXP, 2);
  SET_STRING_ELT(classes_ordered, 0, strings_ordered);
  SET_STRING_ELT(classes_ordered, 1, strings_factor);

  classes_date = r_new_shared_vector(STRSXP, 1);
  SET_STRING_ELT(classes_date, 0, strings_date);

  classes_posixct = r_new_shared_vector(STRSXP, 2);
  SET_STRING_ELT(classes_posixct, 0, strings_posixct);
  SET_STRING_ELT(classes_posixct, 1, strings_posixt);

  chrs_subset = r_new_shared_character("subset");
  chrs_extract = r_new_shared_character("extract");
  chrs_assign = r_new_shared_character("assign");
  chrs_rename = r_new_shared_character("rename");
  chrs_remove = r_new_shared_character("remove");
  chrs_negate = r_new_shared_character("negate");
  chrs_null = r_new_shared_character("NULL");
  chrs_logical = r_new_shared_character("logical");
  chrs_integer = r_new_shared_character("integer");
  chrs_double = r_new_shared_character("double");
  chrs_complex = r_new_shared_character("complex");
  chrs_character = r_new_shared_character("character");
  chrs_raw = r_new_shared_character("raw");
  chrs_list = r_new_shared_character("list");
  chrs_expression = r_new_shared_character("expression");
  chrs_numeric = r_new_shared_character("numeric");
  chrs_function = r_new_shared_character("function");
  chrs_empty = r_new_shared_character("");
  chrs_cast = r_new_shared_character("cast");
  chrs_error = r_new_shared_character("error");
  chrs_combine = r_new_shared_character("combine");
  chrs_convert = r_new_shared_character("convert");
  chrs_asc = r_new_shared_character("asc");
  chrs_desc = r_new_shared_character("desc");
  chrs_largest = r_new_shared_character("largest");
  chrs_smallest = r_new_shared_character("smallest");
  chrs_which = r_new_shared_character("which");

  classes_tibble = r_new_shared_vector(STRSXP, 3);

  strings_tbl_df = Rf_mkChar("tbl_df");
  SET_STRING_ELT(classes_tibble, 0, strings_tbl_df);

  strings_tbl = Rf_mkChar("tbl");
  SET_STRING_ELT(classes_tibble, 1, strings_tbl);
  SET_STRING_ELT(classes_tibble, 2, strings_data_frame);


  classes_vctrs_group_rle = r_new_shared_vector(STRSXP, 3);
  SET_STRING_ELT(classes_vctrs_group_rle, 0, Rf_mkChar("vctrs_group_rle"));
  SET_STRING_ELT(classes_vctrs_group_rle, 1, Rf_mkChar("vctrs_rcrd"));
  SET_STRING_ELT(classes_vctrs_group_rle, 2, Rf_mkChar("vctrs_vctr"));


  vctrs_shared_empty_date = r_new_shared_vector(REALSXP, 0);
  Rf_setAttrib(vctrs_shared_empty_date, R_ClassSymbol, classes_date);

  vctrs_shared_na_cpl.i = NA_REAL;
  vctrs_shared_na_cpl.r = NA_REAL;

  vctrs_shared_missing_lgl = r_new_shared_vector(LGLSXP, 1);
  LOGICAL(vctrs_shared_missing_lgl)[0] = NA_LOGICAL;

  vctrs_shared_missing_int = r_new_shared_vector(INTSXP, 1);
  INTEGER(vctrs_shared_missing_int)[0] = NA_INTEGER;

  vctrs_shared_missing_dbl = r_new_shared_vector(REALSXP, 1);
  REAL(vctrs_shared_missing_dbl)[0] = NA_REAL;

  vctrs_shared_missing_cpl = r_new_shared_vector(CPLXSXP, 1);
  COMPLEX(vctrs_shared_missing_cpl)[0] = vctrs_shared_na_cpl;

  // No actual `NA` value for raw, but we always use `0`
  vctrs_shared_missing_raw = r_new_shared_vector(RAWSXP, 1);
  RAW(vctrs_shared_missing_raw)[0] = 0;

  vctrs_shared_missing_chr = r_new_shared_vector(STRSXP, 1);
  SET_STRING_ELT(vctrs_shared_missing_chr, 0, NA_STRING);

  vctrs_shared_missing_list = r_new_shared_vector(VECSXP, 1);
  SET_VECTOR_ELT(vctrs_shared_missing_list, 0, R_NilValue);

  vctrs_shared_zero_int = r_new_shared_vector(INTSXP, 1);
  INTEGER(vctrs_shared_zero_int)[0] = 0;

  syms_i = Rf_install("i");
  syms_j = Rf_install("j");
  syms_n = Rf_install("n");
  syms_x = Rf_install("x");
  syms_y = Rf_install("y");
  syms_x_size = Rf_install("x_size");
  syms_y_size = Rf_install("y_size");
  syms_to = Rf_install("to");
  syms_dots = Rf_install("...");
  syms_bracket = Rf_install("[");
  syms_x_arg = Rf_install("x_arg");
  syms_y_arg = Rf_install("y_arg");
  syms_to_arg = Rf_install("to_arg");
  syms_times_arg = Rf_install("times_arg");
  syms_subscript_arg = Rf_install("subscript_arg");
  syms_needles_arg = Rf_install("needles_arg");
  syms_haystack_arg = Rf_install("haystack_arg");
  syms_out = Rf_install("out");
  syms_value = Rf_install("value");
  syms_quiet = Rf_install("quiet");
  syms_dot_name_spec = Rf_install(".name_spec");
  syms_outer = Rf_install("outer");
  syms_inner = Rf_install("inner");
  syms_tilde = Rf_install("~");
  syms_dot_environment = Rf_install(".Environment");
  syms_ptype = Rf_install("ptype");
  syms_missing = R_MissingArg;
  syms_size = Rf_install("size");
  syms_subscript_action = Rf_install("subscript_action");
  syms_subscript_type = Rf_install("subscript_type");
  syms_repair = Rf_install("repair");
  syms_tzone = Rf_install("tzone");
  syms_data = Rf_install("data");
  syms_try_catch_impl = Rf_install("try_catch_impl");
  syms_try_catch_hnd = Rf_install("try_catch_hnd");
  syms_vctrs_error_incompatible_type = Rf_install("vctrs_error_incompatible_type");
  syms_vctrs_error_cast_lossy = Rf_install("vctrs_error_cast_lossy");
  syms_cnd_signal = Rf_install("cnd_signal");
  syms_logical = Rf_install("logical");
  syms_numeric = Rf_install("numeric");
  syms_character = Rf_install("character");
  syms_body = Rf_install("body");
  syms_parent = Rf_install("parent");
  syms_s3_methods_table = Rf_install(".__S3MethodsTable__.");
  syms_from_dispatch = Rf_install("vctrs:::from_dispatch");
  syms_s3_fallback = Rf_install("vctrs:::s3_fallback");
  syms_stop_incompatible_type = Rf_install("stop_incompatible_type");
  syms_stop_incompatible_size = Rf_install("stop_incompatible_size");
  syms_stop_assert_size = Rf_install("stop_assert_size");
  syms_stop_matches_overflow = Rf_install("stop_matches_overflow");
  syms_stop_matches_nothing = Rf_install("stop_matches_nothing");
  syms_stop_matches_remaining = Rf_install("stop_matches_remaining");
  syms_stop_matches_incomplete = Rf_install("stop_matches_incomplete");
  syms_stop_matches_multiple = Rf_install("stop_matches_multiple");
  syms_warn_matches_multiple = Rf_install("warn_matches_multiple");
  syms_stop_matches_relationship_one_to_one = Rf_install("stop_matches_relationship_one_to_one");
  syms_stop_matches_relationship_one_to_many = Rf_install("stop_matches_relationship_one_to_many");
  syms_stop_matches_relationship_many_to_one = Rf_install("stop_matches_relationship_many_to_one");
  syms_warn_matches_relationship_many_to_many = Rf_install("warn_matches_relationship_many_to_many");
  syms_stop_combine_unmatched = Rf_install("stop_combine_unmatched");
  syms_action = Rf_install("action");
  syms_vctrs_common_class_fallback = Rf_install(c_strs_vctrs_common_class_fallback);
  syms_fallback_class = Rf_install("fallback_class");
  syms_abort = Rf_install("abort");
  syms_message = Rf_install("message");
  syms_chr_proxy_collate = Rf_install("chr_proxy_collate");
  syms_actual = Rf_install("actual");
  syms_required = Rf_install("required");
  syms_call = Rf_install("call");
  syms_dot_call = Rf_install(".call");
  syms_which = Rf_install("which");
  syms_slice_value = Rf_install("slice_value");
  syms_index_style = Rf_install("index_style");
  syms_loc = Rf_install("loc");

  fns_bracket = r_env_get(R_BaseEnv, syms_bracket);
  fns_quote = r_env_get(R_BaseEnv, Rf_install("quote"));
  fns_names = r_env_get(R_BaseEnv, Rf_install("names"));

  new_env_call = r_parse_eval("as.call(list(new.env, TRUE, NULL, NULL))", R_BaseEnv);
  R_PreserveObject(new_env_call);

  new_env__parent_node = CDDR(new_env_call);
  new_env__size_node = CDR(new_env__parent_node);

  rlang_sym_as_character = (SEXP (*)(SEXP)) R_GetCCallable("rlang", "rlang_sym_as_character");

  syms_as_data_frame2 = Rf_install("as.data.frame2");
  syms_colnames = Rf_install("colnames");

  fns_as_data_frame2 = r_env_get(ns, syms_as_data_frame2);
  fns_colnames = r_env_get(R_BaseEnv, syms_colnames);

  compact_seq_class_string = "vctrs_compact_seq";
  compact_seq_classes = Rf_allocVector(STRSXP, 1);
  R_PreserveObject(compact_seq_classes);
  SET_STRING_ELT(compact_seq_classes, 0, Rf_mkChar(compact_seq_class_string));

  compact_rep_class_string = "vctrs_compact_rep";
  compact_rep_classes = Rf_allocVector(STRSXP, 1);
  R_PreserveObject(compact_rep_classes);
  SET_STRING_ELT(compact_rep_classes, 0, Rf_mkChar(compact_rep_class_string));

  compact_condition_class_string = "vctrs_compact_condition";
  compact_condition_classes = Rf_allocVector(STRSXP, 1);
  R_PreserveObject(compact_condition_classes);
  SET_STRING_ELT(compact_condition_classes, 0, Rf_mkChar(compact_condition_class_string));

  rlang_result_names = Rf_allocVector(STRSXP, 2);
  R_PreserveObject(rlang_result_names);
  SET_STRING_ELT(rlang_result_names, 0, Rf_mkChar("ok"));
  SET_STRING_ELT(rlang_result_names, 1, Rf_mkChar("err"));

  rlang_result_class = Rf_allocVector(STRSXP, 1);
  R_PreserveObject(rlang_result_class);
  SET_STRING_ELT(rlang_result_class, 0, Rf_mkChar("rlang_result"));

  // We assume the following in `union vctrs_dbl_indicator`
  VCTRS_ASSERT(sizeof(double) == sizeof(int64_t));
  VCTRS_ASSERT(sizeof(double) == 2 * sizeof(int));

  // We assume the following in `vec_order()`
  VCTRS_ASSERT(sizeof(int) == sizeof(int32_t));
  VCTRS_ASSERT(sizeof(double) == sizeof(int64_t));
}

r_obj* vctrs_is_altrep(r_obj* x) {
  return r_lgl(ALTREP(x));
}

SEXP vctrs_is_unspecified(SEXP x) {
  return Rf_ScalarLogical(vec_is_unspecified(x));
}

r_obj* vctrs_list_drop_empty(r_obj* x) {
  return list_drop_empty(x);
}

SEXP vctrs_locate_complete(SEXP x) {
  return vec_locate_complete(x);
}

void vctrs_n_distinct_loop(struct dictionary* d, R_len_t n) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VCTRS_N_DISTINCT_LOOP(nil_dict_hash_scalar); break;
  case VCTRS_TYPE_logical: VCTRS_N_DISTINCT_LOOP(lgl_dict_hash_scalar); break;
  case VCTRS_TYPE_integer: VCTRS_N_DISTINCT_LOOP(int_dict_hash_scalar); break;
  case VCTRS_TYPE_double: VCTRS_N_DISTINCT_LOOP(dbl_dict_hash_scalar); break;
  case VCTRS_TYPE_complex: VCTRS_N_DISTINCT_LOOP(cpl_dict_hash_scalar); break;
  case VCTRS_TYPE_character: VCTRS_N_DISTINCT_LOOP(chr_dict_hash_scalar); break;
  case VCTRS_TYPE_raw: VCTRS_N_DISTINCT_LOOP(raw_dict_hash_scalar); break;
  case VCTRS_TYPE_list: VCTRS_N_DISTINCT_LOOP(list_dict_hash_scalar); break;
  case VCTRS_TYPE_dataframe: VCTRS_N_DISTINCT_LOOP(df_dict_hash_scalar); break;
  default: stop_unimplemented_vctrs_type("vctrs_n_distinct_loop", d->p_poly_vec->type);
  }
}

SEXP vctrs_n_fields(SEXP x) {
  check_rcrd(x);

  return Rf_ScalarInteger(Rf_length(x));
}

SEXP vctrs_new_date(SEXP x) {
  return new_date(x);
}

SEXP vctrs_new_datetime(SEXP x, SEXP tzone) {
  return new_datetime(x, tzone);
}

SEXP vctrs_order(
  SEXP x,
  SEXP direction,
  SEXP na_value,
  SEXP nan_distinct,
  SEXP chr_proxy_collate
) {
  bool c_nan_distinct = parse_nan_distinct(nan_distinct);
  return vec_order(x, direction, na_value, c_nan_distinct, chr_proxy_collate);
}

SEXP vctrs_s3_find_method(SEXP generic, SEXP x, SEXP table) {
  return s3_find_method(r_chr_get_c_string(generic, 0), x, table);
}

SEXP vctrs_slice_complete(SEXP x) {
  return vec_slice_complete(x);
}

SEXP vctrs_try_catch_callback(SEXP ptr, SEXP cnd) {
  struct r_try_catch_data* data = (struct r_try_catch_data*) R_ExternalPtrAddr(ptr);

  if (cnd == R_NilValue) {
    if (data->fn) {
      data->fn(data->fn_data);
    }
  } else {
    data->err = cnd;
    if (data->hnd) {
      data->hnd(data->hnd_data);
    }
  }

  return R_NilValue;
}

r_obj* vctrs_typeof(r_obj* x, r_obj* dispatch) {
  enum vctrs_type type;
  if (r_lgl_get(dispatch, 0)) {
    type = vec_proxy_info(x).type;
  } else {
    type = vec_typeof(x);
  }
  return r_chr(vec_type_as_str(type));
}

void vctrs_unique_loc_loop(struct dictionary* d, struct growable* g, R_len_t n) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VCTRS_UNIQUE_LOC_LOOP(nil_dict_hash_with); break;
  case VCTRS_TYPE_logical: VCTRS_UNIQUE_LOC_LOOP(lgl_dict_hash_with); break;
  case VCTRS_TYPE_integer: VCTRS_UNIQUE_LOC_LOOP(int_dict_hash_with); break;
  case VCTRS_TYPE_double: VCTRS_UNIQUE_LOC_LOOP(dbl_dict_hash_with); break;
  case VCTRS_TYPE_complex: VCTRS_UNIQUE_LOC_LOOP(cpl_dict_hash_with); break;
  case VCTRS_TYPE_character: VCTRS_UNIQUE_LOC_LOOP(chr_dict_hash_with); break;
  case VCTRS_TYPE_raw: VCTRS_UNIQUE_LOC_LOOP(raw_dict_hash_with); break;
  case VCTRS_TYPE_list: VCTRS_UNIQUE_LOC_LOOP(list_dict_hash_with); break;
  case VCTRS_TYPE_dataframe: VCTRS_UNIQUE_LOC_LOOP(df_dict_hash_with); break;
  default: stop_unimplemented_vctrs_type("vctrs_unique_loc_loop", d->p_poly_vec->type);
  }
}

SEXP vctrs_unspecified(SEXP n) {
  if (Rf_length(n) != 1) {
    Rf_errorcall(R_NilValue, "`n` must be a single number");
  }
  if (TYPEOF(n) != INTSXP) {
    n = vec_cast(n,
                 r_globals.empty_int,
                 vec_args.empty,
                 vec_args.empty,
                 r_lazy_null);
  }
  int len = INTEGER(n)[0];
  return vec_unspecified(len);
}

r_obj* vctrs_validate_minimal_names(r_obj* names, r_obj* n_) {
  r_ssize n = -1;

  if (r_typeof(n_) == R_TYPE_integer) {
    if (r_length(n_) != 1) {
      r_stop_internal("`n` must be a single number.");
    }
    n = r_int_get(n_, 0);
  }

  vec_validate_minimal_names(names, n, r_lazy_null);
  return names;
}

r_obj* vctrs_validate_name_repair_arg(r_obj* arg) {
  struct name_repair_opts opts = new_name_repair_opts(arg,
                                                      r_lazy_null,
                                                      true,
                                                      r_lazy_null);
  if (opts.type == NAME_REPAIR_custom) {
    return opts.fn;
  } else if (r_length(arg) != 1) {
    return r_str_as_character(r_str(name_repair_arg_as_c_string(opts.type)));
  } else {
    return arg;
  }
}

bool vec_any_missing(r_obj* x) {
  return vec_first_missing(x) != vec_size(x);
}

const char* vec_arg_format(struct vctrs_arg* p_arg) {
  r_obj* arg = KEEP(vctrs_arg(p_arg));
  const char* out = r_format_error_arg(arg);
  FREE(1);
  return out;
}

static inline struct vctrs_arg vec_as_arg(SEXP x) {
  if (x == R_NilValue) {
    return *vec_args.empty;
  }

  if (!r_is_string(x)) {
    Rf_errorcall(R_NilValue, "Argument tag must be a string.");
  }
  return new_wrapper_arg(NULL, r_chr_get_c_string(x, 0));
}

r_obj* vec_as_location_opts(r_obj* subscript,
                            r_ssize n,
                            r_obj* names,
                            const struct location_opts* opts) {

  ERR err = NULL;
  subscript = vec_as_subscript_opts(subscript, &opts->subscript_opts, &err);
  KEEP2(subscript, err);

  if (err) {
    r_cnd_signal(err);
    r_stop_unreachable();
  }

  r_obj* out = r_null;
  switch (r_typeof(subscript)) {
  case R_TYPE_null: out = r_globals.empty_int; break;
  case R_TYPE_logical: out = lgl_as_location(subscript, n, opts); break;
  case R_TYPE_integer: out = int_as_location(subscript, n, opts); break;
  case R_TYPE_double: out = dbl_as_location(subscript, n, opts); break;
  case R_TYPE_character: out = chr_as_location(subscript, names, opts); break;
  default: r_stop_unimplemented_type(r_typeof(subscript));
  }

  FREE(2);
  return out;
}

r_obj* vec_as_names(r_obj* names, const struct name_repair_opts* opts) {
  if (!opts) {
    return names;
  }
  switch (opts->type) {
  case NAME_REPAIR_none: return names;
  case NAME_REPAIR_minimal: return ffi_as_minimal_names(names);
  case NAME_REPAIR_unique: return vec_as_unique_names(names, opts->quiet);
  case NAME_REPAIR_universal: return vec_as_universal_names(names, opts->quiet);
  case NAME_REPAIR_check_unique: return check_unique_names(names, opts);
  case NAME_REPAIR_custom: return vec_as_custom_names(names, opts);
  }
  r_stop_unreachable();
}

r_ssize vec_as_short_length(r_obj* n,
                            struct vctrs_arg* p_arg,
                            struct r_lazy call) {
  r_ssize out = vec_as_ssize(n, p_arg, call);

  if (out < 0) {
    r_abort_lazy_call(call,
                      "%s must be a positive number or zero.",
                      vec_arg_format(p_arg));
  }

  if (out > INT_MAX) {
    // Ideally we'd mention long vector support in an info bullets
    r_abort_lazy_call(call,
                      "%s is too large a number and long vectors are not supported.",
                      vec_arg_format(p_arg));
  }

  return out;
}

r_obj* vec_as_subscript_opts(r_obj* subscript,
                             const struct subscript_opts* opts,
                             ERR* err) {
  if (vec_dim_n(subscript) != 1) {
    *err = new_error_subscript_type(subscript, opts, fns_cnd_body_subscript_dim);
    return r_null;
  }

  r_keep_loc subscript_pi;
  KEEP_HERE(subscript, &subscript_pi);

  r_obj* orig_names = KEEP(r_names(subscript));

  switch (r_typeof(subscript)) {
  case R_TYPE_null:
    if (opts->numeric == SUBSCRIPT_TYPE_ACTION_CAST) {
      subscript = r_globals.empty_int;
    }
    break;
  case R_TYPE_symbol:
    if (opts->character == SUBSCRIPT_TYPE_ACTION_CAST) {
      subscript = rlang_sym_as_character(subscript);
    }
    break;
  default:
    break;
  }
  KEEP_AT(subscript, subscript_pi);

  if (!obj_is_vector(subscript, VCTRS_ALLOW_NULL_no)) {
    *err = new_error_subscript_type(subscript, opts, r_null);
    FREE(2);
    return r_null;
  }

  if (r_is_object(subscript)) {
    subscript = obj_cast_subscript(subscript, opts, err);
  } else if (r_typeof(subscript) == R_TYPE_double) {
    subscript = dbl_cast_subscript(subscript, opts, err);
  }
  KEEP_AT(subscript, subscript_pi);

  if (*err) {
    FREE(2);
    return r_null;
  }

  // Coerce unspecified vectors to integer only if logical indices are
  // not allowed
  if (opts->logical == SUBSCRIPT_TYPE_ACTION_ERROR && vec_is_unspecified(subscript)) {
    struct vctrs_arg* arg = opts->subscript_arg;
    if (opts->numeric == SUBSCRIPT_TYPE_ACTION_CAST) {
      subscript = vec_cast(subscript,
                           r_globals.empty_int,
                           arg,
                           NULL,
                           r_lazy_null);
    } else {
      subscript = vec_cast(subscript,
                           r_globals.empty_chr,
                           arg,
                           NULL,
                           r_lazy_null);
    }
  }
  KEEP_AT(subscript, subscript_pi);

  enum subscript_type_action action = SUBSCRIPT_TYPE_ACTION_ERROR;
  switch (r_typeof(subscript)) {
  case R_TYPE_logical: action = opts->logical; break;
  case R_TYPE_integer: action = opts->numeric; break;
  case R_TYPE_character: action = opts->character; break;
  default: break;
  }

  if (action == SUBSCRIPT_TYPE_ACTION_ERROR) {
    *err = new_error_subscript_type(subscript, opts, r_null);
    FREE(2);
    return r_null;
  }

  if (orig_names != r_null) {
    // FIXME: Handle names in cast methods
    subscript = r_clone_referenced(subscript);
    KEEP_AT(subscript, subscript_pi);
    r_attrib_poke_names(subscript, orig_names);
  }

  FREE(2);
  return subscript;
}

r_obj* vec_as_unique_names(r_obj* names, bool quiet) {
  if (is_unique_names(names) && !any_has_suffix(names)) {
    return names;
  } else {
    return(as_unique_names_impl(names, quiet));
  }
}

r_obj* vec_as_universal_names(r_obj* names, bool quiet) {
  r_obj* quiet_obj = KEEP(r_lgl(quiet));
  r_obj* out = vctrs_dispatch2(syms_as_universal_names, fns_as_universal_names,
                               syms_names, names,
                               syms_quiet, quiet_obj);
  FREE(1);
  return out;
}

r_obj* vec_assign_fallback(
  r_obj* x,
  r_obj* index,
  r_obj* value,
  enum assignment_slice_value slice_value,
  enum vctrs_index_style index_style
) {
  r_obj* ffi_slice_value;
  switch (slice_value) {
  case ASSIGNMENT_SLICE_VALUE_no: ffi_slice_value = r_false; break;
  case ASSIGNMENT_SLICE_VALUE_yes: ffi_slice_value = r_true; break;
  default: r_stop_unreachable();
  }

  r_obj* ffi_index_style;
  switch (index_style) {
  case VCTRS_INDEX_STYLE_location: ffi_index_style = chrs.location; break;
  case VCTRS_INDEX_STYLE_condition: ffi_index_style = chrs.condition; break;
  default: r_stop_unreachable();
  }

  return vctrs_dispatch5(syms_vec_assign_fallback, fns_vec_assign_fallback,
                         syms_x, x,
                         syms_i, index,
                         syms_slice_value, ffi_slice_value,
                         syms_index_style, ffi_index_style,
                         syms_value, value);
}

r_obj* vec_assign_opts(r_obj* x,
                       r_obj* index,
                       r_obj* value,
                       const struct vec_assign_opts* p_opts) {
  if (x == r_null) {
    return r_null;
  }

  struct r_lazy call = r_lazy_is_null(p_opts->call) ? lazy_calls.vec_assign : p_opts->call;
  struct vctrs_arg* x_arg = r_lazy_is_null(p_opts->call) ? vec_args.x : p_opts->x_arg;
  struct vctrs_arg* value_arg = r_lazy_is_null(p_opts->call) ? vec_args.value : p_opts->value_arg;

  obj_check_vector(x, VCTRS_ALLOW_NULL_no, x_arg, call);
  obj_check_vector(value, VCTRS_ALLOW_NULL_no, value_arg, call);

  const r_ssize x_size = vec_size(x);

  // Determine index style. Logical condition indices follow an optimized path.
  enum vctrs_index_style index_style =
    (is_condition_index(index) && r_length(index) == x_size) ?
    VCTRS_INDEX_STYLE_condition :
    VCTRS_INDEX_STYLE_location;

  if (index_style == VCTRS_INDEX_STYLE_location) {
    // Validate and convert to integer locations with `vec_as_location()`
    r_obj* x_names = KEEP(vec_names(x));
    const struct location_opts location_opts = new_location_opts_assign();
    index = vec_as_location_opts(
      index,
      x_size,
      x_names,
      &location_opts
    );
    FREE(1);
  }
  KEEP(index);

  // We won't be proxying recursively
  const bool recursively_proxied = false;

  struct vec_proxy_assign_opts assign_opts = {
    .assign_names = p_opts->assign_names,
    .ignore_outer_names = p_opts->ignore_outer_names,
    .call = call,
    .x_arg = x_arg,
    .value_arg = value_arg,
    .index_style = index_style,
    .slice_value = p_opts->slice_value,
    .ownership = p_opts->ownership,
    .recursively_proxied = recursively_proxied
  };
  struct vec_restore_opts restore_opts = {
    .ownership = p_opts->ownership,
    .recursively_proxied = recursively_proxied
  };

  // Cast `value` and check that it can recycle
  value = KEEP(vec_cast(value, x, assign_opts.value_arg, assign_opts.x_arg, assign_opts.call));

  check_recyclable_against_index(
    value,
    index,
    x_size,
    assign_opts.slice_value,
    assign_opts.index_style,
    assign_opts.value_arg,
    assign_opts.call
  );

  r_obj* proxy = KEEP(vec_proxy(x));
  proxy = KEEP(vec_proxy_assign_opts(proxy, index, value, &assign_opts));
  r_obj* out = vec_restore_opts(proxy, x, &restore_opts);

  FREE(4);
  return out;
}

SEXP vec_assign_shaped(
  SEXP proxy,
  SEXP index,
  SEXP value,
  enum vctrs_ownership ownership,
  enum assignment_slice_value slice_value,
  enum vctrs_index_style index_style
) {
  switch (vec_proxy_typeof(proxy)) {
  case VCTRS_TYPE_logical:   return lgl_assign_shaped(proxy, index, value, ownership, slice_value, index_style);
  case VCTRS_TYPE_integer:   return int_assign_shaped(proxy, index, value, ownership, slice_value, index_style);
  case VCTRS_TYPE_double:    return dbl_assign_shaped(proxy, index, value, ownership, slice_value, index_style);
  case VCTRS_TYPE_complex:   return cpl_assign_shaped(proxy, index, value, ownership, slice_value, index_style);
  case VCTRS_TYPE_character: return chr_assign_shaped(proxy, index, value, ownership, slice_value, index_style);
  case VCTRS_TYPE_raw:       return raw_assign_shaped(proxy, index, value, ownership, slice_value, index_style);
  case VCTRS_TYPE_list:      return list_assign_shaped(proxy, index, value, ownership, slice_value, index_style);
  default:                   stop_unimplemented_vctrs_type("vec_assign_shaped", vec_proxy_typeof(proxy));
  }
}

static inline SEXP vec_bare_dim(SEXP x) {
  return r_dim(x);
}

static inline R_len_t vec_bare_dim_n(SEXP x) {
  return Rf_length(vec_bare_dim(x));
}

enum vctrs_type vec_base_typeof(r_obj* x, bool proxied) {
  switch (r_typeof(x)) {
  // Atomic types are always vectors
  case R_TYPE_null: return VCTRS_TYPE_null;
  case R_TYPE_logical: return VCTRS_TYPE_logical;
  case R_TYPE_integer: return VCTRS_TYPE_integer;
  case R_TYPE_double: return VCTRS_TYPE_double;
  case R_TYPE_complex: return VCTRS_TYPE_complex;
  case R_TYPE_character: return VCTRS_TYPE_character;
  case R_TYPE_raw: return VCTRS_TYPE_raw;
  case R_TYPE_list:
    // Bare lists and data frames are vectors
    if (!r_is_object(x)) return VCTRS_TYPE_list;
    if (is_data_frame(x)) return VCTRS_TYPE_dataframe;
    // S3 lists are only vectors if they are proxied
    if (proxied || r_inherits(x, "list")) return VCTRS_TYPE_list;
    // fallthrough
  default: return VCTRS_TYPE_scalar;
  }
}

r_obj* vec_c(
  r_obj* xs,
  r_obj* ptype,
  r_obj* name_spec,
  const struct name_repair_opts* name_repair,
  struct vctrs_arg* p_error_arg,
  struct r_lazy error_call
) {
  return list_combine_for_vec_c(
    xs,
    ptype,
    name_spec,
    name_repair,
    p_error_arg,
    error_call
  );
}

r_obj* vec_cast_common(r_obj* xs,
                       r_obj* to,
                       struct vctrs_arg* p_arg,
                       struct r_lazy call) {
  return vec_cast_common_params(xs,
                                to,
                                S3_FALLBACK_false,
                                p_arg,
                                call);
}

r_obj* vec_cast_common_opts(r_obj* xs,
                            r_obj* to,
                            const struct cast_common_opts* opts) {
  r_obj* type = KEEP(vec_ptype_common(
    xs,
    to,
    PTYPE_FINALISE_DEFAULT,
    opts->s3_fallback,
    opts->p_arg,
    opts->call
  ));

  const r_ssize xs_size = r_length(xs);
  r_obj* xs_names = KEEP(r_names(xs));
  r_obj* const* v_xs = r_list_cbegin(xs);

  r_obj* out = KEEP(r_alloc_list(xs_size));
  r_attrib_poke_names(out, xs_names);

  r_ssize i = 0;

  struct vctrs_arg* p_x_arg = new_subscript_arg(
    opts->p_arg,
    xs_names,
    xs_size,
    &i
  );
  KEEP(p_x_arg->shelter);

  for (; i < xs_size; ++i) {
    r_obj* elt = v_xs[i];
    struct cast_opts cast_opts = {
      .x = elt,
      .to = type,
      .p_x_arg = p_x_arg,
      .call = opts->call,
      .s3_fallback = opts->s3_fallback
    };
    r_list_poke(out, i, vec_cast_opts(&cast_opts));
  }

  FREE(4);
  return out;
}

r_obj* vec_cast_default(r_obj* x,
                        r_obj* to,
                        struct vctrs_arg* p_x_arg,
                        struct vctrs_arg* p_to_arg,
                        struct r_lazy call,
                        enum s3_fallback s3_fallback) {
  return vec_cast_default_full(x, to, p_x_arg, p_to_arg, call, s3_fallback, false);
}

r_obj* vec_cast_default_full(r_obj* x,
                             r_obj* to,
                             struct vctrs_arg* p_x_arg,
                             struct vctrs_arg* p_to_arg,
                             struct r_lazy call,
                             enum s3_fallback s3_fallback,
                             bool from_dispatch) {
  r_obj* ffi_s3_fallback = KEEP(r_int(s3_fallback));

  r_obj* ffi_x_arg = KEEP(vctrs_arg(p_x_arg));
  r_obj* ffi_to_arg = KEEP(vctrs_arg(p_to_arg));

  r_obj* ffi_call = KEEP(r_lazy_eval(call));
  r_obj* out = vctrs_eval_mask7(syms.vec_default_cast,
                                syms_x, x,
                                syms_to, to,
                                syms_x_arg, ffi_x_arg,
                                syms_to_arg, ffi_to_arg,
                                syms_call, ffi_call,
                                syms_from_dispatch, r_lgl(from_dispatch),
                                syms_s3_fallback, ffi_s3_fallback);
  FREE(4);
  return out;
}

r_obj* vec_cast_dispatch_native(const struct cast_opts* opts,
                                enum vctrs_type x_type,
                                enum vctrs_type to_type,
                                bool* lossy) {
  r_obj* x = opts->x;
  r_obj* to = opts->to;
  struct vctrs_arg* x_arg = opts->p_x_arg;
  struct vctrs_arg* to_arg = opts->p_to_arg;

  int dir = 0;
  enum vctrs_type2_s3 type2_s3 = vec_typeof2_s3_impl(x, to, x_type, to_type, &dir);

  switch (type2_s3) {

  case VCTRS_TYPE2_S3_character_bare_factor:
    if (dir == 0) {
      return chr_as_factor(x, to, lossy, to_arg);
    } else {
      return fct_as_character(x, x_arg);
    }

  case VCTRS_TYPE2_S3_character_bare_ordered:
    if (dir == 0) {
      return chr_as_ordered(x, to, lossy, to_arg);
    } else {
      return ord_as_character(x, x_arg);
    }

  case VCTRS_TYPE2_S3_bare_factor_bare_factor:
    return fct_as_factor(x, to, lossy, x_arg, to_arg);

  case VCTRS_TYPE2_S3_bare_ordered_bare_ordered:
    return ord_as_ordered(opts);

  case VCTRS_TYPE2_S3_bare_date_bare_posixct:
    if (dir == 0) {
      return date_as_posixct(x, to);
    } else {
      return posixct_as_date(x, lossy);
    }

  case VCTRS_TYPE2_S3_bare_date_bare_posixlt:
    if (dir == 0) {
      return date_as_posixlt(x, to);
    } else {
      return posixlt_as_date(x, lossy);
    }

  case VCTRS_TYPE2_S3_bare_posixct_bare_posixlt:
    if (dir == 0) {
      return posixct_as_posixlt(x, to);
    } else {
      return posixlt_as_posixct(x, to);
    }

  case VCTRS_TYPE2_S3_bare_date_bare_date:
    return date_as_date(x);

  case VCTRS_TYPE2_S3_bare_posixct_bare_posixct:
    return posixct_as_posixct(x, to);

  case VCTRS_TYPE2_S3_bare_posixlt_bare_posixlt:
    return posixlt_as_posixlt(x, to);

  case VCTRS_TYPE2_S3_dataframe_bare_tibble:
    if (dir == 0) {
      return tib_cast(opts);
    } else {
      return df_cast_opts(opts);
    }

  case VCTRS_TYPE2_S3_bare_tibble_bare_tibble:
    return tib_cast(opts);

  default:
    return r_null;
  }
}

r_obj* vec_cast_e(const struct cast_opts* opts,
                  ERR* err) {
  struct cast_err_data data = {
    .opts = opts,
    .out = r_null
  };

  *err = r_try_catch(&vec_cast_e_cb,
                     &data,
                     syms_vctrs_error_incompatible_type,
                     NULL,
                     NULL);
  return data.out;
}

void vec_cast_e_cb(void* data_) {
  struct cast_err_data* data = (struct cast_err_data*) data_;
  data->out = vec_cast_opts(data->opts);
}

r_obj* vec_cast_switch_native(const struct cast_opts* opts,
                              enum vctrs_type x_type,
                              enum vctrs_type to_type,
                              bool* lossy) {
  r_obj* x = opts->x;

  int dir = 0;
  enum vctrs_type2 type2 = vec_typeof2_impl(x_type, to_type, &dir);

  switch (type2) {

  case VCTRS_TYPE2_logical_logical:
  case VCTRS_TYPE2_integer_integer:
  case VCTRS_TYPE2_double_double:
  case VCTRS_TYPE2_complex_complex:
  case VCTRS_TYPE2_raw_raw:
  case VCTRS_TYPE2_character_character:
  case VCTRS_TYPE2_list_list:
    return x;

  case VCTRS_TYPE2_logical_integer:
    if (dir == 0) {
      return lgl_as_integer(x, lossy);
    } else {
      return int_as_logical(x, lossy);
    }

  case VCTRS_TYPE2_logical_double:
    if (dir == 0) {
      return lgl_as_double(x, lossy);
    } else {
      return dbl_as_logical(x, lossy);
    }

  case VCTRS_TYPE2_integer_double:
    if (dir == 0) {
      return int_as_double(x, lossy);
    } else {
      return dbl_as_integer(x, lossy);
    }

  case VCTRS_TYPE2_dataframe_dataframe:
    return df_cast_opts(opts);

  default:
    break;
  }

  return r_null;
}

void vec_check_size(
  r_obj* x,
  r_ssize size,
  enum vctrs_allow_null allow_null,
  struct vctrs_arg* p_x_arg,
  struct r_lazy call
) {
  if (!vec_is_size(x, size, allow_null, p_x_arg, call)) {
    const r_ssize x_size = vec_size_params(x, p_x_arg, call);
    stop_assert_size(x_size, size, p_x_arg, call);
  }
}

r_obj* vec_chop(r_obj* x, r_obj* indices, r_obj* sizes) {
  const r_ssize n = vec_size(x);
  r_obj* names = KEEP(vec_names(x));

  if (indices != r_null && sizes != r_null) {
    r_abort_lazy_call(r_lazy_null, "Can't supply both `indices` and `sizes`.");
  }

  if (indices != r_null) {
    const bool allow_compact = false;
    indices = list_as_locations(indices, n, names, allow_compact);
  }
  KEEP(indices);

  if (sizes != r_null) {
    sizes = vec_as_chop_sizes(sizes, n);
  }
  KEEP(sizes);

  r_obj* out = vec_chop_unsafe(x, indices, sizes);

  FREE(3);
  return out;
}

r_obj* vec_chop_base(r_obj* x,
                     struct vctrs_proxy_info info,
                     struct vctrs_chop_indices* p_indices) {
  if (vec_requires_fallback(x, info)) {
    // Fallback to `[` if the class doesn't implement a proxy. This is
    // to be maximally compatible with existing classes.
    if (info.type == VCTRS_TYPE_scalar) {
      r_abort_lazy_call(r_lazy_null, "Can't slice a scalar");
    }

    if (has_dim(x)) {
      return chop_fallback_shaped(x, p_indices);
    } else {
      return chop_fallback(x, p_indices);
    }
  }

  switch (info.type) {
  case VCTRS_TYPE_logical:
  case VCTRS_TYPE_integer:
  case VCTRS_TYPE_double:
  case VCTRS_TYPE_complex:
  case VCTRS_TYPE_character:
  case VCTRS_TYPE_raw:
  case VCTRS_TYPE_list: {
    if (has_dim(x)) {
      return chop_shaped(x, info, p_indices);
    } else {
      return chop(x, info, p_indices);
    }
  }
  case VCTRS_TYPE_dataframe: {
    return chop_df(x, info, p_indices);
  }
  default:
    obj_check_vector(x, VCTRS_ALLOW_NULL_no, vec_args.empty, r_lazy_null);
    stop_unimplemented_vctrs_type("vec_chop_base", info.type);
  }
}

r_obj* vec_chop_unsafe(r_obj* x, r_obj* indices, r_obj* sizes) {
  struct vctrs_proxy_info info = vec_proxy_info(x);
  KEEP(info.inner);

  struct vctrs_chop_indices* p_indices = new_chop_indices(x, indices, sizes);
  KEEP(p_indices->shelter);

  r_obj* out = vec_chop_base(x, info, p_indices);

  FREE(2);
  return out;
}

static inline SEXP vec_clone_referenced(SEXP x, const enum vctrs_ownership ownership) {
  switch (ownership) {
  case VCTRS_OWNERSHIP_foreign: return r_clone_referenced(x);
  case VCTRS_OWNERSHIP_shallow: return x;
  case VCTRS_OWNERSHIP_deep: return x;
  default: r_stop_unreachable();
  }
}

size_t vec_compute_n_bytes_lazy_counts(
  SEXP x,
  const enum vctrs_type type
) {
  switch (type) {
  case VCTRS_TYPE_integer:
  case VCTRS_TYPE_logical:
    return INT_MAX_RADIX_PASS;
  case VCTRS_TYPE_double:
  case VCTRS_TYPE_complex:
    return DBL_MAX_RADIX_PASS;
  case VCTRS_TYPE_character:
    return 0;
  case VCTRS_TYPE_dataframe:
    return df_compute_n_bytes_lazy_counts(x);
  default:
    Rf_errorcall(R_NilValue, "This type is not supported by `vec_order()`.");
  }
}

size_t vec_compute_n_bytes_lazy_raw(
  SEXP x,
  const enum vctrs_type type
) {
  switch (type) {
  case VCTRS_TYPE_integer:
  case VCTRS_TYPE_logical:
    return sizeof(int);
  case VCTRS_TYPE_double:
    return sizeof(double);
  case VCTRS_TYPE_complex:
    // Complex types will be split into two double vectors
    return sizeof(double);
  case VCTRS_TYPE_character:
    // Both `SEXP` and `const char*` are written to the working memory.
    // Should be the same size (8 bytes), both are pointers, but be defensive.
    return sizeof(SEXP) > sizeof(const char*) ? sizeof(SEXP) : sizeof(const char*);
  case VCTRS_TYPE_dataframe:
    return df_compute_n_bytes_lazy_raw(x);
  default:
    Rf_errorcall(R_NilValue, "This type is not supported by `vec_order()`.");
  }
}

void vec_detect_complete_switch(SEXP x, R_len_t size, int* p_out) {
  switch (vec_proxy_typeof(x)) {
  case VCTRS_TYPE_logical: lgl_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_integer: int_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_double: dbl_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_complex: cpl_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_character: chr_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_raw: raw_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_list: list_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_dataframe: df_detect_complete(x, size, p_out); break;
  case VCTRS_TYPE_null: break;
  case VCTRS_TYPE_scalar: stop_scalar_type(x, vec_args.empty, r_lazy_null);
  default: stop_unimplemented_vctrs_type("vec_detect_complete", vec_proxy_typeof(x));
  }
}

r_obj* vec_df_restore(r_obj* x,
                      r_obj* to,
                      const struct vec_restore_opts* p_opts) {
  r_obj* out = KEEP(vec_bare_df_restore(x, to, p_opts));
  out = vec_restore_dispatch(out, to);
  FREE(1);
  return out;
}

static inline SEXP vec_dim(SEXP x) {
  SEXP dim = vec_bare_dim(x);

  if (dim == R_NilValue) {
    dim = r_int(Rf_length(x));
  }

  return dim;
}

static inline R_len_t vec_dim_n(SEXP x) {
  SEXP dim = vec_bare_dim(x);

  if (dim == R_NilValue) {
    return 1;
  }

  return Rf_length(dim);
}

void vec_fill_missing_down(const int* p_na, r_ssize size, bool leading, int* p_loc) {
  r_ssize loc = 0;

  if (leading) {
    // Increment `loc` to the first non-missing value
    for (r_ssize i = 0; i < size; ++i) {
      if (!p_na[i]) {
        loc = i;
        break;
      }
    }

    // Back-fill with first non-missing value
    for (r_ssize i = loc - 1; i >= 0; --i) {
      p_loc[i] = loc + 1;
    }
  }

  for (r_ssize i = loc; i < size; ++i) {
    if (!p_na[i]) {
      loc = i;
    }

    p_loc[i] = loc + 1;
  }
}

void vec_fill_missing_down_with_max_fill(const int* p_na, r_ssize size, bool leading, int max_fill, int* p_loc) {
  r_ssize loc = 0;

  if (leading) {
    // Increment `loc` to the first non-missing value
    for (r_ssize i = 0; i < size; ++i) {
      if (!p_na[i]) {
        loc = i;
        break;
      }
    }

    // Back-fill with first non-missing value with a max_fill
    r_ssize n_fill = 0;

    for (r_ssize i = loc - 1; i >= 0; --i) {
      if (n_fill == max_fill) {
        p_loc[i] = i + 1;
      } else {
        p_loc[i] = loc + 1;
        ++n_fill;
      }
    }
  }

  r_ssize n_fill = 0;

  for (r_ssize i = loc; i < size; ++i) {
    if (!p_na[i]) {
      loc = i;
      n_fill = 0;
      p_loc[i] = i + 1;
      continue;
    }

    if (n_fill == max_fill) {
      p_loc[i] = i + 1;
    } else {
      p_loc[i] = loc + 1;
      ++n_fill;
    }
  }
}

void vec_fill_missing_up(const int* p_na, r_ssize size, bool leading, int* p_loc) {
  r_ssize loc = size - 1;

  if (leading) {
    // Decrement `loc` to the last non-missing value
    for (r_ssize i = size - 1; i >= 0; --i) {
      if (!p_na[i]) {
        loc = i;
        break;
      }
    }

    // Forward-fill with last non-missing value
    for (r_ssize i = loc + 1; i < size; ++i) {
      p_loc[i] = loc + 1;
    }
  }

  for (r_ssize i = loc; i >= 0; --i) {
    if (!p_na[i]) {
      loc = i;
    }

    p_loc[i] = loc + 1;
  }
}

void vec_fill_missing_up_with_max_fill(const int* p_na, r_ssize size, bool leading, int max_fill, int* p_loc) {
  r_ssize loc = size - 1;

  if (leading) {
    // Decrement `loc` to the last non-missing value
    for (r_ssize i = size - 1; i >= 0; --i) {
      if (!p_na[i]) {
        loc = i;
        break;
      }
    }

    // Forward-fill with last non-missing value with a max_fill
    r_ssize n_fill = 0;

    for (r_ssize i = loc + 1; i < size; ++i) {
      if (n_fill == max_fill) {
        p_loc[i] = i + 1;
      } else {
        p_loc[i] = loc + 1;
        ++n_fill;
      }
    }
  }

  r_ssize n_fill = 0;

  for (r_ssize i = loc; i >= 0; --i) {
    if (!p_na[i]) {
      loc = i;
      n_fill = 0;
      p_loc[i] = i + 1;
      continue;
    }

    if (n_fill == max_fill) {
      p_loc[i] = i + 1;
    } else {
      p_loc[i] = loc + 1;
      ++n_fill;
    }
  }
}

bool vec_implements_base_c(r_obj* x) {
  if (!r_is_object(x)) {
    return false;
  }

  if (r_is_s4(x)) {
    return s4_find_method(x, s4_c_method_table) != r_null;
  } else {
    return s3_find_method("c", x, base_method_table) != r_null;
  }
}

bool vec_implements_ptype2(SEXP x) {
  switch (vec_typeof(x)) {
  case VCTRS_TYPE_scalar:
    return false;
  case VCTRS_TYPE_s3: {
    SEXP method_sym = R_NilValue;
    SEXP method = s3_find_method_xy("vec_ptype2", x, x, vctrs_method_table, &method_sym);

    if (method != R_NilValue) {
      return true;
    }

    method = s3_find_method2("vec_ptype2", x, vctrs_method_table, &method_sym);
    return method != R_NilValue;
  }
  default:
    return true;
  }
}

SEXP vec_in(
  SEXP needles,
  SEXP haystack,
  bool na_equal,
  struct vctrs_arg* p_needles_arg,
  struct vctrs_arg* p_haystack_arg,
  struct r_lazy call
) {
  int nprot = 0;

  int _;
  SEXP type = vec_ptype2(
    needles,
    haystack,
    p_needles_arg,
    p_haystack_arg,
    call,
    S3_FALLBACK_false,
    &_
  );
  PROTECT_N(type, &nprot);
  type = PROTECT_N(vec_ptype_finalise(type), &nprot);

  needles = vec_cast_params(
    needles,
    type,
    p_needles_arg,
    vec_args.empty,
    call,
    S3_FALLBACK_false
  );
  PROTECT_N(needles, &nprot);

  haystack = vec_cast_params(
    haystack,
    type,
    p_haystack_arg,
    vec_args.empty,
    call,
    S3_FALLBACK_false
  );
  PROTECT_N(haystack, &nprot);

  needles = PROTECT_N(vec_proxy_equal(needles), &nprot);
  needles = PROTECT_N(obj_encode_utf8(needles), &nprot);

  haystack = PROTECT_N(vec_proxy_equal(haystack), &nprot);
  haystack = PROTECT_N(obj_encode_utf8(haystack), &nprot);

  R_len_t n_haystack = vec_size(haystack);
  R_len_t n_needle = vec_size(needles);

  struct dictionary* d = new_dictionary_params(haystack, false, na_equal);
  PROTECT_DICT(d, &nprot);

  // Load dictionary with haystack
  load_with_haystack(d, n_haystack);

  struct dictionary* d_needles = new_dictionary_params(needles, true, na_equal);
  PROTECT_DICT(d_needles, &nprot);

  // Locate needles
  SEXP out = PROTECT_N(Rf_allocVector(LGLSXP, n_needle), &nprot);
  int* p_out = LOGICAL(out);

  if (na_equal) {
    vec_in_loop(p_out, d, d_needles, n_needle);
  } else {
    vec_in_loop_propagate(p_out, d, d_needles, n_needle);
  }

  UNPROTECT(nprot);
  return out;
}

void vec_in_loop(
  int* p_out,
  struct dictionary* d,
  struct dictionary* d_needles,
  R_len_t n_needle
) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VEC_IN_LOOP(nil_dict_hash_with); break;
  case VCTRS_TYPE_logical: VEC_IN_LOOP(lgl_dict_hash_with); break;
  case VCTRS_TYPE_integer: VEC_IN_LOOP(int_dict_hash_with); break;
  case VCTRS_TYPE_double: VEC_IN_LOOP(dbl_dict_hash_with); break;
  case VCTRS_TYPE_complex: VEC_IN_LOOP(cpl_dict_hash_with); break;
  case VCTRS_TYPE_character: VEC_IN_LOOP(chr_dict_hash_with); break;
  case VCTRS_TYPE_raw: VEC_IN_LOOP(raw_dict_hash_with); break;
  case VCTRS_TYPE_list: VEC_IN_LOOP(list_dict_hash_with); break;
  case VCTRS_TYPE_dataframe: VEC_IN_LOOP(df_dict_hash_with); break;
  default: stop_unimplemented_vctrs_type("vec_in_loop", d->p_poly_vec->type);
  }
}

void vec_in_loop_propagate(
  int* p_out,
  struct dictionary* d,
  struct dictionary* d_needles,
  R_len_t n_needle
) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VEC_IN_LOOP_PROPAGATE(nil_dict_hash_with, nil_dict_is_incomplete); break;
  case VCTRS_TYPE_logical: VEC_IN_LOOP_PROPAGATE(lgl_dict_hash_with, lgl_dict_is_incomplete); break;
  case VCTRS_TYPE_integer: VEC_IN_LOOP_PROPAGATE(int_dict_hash_with, int_dict_is_incomplete); break;
  case VCTRS_TYPE_double: VEC_IN_LOOP_PROPAGATE(dbl_dict_hash_with, dbl_dict_is_incomplete); break;
  case VCTRS_TYPE_complex: VEC_IN_LOOP_PROPAGATE(cpl_dict_hash_with, cpl_dict_is_incomplete); break;
  case VCTRS_TYPE_character: VEC_IN_LOOP_PROPAGATE(chr_dict_hash_with, chr_dict_is_incomplete); break;
  case VCTRS_TYPE_raw: VEC_IN_LOOP_PROPAGATE(raw_dict_hash_with, raw_dict_is_incomplete); break;
  case VCTRS_TYPE_list: VEC_IN_LOOP_PROPAGATE(list_dict_hash_with, list_dict_is_incomplete); break;
  case VCTRS_TYPE_dataframe: VEC_IN_LOOP_PROPAGATE(df_dict_hash_with, df_dict_is_incomplete); break;
  default: stop_unimplemented_vctrs_type("vec_in_loop_propagate", d->p_poly_vec->type);
  }
}

r_obj* vec_init(r_obj* x, r_ssize n) {
  obj_check_vector(x, VCTRS_ALLOW_NULL_no, vec_args.x, lazy_calls.vec_init);

  if (n < 0) {
    r_abort_lazy_call(lazy_calls.vec_init,
                      "%s must be a positive integer.",
                      r_c_str_format_error_arg("n"));
  }

  r_obj* i = KEEP(compact_rep(r_globals.na_int, n));
  r_obj* out = vec_slice_unsafe(x, i);

  FREE(1);
  return out;
}

r_obj* vec_invoke_coerce_method(r_obj* method_sym, r_obj* method,
                                r_obj* x_sym, r_obj* x,
                                r_obj* y_sym, r_obj* y,
                                r_obj* x_arg_sym, r_obj* x_arg,
                                r_obj* y_arg_sym, r_obj* y_arg,
                                struct r_lazy lazy_call,
                                enum s3_fallback s3_fallback) {
  r_obj* call = KEEP(r_lazy_eval(lazy_call));

  if (s3_fallback != S3_FALLBACK_false) {
    r_obj* ffi_s3_fallback = KEEP(r_int(s3_fallback));

    r_obj* out = vctrs_dispatch6(method_sym, method,
                                 x_sym, x,
                                 y_sym, y,
                                 x_arg_sym, x_arg,
                                 y_arg_sym, y_arg,
                                 syms_call, call,
                                 syms_s3_fallback, ffi_s3_fallback);
    FREE(2);
    return out;
  } else {
    r_obj* out = vctrs_dispatch5(method_sym, method,
                                 x_sym, x,
                                 y_sym, y,
                                 x_arg_sym, x_arg,
                                 y_arg_sym, y_arg,
                                 syms_call, call);
    FREE(1);
    return out;
  }
}

bool vec_is_coercible(
  r_obj* x,
  r_obj* y,
  struct vctrs_arg* p_x_arg,
  struct vctrs_arg* p_y_arg,
  struct r_lazy call,
  enum s3_fallback s3_fallback
) {
  ERR err = NULL;
  vec_is_coercible_e(
    x,
    y,
    p_x_arg,
    p_y_arg,
    call,
    s3_fallback,
    &err
  );
  return !err;
}

void vec_is_coercible_e(
  r_obj* x,
  r_obj* y,
  struct vctrs_arg* p_x_arg,
  struct vctrs_arg* p_y_arg,
  struct r_lazy call,
  enum s3_fallback s3_fallback,
  ERR* err
) {
  struct is_coercible_data data = {
    .x = x,
    .y = y,
    .p_x_arg = p_x_arg,
    .p_y_arg = p_y_arg,
    .call = call,
    .s3_fallback = s3_fallback,
    .out = r_null
  };

  *err = r_try_catch(&vec_is_coercible_cb,
                     &data,
                     syms_vctrs_error_incompatible_type,
                     NULL,
                     NULL);
}

bool vec_is_recyclable(
  r_obj* x,
  r_ssize size,
  enum vctrs_allow_null allow_null,
  struct vctrs_arg* p_x_arg,
  struct r_lazy call
) {
  const r_ssize x_size = vec_size_params(x, p_x_arg, call);

  if (x_size == size || x_size == 1) {
    return true;
  }

  if (allow_null_as_bool(allow_null) && x == r_null) {
    return true;
  }

  return false;
}

static r_obj* vec_is_restored_cb(r_obj* tag, r_obj* _value, void* _data) {
  if (tag == r_syms.names) {
    // Keep iterating
    return NULL;
  } else {
    // Restored!
    return R_NilValue;
  }
}

bool vec_is_size(
  r_obj* x,
  r_ssize size,
  enum vctrs_allow_null allow_null,
  struct vctrs_arg* p_x_arg,
  struct r_lazy call
) {
  const r_ssize x_size = vec_size_params(x, p_x_arg, call);

  if (x_size == size) {
    return true;
  }

  if (allow_null_as_bool(allow_null) && x == r_null) {
    return true;
  }

  return false;
}

bool vec_is_unspecified(SEXP x) {
  if (r_typeof(x) != R_TYPE_logical) {
    // Both `<vctrs_unspecified>` and `<vector-of-NA>` must be logical
    return false;
  }

  if (has_dim(x)) {
    // Disallow arrays from being unspecified
    return false;
  }

  // If it is classed, that class must be `<vctrs_unspecified>`, otherwise check
  // for all `NA`s. Notably, core attributes like `names` and extraneous
  // attributes are allowed on `x`, and it is still considered unspecified.
  if (r_is_object(x)) {
    return r_inherits(x, "vctrs_unspecified");
  } else {
    return lgl_is_unspecified(x);
  }
}

SEXP vec_locate_complete(SEXP x) {
  SEXP where = PROTECT(vec_detect_complete(x));
  SEXP out = r_lgl_which(where, false);
  UNPROTECT(1);
  return out;
}

r_obj* vec_locate_run_bounds(r_obj* x, enum vctrs_run_bound which, struct r_lazy error_call) {
  struct r_vector_bool* p_where = vec_detect_run_bounds_bool(x, which, error_call);
  KEEP(p_where->shelter);
  const bool* v_where = r_vector_bool_cbegin(p_where);

  const r_ssize size = r_vector_bool_length(p_where);

  r_ssize n = 0;
  for (r_ssize i = 0; i < size; ++i) {
    n += v_where[i];
  }

  r_obj* out = KEEP(r_alloc_integer(n));
  int* v_out = r_int_begin(out);
  r_ssize j = compute_iter_loc(n, which);

  r_ssize loc = compute_iter_loc(size, which);
  const r_ssize step = compute_iter_step(which);

  // First/last value are always the final bound locations
  // (depending on `which`), so `j` won't ever write to OOB locations
  for (r_ssize i = 0; i < size; ++i) {
    v_out[j] = loc + 1;
    j += step * v_where[loc];
    loc += step;
  }

  FREE(2);
  return out;
}

SEXP vec_match(SEXP needles, SEXP haystack) {
  return vec_match_params(needles, haystack, true, NULL, NULL, r_lazy_null);
}

void vec_match_loop(
  int* p_out,
  struct dictionary* d,
  struct dictionary* d_needles,
  R_len_t n_needle
) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VEC_MATCH_LOOP(nil_dict_hash_with); break;
  case VCTRS_TYPE_logical: VEC_MATCH_LOOP(lgl_dict_hash_with); break;
  case VCTRS_TYPE_integer: VEC_MATCH_LOOP(int_dict_hash_with); break;
  case VCTRS_TYPE_double: VEC_MATCH_LOOP(dbl_dict_hash_with); break;
  case VCTRS_TYPE_complex: VEC_MATCH_LOOP(cpl_dict_hash_with); break;
  case VCTRS_TYPE_character: VEC_MATCH_LOOP(chr_dict_hash_with); break;
  case VCTRS_TYPE_raw: VEC_MATCH_LOOP(raw_dict_hash_with); break;
  case VCTRS_TYPE_list: VEC_MATCH_LOOP(list_dict_hash_with); break;
  case VCTRS_TYPE_dataframe: VEC_MATCH_LOOP(df_dict_hash_with); break;
  default: stop_unimplemented_vctrs_type("vec_match_loop", d->p_poly_vec->type);
  }
}

void vec_match_loop_propagate(
  int* p_out,
  struct dictionary* d,
  struct dictionary* d_needles,
  R_len_t n_needle
) {
  switch (d->p_poly_vec->type) {
  case VCTRS_TYPE_null: VEC_MATCH_LOOP_PROPAGATE(nil_dict_hash_with, nil_dict_is_incomplete); break;
  case VCTRS_TYPE_logical: VEC_MATCH_LOOP_PROPAGATE(lgl_dict_hash_with, lgl_dict_is_incomplete); break;
  case VCTRS_TYPE_integer: VEC_MATCH_LOOP_PROPAGATE(int_dict_hash_with, int_dict_is_incomplete); break;
  case VCTRS_TYPE_double: VEC_MATCH_LOOP_PROPAGATE(dbl_dict_hash_with, dbl_dict_is_incomplete); break;
  case VCTRS_TYPE_complex: VEC_MATCH_LOOP_PROPAGATE(cpl_dict_hash_with, cpl_dict_is_incomplete); break;
  case VCTRS_TYPE_character: VEC_MATCH_LOOP_PROPAGATE(chr_dict_hash_with, chr_dict_is_incomplete); break;
  case VCTRS_TYPE_raw: VEC_MATCH_LOOP_PROPAGATE(raw_dict_hash_with, raw_dict_is_incomplete); break;
  case VCTRS_TYPE_list: VEC_MATCH_LOOP_PROPAGATE(list_dict_hash_with, list_dict_is_incomplete); break;
  case VCTRS_TYPE_dataframe: VEC_MATCH_LOOP_PROPAGATE(df_dict_hash_with, df_dict_is_incomplete); break;
  default: stop_unimplemented_vctrs_type("vec_match_loop_propagate", d->p_poly_vec->type);
  }
}

r_obj* vec_names(r_obj* x) {
  return vec_names_impl(x, false);
}

void vec_order_base_switch(
  SEXP x,
  bool decreasing,
  bool na_last,
  bool nan_distinct,
  r_ssize size,
  const enum vctrs_type type,
  struct order* p_order,
  struct lazy_raw* p_lazy_x_chunk,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  switch (type) {
  case VCTRS_TYPE_integer: {
    int_order(
      x,
      decreasing,
      na_last,
      size,
      p_order,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_lazy_counts,
      p_group_infos
    );

    break;
  }
  case VCTRS_TYPE_logical: {
    lgl_order(
      x,
      decreasing,
      na_last,
      size,
      p_order,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_lazy_counts,
      p_group_infos
    );

    break;
  }
  case VCTRS_TYPE_double: {
    dbl_order(
      x,
      decreasing,
      na_last,
      nan_distinct,
      size,
      p_order,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_lazy_counts,
      p_group_infos
    );

    break;
  }
  case VCTRS_TYPE_complex: {
    cpl_order(
      x,
      decreasing,
      na_last,
      nan_distinct,
      size,
      p_order,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_lazy_counts,
      p_group_infos
    );

    break;
  }
  case VCTRS_TYPE_character: {
    chr_order(
      x,
      decreasing,
      na_last,
      size,
      p_order,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_group_infos
    );

    break;
  }
  case VCTRS_TYPE_dataframe: {
    Rf_errorcall(R_NilValue, "Internal error: Data frames should have been handled by now");
  }
  default: {
    Rf_errorcall(R_NilValue, "This type is not supported by `vec_order()`.");
  }
  }
}

void vec_order_chunk_switch(
  bool decreasing,
  bool na_last,
  bool nan_distinct,
  r_ssize size,
  const enum vctrs_type type,
  int* p_o,
  struct lazy_raw* p_lazy_x_chunk,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  switch (type) {
  case VCTRS_TYPE_integer: {
    int_order_chunk(
      decreasing,
      na_last,
      size,
      p_o,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_lazy_counts,
      p_group_infos
    );

    break;
  }
  case VCTRS_TYPE_logical: {
    lgl_order_chunk(
      decreasing,
      na_last,
      size,
      p_o,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_lazy_counts,
      p_group_infos
    );

    break;
  }
  case VCTRS_TYPE_double: {
    dbl_order_chunk(
      decreasing,
      na_last,
      nan_distinct,
      size,
      p_o,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_lazy_counts,
      p_group_infos
    );

    break;
  }
  case VCTRS_TYPE_complex: {
    // Complex types are run in two passes, once over real then over imaginary
    dbl_order_chunk(
      decreasing,
      na_last,
      nan_distinct,
      size,
      p_o,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_lazy_counts,
      p_group_infos
    );

    break;
  }
  case VCTRS_TYPE_character: {
    chr_order_chunk(
      decreasing,
      na_last,
      size,
      p_o,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_lazy_counts,
      p_group_infos
    );

    break;
  }
  case VCTRS_TYPE_dataframe: {
    Rf_errorcall(R_NilValue, "Internal error: df-cols should have already been flattened.");
    break;
  }
  default: {
    Rf_errorcall(R_NilValue, "This type is not supported by `vec_order()`");
  }
  }
}

SEXP vec_order_expand_args(
  SEXP x,
  SEXP decreasing,
  SEXP na_largest
) {
  SEXP args = PROTECT(r_new_list(2));
  SET_VECTOR_ELT(args, 0, decreasing);
  SET_VECTOR_ELT(args, 1, na_largest);

  // Don't check length here. These might be vectorized if `x` is a data frame.
  if (TYPEOF(decreasing) != LGLSXP) {
    Rf_errorcall(R_NilValue, "Internal error: `decreasing` must be logical");
  }
  if (lgl_any_na(decreasing)) {
    Rf_errorcall(R_NilValue, "Internal error: `decreasing` can't contain missing values.");
  }

  if (TYPEOF(na_largest) != LGLSXP) {
    Rf_errorcall(R_NilValue, "Internal error: `na_largest` must be logical");
  }
  if (lgl_any_na(na_largest)) {
    Rf_errorcall(R_NilValue, "Internal error: `na_largest` can't contain missing values.");
  }

  if (is_data_frame(x)) {
    args = df_expand_args(x, args);
    UNPROTECT(1);
    return args;
  }

  if (r_length(decreasing) != 1) {
    Rf_errorcall(R_NilValue, "`direction` must be a single value when `x` is not a data frame.");
  }

  if (r_length(na_largest) != 1) {
    Rf_errorcall(R_NilValue, "`na_value` must be a single value when `x` is not a data frame.");
  }

  UNPROTECT(1);
  return args;
}

SEXP vec_order_info(
  SEXP x,
  SEXP direction,
  SEXP na_value,
  bool nan_distinct,
  SEXP chr_proxy_collate
) {
  const bool group_sizes = true;
  return vec_order_info_impl(x, direction, na_value, nan_distinct, chr_proxy_collate, group_sizes);
}

void vec_order_switch(
  SEXP x,
  SEXP decreasing,
  SEXP na_last,
  bool nan_distinct,
  r_ssize size,
  const enum vctrs_type type,
  struct order* p_order,
  struct lazy_raw* p_lazy_x_chunk,
  struct lazy_raw* p_lazy_x_aux,
  struct lazy_raw* p_lazy_o_aux,
  struct lazy_raw* p_lazy_bytes,
  struct lazy_raw* p_lazy_counts,
  struct group_infos* p_group_infos
) {
  if (type == VCTRS_TYPE_dataframe) {
    df_order(
      x,
      decreasing,
      na_last,
      nan_distinct,
      size,
      p_order,
      p_lazy_x_chunk,
      p_lazy_x_aux,
      p_lazy_o_aux,
      p_lazy_bytes,
      p_lazy_counts,
      p_group_infos
    );

    return;
  }

  if (r_length(decreasing) != 1) {
    Rf_errorcall(
      R_NilValue,
      "Internal error: Size of decreasing != 1, but "
      "`vec_order_expand_args()` didn't catch it."
    );
  }

  if (r_length(na_last) != 1) {
    Rf_errorcall(
      R_NilValue,
      "Internal error: Size of na_last != 1, but "
      "`vec_order_expand_args()` didn't catch it."
    );
  }

  bool c_decreasing = LOGICAL(decreasing)[0];
  bool c_na_last = LOGICAL(na_last)[0];

  vec_order_base_switch(
    x,
    c_decreasing,
    c_na_last,
    nan_distinct,
    size,
    type,
    p_order,
    p_lazy_x_chunk,
    p_lazy_x_aux,
    p_lazy_o_aux,
    p_lazy_bytes,
    p_lazy_counts,
    p_group_infos
  );
}

r_obj* vec_pall(
  r_obj* xs,
  enum vec_parallel_missing missing,
  r_ssize size,
  struct vctrs_arg* p_xs_arg,
  struct r_lazy error_call
) {
  return vec_parallel(xs, missing, size, p_xs_arg, error_call, VEC_PARALLEL_VARIANT_all);
}

void vec_pall_fill(const int* v_x, enum vec_parallel_missing missing, r_ssize size, int* v_out) {
  switch (missing) {
    case VEC_PARALLEL_MISSING_na: vec_pall_fill_missing_as_na(v_x, size, v_out); break;
    case VEC_PARALLEL_MISSING_false: vec_pall_fill_missing_as_false(v_x, size, v_out); break;
    case VEC_PARALLEL_MISSING_true: vec_pall_fill_missing_as_true(v_x, size, v_out); break;
    default: r_stop_unreachable();
  }
}

void vec_pall_fill_missing_as_false(const int* v_x, r_ssize size, int* v_out) {
  for (r_ssize i = 0; i < size; ++i) {
    const int elt_out = v_out[i];
    const int elt_x = v_x[i];
    v_out[i] = elt_out && (elt_x == 1);
  }
}

void vec_pall_fill_missing_as_na(const int* v_x, r_ssize size, int* v_out) {
  for (r_ssize i = 0; i < size; ++i) {
    const int elt_out = v_out[i];
    const int elt_x = v_x[i];

    const bool any_false = !elt_out || !elt_x;
    const bool equal = elt_out == elt_x;
    v_out[i] = !any_false * (equal * elt_out + !equal * r_globals.na_lgl);
  }
}

void vec_pall_fill_missing_as_true(const int* v_x, r_ssize size, int* v_out) {
  for (r_ssize i = 0; i < size; ++i) {
    const int elt_out = v_out[i];
    const int elt_x = v_x[i];
    v_out[i] = elt_out && elt_x;
  }
}