Skip to content

Commit

Permalink
Get rid of STRING_PTR() usage (#213)
Browse files Browse the repository at this point in the history 
* Remove old R compatibility definitions

* Remove `STRING_PTR()` in `slider_init()`

* Remove usage of `STRING_PTR()`

* NEWS bullet
  • Loading branch information
@DavisVaughan
DavisVaughan authored Oct 25, 2024
1 parent 7fe5dfc commit 80e0004
Show file tree
Hide file tree
Showing 8 changed files with 112 additions and 83 deletions.
2 changes: 2 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
# slider (development version)

* Removed usage of non-API `STRING_PTR()` (#209).

* R >=4.0.0 is now required, inline with tidyverse guidelines.

* Updated snapshot tests to use the latest version of cli.
Expand Down
65 changes: 47 additions & 18 deletions src/assign.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,9 +6,19 @@

// -----------------------------------------------------------------------------

#define ASSIGN_ONE(CONST_DEREF) do { \
elt = vec_cast(elt, ptype); \
p_out[i] = CONST_DEREF(elt)[0]; \
#define ASSIGN_ONE(CONST_DEREF) do { \
elt = vec_cast(elt, ptype); \
p_out[i] = CONST_DEREF(elt)[0]; \
} while (0)

#define ASSIGN_ONE_BARRIER(CONST_DEREF, SET) do { \
elt = vec_cast(elt, ptype); \
SET(out, i, CONST_DEREF(elt)[0]); \
} while (0)

// For lists, we don't care what the `elt` is, we just assign it
#define ASSIGN_ONE_LIST(SET) do { \
SET(out, i, elt); \
} while (0)

static inline void assign_one_dbl(double* p_out, R_len_t i, SEXP elt, SEXP ptype) {
Expand All @@ -20,16 +30,17 @@ static inline void assign_one_int(int* p_out, R_len_t i, SEXP elt, SEXP ptype) {
static inline void assign_one_lgl(int* p_out, R_len_t i, SEXP elt, SEXP ptype) {
ASSIGN_ONE(LOGICAL_RO);
}
static inline void assign_one_chr(SEXP* p_out, R_len_t i, SEXP elt, SEXP ptype) {
ASSIGN_ONE(STRING_PTR_RO);
static inline void assign_one_chr(SEXP out, R_len_t i, SEXP elt, SEXP ptype) {
ASSIGN_ONE_BARRIER(STRING_PTR_RO, SET_STRING_ELT);
}

#undef ASSIGN_ONE

static inline void assign_one_lst(SEXP out, R_len_t i, SEXP elt, SEXP ptype) {
SET_VECTOR_ELT(out, i, elt);
ASSIGN_ONE_LIST(SET_VECTOR_ELT);
}

#undef ASSIGN_ONE
#undef ASSIGN_ONE_BARRIER
#undef ASSIGN_ONE_LIST

// -----------------------------------------------------------------------------

#define ASSIGN_LOCS(CTYPE, CONST_DEREF) do { \
Expand All @@ -44,6 +55,26 @@ static inline void assign_one_lst(SEXP out, R_len_t i, SEXP elt, SEXP ptype) {
UNPROTECT(1); \
} while (0)

#define ASSIGN_LOCS_BARRIER(CTYPE, CONST_DEREF, SET) do { \
elt = PROTECT(vec_cast(elt, ptype)); \
const CTYPE value = CONST_DEREF(elt)[0]; \
\
for (R_len_t i = 0; i < size; ++i) { \
SET(out, start, value); \
++start; \
} \
\
UNPROTECT(1); \
} while (0)

// For lists, we don't care what the `elt` is, we just assign it
#define ASSIGN_LOCS_LIST(SET) do { \
for (R_len_t i = 0; i < size; ++i) { \
SET(out, start, elt); \
++start; \
} \
} while (0)

static inline void assign_locs_dbl(double* p_out, int start, int size, SEXP elt, SEXP ptype) {
ASSIGN_LOCS(double, REAL_RO);
}
Expand All @@ -53,19 +84,17 @@ static inline void assign_locs_int(int* p_out, int start, int size, SEXP elt, SE
static inline void assign_locs_lgl(int* p_out, int start, int size, SEXP elt, SEXP ptype) {
ASSIGN_LOCS(int, LOGICAL_RO);
}
static inline void assign_locs_chr(SEXP* p_out, int start, int size, SEXP elt, SEXP ptype) {
ASSIGN_LOCS(SEXP, STRING_PTR_RO);
static inline void assign_locs_chr(SEXP out, int start, int size, SEXP elt, SEXP ptype) {
ASSIGN_LOCS_BARRIER(SEXP, STRING_PTR_RO, SET_STRING_ELT);
}

#undef ASSIGN_LOCS

static inline void assign_locs_lst(SEXP out, int start, int size, SEXP elt, SEXP ptype) {
for (R_len_t i = 0; i < size; ++i) {
SET_VECTOR_ELT(out, start, elt);
++start;
}
ASSIGN_LOCS_LIST(SET_VECTOR_ELT);
}

#undef ASSIGN_LOCS
#undef ASSIGN_LOCS_BARRIER
#undef ASSIGN_LOCS_LIST

// -----------------------------------------------------------------------------

#endif
28 changes: 12 additions & 16 deletions src/hop.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,23 +39,14 @@
} \
} while (0)

#define HOP_LOOP_ATOMIC(CTYPE, DEREF, ASSIGN_ONE) do { \
CTYPE* p_out = DEREF(out); \
HOP_LOOP(ASSIGN_ONE); \
#define HOP_LOOP_ATOMIC(CTYPE, DEREF, ASSIGN_ONE) do { \
CTYPE* p_out = DEREF(out); \
HOP_LOOP(ASSIGN_ONE); \
} while (0)

#define HOP_LOOP_BARRIER(ASSIGN_ONE) do { \
SEXP p_out = out; \
\
/* Initialize with `NA`, not `NULL` */ \
/* for size stability when auto-simplifying */ \
if (atomic && !constrain) { \
for (R_len_t i = 0; i < size; ++i) { \
SET_VECTOR_ELT(p_out, i, slider_shared_na_lgl); \
} \
} \
\
HOP_LOOP(ASSIGN_ONE); \
#define HOP_LOOP_BARRIER(ASSIGN_ONE) do { \
SEXP p_out = out; \
HOP_LOOP(ASSIGN_ONE); \
} while (0)

// -----------------------------------------------------------------------------
Expand Down Expand Up @@ -92,11 +83,16 @@ SEXP hop_common_impl(SEXP x,
SEXPTYPE out_type = TYPEOF(ptype);
SEXP out = PROTECT(slider_init(out_type, size));

if (atomic && !constrain && out_type == VECSXP) {
// Initialize with `NA`, not `NULL`, for size stability when auto simplifying
list_fill(out, slider_shared_na_lgl);
}

switch (out_type) {
case INTSXP: HOP_LOOP_ATOMIC(int, INTEGER, assign_one_int); break;
case REALSXP: HOP_LOOP_ATOMIC(double, REAL, assign_one_dbl); break;
case LGLSXP: HOP_LOOP_ATOMIC(int, LOGICAL, assign_one_lgl); break;
case STRSXP: HOP_LOOP_ATOMIC(SEXP, STRING_PTR, assign_one_chr); break;
case STRSXP: HOP_LOOP_BARRIER(assign_one_chr); break;
case VECSXP: HOP_LOOP_BARRIER(assign_one_lst); break;
default: never_reached("hop_common_impl");
}
Expand Down
38 changes: 15 additions & 23 deletions src/index.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,18 +34,9 @@
SLIDE_INDEX_LOOP(ASSIGN_LOCS); \
} while (0)

#define SLIDE_INDEX_LOOP_BARRIER(ASSIGN_LOCS) do { \
SEXP p_out = out; \
\
/* Initialize with `NA`, not `NULL` */ \
/* for size stability when auto-simplifying */ \
if (atomic && !constrain) { \
for (R_len_t i = 0; i < size; ++i) { \
SET_VECTOR_ELT(p_out, i, slider_shared_na_lgl); \
} \
} \
\
SLIDE_INDEX_LOOP(ASSIGN_LOCS); \
#define SLIDE_INDEX_LOOP_BARRIER(ASSIGN_LOCS) do { \
SEXP p_out = out; \
SLIDE_INDEX_LOOP(ASSIGN_LOCS); \
} while (0)

// -----------------------------------------------------------------------------
Expand Down Expand Up @@ -95,11 +86,16 @@ SEXP slide_index_common_impl(SEXP x,
SEXPTYPE out_type = TYPEOF(ptype);
SEXP out = PROTECT_N(slider_init(out_type, size), &n_prot);

if (atomic && !constrain && out_type == VECSXP) {
// Initialize with `NA`, not `NULL`, for size stability when auto simplifying
list_fill(out, slider_shared_na_lgl);
}

switch (out_type) {
case INTSXP: SLIDE_INDEX_LOOP_ATOMIC(int, INTEGER, assign_locs_int); break;
case REALSXP: SLIDE_INDEX_LOOP_ATOMIC(double, REAL, assign_locs_dbl); break;
case LGLSXP: SLIDE_INDEX_LOOP_ATOMIC(int, LOGICAL, assign_locs_lgl); break;
case STRSXP: SLIDE_INDEX_LOOP_ATOMIC(SEXP, STRING_PTR, assign_locs_chr); break;
case STRSXP: SLIDE_INDEX_LOOP_BARRIER(assign_locs_chr); break;
case VECSXP: SLIDE_INDEX_LOOP_BARRIER(assign_locs_lst); break;
default: never_reached("slide_index_common_impl");
}
Expand Down Expand Up @@ -144,15 +140,6 @@ SEXP slide_index_common_impl(SEXP x,

#define HOP_INDEX_LOOP_BARRIER(ASSIGN_ONE) do { \
SEXP p_out = out; \
\
/* Initialize with `NA`, not `NULL` */ \
/* for size stability when auto-simplifying */ \
if (atomic && !constrain) { \
for (R_len_t i = 0; i < size; ++i) { \
SET_VECTOR_ELT(p_out, i, slider_shared_na_lgl); \
} \
} \
\
HOP_INDEX_LOOP(ASSIGN_ONE); \
} while (0)

Expand Down Expand Up @@ -198,11 +185,16 @@ SEXP hop_index_common_impl(SEXP x,
SEXPTYPE out_type = TYPEOF(ptype);
SEXP out = PROTECT_N(slider_init(out_type, size), &n_prot);

if (atomic && !constrain && out_type == VECSXP) {
// Initialize with `NA`, not `NULL`, for size stability when auto simplifying
list_fill(out, slider_shared_na_lgl);
}

switch (out_type) {
case INTSXP: HOP_INDEX_LOOP_ATOMIC(int, INTEGER, assign_one_int); break;
case REALSXP: HOP_INDEX_LOOP_ATOMIC(double, REAL, assign_one_dbl); break;
case LGLSXP: HOP_INDEX_LOOP_ATOMIC(int, LOGICAL, assign_one_lgl); break;
case STRSXP: HOP_INDEX_LOOP_ATOMIC(SEXP, STRING_PTR, assign_one_chr); break;
case STRSXP: HOP_INDEX_LOOP_BARRIER(assign_one_chr); break;
case VECSXP: HOP_INDEX_LOOP_BARRIER(assign_one_lst); break;
default: never_reached("hop_index_common_impl");
}
Expand Down
26 changes: 11 additions & 15 deletions src/slide.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,20 +44,11 @@
#define SLIDE_LOOP_ATOMIC(CTYPE, DEREF, ASSIGN_ONE) do { \
CTYPE* p_out = DEREF(out); \
SLIDE_LOOP(ASSIGN_ONE); \
} while (0) \

#define SLIDE_LOOP_BARRIER(ASSIGN_ONE) do { \
SEXP p_out = out; \
\
/* Initialize with `NA`, not `NULL` */ \
/* for size stability when auto-simplifying */ \
if (atomic && !constrain) { \
for (R_len_t i = 0; i < size; ++i) { \
SET_VECTOR_ELT(p_out, i, slider_shared_na_lgl); \
} \
} \
\
SLIDE_LOOP(ASSIGN_ONE); \
} while (0)

#define SLIDE_LOOP_BARRIER(ASSIGN_ONE) do { \
SEXP p_out = out; \
SLIDE_LOOP(ASSIGN_ONE); \
} while (0)

// -----------------------------------------------------------------------------
Expand Down Expand Up @@ -113,11 +104,16 @@ SEXP slide_common_impl(SEXP x,
SEXPTYPE out_type = TYPEOF(ptype);
SEXP out = PROTECT(slider_init(out_type, size));

if (atomic && !constrain && out_type == VECSXP) {
// Initialize with `NA`, not `NULL`, for size stability when auto simplifying
list_fill(out, slider_shared_na_lgl);
}

switch (out_type) {
case INTSXP: SLIDE_LOOP_ATOMIC(int, INTEGER, assign_one_int); break;
case REALSXP: SLIDE_LOOP_ATOMIC(double, REAL, assign_one_dbl); break;
case LGLSXP: SLIDE_LOOP_ATOMIC(int, LOGICAL, assign_one_lgl); break;
case STRSXP: SLIDE_LOOP_ATOMIC(SEXP, STRING_PTR, assign_one_chr); break;
case STRSXP: SLIDE_LOOP_BARRIER(assign_one_chr); break;
case VECSXP: SLIDE_LOOP_BARRIER(assign_one_lst); break;
default: never_reached("slide_common_impl");
}
Expand Down
10 changes: 0 additions & 10 deletions src/slider.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,14 +15,4 @@
#define SLIDE -1
#define SLIDE2 -2

// Compatibility ------------------------------------------------

#if (R_VERSION < R_Version(3, 5, 0))
#define LOGICAL_RO(x) ((const int*) LOGICAL(x))
#define INTEGER_RO(x) ((const int*) INTEGER(x))
#define REAL_RO(x) ((const double*) REAL(x))
#define RAW_RO(x) ((const Rbyte*) RAW(x))
#define STRING_PTR_RO(x) ((const SEXP*) STRING_PTR(x))
#endif

#endif
24 changes: 23 additions & 1 deletion src/utils.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,17 @@ SEXP slider_ns_env = NULL;
return out; \
} while (0)

#define SLIDER_INIT_BARRIER(CTYPE, SET, NA_VALUE) do { \
SEXP out = PROTECT(Rf_allocVector(type, size)); \
\
for (R_xlen_t i = 0; i < size; ++i) { \
SET(out, i, NA_VALUE); \
} \
\
UNPROTECT(1); \
return out; \
} while (0)

// Lists are initialized with `NULL` elements
static SEXP list_init(R_xlen_t size) {
return Rf_allocVector(VECSXP, size);
Expand All @@ -49,14 +60,25 @@ SEXP slider_init(SEXPTYPE type, R_xlen_t size) {
case LGLSXP: SLIDER_INIT_ATOMIC(int, LOGICAL, NA_LOGICAL);
case INTSXP: SLIDER_INIT_ATOMIC(int, INTEGER, NA_INTEGER);
case REALSXP: SLIDER_INIT_ATOMIC(double, REAL, NA_REAL);
case STRSXP: SLIDER_INIT_ATOMIC(SEXP, STRING_PTR, NA_STRING);
case STRSXP: SLIDER_INIT_BARRIER(SEXP, SET_STRING_ELT, NA_STRING);
case VECSXP: return list_init(size);
default: Rf_errorcall(R_NilValue, "Internal error: Unknown type in `slider_init()`.");
}
never_reached("slider_init");
}

#undef SLIDER_INIT_ATOMIC
#undef SLIDER_INIT_BARRIER

// -----------------------------------------------------------------------------

void list_fill(SEXP x, SEXP value) {
R_xlen_t size = Rf_xlength(x);

for (R_xlen_t i = 0; i < size; ++i) {
SET_VECTOR_ELT(x, i, value);
}
}

// -----------------------------------------------------------------------------

Expand Down
2 changes: 2 additions & 0 deletions src/utils.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,6 +79,8 @@ extern SEXP slider_ns_env;

SEXP slider_init(SEXPTYPE type, R_xlen_t size);

void list_fill(SEXP x, SEXP value);

void stop_not_all_size_one(int iteration, int size);

void check_slide_starts_not_past_stops(SEXP starts,
Expand Down

0 comments on commit 80e0004

Please sign in to comment.