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

这只是 lot 不那么优雅，生成的代码更加丑陋 - 但是我通过将srcref设置为原始代码来隐藏它，所以没有人需要知道。

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

0 个答案: