1#' Helpers for pairlist and language nodes 2#' 3#' @description 4#' 5#' **Important**: These functions are for expert R programmers only. 6#' You should only use them if you feel comfortable manipulating low 7#' level R data structures at the C level. We export them at the R level 8#' in order to make it easy to prototype C code. They don't perform 9#' any type checking and can crash R very easily (try to take the CAR 10#' of an integer vector --- save any important objects beforehand!). 11#' 12#' @param x A language or pairlist node. Note that these functions are 13#' barebones and do not perform any type checking. 14#' @param car,newcar,cdr,newcdr The new CAR or CDR for the node. These 15#' can be any R objects. 16#' @param newtag The new tag for the node. This should be a symbol. 17#' @return Setters like `node_poke_car()` invisibly return `x` modified 18#' in place. Getters return the requested node component. 19#' @seealso [duplicate()] for creating copy-safe objects and 20#' [base::pairlist()] for an easier way of creating a linked list of 21#' nodes. 22#' @keywords internal 23#' @export 24new_node <- function(car, cdr = NULL) { 25 .Call(rlang_new_node, car, cdr) 26} 27 28#' @rdname new_node 29#' @export 30node_car <- function(x) { 31 .Call(rlang_node_car, x) 32} 33#' @rdname new_node 34#' @export 35node_cdr <- function(x) { 36 .Call(rlang_node_cdr, x) 37} 38#' @rdname new_node 39#' @export 40node_caar <- function(x) { 41 .Call(rlang_node_caar, x) 42} 43#' @rdname new_node 44#' @export 45node_cadr <- function(x) { 46 .Call(rlang_node_cadr, x) 47} 48#' @rdname new_node 49#' @export 50node_cdar <- function(x) { 51 .Call(rlang_node_cdar, x) 52} 53#' @rdname new_node 54#' @export 55node_cddr <- function(x) { 56 .Call(rlang_node_cddr, x) 57} 58 59#' @rdname new_node 60#' @export 61node_poke_car <- function(x, newcar) { 62 invisible(.Call(rlang_node_poke_car, x, newcar)) 63} 64#' @rdname new_node 65#' @export 66node_poke_cdr <- function(x, newcdr) { 67 invisible(.Call(rlang_node_poke_cdr, x, newcdr)) 68} 69#' @rdname new_node 70#' @export 71node_poke_caar <- function(x, newcar) { 72 invisible(.Call(rlang_node_poke_caar, x, newcar)) 73} 74#' @rdname new_node 75#' @export 76node_poke_cadr <- function(x, newcar) { 77 invisible(.Call(rlang_node_poke_cadr, x, newcar)) 78} 79#' @rdname new_node 80#' @export 81node_poke_cdar <- function(x, newcdr) { 82 invisible(.Call(rlang_node_poke_cdar, x, newcdr)) 83} 84#' @rdname new_node 85#' @export 86node_poke_cddr <- function(x, newcdr) { 87 invisible(.Call(rlang_node_poke_cddr, x, newcdr)) 88} 89 90node_get <- function(node, i) { 91 if (node < 1L) { 92 abort("`i` must be an integer greater than 0.") 93 } 94 while (i > 1L) { 95 node <- node_cdr(node) 96 i <- i - 1L 97 } 98 node 99} 100node_get_car <- function(node, i) { 101 node_car(node_get(node, i)) 102} 103 104#' @rdname new_node 105#' @export 106node_tag <- function(x) { 107 .Call(rlang_node_tag, x) 108} 109#' @rdname new_node 110#' @export 111node_poke_tag <- function(x, newtag) { 112 invisible(.Call(rlang_node_poke_tag, x, newtag)) 113} 114 115#' Coerce to pairlist 116#' 117#' This transforms vector objects to a linked pairlist of nodes. See 118#' the [pairlist][node] type help page. 119#' 120#' 121#' @keywords internal 122#' @section Life cycle: 123#' 124#' `as_pairlist()` is experimental because we are still figuring out 125#' the naming scheme for pairlists and node-like objects. 126#' 127#' @param x An object to coerce. 128#' @export 129as_pairlist <- function(x) { 130 if (! typeof(x) %in% c(atomic_types, "list", "pairlist", "NULL")) { 131 abort_coercion(x, "pairlist") 132 } 133 as.vector(x, "pairlist") 134} 135 136#' Is object a node or pairlist? 137#' 138#' @description 139#' 140#' * `is_pairlist()` checks that `x` has type `pairlist`. 141#' 142#' * `is_node()` checks that `x` has type `pairlist` or `language`. 143#' It tests whether `x` is a node that has a CAR and a CDR, 144#' including callable nodes (language objects). 145#' 146#' * `is_node_list()` checks that `x` has type `pairlist` or `NULL`. 147#' `NULL` is the empty node list. 148#' 149#' 150#' @section Life cycle: 151#' 152#' These functions are experimental. We are still figuring out a good 153#' naming convention to refer to the different lisp-like lists in R. 154#' 155#' @param x Object to test. 156#' @seealso [is_call()] tests for language nodes. 157#' @keywords internal 158#' @export 159is_pairlist <- function(x) { 160 typeof(x) == "pairlist" 161} 162#' @rdname is_pairlist 163#' @export 164is_node <- function(x) { 165 typeof(x) %in% c("pairlist", "language") 166} 167#' @rdname is_pairlist 168#' @export 169is_node_list <- function(x) { 170 typeof(x) %in% c("pairlist", "NULL") 171} 172 173# Shallow copy of node trees 174node_tree_clone <- function(x) { 175 .Call(rlang_node_tree_clone, x); 176} 177 178node_walk <- function(.x, .f, ...) { 179 cur <- .x 180 while (!is.null(cur)) { 181 .f(cur, ...) 182 cur <- node_cdr(cur) 183 } 184 NULL 185} 186node_walk_nonnull <- function(.x, .f, ...) { 187 cur <- .x 188 out <- NULL 189 while (!is.null(cur) && is.null(out)) { 190 out <- .f(cur, ...) 191 cur <- node_cdr(cur) 192 } 193 out 194} 195node_walk_last <- function(.x, .f, ...) { 196 cur <- .x 197 while (!is.null(node_cdr(cur))) { 198 cur <- node_cdr(cur) 199 } 200 .f(cur, ...) 201} 202 203node_append <- function(.x, .y) { 204 node_walk_last(.x, function(l) node_poke_cdr(l, .y)) 205 .x 206} 207 208node_list_reverse <- function(x) { 209 .Call(rlang_pairlist_rev, x) 210} 211 212 213#' Create a new call from components 214#' 215#' @param car The head of the call. It should be a 216#' [callable][is_callable] object: a symbol, call, or literal 217#' function. 218#' @param cdr The tail of the call, i.e. a [node list][node] of 219#' arguments. 220#' 221#' @keywords internal 222#' @export 223new_call <- function(car, cdr = NULL) { 224 .Call(rlang_new_call, car, cdr) 225} 226