`match.call()` and `sys.call()` called from a function of the enclosing environment

Question

match.call() and sys.call() are straightforward to get the call to the current executed function, however I cannot seem to get the call to the function one level up reliably.

I would like to build the following function factory

factory <- function(){

  CALL <- function(){
    # does operations on what would be the output of match.call() and sys.call() 
    # if they were executed in the manufactured function
  }

  CALL2 <- function() {
    # calls CALL() and does other operations
  }

  function(x, y){
    # calls CALL() and CALL2(), not necessarily at the top level
  }
}

Here is a simplified example, with expected output, where I just try to print the correct match.call() and sys.call() :

code

I expect your answer to edit the following by adding code where # INSERT SOME CODE comments are found.

My code at the end calls the CALL and CALL2 functions in different ways, to test test the robustnes of the solution.

Each of these ways is expected to print the same output, which is what {print(match.call()); print(sys.call())} would print.

factory <- function(){
  CALL <- function(){
    # INSERT SOME CODE HERE
  }
  CALL2 <- function() {
    # INSERT SOME CODE HERE IF NECESSARY
    CALL()
  }

  function(x, y){
    # INSERT SOME CODE HERE IF NECESSARY

    # Don't edit following code
    message("call from top level")
    CALL()
    message("call from lst")
    dplyr::lst(CALL())
    message("call from lapply")
    lapply(CALL(), identity)
    message("call from sub function")
    f <- function() CALL()
    f()
    message("call from another function from enclosing env")
    CALL2()
    message("call from lst")
    dplyr::lst(CALL2())
    message("call from lapply")
    lapply(CALL2(), identity)
    message("call from sub function")
    g <- function() CALL2()
    g()
    invisible(NULL)
  }
}

input

To test the function the following code should be executed :

fun <- factory()
fun("foo", y = "bar")

OR

fun2 <- function(){
  fun("foo", y = "bar")
}
fun2()

This way the solution is tested with 2 different call stacks, again for robustness.

desired output

Anytime CALL is called in the example above, should print the following, however it is called :

fun(x = "foo", y = "bar")
fun("foo", y = "bar")

Which means the complete output when running fun("foo", y = "bar") or fun2() should be :

call from top level
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from lst
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from lapply
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from sub function
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from another function from enclosing env
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from lst
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from lapply
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from sub function
fun(x = "foo", y = "bar")
fun("foo", y = "bar")

Maybe rlang / tidyeval can come to the rescue ?

---

WHAT I TRIED

I believe I found a way to succeed with match.call().

To make sure match.call() is executed in the right environment, I create a binding ENV to the environment of my manufactured function with ENV <- environment(). Then I can retrieve this environment by calling ENV <- eval.parent(quote(ENV)) in CALL() and CALL2(), and then can get the proper output by calling eval(quote(match.call()), ENV).

This same strategy doesn't work with sys.call() however.

factory <- function(){

  CALL <- function(){
    ENV <- eval.parent(quote(ENV))
    print(eval(quote(match.call()), ENV))
    print(eval(quote(sys.call()), ENV))
  }

  CALL2 <- function() {
    ENV <- eval.parent(quote(ENV))
    CALL()
  }

  function(x, y){
    ENV <- environment()
    message("call from top level")
    CALL()
    message("call from lst")
    dplyr::lst(CALL())
    message("call from lapply")
    lapply(CALL(), identity)
    message("call from sub function")
    f <- function() CALL()
    f()
    message("call from another function from enclosing env")
    CALL2()
    message("call from lst")
    dplyr::lst(CALL2())
    message("call from lapply")
    lapply(CALL2(), identity)
    message("call from sub function")
    g <- function() CALL2()
    g()
    invisible(NULL)
  }
}

Output:

fun <- factory()
fun("foo", y = "bar")
#> call from top level
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lst
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lapply
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from sub function
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from another function from enclosing env
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lst
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lapply
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from sub function
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)

fun2 <- function(){
  fun("foo", y = "bar")
}
fun2()
#> call from top level
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lst
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lapply
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from sub function
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from another function from enclosing env
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lst
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lapply
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from sub function
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)

^{Created on 2019-06-05 by the reprex package (v0.2.1)}

As you can see the output shows eval(quote(sys.call()), ENV) where I want to see fun("foo", y = "bar").

Instead of print(eval(quote(sys.call()), ENV)) I also tried print(sys.call(1)) and print(sys.call(sys.parent())) and both sometimes print the right thing, but are not robust.

Answer 1

Just to give you a different point of view of the problem itself, you could just save the call in the enclosing environment, always matching it in the "main" function:

factory <- function(){
  matched_call <- NULL

  CALL <- function(){
    print(matched_call)
  }
  CALL2 <- function() {
    CALL()
  }

  function(x, y){
    matched_call <<- match.call()
    on.exit(matched_call <<- NULL)

    ...
  }
}