Is it possible to get the original symbol name from an internally-called function?

Question

I suspect that the answer is "No, you have to make a standard evaluation escape hatch", but maybe someone has some ideas.

Imagine writing a function that use non-standard evaluation to get the symbol/name of an object passed into it:

inner_func <- function(inner_arg) {
    substitute(inner_arg)
}

inner_func(iris)
#> iris

This falls apart if you call inner_func() inside a wrapping function, of course.

wrapper_func <- function(wrapper_arg) {
    inner_func(wrapper_arg)
}

wrapper_func(iris)
#> wrapper_arg

Is there a way to get the original symbol out of inner_func() even when it is passed inside another function, without changing the behaviour of inner_func()? I know that this is possible:

inner_func <- function(inner_arg) {
    evalq(as.symbol(inner_arg))
}

wrapper_func <- function(wrapper_func) {
    # Get the symbol as a Character
    obj_name <- deparse(substitute(wrapper_func))
    
    # eval(as.symbol()) inside inner_func() to turn it back into a symbol
    inner_func(obj_name)
}

wrapper_func(iris)
#> iris

But it involves doing some extra processing in inner_func() that compromises its ability to be called as it was originally:

inner_func(iris)

#> Error in as.vector(x, mode = mode) :
 'list' object cannot be coerced to type 'symbol'

If possible, I would prefer to do all of the extra processing in wrapper_func().

Answer 1

1. bquote approach:

As answered here:

inner_func <- function(inner_arg) {
    substitute(inner_arg)
}

wrapper_func <- function(wrapper_arg) {
    cap_expr <- substitute(wrapper_arg)
    eval(bquote(inner_func(.(cap_expr))))
}

wrapper_func2 <- function(wrapper_arg2) {
    cap_expr <- substitute(wrapper_arg2)
    eval(bquote(wrapper_func(.(cap_expr))))
}

inner_func(iris) # iris
wrapper_func(iris) # iris
wrapper_func2(iris) # iris

2. substitute approach:

wrapper_func <- function(wrapper_arg) {
    eval(substitute(inner_func(wrapper_arg)))
}

wrapper_func2 <- function(wrapper_arg2) {
    eval(substitute(wrapper_func(wrapper_arg2)))
}

Let's do a step by step of what happen when you call wrapper_func2(iris). I will rewrite wrapper_func2 and wrapper_func using pipes for ease of explanation:

wrapper_func2 <- function(wrapper_arg2) {
    # eval(substitute(wrapper_func(wrapper_arg2))) # original
    wrapper_func(wrapper_arg2) |> 
        substitute() |> # after substitute(wrapper_func(wrapper_arg2)) you get wrapper_func(iris)
        # deparse() # toggle deparse() comment here to see
        eval() # then evaluate wrapper_func(iris)
}

---

Next, evaluate wrapper_func(iris):

wrapper_func <- function(wrapper_arg) {
    # eval(substitute(inner_func(wrapper_arg))) # original
    inner_func(wrapper_arg) |> 
        substitute() |> # after substitute(inner_func(wrapper_arg)) you get inner_func(iris) 
        # deparse()
        eval() # then evaluate inner_func(iris)
}

---

Next, evaluate inner_func(iris)

inner_func <- function(inner_arg) {
    substitute(inner_arg) # after substitute(inner_arg) you get iris
}

Answer 2

Using rlang

library(rlang)

inner_func <- function(inner_arg) {
    substitute(inner_arg)
}

wrapper_func <- function(wrapper_arg) {
    eval_tidy(inner_func(ensym(wrapper_arg)))
}

wrapper_func2 <- function(wrapper_arg2) {
    eval_tidy(inner_func(ensym(wrapper_arg2)))
}

inner_func(iris)
#> iris
wrapper_func(iris)
#> iris
wrapper_func2(iris)
#> iris

^{Created on 2023-03-26 with reprex v2.0.2}

---

Originally I misinterpreted the question as how to do it all in inner_func() instead of how to do it all in the wrapper functions. Leaving that answer below.

I think you can use sys.calls and iterate through the list of calls.

inner_func <- function(inner_arg) {
  calls <- lapply(sys.calls(), \(x) match.call(get(x[[1]]), x))
  level <- length(calls)
  arg <- calls[[level]][-1][1]
  if (level == 1) {
    return(arg[[1]])
  }
  while (level > 1) {
    level <- level - 1
    call_args <- as.list(calls[[level]][-1])
    arg_char <- as.character(arg)
    if (!arg_char %in% names(call_args)) {
      return(arg)
    }
    arg <- as.list(calls[[level]][-1])[[as.character(arg)]]
  }
  arg
}

wrapper_func <- function(wrapper_arg) {
  inner_func(wrapper_arg)
}

wrapper_func2 <- function(wrapper_arg2) {
  wrapper_func(wrapper_arg2)
}

wrapper_func3 <- function(x){
  paste0(x, as.character(wrapper_func2(iris)))
}

inner_func(iris)
# iris
wrapper_func(iris)
# iris
wrapper_func2(iris)
# iris
wrapper_func3('pasted_to_front_')
# [1] "pasted_to_front_iris"