`match.call ()` и `sys.call ()` вызываются из функции окружающей среды

match.call() и sys.call() легко получить вызов текущей выполняемой функции, однако я не могу надежно получить вызов функции на один уровень выше.

Я хотел бы построить следующую фабрику функций

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
  }
}

Вот упрощенный пример с ожидаемым результатом, где я просто пытаюсь напечатать правильные match.call() и sys.call():

код

Я ожидаю, что ваш ответ изменит следующее, добавив код с # INSERT SOME CODE комментариями.

Мой код в конце вызывает функции CALL и CALL2 по-разному, чтобы проверить надежность решения.

Ожидается, что каждый из этих способов будет печатать один и тот же результат, что и {print(match.call()); print(sys.call())}.

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)
  }
}

ввод

Для проверки функции необходимо выполнить следующий код:

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

OR

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

Таким образом, решение тестируется с двумя разными стеками вызовов, опять же на надежность.

желаемый результат

Каждый раз, когда CALL вызывается в приведенном выше примере, должно выводиться следующее, независимо от его вызова:

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

Это означает, что полный вывод при запуске fun("foo", y = "bar") или fun2() должен быть:

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")

Может, rlang / tidyeval придет на помощь?

ЧТО Я ПЫТАЛСЯ

Я считаю, что нашел способ добиться успеха с match.call().

Чтобы убедиться, что match.call() выполняется в правильной среде, я создаю привязку ENV к среде созданной мной функции с помощью ENV <- environment(). Затем я могу получить эту среду, вызвав ENV <- eval.parent(quote(ENV)) в CALL() и CALL2(), а затем могу получить правильный результат, вызвав eval(quote(match.call()), ENV).

Однако эта же стратегия не работает с sys.call().

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)
  }
}

Выход:

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)

^{Создано 5 июня 2019 г. пакетом REPEX (v0.2.1)}

Как видите, результат показывает eval(quote(sys.call()), ENV), где я хочу видеть fun("foo", y = "bar").

Вместо print(eval(quote(sys.call()), ENV)) я также пробовал print(sys.call(1)) и print(sys.call(sys.parent())), и оба иногда печатают правильные вещи, но они не надежны.