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