From 315492648ae53cf5397be6e0ab8ded895cda6212 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Mon, 1 Jul 2024 13:45:23 -0400 Subject: [PATCH 1/5] First implementation of ALTREP views on lgl/int/dbl/cpl --- R/altrep.R | 3 + R/view.R | 13 + src/Makevars | 1 + src/internal/exported.c | 29 +++ src/internal/init.c | 6 + src/rlang/altrep.h | 15 ++ src/rlang/rlang.c | 8 + src/rlang/rlang.h | 1 + src/rlang/view.c | 481 +++++++++++++++++++++++++++++++++++++ src/rlang/view.h | 16 ++ tests/testthat/test-view.R | 177 ++++++++++++++ 11 files changed, 750 insertions(+) create mode 100644 R/altrep.R create mode 100644 R/view.R create mode 100644 src/rlang/view.c create mode 100644 src/rlang/view.h create mode 100644 tests/testthat/test-view.R diff --git a/R/altrep.R b/R/altrep.R new file mode 100644 index 0000000000..588037ca08 --- /dev/null +++ b/R/altrep.R @@ -0,0 +1,3 @@ +is_altrep <- function(x) { + .Call(ffi_is_altrep, x) +} diff --git a/R/view.R b/R/view.R new file mode 100644 index 0000000000..8e0e46ea32 --- /dev/null +++ b/R/view.R @@ -0,0 +1,13 @@ +vec_view <- function(x, start, size) { + check_number_whole(start) + check_number_whole(size) + .Call(ffi_vec_view, x, start, size) +} + +view_is_materialized <- function(x) { + .Call(ffi_view_is_materialized, x) +} + +view_materialize <- function(x) { + .Call(ffi_view_materialize, x) +} diff --git a/src/Makevars b/src/Makevars index ab0a7e8657..6a9fee8910 100644 --- a/src/Makevars +++ b/src/Makevars @@ -30,6 +30,7 @@ lib-files = \ rlang/vec.c \ rlang/vec-chr.c \ rlang/vec-lgl.c \ + rlang/view.c \ rlang/vendor.c \ rlang/walk.c diff --git a/src/internal/exported.c b/src/internal/exported.c index 889977b3ff..5bcf950841 100644 --- a/src/internal/exported.c +++ b/src/internal/exported.c @@ -2,6 +2,9 @@ #include "../internal/utils.h" #include "../internal/vec.h" +// From rlang/rlang.c +void r_init_library_with_dll(DllInfo* dll, const char* package); + // From rlang/vec.c void r_vec_poke_n(r_obj* x, r_ssize offset, r_obj* y, r_ssize from, r_ssize n); @@ -18,6 +21,13 @@ r_obj* ffi_compiled_by_gcc(void) { } +// altrep.h + +r_obj* ffi_is_altrep(r_obj* x) { + return r_lgl(r_is_altrep(x)); +} + + // cnd.c r_obj* ffi_cnd_signal(r_obj* cnd) { @@ -1053,6 +1063,25 @@ r_obj* ffi_list_poke(r_obj* x, r_obj* i, r_obj* value) { } +// view.c + +r_obj* ffi_vec_view(r_obj* x, r_obj* ffi_start, r_obj* ffi_size) { + const r_ssize start = r_arg_as_ssize(ffi_start, "start") - 1; + const r_ssize size = r_arg_as_ssize(ffi_size, "size"); + return r_vec_view(x, start, size); +} + +r_obj* ffi_view_is_materialized(r_obj* x) { + r_check_view(x); + return r_lgl(r_view_is_materialized(x)); +} + +r_obj* ffi_view_materialize(r_obj* x) { + r_check_view(x); + return r_view_materialize(x); +} + + // walk.c static inline diff --git a/src/internal/init.c b/src/internal/init.c index a3f3e008c2..ac73c965e9 100644 --- a/src/internal/init.c +++ b/src/internal/init.c @@ -111,6 +111,7 @@ static const R_CallMethodDef r_callables[] = { {"ffi_init_rlang", (DL_FUNC) &ffi_init_rlang, 1}, {"ffi_interp", (DL_FUNC) &ffi_interp, 2}, {"ffi_interrupt", (DL_FUNC) &ffi_interrupt, 0}, + {"ffi_is_altrep", (DL_FUNC) &ffi_is_altrep, 1}, {"ffi_is_atomic", (DL_FUNC) &ffi_is_atomic, 2}, {"ffi_is_call", (DL_FUNC) &ffi_is_call, 4}, {"ffi_is_character", (DL_FUNC) &ffi_is_character, 4}, @@ -238,6 +239,9 @@ static const R_CallMethodDef r_callables[] = { {"ffi_vec_poke_n", (DL_FUNC) &ffi_vec_poke_n, 5}, {"ffi_vec_poke_range", (DL_FUNC) &ffi_vec_poke_range, 5}, {"ffi_vec_resize", (DL_FUNC) &ffi_vec_resize, 2}, + {"ffi_vec_view", (DL_FUNC) &ffi_vec_view, 3}, + {"ffi_view_is_materialized", (DL_FUNC) &ffi_view_is_materialized, 1}, + {"ffi_view_materialize", (DL_FUNC) &ffi_view_materialize, 1}, {"ffi_which_operator", (DL_FUNC) &ffi_which_operator, 1}, {"ffi_wref_key", (DL_FUNC) &ffi_wref_key, 1}, {"ffi_wref_value", (DL_FUNC) &ffi_wref_value, 1}, @@ -321,6 +325,8 @@ void R_init_rlang(DllInfo* dll) { R_registerRoutines(dll, NULL, r_callables, NULL, externals); R_useDynamicSymbols(dll, FALSE); + + r_init_library_with_dll(dll, "rlang"); } diff --git a/src/rlang/altrep.h b/src/rlang/altrep.h index dc07b94eee..6b1cdef473 100644 --- a/src/rlang/altrep.h +++ b/src/rlang/altrep.h @@ -13,5 +13,20 @@ # define ALTREP(x) false #endif +static inline +bool r_is_altrep(r_obj* x) { + return ALTREP(x); +} + +static inline +r_obj* r_altrep_data1(r_obj* x) { + return R_altrep_data1(x); +} + +static inline +r_obj* r_altrep_data2(r_obj* x) { + return R_altrep_data2(x); +} + #endif diff --git a/src/rlang/rlang.c b/src/rlang/rlang.c index 935cd9ef32..a731ab6a0b 100644 --- a/src/rlang/rlang.c +++ b/src/rlang/rlang.c @@ -29,6 +29,7 @@ #include "vec-chr.c" #include "vec-lgl.c" #include "vendor.c" +#include "view.c" #include "walk.c" @@ -120,4 +121,11 @@ r_obj* r_init_library(r_obj* ns) { return r_null; } +// This *must* be called before making any calls to the functions +// provided in the library. Call this function from your `R_init_()` +// function, passing along the `dll` and your package's name. +void r_init_library_with_dll(DllInfo* dll, const char* package) { + r_init_library_view(dll, package); +} + bool _r_use_local_precious_list = false; diff --git a/src/rlang/rlang.h b/src/rlang/rlang.h index 7e71e4b074..0ce13faf6f 100644 --- a/src/rlang/rlang.h +++ b/src/rlang/rlang.h @@ -72,6 +72,7 @@ bool _r_use_local_precious_list; #include "vec-chr.h" #include "vec-lgl.h" #include "vendor.h" +#include "view.h" #include "walk.h" diff --git a/src/rlang/view.c b/src/rlang/view.c new file mode 100644 index 0000000000..8a93299239 --- /dev/null +++ b/src/rlang/view.c @@ -0,0 +1,481 @@ +#include "rlang.h" +#include "view.h" + +#include + +/* +Structure of a `view`: + +Before materialization: +- `data1` is the original vector +- `data2` is a RAWSXP holding a `r_view_metadata` + +After materialization: +- `data1` is `R_NilValue` +- `data2` is the materialized view + +So `data1 == R_NilValue` is how we determine if we have materialized or not +*/ + +struct r_view_metadata { + r_ssize start; + r_ssize size; +}; + +// Initialised at load time +R_altrep_class_t r_lgl_view_class; +R_altrep_class_t r_int_view_class; +R_altrep_class_t r_dbl_view_class; +R_altrep_class_t r_cpl_view_class; + +// ----------------------------------------------------------------------------- + +static inline r_obj* +r_view(R_altrep_class_t cls, r_obj* x, r_ssize start, r_ssize size) { + if (r_attrib(x) != r_null) { + r_stop_internal("`x` can't have any attributes."); + } + + // We don't want it to have any chance of changing out from under us + r_mark_shared(x); + + r_obj* metadata = r_alloc_raw(sizeof(struct r_view_metadata)); + struct r_view_metadata* p_metadata = r_raw_begin(metadata); + p_metadata->start = start; + p_metadata->size = size; + + return R_new_altrep(cls, x, metadata); +} + +static inline r_obj* r_lgl_view(r_obj* x, r_ssize start, r_ssize size) { + return r_view(r_lgl_view_class, x, start, size); +} +static inline r_obj* r_int_view(r_obj* x, r_ssize start, r_ssize size) { + return r_view(r_int_view_class, x, start, size); +} +static inline r_obj* r_dbl_view(r_obj* x, r_ssize start, r_ssize size) { + return r_view(r_dbl_view_class, x, start, size); +} +static inline r_obj* r_cpl_view(r_obj* x, r_ssize start, r_ssize size) { + return r_view(r_cpl_view_class, x, start, size); +} + +// Up to the caller to verify that `start` and `size` are sized correctly. +// `start` is 0-indexed. +r_obj* r_vec_view(r_obj* x, r_ssize start, r_ssize size) { + switch (r_typeof(x)) { + case R_TYPE_logical: + return r_lgl_view(x, start, size); + case R_TYPE_integer: + return r_int_view(x, start, size); + case R_TYPE_double: + return r_dbl_view(x, start, size); + case R_TYPE_complex: + return r_cpl_view(x, start, size); + default: + r_stop_internal("Type not implemented."); + } +} + +// ----------------------------------------------------------------------------- + +static inline bool r_is_lgl_view(r_obj* x) { + return R_altrep_inherits(x, r_lgl_view_class); +} +static inline bool r_is_int_view(r_obj* x) { + return R_altrep_inherits(x, r_int_view_class); +} +static inline bool r_is_dbl_view(r_obj* x) { + return R_altrep_inherits(x, r_dbl_view_class); +} +static inline bool r_is_cpl_view(r_obj* x) { + return R_altrep_inherits(x, r_cpl_view_class); +} + +bool r_is_view(r_obj* x) { + switch (r_typeof(x)) { + case R_TYPE_logical: + return r_is_lgl_view(x); + case R_TYPE_integer: + return r_is_int_view(x); + case R_TYPE_double: + return r_is_dbl_view(x); + case R_TYPE_complex: + return r_is_cpl_view(x); + default: + return false; + } +} + +void r_check_view(r_obj* x) { + if (r_is_view(x)) { + return; + } + r_stop_internal("`x` must be an ALTREP view."); +} + +// ----------------------------------------------------------------------------- + +#define R_VIEW_MATERIALIZE(ALLOC, CTYPE, BEGIN, GET_REGION) \ + r_obj* data = r_altrep_data1(x); \ + \ + if (data == r_null) { \ + r_stop_internal( \ + "`x` has already been materialized, return `data2` directly rather " \ + "than calling this." \ + ); \ + } \ + \ + r_obj* metadata = r_altrep_data2(x); \ + struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ + \ + const r_ssize start = p_metadata->start; \ + const r_ssize size = p_metadata->size; \ + \ + r_obj* out = KEEP(ALLOC(size)); \ + CTYPE* v_out = BEGIN(out); \ + \ + /* Be friendly to ALTREP `data` too */ \ + GET_REGION(data, start, size, v_out); \ + \ + /* Declare ourselves as materialized */ \ + R_set_altrep_data1(x, r_null); \ + R_set_altrep_data2(x, out); \ + \ + FREE(1); \ + return out + +static r_obj* r_lgl_view_materialize(r_obj* x) { + R_VIEW_MATERIALIZE(r_alloc_logical, int, r_lgl_begin, LOGICAL_GET_REGION); +} +static r_obj* r_int_view_materialize(r_obj* x) { + R_VIEW_MATERIALIZE(r_alloc_integer, int, r_int_begin, INTEGER_GET_REGION); +} +static r_obj* r_dbl_view_materialize(r_obj* x) { + R_VIEW_MATERIALIZE(r_alloc_double, double, r_dbl_begin, REAL_GET_REGION); +} +static r_obj* r_cpl_view_materialize(r_obj* x) { + R_VIEW_MATERIALIZE( + r_alloc_complex, r_complex, r_cpl_begin, COMPLEX_GET_REGION + ); +} + +r_obj* r_view_materialize(r_obj* x) { + switch (r_typeof(x)) { + case R_TYPE_logical: + return r_lgl_view_materialize(x); + case R_TYPE_integer: + return r_int_view_materialize(x); + case R_TYPE_double: + return r_dbl_view_materialize(x); + case R_TYPE_complex: + return r_cpl_view_materialize(x); + default: + r_stop_internal("Type not implemented."); + } +} + +// ----------------------------------------------------------------------------- + +#define R_VIEW_DATAPTR_WRITABLE(MATERIALIZE, BEGIN) \ + r_obj* out = NULL; \ + r_obj* data = r_altrep_data1(x); \ + \ + if (data != r_null) { \ + /* We can't give out a writable pointer to `data`. */ \ + /* Materialize and give a writable pointer to that instead. */ \ + out = MATERIALIZE(x); \ + } else { \ + /* Already materialized */ \ + out = r_altrep_data2(x); \ + } \ + \ + return BEGIN(out); + +static inline int* r_lgl_view_dataptr_writable(r_obj* x) { + R_VIEW_DATAPTR_WRITABLE(r_lgl_view_materialize, r_lgl_begin); +} +static inline int* r_int_view_dataptr_writable(r_obj* x) { + R_VIEW_DATAPTR_WRITABLE(r_int_view_materialize, r_int_begin); +} +static inline double* r_dbl_view_dataptr_writable(r_obj* x) { + R_VIEW_DATAPTR_WRITABLE(r_dbl_view_materialize, r_dbl_begin); +} +static inline r_complex* r_cpl_view_dataptr_writable(r_obj* x) { + R_VIEW_DATAPTR_WRITABLE(r_cpl_view_materialize, r_cpl_begin); +} + +#define R_VIEW_DATAPTR_READONLY(CBEGIN) \ + r_obj* data = r_altrep_data1(x); \ + \ + if (data != r_null) { \ + /* Provide a readonly view into the data at the right offset */ \ + r_obj* metadata = r_altrep_data2(x); \ + const struct r_view_metadata* p_metadata = r_raw_cbegin(metadata); \ + return CBEGIN(data) + p_metadata->start; \ + } else { \ + /* Provide a readonly view into the materialized data */ \ + return CBEGIN(r_altrep_data2(x)); \ + } + +static inline int const* r_lgl_view_dataptr_readonly(r_obj* x) { + R_VIEW_DATAPTR_READONLY(r_lgl_cbegin); +} +static inline int const* r_int_view_dataptr_readonly(r_obj* x) { + R_VIEW_DATAPTR_READONLY(r_int_cbegin); +} +static inline double const* r_dbl_view_dataptr_readonly(r_obj* x) { + R_VIEW_DATAPTR_READONLY(r_dbl_cbegin); +} +static inline r_complex const* r_cpl_view_dataptr_readonly(r_obj* x) { + R_VIEW_DATAPTR_READONLY(r_cpl_cbegin); +} + +#define R_VIEW_DATAPTR(WRITABLE, READONLY) \ + if (writable) { \ + return (void*) WRITABLE(x); \ + } else { \ + /* Caller promises not to mutate it */ \ + return (void*) READONLY(x); \ + } + +static void* r_lgl_view_dataptr(r_obj* x, Rboolean writable) { + R_VIEW_DATAPTR(r_lgl_view_dataptr_writable, r_lgl_view_dataptr_readonly); +} +static void* r_int_view_dataptr(r_obj* x, Rboolean writable) { + R_VIEW_DATAPTR(r_int_view_dataptr_writable, r_int_view_dataptr_readonly); +} +static void* r_dbl_view_dataptr(r_obj* x, Rboolean writable) { + R_VIEW_DATAPTR(r_dbl_view_dataptr_writable, r_dbl_view_dataptr_readonly); +} +static void* r_cpl_view_dataptr(r_obj* x, Rboolean writable) { + R_VIEW_DATAPTR(r_cpl_view_dataptr_writable, r_cpl_view_dataptr_readonly); +} + +// We can always provide a readonly view +static const void* r_lgl_view_dataptr_or_null(r_obj* x) { + return (const void*) r_lgl_view_dataptr_readonly(x); +} +static const void* r_int_view_dataptr_or_null(r_obj* x) { + return (const void*) r_int_view_dataptr_readonly(x); +} +static const void* r_dbl_view_dataptr_or_null(r_obj* x) { + return (const void*) r_dbl_view_dataptr_readonly(x); +} +static const void* r_cpl_view_dataptr_or_null(r_obj* x) { + return (const void*) r_cpl_view_dataptr_readonly(x); +} + +// ----------------------------------------------------------------------------- + +static r_ssize r_view_length(r_obj* x) { + r_obj* data = r_altrep_data1(x); + + if (data != r_null) { + // Pull from metadata + r_obj* metadata = r_altrep_data2(x); + const struct r_view_metadata* p_metadata = r_raw_cbegin(metadata); + return p_metadata->size; + } else { + // Pull from materialized object + return Rf_xlength(r_altrep_data2(x)); + } +} + +// ----------------------------------------------------------------------------- + +static inline Rboolean r_view_inspect( + const char* name, + r_obj* x, + int pre, + int deep, + int pvec, + void (*inspect_subtree)(r_obj*, int, int, int) +) { + Rprintf( + "%s (materialized=%s)\n", name, r_altrep_data1(x) == r_null ? "T" : "F" + ); + return TRUE; +} + +static Rboolean r_lgl_view_inspect( + r_obj* x, + int pre, + int deep, + int pvec, + void (*inspect_subtree)(r_obj*, int, int, int) +) { + return r_view_inspect( + "altrep_logical_view", x, pre, deep, pvec, inspect_subtree + ); +} +static Rboolean r_int_view_inspect( + r_obj* x, + int pre, + int deep, + int pvec, + void (*inspect_subtree)(r_obj*, int, int, int) +) { + return r_view_inspect( + "altrep_integer_view", x, pre, deep, pvec, inspect_subtree + ); +} +static Rboolean r_dbl_view_inspect( + r_obj* x, + int pre, + int deep, + int pvec, + void (*inspect_subtree)(r_obj*, int, int, int) +) { + return r_view_inspect( + "altrep_double_view", x, pre, deep, pvec, inspect_subtree + ); +} +static Rboolean r_cpl_view_inspect( + r_obj* x, + int pre, + int deep, + int pvec, + void (*inspect_subtree)(r_obj*, int, int, int) +) { + return r_view_inspect( + "altrep_complex_view", x, pre, deep, pvec, inspect_subtree + ); +} + +// ----------------------------------------------------------------------------- + +static r_obj* r_view_serialized_state(r_obj* x) { + // Falls back to materializing the full object and serializing that, + // no ALTREP used in the serialization. Particularly important to ensure + // we can iterate on the internal structure without worrying about loading + // old serialized ALTREP objects. + return NULL; +} + +// ----------------------------------------------------------------------------- + +#define R_VIEW_ELT(ELT) \ + r_obj* data = r_altrep_data1(x); \ + \ + if (data != r_null) { \ + /* Element comes from original data */ \ + r_obj* metadata = r_altrep_data2(x); \ + const struct r_view_metadata* p_metadata = r_raw_cbegin(metadata); \ + return ELT(data, p_metadata->start + i); \ + } else { \ + /* Element comes from materialized data */ \ + return ELT(r_altrep_data2(x), i); \ + } + +static int r_lgl_view_elt(r_obj* x, r_ssize i) { + R_VIEW_ELT(LOGICAL_ELT); +} +static int r_int_view_elt(r_obj* x, r_ssize i) { + R_VIEW_ELT(INTEGER_ELT); +} +static double r_dbl_view_elt(r_obj* x, r_ssize i) { + R_VIEW_ELT(REAL_ELT); +} +static r_complex r_cpl_view_elt(r_obj* x, r_ssize i) { + R_VIEW_ELT(COMPLEX_ELT); +} + +// ----------------------------------------------------------------------------- + +// Purposefully not implemented +// +// R_set_altvec_Extract_subset_method +// This falls back to a default implementation that uses the `Elt` method, +// which we think is good enough (though it is slower) +// +// R_set_alttype_Get_region_method +// This first tries Dataptr_or_null, which we have a very efficient method +// for. It never returns `NULL` since we can always return a readonly pointer. + +static void r_init_library_lgl_view(DllInfo* dll, const char* package) { + r_lgl_view_class = R_make_altlogical_class("logical_view", package, dll); + + // ALTVEC + R_set_altvec_Dataptr_method(r_lgl_view_class, r_lgl_view_dataptr); + R_set_altvec_Dataptr_or_null_method( + r_lgl_view_class, r_lgl_view_dataptr_or_null + ); + + // ALTREP + R_set_altrep_Length_method(r_lgl_view_class, r_view_length); + R_set_altrep_Inspect_method(r_lgl_view_class, r_lgl_view_inspect); + R_set_altrep_Serialized_state_method( + r_lgl_view_class, r_view_serialized_state + ); + + // ALTTYPE + R_set_altlogical_Elt_method(r_lgl_view_class, r_lgl_view_elt); +} + +static void r_init_library_int_view(DllInfo* dll, const char* package) { + r_int_view_class = R_make_altinteger_class("integer_view", package, dll); + + // ALTVEC + R_set_altvec_Dataptr_method(r_int_view_class, r_int_view_dataptr); + R_set_altvec_Dataptr_or_null_method( + r_int_view_class, r_int_view_dataptr_or_null + ); + + // ALTREP + R_set_altrep_Length_method(r_int_view_class, r_view_length); + R_set_altrep_Inspect_method(r_int_view_class, r_int_view_inspect); + R_set_altrep_Serialized_state_method( + r_int_view_class, r_view_serialized_state + ); + + // ALTTYPE + R_set_altinteger_Elt_method(r_int_view_class, r_int_view_elt); +} + +static void r_init_library_dbl_view(DllInfo* dll, const char* package) { + r_dbl_view_class = R_make_altreal_class("double_view", package, dll); + + // ALTVEC + R_set_altvec_Dataptr_method(r_dbl_view_class, r_dbl_view_dataptr); + R_set_altvec_Dataptr_or_null_method( + r_dbl_view_class, r_dbl_view_dataptr_or_null + ); + + // ALTREP + R_set_altrep_Length_method(r_dbl_view_class, r_view_length); + R_set_altrep_Inspect_method(r_dbl_view_class, r_dbl_view_inspect); + R_set_altrep_Serialized_state_method( + r_dbl_view_class, r_view_serialized_state + ); + + // ALTTYPE + R_set_altreal_Elt_method(r_dbl_view_class, r_dbl_view_elt); +} + +static void r_init_library_cpl_view(DllInfo* dll, const char* package) { + r_cpl_view_class = R_make_altcomplex_class("complex_view", package, dll); + + // ALTVEC + R_set_altvec_Dataptr_method(r_cpl_view_class, r_cpl_view_dataptr); + R_set_altvec_Dataptr_or_null_method( + r_cpl_view_class, r_cpl_view_dataptr_or_null + ); + + // ALTREP + R_set_altrep_Length_method(r_cpl_view_class, r_view_length); + R_set_altrep_Inspect_method(r_cpl_view_class, r_cpl_view_inspect); + R_set_altrep_Serialized_state_method( + r_cpl_view_class, r_view_serialized_state + ); + + // ALTTYPE + R_set_altcomplex_Elt_method(r_cpl_view_class, r_cpl_view_elt); +} + +void r_init_library_view(DllInfo* dll, const char* package) { + r_init_library_lgl_view(dll, package); + r_init_library_int_view(dll, package); + r_init_library_dbl_view(dll, package); + r_init_library_cpl_view(dll, package); +} diff --git a/src/rlang/view.h b/src/rlang/view.h new file mode 100644 index 0000000000..40a3606898 --- /dev/null +++ b/src/rlang/view.h @@ -0,0 +1,16 @@ +#ifndef RLANG_VIEW_H +#define RLANG_VIEW_H + +r_obj* r_vec_view(r_obj* x, r_ssize start, r_ssize size); + +static inline +bool r_view_is_materialized(r_obj* x) { + return r_altrep_data1(x) == r_null; +} + +r_obj* r_view_materialize(r_obj* x); + +bool r_is_view(r_obj* x); +void r_check_view(r_obj* x); + +#endif diff --git a/tests/testthat/test-view.R b/tests/testthat/test-view.R new file mode 100644 index 0000000000..09305fcd10 --- /dev/null +++ b/tests/testthat/test-view.R @@ -0,0 +1,177 @@ +test_that("views can be created", { + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + expect_identical(x, base[2:4]) + + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + expect_identical(x, base[2:4]) + + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + expect_identical(x, base[2:4]) + + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + expect_identical(x, base[2:4]) +}) + +test_that("views have right length", { + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(length(x), 3L) + + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(length(x), 3L) + + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(length(x), 3L) + + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(length(x), 3L) +}) + +test_that("views can be sliced with subset", { + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[1:2], base[2:3]) + expect_identical(x[2:4], base[3:5]) + expect_identical(x[0L], base[0L]) + expect_identical(x[c(0L, 2L)], base[c(0L, 3L)]) + expect_false(view_is_materialized(x)) + + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[1:2], base[2:3]) + expect_identical(x[2:4], base[3:5]) + expect_identical(x[0L], base[0L]) + expect_identical(x[c(0L, 2L)], base[c(0L, 3L)]) + expect_false(view_is_materialized(x)) + + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[1:2], base[2:3]) + expect_identical(x[2:4], base[3:5]) + expect_identical(x[0L], base[0L]) + expect_identical(x[c(0L, 2L)], base[c(0L, 3L)]) + expect_false(view_is_materialized(x)) + + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[1:2], base[2:3]) + expect_identical(x[2:4], base[3:5]) + expect_identical(x[0L], base[0L]) + expect_identical(x[c(0L, 2L)], base[c(0L, 3L)]) + expect_false(view_is_materialized(x)) +}) + +test_that("views can be sliced with subset2", { + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[[1]], base[[2L]]) + expect_identical(x[[3]], base[[4L]]) + expect_error(x[[4]]) + expect_false(view_is_materialized(x)) + + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[[1]], base[[2L]]) + expect_identical(x[[3]], base[[4L]]) + expect_error(x[[4]]) + expect_false(view_is_materialized(x)) + + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[[1]], base[[2L]]) + expect_identical(x[[3]], base[[4L]]) + expect_error(x[[4]]) + expect_false(view_is_materialized(x)) + + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[[1]], base[[2L]]) + expect_identical(x[[3]], base[[4L]]) + expect_error(x[[4]]) + expect_false(view_is_materialized(x)) +}) + +test_that("views can be manually materialized", { + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + materialized <- view_materialize(x) + expect_true(view_is_materialized(x)) + expect_false(is_altrep(materialized)) + + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + materialized <- view_materialize(x) + expect_true(view_is_materialized(x)) + expect_false(is_altrep(materialized)) + + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + materialized <- view_materialize(x) + expect_true(view_is_materialized(x)) + expect_false(is_altrep(materialized)) + + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + materialized <- view_materialize(x) + expect_true(view_is_materialized(x)) + expect_false(is_altrep(materialized)) +}) + +test_that("view duplication causes a materialization", { + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) + + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) + + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) + + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) +}) + +test_that("can make zero length view", { + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 2L, size = 0L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) + + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 2L, size = 0L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) + + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 2L, size = 0L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) + + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 2L, size = 0L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) +}) From ce1da3be74f657a3bcb7c619ede7fc0992ac1b19 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Mon, 1 Jul 2024 15:30:03 -0400 Subject: [PATCH 2/5] Add chr/list support --- src/rlang/view.c | 205 ++++++++++++++++++++++++++++++++++++- tests/testthat/test-view.R | 86 ++++++++++++---- 2 files changed, 272 insertions(+), 19 deletions(-) diff --git a/src/rlang/view.c b/src/rlang/view.c index 8a93299239..e31055c1ac 100644 --- a/src/rlang/view.c +++ b/src/rlang/view.c @@ -1,5 +1,4 @@ #include "rlang.h" -#include "view.h" #include @@ -27,6 +26,8 @@ R_altrep_class_t r_lgl_view_class; R_altrep_class_t r_int_view_class; R_altrep_class_t r_dbl_view_class; R_altrep_class_t r_cpl_view_class; +R_altrep_class_t r_chr_view_class; +R_altrep_class_t r_list_view_class; // ----------------------------------------------------------------------------- @@ -59,6 +60,12 @@ static inline r_obj* r_dbl_view(r_obj* x, r_ssize start, r_ssize size) { static inline r_obj* r_cpl_view(r_obj* x, r_ssize start, r_ssize size) { return r_view(r_cpl_view_class, x, start, size); } +static inline r_obj* r_chr_view(r_obj* x, r_ssize start, r_ssize size) { + return r_view(r_chr_view_class, x, start, size); +} +static inline r_obj* r_list_view(r_obj* x, r_ssize start, r_ssize size) { + return r_view(r_list_view_class, x, start, size); +} // Up to the caller to verify that `start` and `size` are sized correctly. // `start` is 0-indexed. @@ -72,6 +79,10 @@ r_obj* r_vec_view(r_obj* x, r_ssize start, r_ssize size) { return r_dbl_view(x, start, size); case R_TYPE_complex: return r_cpl_view(x, start, size); + case R_TYPE_character: + return r_chr_view(x, start, size); + case R_TYPE_list: + return r_list_view(x, start, size); default: r_stop_internal("Type not implemented."); } @@ -91,6 +102,12 @@ static inline bool r_is_dbl_view(r_obj* x) { static inline bool r_is_cpl_view(r_obj* x) { return R_altrep_inherits(x, r_cpl_view_class); } +static inline bool r_is_chr_view(r_obj* x) { + return R_altrep_inherits(x, r_chr_view_class); +} +static inline bool r_is_list_view(r_obj* x) { + return R_altrep_inherits(x, r_list_view_class); +} bool r_is_view(r_obj* x) { switch (r_typeof(x)) { @@ -102,6 +119,10 @@ bool r_is_view(r_obj* x) { return r_is_dbl_view(x); case R_TYPE_complex: return r_is_cpl_view(x); + case R_TYPE_character: + return r_is_chr_view(x); + case R_TYPE_list: + return r_is_list_view(x); default: return false; } @@ -145,6 +166,39 @@ void r_check_view(r_obj* x) { FREE(1); \ return out +#define R_VIEW_MATERIALIZE_BARRIER(ALLOC, CTYPE, CBEGIN, POKE) \ + r_obj* data = r_altrep_data1(x); \ + \ + if (data == r_null) { \ + r_stop_internal( \ + "`x` has already been materialized, return `data2` directly rather " \ + "than calling this." \ + ); \ + } \ + \ + r_obj* metadata = r_altrep_data2(x); \ + struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ + \ + const r_ssize start = p_metadata->start; \ + const r_ssize size = p_metadata->size; \ + \ + /* Read only pointer into original data, shifted to `start` */ \ + CTYPE const* v_data = CBEGIN(data) + start; \ + \ + r_obj* out = KEEP(ALLOC(size)); \ + \ + for (r_ssize i = 0; i < size; ++i) { \ + r_obj* elt = v_data[i]; \ + POKE(out, i, elt); \ + } \ + \ + /* Declare ourselves as materialized */ \ + R_set_altrep_data1(x, r_null); \ + R_set_altrep_data2(x, out); \ + \ + FREE(1); \ + return out + static r_obj* r_lgl_view_materialize(r_obj* x) { R_VIEW_MATERIALIZE(r_alloc_logical, int, r_lgl_begin, LOGICAL_GET_REGION); } @@ -159,6 +213,14 @@ static r_obj* r_cpl_view_materialize(r_obj* x) { r_alloc_complex, r_complex, r_cpl_begin, COMPLEX_GET_REGION ); } +static r_obj* r_chr_view_materialize(r_obj* x) { + R_VIEW_MATERIALIZE_BARRIER( + r_alloc_character, r_obj*, r_chr_cbegin, r_chr_poke + ); +} +static r_obj* r_list_view_materialize(r_obj* x) { + R_VIEW_MATERIALIZE_BARRIER(r_alloc_list, r_obj*, r_list_cbegin, r_list_poke); +} r_obj* r_view_materialize(r_obj* x) { switch (r_typeof(x)) { @@ -170,6 +232,10 @@ r_obj* r_view_materialize(r_obj* x) { return r_dbl_view_materialize(x); case R_TYPE_complex: return r_cpl_view_materialize(x); + case R_TYPE_character: + return r_chr_view_materialize(x); + case R_TYPE_list: + return r_list_view_materialize(x); default: r_stop_internal("Type not implemented."); } @@ -204,6 +270,17 @@ static inline double* r_dbl_view_dataptr_writable(r_obj* x) { static inline r_complex* r_cpl_view_dataptr_writable(r_obj* x) { R_VIEW_DATAPTR_WRITABLE(r_cpl_view_materialize, r_cpl_begin); } +static inline void* r_chr_view_dataptr_writable(r_obj* x) { + // R's internal usage of `STRING_PTR()` forces us to implement this, + // but we should never call this function ourselves. `STRING_PTR()` is also + // non-API, so we have to use `DATAPTR()` to get the writable pointer. + R_VIEW_DATAPTR_WRITABLE(r_chr_view_materialize, DATAPTR); +} +// static inline void r_list_view_dataptr_writable(r_obj* x) { +// // R does not use `VECTOR_PTR()` internally, and it even errors in +// // `ALTVEC_DATAPTR_EX()` if you try and take a `writable` `DATAPTR()` on an +// // ALTREP list, so we don't need this. +// } #define R_VIEW_DATAPTR_READONLY(CBEGIN) \ r_obj* data = r_altrep_data1(x); \ @@ -230,6 +307,12 @@ static inline double const* r_dbl_view_dataptr_readonly(r_obj* x) { static inline r_complex const* r_cpl_view_dataptr_readonly(r_obj* x) { R_VIEW_DATAPTR_READONLY(r_cpl_cbegin); } +static inline r_obj* const* r_chr_view_dataptr_readonly(r_obj* x) { + R_VIEW_DATAPTR_READONLY(r_chr_cbegin); +} +static inline r_obj* const* r_list_view_dataptr_readonly(r_obj* x) { + R_VIEW_DATAPTR_READONLY(r_list_cbegin); +} #define R_VIEW_DATAPTR(WRITABLE, READONLY) \ if (writable) { \ @@ -239,6 +322,15 @@ static inline r_complex const* r_cpl_view_dataptr_readonly(r_obj* x) { return (void*) READONLY(x); \ } +#define R_VIEW_DATAPTR_BARRIER(READONLY) \ + if (writable) { \ + /* `ALTVEC_DATAPTR_EX()` should have errored */ \ + r_stop_unreachable(); \ + } else { \ + /* Caller promises not to mutate it */ \ + return (void*) READONLY(x); \ + } + static void* r_lgl_view_dataptr(r_obj* x, Rboolean writable) { R_VIEW_DATAPTR(r_lgl_view_dataptr_writable, r_lgl_view_dataptr_readonly); } @@ -251,6 +343,12 @@ static void* r_dbl_view_dataptr(r_obj* x, Rboolean writable) { static void* r_cpl_view_dataptr(r_obj* x, Rboolean writable) { R_VIEW_DATAPTR(r_cpl_view_dataptr_writable, r_cpl_view_dataptr_readonly); } +static void* r_chr_view_dataptr(r_obj* x, Rboolean writable) { + R_VIEW_DATAPTR(r_chr_view_dataptr_writable, r_chr_view_dataptr_readonly); +} +static void* r_list_view_dataptr(r_obj* x, Rboolean writable) { + R_VIEW_DATAPTR_BARRIER(r_list_view_dataptr_readonly); +} // We can always provide a readonly view static const void* r_lgl_view_dataptr_or_null(r_obj* x) { @@ -265,6 +363,12 @@ static const void* r_dbl_view_dataptr_or_null(r_obj* x) { static const void* r_cpl_view_dataptr_or_null(r_obj* x) { return (const void*) r_cpl_view_dataptr_readonly(x); } +static const void* r_chr_view_dataptr_or_null(r_obj* x) { + return (const void*) r_chr_view_dataptr_readonly(x); +} +static const void* r_list_view_dataptr_or_null(r_obj* x) { + return (const void*) r_list_view_dataptr_readonly(x); +} // ----------------------------------------------------------------------------- @@ -342,6 +446,28 @@ static Rboolean r_cpl_view_inspect( "altrep_complex_view", x, pre, deep, pvec, inspect_subtree ); } +static Rboolean r_chr_view_inspect( + r_obj* x, + int pre, + int deep, + int pvec, + void (*inspect_subtree)(r_obj*, int, int, int) +) { + return r_view_inspect( + "altrep_character_view", x, pre, deep, pvec, inspect_subtree + ); +} +static Rboolean r_list_view_inspect( + r_obj* x, + int pre, + int deep, + int pvec, + void (*inspect_subtree)(r_obj*, int, int, int) +) { + return r_view_inspect( + "altrep_list_view", x, pre, deep, pvec, inspect_subtree + ); +} // ----------------------------------------------------------------------------- @@ -380,6 +506,38 @@ static double r_dbl_view_elt(r_obj* x, r_ssize i) { static r_complex r_cpl_view_elt(r_obj* x, r_ssize i) { R_VIEW_ELT(COMPLEX_ELT); } +static r_obj* r_chr_view_elt(r_obj* x, r_ssize i) { + R_VIEW_ELT(STRING_ELT); +} +static r_obj* r_list_view_elt(r_obj* x, r_ssize i) { + R_VIEW_ELT(VECTOR_ELT); +} + +// ----------------------------------------------------------------------------- + +#define R_VIEW_SET_ELT(MATERIALIZE, POKE) \ + r_obj* data = r_altrep_data1(x); \ + \ + if (data != r_null) { \ + /* Materialize so we can set the element. */ \ + /* Only protect `elt` when we materialize, for performance. */ \ + /* (although gc is disabled here anyways by `ALT_SET_ELT()`). */ \ + KEEP(elt); \ + data = MATERIALIZE(x); \ + POKE(data, i, elt); \ + FREE(1); \ + } else { \ + /* Already materialized */ \ + data = r_altrep_data2(x); \ + POKE(data, i, elt); \ + } + +static void r_chr_view_set_elt(r_obj* x, r_ssize i, r_obj* elt) { + R_VIEW_SET_ELT(r_chr_view_materialize, r_chr_poke); +} +static void r_list_view_set_elt(r_obj* x, r_ssize i, r_obj* elt) { + R_VIEW_SET_ELT(r_list_view_materialize, r_list_poke); +} // ----------------------------------------------------------------------------- @@ -392,6 +550,7 @@ static r_complex r_cpl_view_elt(r_obj* x, r_ssize i) { // R_set_alttype_Get_region_method // This first tries Dataptr_or_null, which we have a very efficient method // for. It never returns `NULL` since we can always return a readonly pointer. +// No ALTREP `Get_region` method possible for character vectors or lists. static void r_init_library_lgl_view(DllInfo* dll, const char* package) { r_lgl_view_class = R_make_altlogical_class("logical_view", package, dll); @@ -473,9 +632,53 @@ static void r_init_library_cpl_view(DllInfo* dll, const char* package) { R_set_altcomplex_Elt_method(r_cpl_view_class, r_cpl_view_elt); } +static void r_init_library_chr_view(DllInfo* dll, const char* package) { + r_chr_view_class = R_make_altstring_class("character_view", package, dll); + + // ALTVEC + R_set_altvec_Dataptr_method(r_chr_view_class, r_chr_view_dataptr); + R_set_altvec_Dataptr_or_null_method( + r_chr_view_class, r_chr_view_dataptr_or_null + ); + + // ALTREP + R_set_altrep_Length_method(r_chr_view_class, r_view_length); + R_set_altrep_Inspect_method(r_chr_view_class, r_chr_view_inspect); + R_set_altrep_Serialized_state_method( + r_chr_view_class, r_view_serialized_state + ); + + // ALTTYPE + R_set_altstring_Elt_method(r_chr_view_class, r_chr_view_elt); + R_set_altstring_Set_elt_method(r_chr_view_class, r_chr_view_set_elt); +} + +static void r_init_library_list_view(DllInfo* dll, const char* package) { + r_list_view_class = R_make_altlist_class("list_view", package, dll); + + // ALTVEC + R_set_altvec_Dataptr_method(r_list_view_class, r_list_view_dataptr); + R_set_altvec_Dataptr_or_null_method( + r_list_view_class, r_list_view_dataptr_or_null + ); + + // ALTREP + R_set_altrep_Length_method(r_list_view_class, r_view_length); + R_set_altrep_Inspect_method(r_list_view_class, r_list_view_inspect); + R_set_altrep_Serialized_state_method( + r_list_view_class, r_view_serialized_state + ); + + // ALTTYPE + R_set_altlist_Elt_method(r_list_view_class, r_list_view_elt); + R_set_altlist_Set_elt_method(r_list_view_class, r_list_view_set_elt); +} + void r_init_library_view(DllInfo* dll, const char* package) { r_init_library_lgl_view(dll, package); r_init_library_int_view(dll, package); r_init_library_dbl_view(dll, package); r_init_library_cpl_view(dll, package); + r_init_library_chr_view(dll, package); + r_init_library_list_view(dll, package); } diff --git a/tests/testthat/test-view.R b/tests/testthat/test-view.R index 09305fcd10..cd9449adef 100644 --- a/tests/testthat/test-view.R +++ b/tests/testthat/test-view.R @@ -18,6 +18,16 @@ test_that("views can be created", { x <- vec_view(base, start = 2L, size = 3L) expect_false(view_is_materialized(x)) expect_identical(x, base[2:4]) + + base <- c("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + expect_identical(x, base[2:4]) + + base <- list("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + expect_identical(x, base[2:4]) }) test_that("views have right length", { @@ -36,6 +46,14 @@ test_that("views have right length", { base <- c(1, 2, 3, 4) + 1i x <- vec_view(base, start = 2L, size = 3L) expect_identical(length(x), 3L) + + base <- c("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(length(x), 3L) + + base <- list("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(length(x), 3L) }) test_that("views can be sliced with subset", { @@ -70,6 +88,22 @@ test_that("views can be sliced with subset", { expect_identical(x[0L], base[0L]) expect_identical(x[c(0L, 2L)], base[c(0L, 3L)]) expect_false(view_is_materialized(x)) + + base <- c("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[1:2], base[2:3]) + expect_identical(x[2:4], base[3:5]) + expect_identical(x[0L], base[0L]) + expect_identical(x[c(0L, 2L)], base[c(0L, 3L)]) + expect_false(view_is_materialized(x)) + + base <- list("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[1:2], base[2:3]) + expect_identical(x[2:4], base[3:5]) + expect_identical(x[0L], base[0L]) + expect_identical(x[c(0L, 2L)], base[c(0L, 3L)]) + expect_false(view_is_materialized(x)) }) test_that("views can be sliced with subset2", { @@ -100,6 +134,20 @@ test_that("views can be sliced with subset2", { expect_identical(x[[3]], base[[4L]]) expect_error(x[[4]]) expect_false(view_is_materialized(x)) + + base <- c("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[[1]], base[[2L]]) + expect_identical(x[[3]], base[[4L]]) + expect_error(x[[4]]) + expect_false(view_is_materialized(x)) + + base <- list("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[[1]], base[[2L]]) + expect_identical(x[[3]], base[[4L]]) + expect_error(x[[4]]) + expect_false(view_is_materialized(x)) }) test_that("views can be manually materialized", { @@ -130,28 +178,20 @@ test_that("views can be manually materialized", { materialized <- view_materialize(x) expect_true(view_is_materialized(x)) expect_false(is_altrep(materialized)) -}) - -test_that("view duplication causes a materialization", { - base <- c(TRUE, FALSE, TRUE, FALSE) - x <- vec_view(base, start = 2L, size = 3L) - expect_identical(x, base[0L]) - expect_identical(length(x), 0L) - base <- c(1L, 2L, 3L, 4L) + base <- c("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) - expect_identical(x, base[0L]) - expect_identical(length(x), 0L) - - base <- c(1, 2, 3, 4) - x <- vec_view(base, start = 2L, size = 3L) - expect_identical(x, base[0L]) - expect_identical(length(x), 0L) + expect_false(view_is_materialized(x)) + materialized <- view_materialize(x) + expect_true(view_is_materialized(x)) + expect_false(is_altrep(materialized)) - base <- c(1, 2, 3, 4) + 1i + base <- list("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) - expect_identical(x, base[0L]) - expect_identical(length(x), 0L) + expect_false(view_is_materialized(x)) + materialized <- view_materialize(x) + expect_true(view_is_materialized(x)) + expect_false(is_altrep(materialized)) }) test_that("can make zero length view", { @@ -174,4 +214,14 @@ test_that("can make zero length view", { x <- vec_view(base, start = 2L, size = 0L) expect_identical(x, base[0L]) expect_identical(length(x), 0L) + + base <- c("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 0L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) + + base <- list("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 0L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) }) From ad22706efd7aa22b20c3fb2e447b6ab990c5e4e1 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Mon, 1 Jul 2024 15:46:48 -0400 Subject: [PATCH 3/5] Add raw support --- src/rlang/rlang-types.h | 1 + src/rlang/vec.h | 12 ++++++-- src/rlang/view.c | 61 ++++++++++++++++++++++++++++++++++++++ tests/testthat/test-view.R | 36 ++++++++++++++++++++++ 4 files changed, 108 insertions(+), 2 deletions(-) diff --git a/src/rlang/rlang-types.h b/src/rlang/rlang-types.h index 0dd2e82ffc..cdd44ba3c5 100644 --- a/src/rlang/rlang-types.h +++ b/src/rlang/rlang-types.h @@ -22,6 +22,7 @@ typedef struct SEXPREC r_obj; typedef Rcomplex r_complex; +typedef Rbyte r_byte; typedef R_xlen_t r_ssize; #define R_SSIZE_MAX R_XLEN_T_MAX diff --git a/src/rlang/vec.h b/src/rlang/vec.h index 78f104028b..b512c8a88f 100644 --- a/src/rlang/vec.h +++ b/src/rlang/vec.h @@ -21,9 +21,13 @@ r_complex* r_cpl_begin(r_obj* x) { return COMPLEX(x); } static inline -void* r_raw_begin(r_obj* x) { +r_byte* r_raw_begin0(r_obj* x) { return RAW(x); } +static inline +void* r_raw_begin(r_obj* x) { + return r_raw_begin0(x); +} static inline const int* r_int_cbegin(r_obj* x) { @@ -42,8 +46,12 @@ const r_complex* r_cpl_cbegin(r_obj* x) { return (const r_complex*) COMPLEX(x); } static inline +const r_byte* r_raw_cbegin0(r_obj* x) { + return (const r_byte*) RAW(x); +} +static inline const void* r_raw_cbegin(r_obj* x) { - return (const void*) RAW(x); + return (const void*) r_raw_cbegin0(x); } static inline r_obj* const * r_chr_cbegin(r_obj* x) { diff --git a/src/rlang/view.c b/src/rlang/view.c index e31055c1ac..9351d8e024 100644 --- a/src/rlang/view.c +++ b/src/rlang/view.c @@ -26,6 +26,7 @@ R_altrep_class_t r_lgl_view_class; R_altrep_class_t r_int_view_class; R_altrep_class_t r_dbl_view_class; R_altrep_class_t r_cpl_view_class; +R_altrep_class_t r_raw_view_class; R_altrep_class_t r_chr_view_class; R_altrep_class_t r_list_view_class; @@ -60,6 +61,9 @@ static inline r_obj* r_dbl_view(r_obj* x, r_ssize start, r_ssize size) { static inline r_obj* r_cpl_view(r_obj* x, r_ssize start, r_ssize size) { return r_view(r_cpl_view_class, x, start, size); } +static inline r_obj* r_raw_view(r_obj* x, r_ssize start, r_ssize size) { + return r_view(r_raw_view_class, x, start, size); +} static inline r_obj* r_chr_view(r_obj* x, r_ssize start, r_ssize size) { return r_view(r_chr_view_class, x, start, size); } @@ -79,6 +83,8 @@ r_obj* r_vec_view(r_obj* x, r_ssize start, r_ssize size) { return r_dbl_view(x, start, size); case R_TYPE_complex: return r_cpl_view(x, start, size); + case R_TYPE_raw: + return r_raw_view(x, start, size); case R_TYPE_character: return r_chr_view(x, start, size); case R_TYPE_list: @@ -102,6 +108,9 @@ static inline bool r_is_dbl_view(r_obj* x) { static inline bool r_is_cpl_view(r_obj* x) { return R_altrep_inherits(x, r_cpl_view_class); } +static inline bool r_is_raw_view(r_obj* x) { + return R_altrep_inherits(x, r_raw_view_class); +} static inline bool r_is_chr_view(r_obj* x) { return R_altrep_inherits(x, r_chr_view_class); } @@ -119,6 +128,8 @@ bool r_is_view(r_obj* x) { return r_is_dbl_view(x); case R_TYPE_complex: return r_is_cpl_view(x); + case R_TYPE_raw: + return r_is_raw_view(x); case R_TYPE_character: return r_is_chr_view(x); case R_TYPE_list: @@ -213,6 +224,9 @@ static r_obj* r_cpl_view_materialize(r_obj* x) { r_alloc_complex, r_complex, r_cpl_begin, COMPLEX_GET_REGION ); } +static r_obj* r_raw_view_materialize(r_obj* x) { + R_VIEW_MATERIALIZE(r_alloc_raw, r_byte, r_raw_begin0, RAW_GET_REGION); +} static r_obj* r_chr_view_materialize(r_obj* x) { R_VIEW_MATERIALIZE_BARRIER( r_alloc_character, r_obj*, r_chr_cbegin, r_chr_poke @@ -232,6 +246,8 @@ r_obj* r_view_materialize(r_obj* x) { return r_dbl_view_materialize(x); case R_TYPE_complex: return r_cpl_view_materialize(x); + case R_TYPE_raw: + return r_raw_view_materialize(x); case R_TYPE_character: return r_chr_view_materialize(x); case R_TYPE_list: @@ -270,6 +286,9 @@ static inline double* r_dbl_view_dataptr_writable(r_obj* x) { static inline r_complex* r_cpl_view_dataptr_writable(r_obj* x) { R_VIEW_DATAPTR_WRITABLE(r_cpl_view_materialize, r_cpl_begin); } +static inline r_byte* r_raw_view_dataptr_writable(r_obj* x) { + R_VIEW_DATAPTR_WRITABLE(r_raw_view_materialize, r_raw_begin0); +} static inline void* r_chr_view_dataptr_writable(r_obj* x) { // R's internal usage of `STRING_PTR()` forces us to implement this, // but we should never call this function ourselves. `STRING_PTR()` is also @@ -307,6 +326,9 @@ static inline double const* r_dbl_view_dataptr_readonly(r_obj* x) { static inline r_complex const* r_cpl_view_dataptr_readonly(r_obj* x) { R_VIEW_DATAPTR_READONLY(r_cpl_cbegin); } +static inline r_byte const* r_raw_view_dataptr_readonly(r_obj* x) { + R_VIEW_DATAPTR_READONLY(r_raw_cbegin0); +} static inline r_obj* const* r_chr_view_dataptr_readonly(r_obj* x) { R_VIEW_DATAPTR_READONLY(r_chr_cbegin); } @@ -343,6 +365,9 @@ static void* r_dbl_view_dataptr(r_obj* x, Rboolean writable) { static void* r_cpl_view_dataptr(r_obj* x, Rboolean writable) { R_VIEW_DATAPTR(r_cpl_view_dataptr_writable, r_cpl_view_dataptr_readonly); } +static void* r_raw_view_dataptr(r_obj* x, Rboolean writable) { + R_VIEW_DATAPTR(r_raw_view_dataptr_writable, r_raw_view_dataptr_readonly); +} static void* r_chr_view_dataptr(r_obj* x, Rboolean writable) { R_VIEW_DATAPTR(r_chr_view_dataptr_writable, r_chr_view_dataptr_readonly); } @@ -363,6 +388,9 @@ static const void* r_dbl_view_dataptr_or_null(r_obj* x) { static const void* r_cpl_view_dataptr_or_null(r_obj* x) { return (const void*) r_cpl_view_dataptr_readonly(x); } +static const void* r_raw_view_dataptr_or_null(r_obj* x) { + return (const void*) r_raw_view_dataptr_readonly(x); +} static const void* r_chr_view_dataptr_or_null(r_obj* x) { return (const void*) r_chr_view_dataptr_readonly(x); } @@ -446,6 +474,15 @@ static Rboolean r_cpl_view_inspect( "altrep_complex_view", x, pre, deep, pvec, inspect_subtree ); } +static Rboolean r_raw_view_inspect( + r_obj* x, + int pre, + int deep, + int pvec, + void (*inspect_subtree)(r_obj*, int, int, int) +) { + return r_view_inspect("altrep_raw_view", x, pre, deep, pvec, inspect_subtree); +} static Rboolean r_chr_view_inspect( r_obj* x, int pre, @@ -506,6 +543,9 @@ static double r_dbl_view_elt(r_obj* x, r_ssize i) { static r_complex r_cpl_view_elt(r_obj* x, r_ssize i) { R_VIEW_ELT(COMPLEX_ELT); } +static r_byte r_raw_view_elt(r_obj* x, r_ssize i) { + R_VIEW_ELT(RAW_ELT); +} static r_obj* r_chr_view_elt(r_obj* x, r_ssize i) { R_VIEW_ELT(STRING_ELT); } @@ -632,6 +672,26 @@ static void r_init_library_cpl_view(DllInfo* dll, const char* package) { R_set_altcomplex_Elt_method(r_cpl_view_class, r_cpl_view_elt); } +static void r_init_library_raw_view(DllInfo* dll, const char* package) { + r_raw_view_class = R_make_altraw_class("raw_view", package, dll); + + // ALTVEC + R_set_altvec_Dataptr_method(r_raw_view_class, r_raw_view_dataptr); + R_set_altvec_Dataptr_or_null_method( + r_raw_view_class, r_raw_view_dataptr_or_null + ); + + // ALTREP + R_set_altrep_Length_method(r_raw_view_class, r_view_length); + R_set_altrep_Inspect_method(r_raw_view_class, r_raw_view_inspect); + R_set_altrep_Serialized_state_method( + r_raw_view_class, r_view_serialized_state + ); + + // ALTTYPE + R_set_altraw_Elt_method(r_raw_view_class, r_raw_view_elt); +} + static void r_init_library_chr_view(DllInfo* dll, const char* package) { r_chr_view_class = R_make_altstring_class("character_view", package, dll); @@ -679,6 +739,7 @@ void r_init_library_view(DllInfo* dll, const char* package) { r_init_library_int_view(dll, package); r_init_library_dbl_view(dll, package); r_init_library_cpl_view(dll, package); + r_init_library_raw_view(dll, package); r_init_library_chr_view(dll, package); r_init_library_list_view(dll, package); } diff --git a/tests/testthat/test-view.R b/tests/testthat/test-view.R index cd9449adef..cffa57564b 100644 --- a/tests/testthat/test-view.R +++ b/tests/testthat/test-view.R @@ -19,6 +19,11 @@ test_that("views can be created", { expect_false(view_is_materialized(x)) expect_identical(x, base[2:4]) + base <- as.raw(c(1, 2, 3, 4)) + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + expect_identical(x, base[2:4]) + base <- c("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_false(view_is_materialized(x)) @@ -47,6 +52,10 @@ test_that("views have right length", { x <- vec_view(base, start = 2L, size = 3L) expect_identical(length(x), 3L) + base <- as.raw(c(1, 2, 3, 4)) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(length(x), 3L) + base <- c("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_identical(length(x), 3L) @@ -89,6 +98,14 @@ test_that("views can be sliced with subset", { expect_identical(x[c(0L, 2L)], base[c(0L, 3L)]) expect_false(view_is_materialized(x)) + base <- as.raw(c(1, 2, 3, 4)) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[1:2], base[2:3]) + expect_identical(x[2:4], base[3:5]) + expect_identical(x[0L], base[0L]) + expect_identical(x[c(0L, 2L)], base[c(0L, 3L)]) + expect_false(view_is_materialized(x)) + base <- c("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_identical(x[1:2], base[2:3]) @@ -135,6 +152,13 @@ test_that("views can be sliced with subset2", { expect_error(x[[4]]) expect_false(view_is_materialized(x)) + base <- as.raw(c(1, 2, 3, 4)) + x <- vec_view(base, start = 2L, size = 3L) + expect_identical(x[[1]], base[[2L]]) + expect_identical(x[[3]], base[[4L]]) + expect_error(x[[4]]) + expect_false(view_is_materialized(x)) + base <- c("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_identical(x[[1]], base[[2L]]) @@ -179,6 +203,13 @@ test_that("views can be manually materialized", { expect_true(view_is_materialized(x)) expect_false(is_altrep(materialized)) + base <- as.raw(c(1, 2, 3, 4)) + x <- vec_view(base, start = 2L, size = 3L) + expect_false(view_is_materialized(x)) + materialized <- view_materialize(x) + expect_true(view_is_materialized(x)) + expect_false(is_altrep(materialized)) + base <- c("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_false(view_is_materialized(x)) @@ -215,6 +246,11 @@ test_that("can make zero length view", { expect_identical(x, base[0L]) expect_identical(length(x), 0L) + base <- as.raw(c(1, 2, 3, 4)) + x <- vec_view(base, start = 2L, size = 0L) + expect_identical(x, base[0L]) + expect_identical(length(x), 0L) + base <- c("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 0L) expect_identical(x, base[0L]) From acdf0ab94b50d49c64b5a5e6f664a7d10d055cbe Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Thu, 4 Jul 2024 13:28:08 -0400 Subject: [PATCH 4/5] Cache pointers for performance optimizations This typically makes most accesses 30-40% faster than the previous approach, due to less indirection. This puts us at just 2x slower than non-ALTREP accesses, rather than previously where we were 3-4x slower. Seems pretty good. --- R/view.R | 4 + src/internal/exported.c | 5 + src/internal/init.c | 1 + src/rlang/view.c | 359 ++++++++++++++++++++-------------- src/rlang/view.h | 8 +- tests/testthat/_snaps/view.md | 49 +++++ tests/testthat/test-view.R | 194 ++++++++++++++++++ 7 files changed, 472 insertions(+), 148 deletions(-) create mode 100644 tests/testthat/_snaps/view.md diff --git a/R/view.R b/R/view.R index 8e0e46ea32..df4bb84098 100644 --- a/R/view.R +++ b/R/view.R @@ -4,6 +4,10 @@ vec_view <- function(x, start, size) { .Call(ffi_vec_view, x, start, size) } +view_inspect <- function(x) { + invisible(.Call(ffi_view_inspect, x)) +} + view_is_materialized <- function(x) { .Call(ffi_view_is_materialized, x) } diff --git a/src/internal/exported.c b/src/internal/exported.c index 5bcf950841..5535f343e3 100644 --- a/src/internal/exported.c +++ b/src/internal/exported.c @@ -1071,6 +1071,11 @@ r_obj* ffi_vec_view(r_obj* x, r_obj* ffi_start, r_obj* ffi_size) { return r_vec_view(x, start, size); } +r_obj* ffi_view_inspect(r_obj* x) { + r_check_view(x); + return r_lgl(r_view_inspect(x)); +} + r_obj* ffi_view_is_materialized(r_obj* x) { r_check_view(x); return r_lgl(r_view_is_materialized(x)); diff --git a/src/internal/init.c b/src/internal/init.c index ac73c965e9..e7c11ed591 100644 --- a/src/internal/init.c +++ b/src/internal/init.c @@ -240,6 +240,7 @@ static const R_CallMethodDef r_callables[] = { {"ffi_vec_poke_range", (DL_FUNC) &ffi_vec_poke_range, 5}, {"ffi_vec_resize", (DL_FUNC) &ffi_vec_resize, 2}, {"ffi_vec_view", (DL_FUNC) &ffi_vec_view, 3}, + {"ffi_view_inspect", (DL_FUNC) &ffi_view_inspect, 1}, {"ffi_view_is_materialized", (DL_FUNC) &ffi_view_is_materialized, 1}, {"ffi_view_materialize", (DL_FUNC) &ffi_view_materialize, 1}, {"ffi_which_operator", (DL_FUNC) &ffi_which_operator, 1}, diff --git a/src/rlang/view.c b/src/rlang/view.c index 9351d8e024..b2fe6070f0 100644 --- a/src/rlang/view.c +++ b/src/rlang/view.c @@ -4,21 +4,32 @@ /* Structure of a `view`: - -Before materialization: -- `data1` is the original vector +- `data1` is: + - the original vector, before materialization + - the materialized vector, after materialization - `data2` is a RAWSXP holding a `r_view_metadata` - -After materialization: -- `data1` is `R_NilValue` -- `data2` is the materialized view - -So `data1 == R_NilValue` is how we determine if we have materialized or not */ struct r_view_metadata { + // Whether or not the ALTREP view has been materialized. + bool materialized; + + // The offset into the original data to start at. r_ssize start; + + // The size of the view. r_ssize size; + + // A read only pointer into the data, to save indirection costs. We typically + // set this upon view creation, unless `x` is ALTREP, in which case we delay + // setting it until the first `DATAPTR_RO()` request, to be friendly to + // ALTREP types that we wrap. After materialization, it is always set. + const void* v_data_read; + + // A write only pointer into the data, to save indirection costs. + // Always `NULL` before materialization, and it set at materialization time. + // Never set for lists or character vectors, as write pointers are unsafe. + void* v_data_write; }; // Initialised at load time @@ -32,43 +43,44 @@ R_altrep_class_t r_list_view_class; // ----------------------------------------------------------------------------- -static inline r_obj* -r_view(R_altrep_class_t cls, r_obj* x, r_ssize start, r_ssize size) { - if (r_attrib(x) != r_null) { - r_stop_internal("`x` can't have any attributes."); - } - - // We don't want it to have any chance of changing out from under us - r_mark_shared(x); - - r_obj* metadata = r_alloc_raw(sizeof(struct r_view_metadata)); - struct r_view_metadata* p_metadata = r_raw_begin(metadata); - p_metadata->start = start; - p_metadata->size = size; - - return R_new_altrep(cls, x, metadata); -} +#define R_VIEW(CLS, CBEGIN) \ + if (r_attrib(x) != r_null) { \ + r_stop_internal("`x` can't have any attributes."); \ + } \ + \ + /* We don't want it to have any chance of changing out from under us */ \ + r_mark_shared(x); \ + \ + r_obj* metadata = r_alloc_raw(sizeof(struct r_view_metadata)); \ + struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ + p_metadata->materialized = false; \ + p_metadata->start = start; \ + p_metadata->size = size; \ + p_metadata->v_data_read = r_is_altrep(x) ? NULL : CBEGIN(x) + start; \ + p_metadata->v_data_write = NULL; \ + \ + return R_new_altrep(CLS, x, metadata) static inline r_obj* r_lgl_view(r_obj* x, r_ssize start, r_ssize size) { - return r_view(r_lgl_view_class, x, start, size); + R_VIEW(r_lgl_view_class, r_lgl_cbegin); } static inline r_obj* r_int_view(r_obj* x, r_ssize start, r_ssize size) { - return r_view(r_int_view_class, x, start, size); + R_VIEW(r_int_view_class, r_int_cbegin); } static inline r_obj* r_dbl_view(r_obj* x, r_ssize start, r_ssize size) { - return r_view(r_dbl_view_class, x, start, size); + R_VIEW(r_dbl_view_class, r_dbl_cbegin); } static inline r_obj* r_cpl_view(r_obj* x, r_ssize start, r_ssize size) { - return r_view(r_cpl_view_class, x, start, size); + R_VIEW(r_cpl_view_class, r_cpl_cbegin); } static inline r_obj* r_raw_view(r_obj* x, r_ssize start, r_ssize size) { - return r_view(r_raw_view_class, x, start, size); + R_VIEW(r_raw_view_class, r_raw_cbegin); } static inline r_obj* r_chr_view(r_obj* x, r_ssize start, r_ssize size) { - return r_view(r_chr_view_class, x, start, size); + R_VIEW(r_chr_view_class, r_chr_cbegin); } static inline r_obj* r_list_view(r_obj* x, r_ssize start, r_ssize size) { - return r_view(r_list_view_class, x, start, size); + R_VIEW(r_list_view_class, r_list_cbegin); } // Up to the caller to verify that `start` and `size` are sized correctly. @@ -148,47 +160,52 @@ void r_check_view(r_obj* x) { // ----------------------------------------------------------------------------- -#define R_VIEW_MATERIALIZE(ALLOC, CTYPE, BEGIN, GET_REGION) \ - r_obj* data = r_altrep_data1(x); \ +#define R_VIEW_MATERIALIZE(ALLOC, CTYPE, CBEGIN, BEGIN, GET_REGION) \ + r_obj* metadata = r_altrep_data2(x); \ + struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ \ - if (data == r_null) { \ + if (p_metadata->materialized) { \ r_stop_internal( \ - "`x` has already been materialized, return `data2` directly rather " \ + "`x` has already been materialized, return `data1` directly rather " \ "than calling this." \ ); \ } \ \ - r_obj* metadata = r_altrep_data2(x); \ - struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ + r_obj* data = r_altrep_data1(x); \ \ const r_ssize start = p_metadata->start; \ const r_ssize size = p_metadata->size; \ \ r_obj* out = KEEP(ALLOC(size)); \ - CTYPE* v_out = BEGIN(out); \ \ - /* Be friendly to ALTREP `data` too */ \ - GET_REGION(data, start, size, v_out); \ + /* Go ahead and take dataptrs, we know this isn't ALTREP */ \ + CTYPE const* v_out_read = CBEGIN(out); \ + CTYPE* v_out_write = BEGIN(out); \ + \ + /* Materialize, but be friendly to ALTREP `data` too */ \ + GET_REGION(data, start, size, v_out_write); \ \ /* Declare ourselves as materialized */ \ - R_set_altrep_data1(x, r_null); \ - R_set_altrep_data2(x, out); \ + p_metadata->materialized = true; \ + p_metadata->v_data_read = v_out_read; \ + p_metadata->v_data_write = v_out_write; \ + R_set_altrep_data1(x, out); \ \ FREE(1); \ return out #define R_VIEW_MATERIALIZE_BARRIER(ALLOC, CTYPE, CBEGIN, POKE) \ - r_obj* data = r_altrep_data1(x); \ + r_obj* metadata = r_altrep_data2(x); \ + struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ \ - if (data == r_null) { \ + if (p_metadata->materialized) { \ r_stop_internal( \ - "`x` has already been materialized, return `data2` directly rather " \ + "`x` has already been materialized, return `data1` directly rather " \ "than calling this." \ ); \ } \ \ - r_obj* metadata = r_altrep_data2(x); \ - struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ + r_obj* data = r_altrep_data1(x); \ \ const r_ssize start = p_metadata->start; \ const r_ssize size = p_metadata->size; \ @@ -198,34 +215,47 @@ void r_check_view(r_obj* x) { \ r_obj* out = KEEP(ALLOC(size)); \ \ + /* Go ahead and take readonly dataptr, we know this isn't ALTREP. */ \ + /* Never take writable dataptr for character vectors and lists. */ \ + CTYPE const* v_out_read = CBEGIN(out); \ + \ for (r_ssize i = 0; i < size; ++i) { \ r_obj* elt = v_data[i]; \ POKE(out, i, elt); \ } \ \ /* Declare ourselves as materialized */ \ - R_set_altrep_data1(x, r_null); \ - R_set_altrep_data2(x, out); \ + p_metadata->materialized = true; \ + p_metadata->v_data_read = v_out_read; \ + R_set_altrep_data1(x, out); \ \ FREE(1); \ return out static r_obj* r_lgl_view_materialize(r_obj* x) { - R_VIEW_MATERIALIZE(r_alloc_logical, int, r_lgl_begin, LOGICAL_GET_REGION); + R_VIEW_MATERIALIZE( + r_alloc_logical, int, r_lgl_cbegin, r_lgl_begin, LOGICAL_GET_REGION + ); } static r_obj* r_int_view_materialize(r_obj* x) { - R_VIEW_MATERIALIZE(r_alloc_integer, int, r_int_begin, INTEGER_GET_REGION); + R_VIEW_MATERIALIZE( + r_alloc_integer, int, r_int_cbegin, r_int_begin, INTEGER_GET_REGION + ); } static r_obj* r_dbl_view_materialize(r_obj* x) { - R_VIEW_MATERIALIZE(r_alloc_double, double, r_dbl_begin, REAL_GET_REGION); + R_VIEW_MATERIALIZE( + r_alloc_double, double, r_dbl_cbegin, r_dbl_begin, REAL_GET_REGION + ); } static r_obj* r_cpl_view_materialize(r_obj* x) { R_VIEW_MATERIALIZE( - r_alloc_complex, r_complex, r_cpl_begin, COMPLEX_GET_REGION + r_alloc_complex, r_complex, r_cpl_cbegin, r_cpl_begin, COMPLEX_GET_REGION ); } static r_obj* r_raw_view_materialize(r_obj* x) { - R_VIEW_MATERIALIZE(r_alloc_raw, r_byte, r_raw_begin0, RAW_GET_REGION); + R_VIEW_MATERIALIZE( + r_alloc_raw, r_byte, r_raw_cbegin0, r_raw_begin0, RAW_GET_REGION + ); } static r_obj* r_chr_view_materialize(r_obj* x) { R_VIEW_MATERIALIZE_BARRIER( @@ -257,43 +287,56 @@ r_obj* r_view_materialize(r_obj* x) { } } +bool r_view_is_materialized(r_obj* x) { + r_obj* metadata = r_altrep_data2(x); + struct r_view_metadata* p_metadata = r_raw_begin(metadata); + return p_metadata->materialized; +} + // ----------------------------------------------------------------------------- -#define R_VIEW_DATAPTR_WRITABLE(MATERIALIZE, BEGIN) \ - r_obj* out = NULL; \ - r_obj* data = r_altrep_data1(x); \ - \ - if (data != r_null) { \ - /* We can't give out a writable pointer to `data`. */ \ - /* Materialize and give a writable pointer to that instead. */ \ - out = MATERIALIZE(x); \ - } else { \ - /* Already materialized */ \ - out = r_altrep_data2(x); \ - } \ - \ - return BEGIN(out); +#define R_VIEW_DATAPTR_WRITABLE(MATERIALIZE, CTYPE) \ + r_obj* metadata = r_altrep_data2(x); \ + struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ + \ + if (!p_metadata->materialized) { \ + /* This sets `p_metadata->v_data_write` */ \ + MATERIALIZE(x); \ + } \ + \ + return (CTYPE*) p_metadata->v_data_write static inline int* r_lgl_view_dataptr_writable(r_obj* x) { - R_VIEW_DATAPTR_WRITABLE(r_lgl_view_materialize, r_lgl_begin); + R_VIEW_DATAPTR_WRITABLE(r_lgl_view_materialize, int); } static inline int* r_int_view_dataptr_writable(r_obj* x) { - R_VIEW_DATAPTR_WRITABLE(r_int_view_materialize, r_int_begin); + R_VIEW_DATAPTR_WRITABLE(r_int_view_materialize, int); } static inline double* r_dbl_view_dataptr_writable(r_obj* x) { - R_VIEW_DATAPTR_WRITABLE(r_dbl_view_materialize, r_dbl_begin); + R_VIEW_DATAPTR_WRITABLE(r_dbl_view_materialize, double); } static inline r_complex* r_cpl_view_dataptr_writable(r_obj* x) { - R_VIEW_DATAPTR_WRITABLE(r_cpl_view_materialize, r_cpl_begin); + R_VIEW_DATAPTR_WRITABLE(r_cpl_view_materialize, r_complex); } static inline r_byte* r_raw_view_dataptr_writable(r_obj* x) { - R_VIEW_DATAPTR_WRITABLE(r_raw_view_materialize, r_raw_begin0); + R_VIEW_DATAPTR_WRITABLE(r_raw_view_materialize, r_byte); } static inline void* r_chr_view_dataptr_writable(r_obj* x) { // R's internal usage of `STRING_PTR()` forces us to implement this, // but we should never call this function ourselves. `STRING_PTR()` is also // non-API, so we have to use `DATAPTR()` to get the writable pointer. - R_VIEW_DATAPTR_WRITABLE(r_chr_view_materialize, DATAPTR); + r_obj* metadata = r_altrep_data2(x); + struct r_view_metadata* p_metadata = r_raw_begin(metadata); + + if (!p_metadata->materialized) { + /* This does not set `p_metadata->v_data_write` because that isn't safe, */ + /* but it does set `data1` to the materialized data */ + r_chr_view_materialize(x); + } + + r_obj* data = r_altrep_data1(x); + + return DATAPTR(data); } // static inline void r_list_view_dataptr_writable(r_obj* x) { // // R does not use `VECTOR_PTR()` internally, and it even errors in @@ -301,39 +344,45 @@ static inline void* r_chr_view_dataptr_writable(r_obj* x) { // // ALTREP list, so we don't need this. // } -#define R_VIEW_DATAPTR_READONLY(CBEGIN) \ - r_obj* data = r_altrep_data1(x); \ - \ - if (data != r_null) { \ - /* Provide a readonly view into the data at the right offset */ \ - r_obj* metadata = r_altrep_data2(x); \ - const struct r_view_metadata* p_metadata = r_raw_cbegin(metadata); \ - return CBEGIN(data) + p_metadata->start; \ - } else { \ - /* Provide a readonly view into the materialized data */ \ - return CBEGIN(r_altrep_data2(x)); \ - } +#define R_VIEW_DATAPTR_READONLY(CTYPE, CBEGIN) \ + r_obj* metadata = r_altrep_data2(x); \ + struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ + \ + if (p_metadata->v_data_read != NULL) { \ + /* This is the typical case. Only unset if the original object */ \ + /* was ALTREP and we haven't requested `DATAPTR_RO()` before. */ \ + return (CTYPE const*) p_metadata->v_data_read; \ + } \ + \ + /* Provide a readonly view into the data at the right offset */ \ + r_obj* data = r_altrep_data1(x); \ + CTYPE const* v_data_read = CBEGIN(data) + p_metadata->start; \ + \ + /* Set it in the metadata to save some future indirection cost */ \ + p_metadata->v_data_read = v_data_read; \ + \ + return v_data_read static inline int const* r_lgl_view_dataptr_readonly(r_obj* x) { - R_VIEW_DATAPTR_READONLY(r_lgl_cbegin); + R_VIEW_DATAPTR_READONLY(int, r_lgl_cbegin); } static inline int const* r_int_view_dataptr_readonly(r_obj* x) { - R_VIEW_DATAPTR_READONLY(r_int_cbegin); + R_VIEW_DATAPTR_READONLY(int, r_int_cbegin); } static inline double const* r_dbl_view_dataptr_readonly(r_obj* x) { - R_VIEW_DATAPTR_READONLY(r_dbl_cbegin); + R_VIEW_DATAPTR_READONLY(double, r_dbl_cbegin); } static inline r_complex const* r_cpl_view_dataptr_readonly(r_obj* x) { - R_VIEW_DATAPTR_READONLY(r_cpl_cbegin); + R_VIEW_DATAPTR_READONLY(r_complex, r_cpl_cbegin); } static inline r_byte const* r_raw_view_dataptr_readonly(r_obj* x) { - R_VIEW_DATAPTR_READONLY(r_raw_cbegin0); + R_VIEW_DATAPTR_READONLY(r_byte, r_raw_cbegin0); } static inline r_obj* const* r_chr_view_dataptr_readonly(r_obj* x) { - R_VIEW_DATAPTR_READONLY(r_chr_cbegin); + R_VIEW_DATAPTR_READONLY(r_obj*, r_chr_cbegin); } static inline r_obj* const* r_list_view_dataptr_readonly(r_obj* x) { - R_VIEW_DATAPTR_READONLY(r_list_cbegin); + R_VIEW_DATAPTR_READONLY(r_obj*, r_list_cbegin); } #define R_VIEW_DATAPTR(WRITABLE, READONLY) \ @@ -401,22 +450,14 @@ static const void* r_list_view_dataptr_or_null(r_obj* x) { // ----------------------------------------------------------------------------- static r_ssize r_view_length(r_obj* x) { - r_obj* data = r_altrep_data1(x); - - if (data != r_null) { - // Pull from metadata - r_obj* metadata = r_altrep_data2(x); - const struct r_view_metadata* p_metadata = r_raw_cbegin(metadata); - return p_metadata->size; - } else { - // Pull from materialized object - return Rf_xlength(r_altrep_data2(x)); - } + r_obj* metadata = r_altrep_data2(x); + struct r_view_metadata* p_metadata = r_raw_begin(metadata); + return p_metadata->size; } // ----------------------------------------------------------------------------- -static inline Rboolean r_view_inspect( +static inline Rboolean r_view_inspect0( const char* name, r_obj* x, int pre, @@ -424,9 +465,9 @@ static inline Rboolean r_view_inspect( int pvec, void (*inspect_subtree)(r_obj*, int, int, int) ) { - Rprintf( - "%s (materialized=%s)\n", name, r_altrep_data1(x) == r_null ? "T" : "F" - ); + r_obj* metadata = r_altrep_data2(x); + struct r_view_metadata* p_metadata = r_raw_begin(metadata); + Rprintf("%s (materialized=%s)\n", name, p_metadata->materialized ? "T" : "F"); return TRUE; } @@ -437,7 +478,7 @@ static Rboolean r_lgl_view_inspect( int pvec, void (*inspect_subtree)(r_obj*, int, int, int) ) { - return r_view_inspect( + return r_view_inspect0( "altrep_logical_view", x, pre, deep, pvec, inspect_subtree ); } @@ -448,7 +489,7 @@ static Rboolean r_int_view_inspect( int pvec, void (*inspect_subtree)(r_obj*, int, int, int) ) { - return r_view_inspect( + return r_view_inspect0( "altrep_integer_view", x, pre, deep, pvec, inspect_subtree ); } @@ -459,7 +500,7 @@ static Rboolean r_dbl_view_inspect( int pvec, void (*inspect_subtree)(r_obj*, int, int, int) ) { - return r_view_inspect( + return r_view_inspect0( "altrep_double_view", x, pre, deep, pvec, inspect_subtree ); } @@ -470,7 +511,7 @@ static Rboolean r_cpl_view_inspect( int pvec, void (*inspect_subtree)(r_obj*, int, int, int) ) { - return r_view_inspect( + return r_view_inspect0( "altrep_complex_view", x, pre, deep, pvec, inspect_subtree ); } @@ -481,7 +522,9 @@ static Rboolean r_raw_view_inspect( int pvec, void (*inspect_subtree)(r_obj*, int, int, int) ) { - return r_view_inspect("altrep_raw_view", x, pre, deep, pvec, inspect_subtree); + return r_view_inspect0( + "altrep_raw_view", x, pre, deep, pvec, inspect_subtree + ); } static Rboolean r_chr_view_inspect( r_obj* x, @@ -490,7 +533,7 @@ static Rboolean r_chr_view_inspect( int pvec, void (*inspect_subtree)(r_obj*, int, int, int) ) { - return r_view_inspect( + return r_view_inspect0( "altrep_character_view", x, pre, deep, pvec, inspect_subtree ); } @@ -501,11 +544,32 @@ static Rboolean r_list_view_inspect( int pvec, void (*inspect_subtree)(r_obj*, int, int, int) ) { - return r_view_inspect( + return r_view_inspect0( "altrep_list_view", x, pre, deep, pvec, inspect_subtree ); } +Rboolean r_view_inspect(r_obj* x) { + switch (r_typeof(x)) { + case R_TYPE_logical: + return r_lgl_view_inspect(x, 0, 0, 0, NULL); + case R_TYPE_integer: + return r_int_view_inspect(x, 0, 0, 0, NULL); + case R_TYPE_double: + return r_dbl_view_inspect(x, 0, 0, 0, NULL); + case R_TYPE_complex: + return r_cpl_view_inspect(x, 0, 0, 0, NULL); + case R_TYPE_raw: + return r_raw_view_inspect(x, 0, 0, 0, NULL); + case R_TYPE_character: + return r_chr_view_inspect(x, 0, 0, 0, NULL); + case R_TYPE_list: + return r_list_view_inspect(x, 0, 0, 0, NULL); + default: + r_stop_internal("Type not implemented."); + } +} + // ----------------------------------------------------------------------------- static r_obj* r_view_serialized_state(r_obj* x) { @@ -518,58 +582,67 @@ static r_obj* r_view_serialized_state(r_obj* x) { // ----------------------------------------------------------------------------- -#define R_VIEW_ELT(ELT) \ - r_obj* data = r_altrep_data1(x); \ - \ - if (data != r_null) { \ - /* Element comes from original data */ \ - r_obj* metadata = r_altrep_data2(x); \ - const struct r_view_metadata* p_metadata = r_raw_cbegin(metadata); \ - return ELT(data, p_metadata->start + i); \ - } else { \ - /* Element comes from materialized data */ \ - return ELT(r_altrep_data2(x), i); \ - } +// Particularly useful to have `v_data_read` here, because the default +// method for `Extract_subset` uses `*_ELT()` repeatedly to get each element, +// so we want as little indirection as possible here. +#define R_VIEW_ELT(CTYPE, ELT) \ + r_obj* metadata = r_altrep_data2(x); \ + struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ + \ + if (p_metadata->v_data_read != NULL) { \ + /* This is the typical case. Only unset if the original object */ \ + /* was ALTREP and we haven't requested `DATAPTR_RO()` before or */ \ + /* materialized the view. */ \ + CTYPE const* v_data_read = (CTYPE const*) p_metadata->v_data_read; \ + return v_data_read[i]; \ + } \ + \ + /* Element comes from original data that was also ALTREP. */ \ + /* If we had materialized already, `v_data_read` would have been set. */ \ + r_obj* data = r_altrep_data1(x); \ + \ + return ELT(data, p_metadata->start + i) static int r_lgl_view_elt(r_obj* x, r_ssize i) { - R_VIEW_ELT(LOGICAL_ELT); + R_VIEW_ELT(int, LOGICAL_ELT); } static int r_int_view_elt(r_obj* x, r_ssize i) { - R_VIEW_ELT(INTEGER_ELT); + R_VIEW_ELT(int, INTEGER_ELT); } static double r_dbl_view_elt(r_obj* x, r_ssize i) { - R_VIEW_ELT(REAL_ELT); + R_VIEW_ELT(double, REAL_ELT); } static r_complex r_cpl_view_elt(r_obj* x, r_ssize i) { - R_VIEW_ELT(COMPLEX_ELT); + R_VIEW_ELT(r_complex, COMPLEX_ELT); } static r_byte r_raw_view_elt(r_obj* x, r_ssize i) { - R_VIEW_ELT(RAW_ELT); + R_VIEW_ELT(r_byte, RAW_ELT); } static r_obj* r_chr_view_elt(r_obj* x, r_ssize i) { - R_VIEW_ELT(STRING_ELT); + R_VIEW_ELT(r_obj*, STRING_ELT); } static r_obj* r_list_view_elt(r_obj* x, r_ssize i) { - R_VIEW_ELT(VECTOR_ELT); + R_VIEW_ELT(r_obj*, VECTOR_ELT); } // ----------------------------------------------------------------------------- #define R_VIEW_SET_ELT(MATERIALIZE, POKE) \ - r_obj* data = r_altrep_data1(x); \ + r_obj* metadata = r_altrep_data2(x); \ + struct r_view_metadata* p_metadata = r_raw_begin(metadata); \ \ - if (data != r_null) { \ + if (p_metadata->materialized) { \ + /* Already materialized */ \ + r_obj* data = r_altrep_data1(x); \ + POKE(data, i, elt); \ + } else { \ /* Materialize so we can set the element. */ \ /* Only protect `elt` when we materialize, for performance. */ \ /* (although gc is disabled here anyways by `ALT_SET_ELT()`). */ \ KEEP(elt); \ - data = MATERIALIZE(x); \ + r_obj* data = MATERIALIZE(x); \ POKE(data, i, elt); \ FREE(1); \ - } else { \ - /* Already materialized */ \ - data = r_altrep_data2(x); \ - POKE(data, i, elt); \ } static void r_chr_view_set_elt(r_obj* x, r_ssize i, r_obj* elt) { @@ -585,7 +658,7 @@ static void r_list_view_set_elt(r_obj* x, r_ssize i, r_obj* elt) { // // R_set_altvec_Extract_subset_method // This falls back to a default implementation that uses the `Elt` method, -// which we think is good enough (though it is slower) +// which we think is good enough due to how we cache the readonly pointer. // // R_set_alttype_Get_region_method // This first tries Dataptr_or_null, which we have a very efficient method diff --git a/src/rlang/view.h b/src/rlang/view.h index 40a3606898..210438ef01 100644 --- a/src/rlang/view.h +++ b/src/rlang/view.h @@ -3,12 +3,10 @@ r_obj* r_vec_view(r_obj* x, r_ssize start, r_ssize size); -static inline -bool r_view_is_materialized(r_obj* x) { - return r_altrep_data1(x) == r_null; -} - r_obj* r_view_materialize(r_obj* x); +bool r_view_is_materialized(r_obj* x); + +Rboolean r_view_inspect(r_obj* x); bool r_is_view(r_obj* x); void r_check_view(r_obj* x); diff --git a/tests/testthat/_snaps/view.md b/tests/testthat/_snaps/view.md new file mode 100644 index 0000000000..4172e92775 --- /dev/null +++ b/tests/testthat/_snaps/view.md @@ -0,0 +1,49 @@ +# views can be inspected + + Code + view_inspect(x) + Output + altrep_logical_view (materialized=F) + +--- + + Code + view_inspect(x) + Output + altrep_integer_view (materialized=F) + +--- + + Code + view_inspect(x) + Output + altrep_double_view (materialized=F) + +--- + + Code + view_inspect(x) + Output + altrep_complex_view (materialized=F) + +--- + + Code + view_inspect(x) + Output + altrep_raw_view (materialized=F) + +--- + + Code + view_inspect(x) + Output + altrep_character_view (materialized=F) + +--- + + Code + view_inspect(x) + Output + altrep_list_view (materialized=F) + diff --git a/tests/testthat/test-view.R b/tests/testthat/test-view.R index cffa57564b..d15c196087 100644 --- a/tests/testthat/test-view.R +++ b/tests/testthat/test-view.R @@ -174,6 +174,115 @@ test_that("views can be sliced with subset2", { expect_false(view_is_materialized(x)) }) +test_that("views can be assigned to", { + assign <- c(NA, TRUE) + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 2L, size = 3L) + x[2:3] <- assign + expect_identical(x[2:3], assign) + expect_identical(base, c(TRUE, FALSE, TRUE, FALSE)) + + assign <- c(NA, 5L) + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 2L, size = 3L) + x[2:3] <- assign + expect_identical(x[2:3], assign) + expect_identical(base, c(1L, 2L, 3L, 4L)) + + assign <- c(NA, 5) + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 2L, size = 3L) + x[2:3] <- assign + expect_identical(x[2:3], assign) + expect_identical(base, c(1, 2, 3, 4)) + + assign <- c(NA, 5) + 2i + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 2L, size = 3L) + x[2:3] <- assign + expect_identical(x[2:3], assign) + expect_identical(base, c(1, 2, 3, 4) + 1i) + + assign <- as.raw(c(0, 5)) + base <- as.raw(c(1, 2, 3, 4)) + x <- vec_view(base, start = 2L, size = 3L) + x[2:3] <- assign + expect_identical(x[2:3], assign) + expect_identical(base, as.raw(c(1, 2, 3, 4))) + + assign <- c(NA, "e") + base <- c("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + x[2:3] <- assign + expect_identical(x[2:3], assign) + expect_identical(base, c("a", "b", "c", "d")) + + assign <- list(NA, "e") + base <- list("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + x[2:3] <- assign + expect_identical(x[2:3], assign) + expect_identical(base, list("a", "b", "c", "d")) +}) + +test_that("views can wrap other views", { + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 1L, size = 3L) + y <- vec_view(x, start = 2L, size = 2L) + expect_identical(y[[2L]], base[[3L]]) + expect_identical(y[1:2], base[2:3]) + expect_identical(y, x[2:3]) + expect_false(view_is_materialized(x)) + + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 1L, size = 3L) + y <- vec_view(x, start = 2L, size = 2L) + expect_identical(y[[2L]], base[[3L]]) + expect_identical(y[1:2], base[2:3]) + expect_identical(y, x[2:3]) + expect_false(view_is_materialized(x)) + + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 1L, size = 3L) + y <- vec_view(x, start = 2L, size = 2L) + expect_identical(y[[2L]], base[[3L]]) + expect_identical(y[1:2], base[2:3]) + expect_identical(y, x[2:3]) + expect_false(view_is_materialized(x)) + + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 1L, size = 3L) + y <- vec_view(x, start = 2L, size = 2L) + expect_identical(y[[2L]], base[[3L]]) + expect_identical(y[1:2], base[2:3]) + expect_identical(y, x[2:3]) + expect_false(view_is_materialized(x)) + + base <- as.raw(c(1, 2, 3, 4)) + x <- vec_view(base, start = 1L, size = 3L) + y <- vec_view(x, start = 2L, size = 2L) + expect_identical(y[[2L]], base[[3L]]) + expect_identical(y[1:2], base[2:3]) + expect_identical(y, x[2:3]) + expect_false(view_is_materialized(x)) + + base <- c("a", "b", "c", "d") + x <- vec_view(base, start = 1L, size = 3L) + y <- vec_view(x, start = 2L, size = 2L) + expect_identical(y[[2L]], base[[3L]]) + expect_identical(y[1:2], base[2:3]) + expect_identical(y, x[2:3]) + expect_false(view_is_materialized(x)) + + base <- list("a", "b", "c", "d") + x <- vec_view(base, start = 1L, size = 3L) + y <- vec_view(x, start = 2L, size = 2L) + expect_identical(y[[2L]], base[[3L]]) + expect_identical(y[1:2], base[2:3]) + expect_identical(y, x[2:3]) + expect_false(view_is_materialized(x)) +}) + test_that("views can be manually materialized", { base <- c(TRUE, FALSE, TRUE, FALSE) x <- vec_view(base, start = 2L, size = 3L) @@ -225,6 +334,91 @@ test_that("views can be manually materialized", { expect_false(is_altrep(materialized)) }) +test_that("views can be inspected", { + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 2L, size = 3L) + expect_snapshot(view_inspect(x)) + + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 2L, size = 3L) + expect_snapshot(view_inspect(x)) + + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 2L, size = 3L) + expect_snapshot(view_inspect(x)) + + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 2L, size = 3L) + expect_snapshot(view_inspect(x)) + + base <- as.raw(c(1, 2, 3, 4)) + x <- vec_view(base, start = 2L, size = 3L) + expect_snapshot(view_inspect(x)) + + base <- c("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + expect_snapshot(view_inspect(x)) + + base <- list("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + expect_snapshot(view_inspect(x)) +}) + +test_that("views can be roundtripped through serialization, and lose ALTREPness", { + # This is nice because we don't have to worry about compatibility with + # "old" view objects if we ever change the internals. It is also probably + # just the correct way to do this. + + base <- c(TRUE, FALSE, TRUE, FALSE) + x <- vec_view(base, start = 2L, size = 3L) + bytes <- serialize(x, connection = NULL) + x <- unserialize(bytes) + expect_false(is_altrep(x)) + expect_identical(x, base[2:4]) + + base <- c(1L, 2L, 3L, 4L) + x <- vec_view(base, start = 2L, size = 3L) + bytes <- serialize(x, connection = NULL) + x <- unserialize(bytes) + expect_false(is_altrep(x)) + expect_identical(x, base[2:4]) + + base <- c(1, 2, 3, 4) + x <- vec_view(base, start = 2L, size = 3L) + bytes <- serialize(x, connection = NULL) + x <- unserialize(bytes) + expect_false(is_altrep(x)) + expect_identical(x, base[2:4]) + + base <- c(1, 2, 3, 4) + 1i + x <- vec_view(base, start = 2L, size = 3L) + bytes <- serialize(x, connection = NULL) + x <- unserialize(bytes) + expect_false(is_altrep(x)) + expect_identical(x, base[2:4]) + + base <- as.raw(c(1, 2, 3, 4)) + x <- vec_view(base, start = 2L, size = 3L) + bytes <- serialize(x, connection = NULL) + x <- unserialize(bytes) + expect_false(is_altrep(x)) + expect_identical(x, base[2:4]) + + base <- c("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + bytes <- serialize(x, connection = NULL) + x <- unserialize(bytes) + expect_false(is_altrep(x)) + expect_identical(x, base[2:4]) + + base <- list("a", "b", "c", "d") + x <- vec_view(base, start = 2L, size = 3L) + bytes <- serialize(x, connection = NULL) + x <- unserialize(bytes) + expect_false(is_altrep(x)) + expect_identical(x, base[2:4]) +}) + test_that("can make zero length view", { base <- c(TRUE, FALSE, TRUE, FALSE) x <- vec_view(base, start = 2L, size = 0L) From 8ae0feed124ae4ee4d2f7e4821699ea2571abb80 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Thu, 4 Jul 2024 14:08:48 -0400 Subject: [PATCH 5/5] Make ALTLIST view support conditional on R >=4.3.0 --- src/rlang/altrep.h | 6 ++++++ src/rlang/view.c | 36 ++++++++++++++++++++++++++++++++++ tests/testthat/helper-altrep.R | 6 ++++++ tests/testthat/test-view.R | 10 ++++++++++ 4 files changed, 58 insertions(+) create mode 100644 tests/testthat/helper-altrep.R diff --git a/src/rlang/altrep.h b/src/rlang/altrep.h index 6b1cdef473..37753d1706 100644 --- a/src/rlang/altrep.h +++ b/src/rlang/altrep.h @@ -13,6 +13,12 @@ # define ALTREP(x) false #endif +#if R_VERSION >= R_Version(4, 3, 0) +#define RLANG_R_HAS_ALTLIST 1 +#else +#define RLANG_R_HAS_ALTLIST 0 +#endif + static inline bool r_is_altrep(r_obj* x) { return ALTREP(x); diff --git a/src/rlang/view.c b/src/rlang/view.c index b2fe6070f0..45758ef449 100644 --- a/src/rlang/view.c +++ b/src/rlang/view.c @@ -39,7 +39,9 @@ R_altrep_class_t r_dbl_view_class; R_altrep_class_t r_cpl_view_class; R_altrep_class_t r_raw_view_class; R_altrep_class_t r_chr_view_class; +#if RLANG_R_HAS_ALTLIST R_altrep_class_t r_list_view_class; +#endif // ----------------------------------------------------------------------------- @@ -79,9 +81,11 @@ static inline r_obj* r_raw_view(r_obj* x, r_ssize start, r_ssize size) { static inline r_obj* r_chr_view(r_obj* x, r_ssize start, r_ssize size) { R_VIEW(r_chr_view_class, r_chr_cbegin); } +#if RLANG_R_HAS_ALTLIST static inline r_obj* r_list_view(r_obj* x, r_ssize start, r_ssize size) { R_VIEW(r_list_view_class, r_list_cbegin); } +#endif // Up to the caller to verify that `start` and `size` are sized correctly. // `start` is 0-indexed. @@ -99,8 +103,10 @@ r_obj* r_vec_view(r_obj* x, r_ssize start, r_ssize size) { return r_raw_view(x, start, size); case R_TYPE_character: return r_chr_view(x, start, size); +#if RLANG_R_HAS_ALTLIST case R_TYPE_list: return r_list_view(x, start, size); +#endif default: r_stop_internal("Type not implemented."); } @@ -126,9 +132,11 @@ static inline bool r_is_raw_view(r_obj* x) { static inline bool r_is_chr_view(r_obj* x) { return R_altrep_inherits(x, r_chr_view_class); } +#if RLANG_R_HAS_ALTLIST static inline bool r_is_list_view(r_obj* x) { return R_altrep_inherits(x, r_list_view_class); } +#endif bool r_is_view(r_obj* x) { switch (r_typeof(x)) { @@ -144,8 +152,10 @@ bool r_is_view(r_obj* x) { return r_is_raw_view(x); case R_TYPE_character: return r_is_chr_view(x); +#if RLANG_R_HAS_ALTLIST case R_TYPE_list: return r_is_list_view(x); +#endif default: return false; } @@ -262,9 +272,11 @@ static r_obj* r_chr_view_materialize(r_obj* x) { r_alloc_character, r_obj*, r_chr_cbegin, r_chr_poke ); } +#if RLANG_R_HAS_ALTLIST static r_obj* r_list_view_materialize(r_obj* x) { R_VIEW_MATERIALIZE_BARRIER(r_alloc_list, r_obj*, r_list_cbegin, r_list_poke); } +#endif r_obj* r_view_materialize(r_obj* x) { switch (r_typeof(x)) { @@ -280,8 +292,10 @@ r_obj* r_view_materialize(r_obj* x) { return r_raw_view_materialize(x); case R_TYPE_character: return r_chr_view_materialize(x); +#if RLANG_R_HAS_ALTLIST case R_TYPE_list: return r_list_view_materialize(x); +#endif default: r_stop_internal("Type not implemented."); } @@ -338,11 +352,13 @@ static inline void* r_chr_view_dataptr_writable(r_obj* x) { return DATAPTR(data); } +// #if RLANG_R_HAS_ALTLIST // static inline void r_list_view_dataptr_writable(r_obj* x) { // // R does not use `VECTOR_PTR()` internally, and it even errors in // // `ALTVEC_DATAPTR_EX()` if you try and take a `writable` `DATAPTR()` on an // // ALTREP list, so we don't need this. // } +// #endif #define R_VIEW_DATAPTR_READONLY(CTYPE, CBEGIN) \ r_obj* metadata = r_altrep_data2(x); \ @@ -381,9 +397,11 @@ static inline r_byte const* r_raw_view_dataptr_readonly(r_obj* x) { static inline r_obj* const* r_chr_view_dataptr_readonly(r_obj* x) { R_VIEW_DATAPTR_READONLY(r_obj*, r_chr_cbegin); } +#if RLANG_R_HAS_ALTLIST static inline r_obj* const* r_list_view_dataptr_readonly(r_obj* x) { R_VIEW_DATAPTR_READONLY(r_obj*, r_list_cbegin); } +#endif #define R_VIEW_DATAPTR(WRITABLE, READONLY) \ if (writable) { \ @@ -393,6 +411,7 @@ static inline r_obj* const* r_list_view_dataptr_readonly(r_obj* x) { return (void*) READONLY(x); \ } +#if RLANG_R_HAS_ALTLIST #define R_VIEW_DATAPTR_BARRIER(READONLY) \ if (writable) { \ /* `ALTVEC_DATAPTR_EX()` should have errored */ \ @@ -401,6 +420,7 @@ static inline r_obj* const* r_list_view_dataptr_readonly(r_obj* x) { /* Caller promises not to mutate it */ \ return (void*) READONLY(x); \ } +#endif static void* r_lgl_view_dataptr(r_obj* x, Rboolean writable) { R_VIEW_DATAPTR(r_lgl_view_dataptr_writable, r_lgl_view_dataptr_readonly); @@ -420,9 +440,11 @@ static void* r_raw_view_dataptr(r_obj* x, Rboolean writable) { static void* r_chr_view_dataptr(r_obj* x, Rboolean writable) { R_VIEW_DATAPTR(r_chr_view_dataptr_writable, r_chr_view_dataptr_readonly); } +#if RLANG_R_HAS_ALTLIST static void* r_list_view_dataptr(r_obj* x, Rboolean writable) { R_VIEW_DATAPTR_BARRIER(r_list_view_dataptr_readonly); } +#endif // We can always provide a readonly view static const void* r_lgl_view_dataptr_or_null(r_obj* x) { @@ -443,9 +465,11 @@ static const void* r_raw_view_dataptr_or_null(r_obj* x) { static const void* r_chr_view_dataptr_or_null(r_obj* x) { return (const void*) r_chr_view_dataptr_readonly(x); } +#if RLANG_R_HAS_ALTLIST static const void* r_list_view_dataptr_or_null(r_obj* x) { return (const void*) r_list_view_dataptr_readonly(x); } +#endif // ----------------------------------------------------------------------------- @@ -537,6 +561,7 @@ static Rboolean r_chr_view_inspect( "altrep_character_view", x, pre, deep, pvec, inspect_subtree ); } +#if RLANG_R_HAS_ALTLIST static Rboolean r_list_view_inspect( r_obj* x, int pre, @@ -548,6 +573,7 @@ static Rboolean r_list_view_inspect( "altrep_list_view", x, pre, deep, pvec, inspect_subtree ); } +#endif Rboolean r_view_inspect(r_obj* x) { switch (r_typeof(x)) { @@ -563,8 +589,10 @@ Rboolean r_view_inspect(r_obj* x) { return r_raw_view_inspect(x, 0, 0, 0, NULL); case R_TYPE_character: return r_chr_view_inspect(x, 0, 0, 0, NULL); +#if RLANG_R_HAS_ALTLIST case R_TYPE_list: return r_list_view_inspect(x, 0, 0, 0, NULL); +#endif default: r_stop_internal("Type not implemented."); } @@ -621,9 +649,11 @@ static r_byte r_raw_view_elt(r_obj* x, r_ssize i) { static r_obj* r_chr_view_elt(r_obj* x, r_ssize i) { R_VIEW_ELT(r_obj*, STRING_ELT); } +#if RLANG_R_HAS_ALTLIST static r_obj* r_list_view_elt(r_obj* x, r_ssize i) { R_VIEW_ELT(r_obj*, VECTOR_ELT); } +#endif // ----------------------------------------------------------------------------- @@ -648,9 +678,11 @@ static r_obj* r_list_view_elt(r_obj* x, r_ssize i) { static void r_chr_view_set_elt(r_obj* x, r_ssize i, r_obj* elt) { R_VIEW_SET_ELT(r_chr_view_materialize, r_chr_poke); } +#if RLANG_R_HAS_ALTLIST static void r_list_view_set_elt(r_obj* x, r_ssize i, r_obj* elt) { R_VIEW_SET_ELT(r_list_view_materialize, r_list_poke); } +#endif // ----------------------------------------------------------------------------- @@ -786,6 +818,7 @@ static void r_init_library_chr_view(DllInfo* dll, const char* package) { R_set_altstring_Set_elt_method(r_chr_view_class, r_chr_view_set_elt); } +#if RLANG_R_HAS_ALTLIST static void r_init_library_list_view(DllInfo* dll, const char* package) { r_list_view_class = R_make_altlist_class("list_view", package, dll); @@ -806,6 +839,7 @@ static void r_init_library_list_view(DllInfo* dll, const char* package) { R_set_altlist_Elt_method(r_list_view_class, r_list_view_elt); R_set_altlist_Set_elt_method(r_list_view_class, r_list_view_set_elt); } +#endif void r_init_library_view(DllInfo* dll, const char* package) { r_init_library_lgl_view(dll, package); @@ -814,5 +848,7 @@ void r_init_library_view(DllInfo* dll, const char* package) { r_init_library_cpl_view(dll, package); r_init_library_raw_view(dll, package); r_init_library_chr_view(dll, package); +#if RLANG_R_HAS_ALTLIST r_init_library_list_view(dll, package); +#endif } diff --git a/tests/testthat/helper-altrep.R b/tests/testthat/helper-altrep.R new file mode 100644 index 0000000000..7f35aaeaf7 --- /dev/null +++ b/tests/testthat/helper-altrep.R @@ -0,0 +1,6 @@ +# This helper is purposefully used at the end of each test in `test-view.R` +# to only skip the list specific section of each `test_that()` block if +# necessary. +skip_if_no_altlist <- function() { + skip_if_not(getRversion() >= "4.3.0", message = "Missing ALTLIST support.") +} diff --git a/tests/testthat/test-view.R b/tests/testthat/test-view.R index d15c196087..792362dac4 100644 --- a/tests/testthat/test-view.R +++ b/tests/testthat/test-view.R @@ -29,6 +29,7 @@ test_that("views can be created", { expect_false(view_is_materialized(x)) expect_identical(x, base[2:4]) + skip_if_no_altlist() base <- list("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_false(view_is_materialized(x)) @@ -60,6 +61,7 @@ test_that("views have right length", { x <- vec_view(base, start = 2L, size = 3L) expect_identical(length(x), 3L) + skip_if_no_altlist() base <- list("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_identical(length(x), 3L) @@ -114,6 +116,7 @@ test_that("views can be sliced with subset", { expect_identical(x[c(0L, 2L)], base[c(0L, 3L)]) expect_false(view_is_materialized(x)) + skip_if_no_altlist() base <- list("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_identical(x[1:2], base[2:3]) @@ -166,6 +169,7 @@ test_that("views can be sliced with subset2", { expect_error(x[[4]]) expect_false(view_is_materialized(x)) + skip_if_no_altlist() base <- list("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_identical(x[[1]], base[[2L]]) @@ -217,6 +221,7 @@ test_that("views can be assigned to", { expect_identical(x[2:3], assign) expect_identical(base, c("a", "b", "c", "d")) + skip_if_no_altlist() assign <- list(NA, "e") base <- list("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) @@ -274,6 +279,7 @@ test_that("views can wrap other views", { expect_identical(y, x[2:3]) expect_false(view_is_materialized(x)) + skip_if_no_altlist() base <- list("a", "b", "c", "d") x <- vec_view(base, start = 1L, size = 3L) y <- vec_view(x, start = 2L, size = 2L) @@ -326,6 +332,7 @@ test_that("views can be manually materialized", { expect_true(view_is_materialized(x)) expect_false(is_altrep(materialized)) + skip_if_no_altlist() base <- list("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_false(view_is_materialized(x)) @@ -359,6 +366,7 @@ test_that("views can be inspected", { x <- vec_view(base, start = 2L, size = 3L) expect_snapshot(view_inspect(x)) + skip_if_no_altlist() base <- list("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) expect_snapshot(view_inspect(x)) @@ -411,6 +419,7 @@ test_that("views can be roundtripped through serialization, and lose ALTREPness" expect_false(is_altrep(x)) expect_identical(x, base[2:4]) + skip_if_no_altlist() base <- list("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 3L) bytes <- serialize(x, connection = NULL) @@ -450,6 +459,7 @@ test_that("can make zero length view", { expect_identical(x, base[0L]) expect_identical(length(x), 0L) + skip_if_no_altlist() base <- list("a", "b", "c", "d") x <- vec_view(base, start = 2L, size = 0L) expect_identical(x, base[0L])