检查包含生成函数的包的问题

Question

我希望我知道如何使这个例子更小,但我不能很好地理解这个问题.

我有一个包重写R函数使它们尾递归:tailr.它对递归函数进行了一些分析,然后将其转换为循环函数.例如,它将转换此阶乘函数

factorial <- function(n, acc) {
    if (n <= 1) acc
    else factorial(n - 1, acc * n)
}

进入这个版本

factorial <- function(n, acc) {
    .tailr_n <- n
    .tailr_acc <- acc
    callCC(function(escape) {
        repeat {
            n <- .tailr_n
            acc <- .tailr_acc
            if (n <= 1)
                escape(acc)
            else {
                .tailr_n <<- n - 1
                .tailr_acc <<- acc * n
            }
        }
    })
}

生成的函数并不漂亮,但确实有效.

我的问题是如果我编写一个使用转换的包,只包含R的这些行:

#' Computes the factorial.
#' @param n A number
#' @param acc Accumulator to make the function tail-recursive
#' @return factorial of n
#' @export
factorial <- function(n, acc) {
    if (n <= 1) acc
    else factorial(n - 1, acc * n)
}

#' Computes the factorial.
#' @param n A number
#' @return factorial of n
#' @param acc Accumulator to make the function tail-recursive
#' @export
factorial_loop <- tailr::loop_transform(factorial)

运行devtools::check()给我这个错误:

Error in attr(e, "srcref")[[i]] : subscript out of bounds
Calls: <Anonymous> ... <Anonymous> -> collectUsage -> collectUsageFun -> walkCode -> h
Execution halted

如果我将转换的虚拟版本放入包中,我不会收到错误

dummy_transform_body <- function(expr) {
    rlang::expr({
        .tailr_n <- n
        .tailr_acc <- acc
        callCC(function(escape) {
            repeat {
                n <- .tailr_n
                acc <- .tailr_acc
                if (n <= 1)
                    escape(acc)
                else {
                    .tailr_n <<- n - 1
                    .tailr_acc <<- acc * n
                }
            }
        })
    })
}
dummy_transform <- function(fun) {
    fun_q <- rlang::enquo(fun)

    new_fun_body <- dummy_transform_body(body(fun))
    result <- rlang::new_function(
        args = formals(fun),
        body = new_fun_body,
        env = rlang::get_env(fun_q)
    )

    result
}

#' Computes the factorial.
#' @param n A number
#' @return factorial of n
#' @param acc Accumulator to make the function tail-recursive
#' @export
factorial_loop_dummy <- dummy_transform(factorial)

我没有看到这两个函数之间有任何差异,所以我很困惑为什么检查接受虚拟但不接受真实版本.

> body(factorial_loop) == body(factorial_loop_dummy)
[1] TRUE
> environment(factorial_loop)
<environment: namespace:Test>
> environment(factorial_loop_dummy)
<environment: namespace:Test>
> formals(factorial_loop)
$n


$acc


> formals(factorial_loop_dummy)
$n


$acc


> attributes(factorial_loop())
Error in factorial_loop() : argument "n" is missing, with no default
> attributes(factorial_loop)
NULL
> attributes(factorial_loop_dummy)
NULL

错误提到了属性srcref,但转换后的函数都没有任何属性.如果我显式设置srcref属性,它对错误没有帮助.

任何想法,任何人？

更新2018/03/20:

问题似乎与我的转换函数中的准引用拼接有关.如果我取消注释,!!!下面的语句,并手动插入案例factorial,那么错误就会消失.

dummy_transform_body <- function(fun_expr, info) {
    vars <- names(formals(info$fun))
    tmp_assignments <- vector("list", length = length(vars))
    locals_assignments <- vector("list", length = length(vars))
    for (i in seq_along(vars)) {
        local_var <- as.symbol(vars[[i]])
        tmp_var <- parse(text = paste(".tailr_", vars[[i]], sep = ""))[[1]]
        tmp_assignments[[i]] <- rlang::expr(rlang::UQ(tmp_var) <- rlang::UQ(local_var))
        locals_assignments[[i]] <- rlang::expr(rlang::UQ(local_var) <- rlang::UQ(tmp_var))
    }

    # this would be a nice pipeline, but it is a bit much to require
    # magrittr just for this
    fun_expr <- make_returns_explicit(fun_expr, FALSE, info)
    fun_expr <- simplify_returns(fun_expr, info)
    fun_expr <- handle_recursive_returns(fun_expr, info)
    fun_expr <- returns_to_escapes(fun_expr, info)
    fun_expr <- simplify_nested_blocks(fun_expr)

    rlang::expr({
        #!!! tmp_assignments
        .tailr_n <- n
        .tailr_acc <- acc
        callCC(function(escape) {
            repeat {
                #!!! locals_assignments
                n <<- .tailr_n
                acc <<- .tailr_acc
                !! fun_expr
                next
            }
        })
    })
}

另一个更新:

...删除了之前的更新...将拼接放在另一个bock中的黑客不再适用于我...

又一次更新......

好吧,我仍然完全不知道为什么拼接不起作用.我做了其他虚拟功能.所以如果有人有任何想法,我真的很感兴趣.在任何情况下,我设法重写我的tailr功能,以避免!!!,现在似乎工作.

    repeat_body <- as.call(
         c(`{`, locals_assignments, fun_expr, quote(next))
     )
     call_cc_stmt <- rlang::expr(
         callCC(function(escape) {
             repeat {
                 !!repeat_body
             }
         })
     )
     as.call(
         c(`{`, tmp_assignments, call_cc_stmt)
     )

这仅仅是一个很多不太优雅,生成的代码是丑陋的-但我隐藏设置srcref的原代码,所以没有人需要知道.