1 #ifndef DPLYR_DPLYR_H
2 #define DPLYR_DPLYR_H
3
4 #define R_NO_REMAP
5 #include <R.h>
6 #include <Rinternals.h>
7 #include <R_ext/Rdynload.h>
8 #include <Rversion.h>
9
10 #define UTF8_MASK (1<<3)
11 #define ASCII_MASK (1<<6)
12
13 #define IS_ASCII(x) (LEVELS(x) & ASCII_MASK)
14 #define IS_UTF8(x) (LEVELS(x) & UTF8_MASK)
15
16 #if (R_VERSION < R_Version(3, 5, 0))
17 # define LOGICAL_RO(x) ((const int*) LOGICAL(x))
18 # define INTEGER_RO(x) ((const int*) INTEGER(x))
19 # define REAL_RO(x) ((const double*) REAL(x))
20 # define COMPLEX_RO(x) ((const Rcomplex*) COMPLEX(x))
21 # define STRING_PTR_RO(x) ((const SEXP*) STRING_PTR(x))
22 # define RAW_RO(x) ((const Rbyte*) RAW(x))
23 # define DATAPTR_RO(x) ((const void*) STRING_PTR(x))
24 #endif
25
26 #define VECTOR_PTR_RO(x) ((const SEXP*) DATAPTR_RO(x))
27
28 namespace dplyr {
29
30 struct envs {
31 static SEXP ns_dplyr;
32 static SEXP ns_vctrs;
33 static SEXP ns_rlang;
34 };
35
36 struct symbols {
37 static SEXP groups;
38 static SEXP levels;
39 static SEXP ptype;
40 static SEXP dot_current_group;
41 static SEXP current_expression;
42 static SEXP rows;
43 static SEXP caller;
44 static SEXP all_vars;
45 static SEXP dot_drop;
46 static SEXP abort_glue;
47 static SEXP dot_indices;
48 static SEXP chops;
49 static SEXP mask;
50 static SEXP rm;
51 static SEXP envir;
52 static SEXP vec_is_list;
53 static SEXP new_env;
54 static SEXP dot_data;
55 static SEXP used;
56 static SEXP across;
57 };
58
59 struct vectors {
60 static SEXP classes_vctrs_list_of;
61 static SEXP empty_int_vector;
62
63 static SEXP names_expanded;
64 static SEXP names_summarise_recycle_chunks;
65 };
66
67 struct functions {
68 static SEXP vec_chop;
69 static SEXP dot_subset2;
70 static SEXP list;
71 static SEXP function;
72 };
73
74 } // namespace dplyr
75
76 namespace rlang {
77 SEXP eval_tidy(SEXP expr, SEXP data, SEXP env);
78 SEXP as_data_pronoun(SEXP x);
79 SEXP new_data_mask(SEXP bottom, SEXP top);
80 SEXP str_as_symbol(SEXP);
81 SEXP quo_get_expr(SEXP quo);
82 }
83
84 namespace vctrs {
85 bool vec_is_vector(SEXP x) ;
86 R_len_t short_vec_size(SEXP x) ;
87 SEXP short_vec_recycle(SEXP x, R_len_t n);
88
vec_is_list(SEXP x)89 inline bool vec_is_list(SEXP x) {
90 SEXP call = PROTECT(Rf_lang2(dplyr::symbols::vec_is_list, x));
91 SEXP res = Rf_eval(call, dplyr::envs::ns_vctrs);
92 UNPROTECT(1);
93 return LOGICAL(res)[0];
94 }
95
96 }
97
98 SEXP dplyr_expand_groups(SEXP old_groups, SEXP positions, SEXP s_nr);
99 SEXP dplyr_filter_update_rows(SEXP s_n_rows, SEXP group_indices, SEXP keep, SEXP new_rows_sizes);
100 SEXP dplyr_between(SEXP x, SEXP s_left, SEXP s_right);
101 SEXP dplyr_cumall(SEXP x);
102 SEXP dplyr_cumany(SEXP x);
103 SEXP dplyr_cummean(SEXP x);
104 SEXP dplyr_validate_grouped_df(SEXP df, SEXP s_check_bounds);
105 SEXP dplyr_mask_eval_all(SEXP quo, SEXP env_private);
106 SEXP dplyr_mask_eval_all_summarise(SEXP quo, SEXP env_private);
107 SEXP dplyr_mask_eval_all_mutate(SEXP quo, SEXP env_private);
108 SEXP dplyr_mask_eval_all_filter(SEXP quos, SEXP env_private, SEXP s_n, SEXP env_filter);
109 SEXP dplyr_summarise_recycle_chunks(SEXP chunks, SEXP rows, SEXP ptypes);
110 SEXP dplyr_group_indices(SEXP data, SEXP rows);
111 SEXP dplyr_group_keys(SEXP group_data);
112 SEXP dplyr_reduce_lgl_or(SEXP, SEXP);
113 SEXP dplyr_reduce_lgl_and(SEXP, SEXP);
114
115 SEXP dplyr_mask_remove(SEXP env_private, SEXP s_name);
116 SEXP dplyr_mask_add(SEXP env_private, SEXP s_name, SEXP chunks);
117
118 SEXP dplyr_lazy_vec_chop(SEXP data, SEXP rows);
119 SEXP dplyr_data_masks_setup(SEXP chops, SEXP data, SEXP rows);
120 SEXP env_resolved(SEXP env, SEXP names);
121 void add_mask_binding(SEXP name, SEXP env_bindings, SEXP env_chops);
122
123 SEXP dplyr_extract_chunks(SEXP df_list, SEXP df_ptype);
124
125 #define DPLYR_MASK_INIT() \
126 SEXP rows = PROTECT(Rf_findVarInFrame(env_private, dplyr::symbols::rows)); \
127 R_xlen_t ngroups = XLENGTH(rows); \
128 SEXP caller = PROTECT(Rf_findVarInFrame(env_private, dplyr::symbols::caller)); \
129 SEXP mask = PROTECT(Rf_findVarInFrame(env_private, dplyr::symbols::mask)); \
130 SEXP chops_env = PROTECT(Rf_findVarInFrame(env_private, dplyr::symbols::chops)); \
131 SEXP current_group = PROTECT(Rf_findVarInFrame(ENCLOS(chops_env), dplyr::symbols::dot_current_group)) ;\
132 int* p_current_group = INTEGER(current_group)
133
134 #define DPLYR_MASK_FINALISE() UNPROTECT(5)
135
136 #define DPLYR_MASK_SET_GROUP(INDEX) *p_current_group = INDEX + 1
137
138 #define DPLYR_MASK_EVAL(quo) rlang::eval_tidy(quo, mask, caller)
139
140 #define DPLYR_ERROR_INIT(n) \
141 SEXP error_data = PROTECT(Rf_allocVector(VECSXP, n)); \
142 SEXP error_names = PROTECT(Rf_allocVector(STRSXP, n)); \
143 Rf_setAttrib(error_data, R_NamesSymbol, error_names);
144
145 #define DPLYR_ERROR_MESG_INIT(n) \
146 SEXP error_message = PROTECT(Rf_allocVector(STRSXP, n)); \
147
148 #define DPLYR_ERROR_SET(i, name, value) \
149 SET_VECTOR_ELT(error_data, i, value); \
150 SET_STRING_ELT(error_names, i, Rf_mkChar(name));
151
152 #define DPLYR_ERROR_MSG_SET(i, msg) \
153 SET_STRING_ELT(error_message, i, Rf_mkChar(msg)); \
154
155 #define DPLYR_ERROR_THROW(klass) \
156 SEXP error_class = PROTECT(Rf_mkString(klass)); \
157 SEXP error_call = PROTECT(Rf_lang4(dplyr::symbols::abort_glue, error_message, error_data, error_class)); \
158 Rf_eval(error_call, dplyr::envs::ns_dplyr); \
159 UNPROTECT(5) ; // for rchk
160
161 #endif
162