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