1#' Duplicate an R object 2#' 3#' In R semantics, objects are copied by value. This means that 4#' modifying the copy leaves the original object intact. Since 5#' copying data in memory is an expensive operation, copies in R are 6#' as lazy as possible. They only happen when the new object is 7#' actually modified. However, some operations (like [node_poke_car()] 8#' or [node_poke_cdr()]) do not support copy-on-write. In those cases, 9#' it is necessary to duplicate the object manually in order to 10#' preserve copy-by-value semantics. 11#' 12#' Some objects are not duplicable, like symbols and environments. 13#' `duplicate()` returns its input for these unique objects. 14#' 15#' @param x Any R object. However, uncopyable types like symbols and 16#' environments are returned as is (just like with `<-`). 17#' @param shallow This is relevant for recursive data structures like 18#' lists, calls and pairlists. A shallow copy only duplicates the 19#' top-level data structure. The objects contained in the list are 20#' still the same. 21#' @seealso pairlist 22#' @keywords internal 23#' @export 24duplicate <- function(x, shallow = FALSE) { 25 .Call(rlang_duplicate, x, shallow) 26} 27 28 29# nocov start - These functions are mostly for interactive experimentation 30 31poke_type <- function(x, type) { 32 invisible(.Call(rlang_poke_type, x, type)) 33} 34sexp_address <- function(x) { 35 .Call(rlang_sexp_address, x) 36} 37sexp_named <- function(x) { 38 # Don't use `substitute()` because dots might be forwarded 39 arg <- match.call(expand.dots = FALSE)$x 40 .Call(rlang_named, arg, parent.frame()) 41} 42 43mark_object <- function(x) { 44 invisible(.Call(rlang_mark_object, x)) 45} 46unmark_object <- function(x) { 47 invisible(.Call(rlang_unmark_object, x)) 48} 49 50true_length <- function(x) { 51 .Call(rlang_true_length, x) 52} 53env_frame <- function(x) { 54 .Call(rlang_env_frame, x) 55} 56env_hash_table <- function(x) { 57 .Call(rlang_env_hash_table, x) 58} 59 60promise_expr <- function(name, env = caller_env()) { 61 .Call(rlang_promise_expr, name, env) 62} 63promise_env <- function(name, env = caller_env()) { 64 .Call(rlang_promise_env, name, env) 65} 66promise_value <- function(name, env = caller_env()) { 67 .Call(rlang_promise_value, name, env) 68} 69 70warningcall <- function(call, msg) { 71 .Call(rlang_test_Rf_warningcall, call, msg) 72} 73errorcall <- function(call, msg) { 74 .Call(rlang_test_Rf_errorcall, call, msg) 75} 76 77sexp_attrib <- function(x) { 78 .Call(rlang_attrib, x) 79} 80 81vec_alloc <- function(type, n) { 82 stopifnot( 83 is_string(type), 84 is_integer(n, 1) 85 ) 86 .Call(rlang_vec_alloc, type, n) 87} 88 89find_var <- function(env, sym) { 90 .Call(rlang_find_var, env, sym); 91} 92 93chr_get <- function(x, i = 0L) { 94 .Call(rlang_chr_get, x, i) 95} 96 97# nocov end 98