1
2eval_c <- function(expr, data_mask, context_mask) {
3  expr <- call_expand_dots(expr, context_mask$.__current__.)
4  expr <- node_compact_missing(expr)
5  node <- node_cdr(expr)
6
7  # If the first selector is exclusive (negative), start with all
8  # columns. `-foo` is syntax for `everything() - foo`.
9  if (c_arg_kind(node_car(node)) %in% c("diff", "diff_colon")) {
10    init <- quote(everything())
11  } else {
12    init <- named(int())
13  }
14
15  reduce_sels(node, data_mask, context_mask, init = init)
16}
17
18reduce_sels <- function(node, data_mask, context_mask, init) {
19  out <- walk_data_tree(init, data_mask, context_mask)
20
21  while (!is_null(node)) {
22    tag <- node_tag(node)
23    car <- node_car(node)
24    cdr <- node_cdr(node)
25
26    kind <- c_arg_kind(car)
27    new <- switch(kind,
28      diff = unnegate(car),
29      diff_colon = unnegate_colon(car),
30      car
31    )
32
33    new <- walk_data_tree(new, data_mask, context_mask)
34    if (!is_null(tag)) {
35      internal <- data_mask$.__tidyselect__.$internal
36      new <- combine_names(new, tag, internal$name_spec, internal$strict)
37    }
38
39    if (kind == "union") {
40      out <- sel_union(out, new)
41    } else {
42      vars <- data_mask$.__tidyselect__.$internal$vars
43      out <- sel_diff(out, new, vars)
44    }
45
46    node <- cdr
47  }
48
49  out
50}
51
52c_arg_kind <- function(x) {
53  expr <- quo_get_expr2(x, x)
54
55  if (is_negated(x)) {
56    "diff"
57  } else if (is_negated_colon(x)) {
58    "diff_colon"
59  } else {
60    "union"
61  }
62}
63
64unnegate <- function(x) {
65  expr <- quo_get_expr2(x, x)
66  expr <- node_cadr(expr)
67
68  if (is_quosure(expr)) {
69    expr
70  } else if (is_quosure(x)) {
71    quo_set_expr(x, expr)
72  } else {
73    expr
74  }
75}
76unnegate_colon <- function(x) {
77  expr <- quo_get_expr2(x, x)
78
79  expr[[2]] <- unnegate(expr[[2]])
80  expr[[3]] <- unnegate(expr[[3]])
81
82  quo_set_expr2(x, expr, expr)
83}
84
85is_negated <- function(x) {
86  expr <- quo_get_expr2(x, x)
87  is_call(expr, "-", n = 1)
88}
89is_negated_colon <- function(x) {
90  expr <- quo_get_expr2(x, x)
91  is_call(expr, ":") && is_negated(expr[[2]]) && is_negated(expr[[3]])
92}
93
94combine_names <- function(x, tag, name_spec, uniquely_named) {
95  if (uniquely_named && is_data_dups(x)) {
96    name <- as_string(tag)
97    abort("Can't rename duplicate variables to `{name}`.")
98  }
99
100  vctrs::vec_c(!!tag := x, .name_spec = name_spec)
101}
102unique_name_spec <- function(outer, inner) {
103  # For compatibily, we enumerate as "foo1", "foo2", rather than
104  # "foo...1", "foo...2"
105  sep <- if (is_character(inner)) "..." else ""
106  paste(outer, inner, sep = sep)
107}
108minimal_name_spec <- function(outer, inner) {
109  if (is_character(inner)) {
110    paste(outer, inner, sep = "...")
111  } else {
112    outer
113  }
114}
115