Question

以下是http://cran.r-project.org/doc/Rnews/Rnews_2001-3.pdf的代码：

defmacro <- function(..., expr){
    expr <- substitute(expr)
    a <- substitute(list(...))[-1]
    ## process the argument list
    nn <- names(a)
    if (is.null(nn)) nn <- rep("", length(a))
    nn
    for(i in seq(length=length(a))) {
        if (nn[i] == "") {
            nn[i] <- paste(a[[i]])
            msg <- paste(a[[i]], "not supplied")
            a[[i]] <- substitute(stop(foo),
                    list(foo = msg))
            print(a)
        }
    }
    names(a) = nn
    a = as.list(a)
    ff = eval(substitute( 
                    function() { 
                        tmp = substitute(body)
#                       # new environment to eval expr
#                       private_env = new.env()
#                       pf = parent.frame()
#                       for(arg_name in names(a)) {
#                           private_env[[a]] = pf[[a]]
#                       }
#                       eval(tmp, private_env)
                        eval(tmp, parent.frame())
                    }, 
                    list(body = expr)))
    formals(ff) = a
    mm = match.call()
    mm$expr = NULL
    mm[[1]] = as.name("macro")
    mm_src = c(deparse(mm), deparse(expr))
    attr(ff, "source") = mm_src
    ff
}
setna = defmacro(a, b, values, expr = {a$b[a$b %in% values] = NA; a})
dat = data.frame(x = 1:4, y = rep(-9, 4))
setna(dat, y, -9)
dat

作者质疑读者想出一个新的defmacro，它在父框架中使用局部变量而不是eval（这可能是危险的，因为它可以修改父框架中的对象）。

我尝试创建一个新环境并从父环境中复制变量，并在那里评估函数体（代码注释掉），但结果是它根本没有评估体。

有人可以帮忙吗？

@bergant建议eval(tmp, new.env())会这样做，而且当宏没有嵌套时它确实有效，但是我们遇到了一个问题：

#' TODO: doc
#' @export 
defmacro <- function(..., expr){
    expr <- substitute(expr)
    a <- substitute(list(...))[-1]
    ## process the argument list
    nn <- names(a)
    if (is.null(nn)) nn <- rep("", length(a))
    nn
    for(i in seq(length=length(a))) {
        if (nn[i] == "") {
            nn[i] <- paste(a[[i]])
            msg <- paste(a[[i]], "not supplied")
            a[[i]] <- substitute(stop(foo),
                    list(foo = msg))
            print(a)
        }
    }
    names(a) = nn
    a = as.list(a)
    ff = eval(substitute( 
                    function() { 
                        tmp = substitute(body)
                        eval(tmp, parent.frame())
                    }, 
                    list(body = expr)))
    formals(ff) = a
    mm = match.call()
    mm$expr = NULL
    mm[[1]] = as.name("macro")
    mm_src = c(deparse(mm), deparse(expr))
    attr(ff, "source") = mm_src
    ff
}


#' IfLen macro
#' 
#' Check whether a object has non-zero length, and 
#' eval expression accordingly.
#' 
#' @param df An object which can be passed to \code{length}
#' @param body1 If \code{length(df)} is not zero, then this clause is evaluated, otherwise, body2 is evaluated.
#' @param body2 See above.
#' 
#' @examples 
#' ifLen(c(1, 2), { print('yes!') }, {print("no!")})
#' 
#' @author kaiyin
#' @export
ifLen = defmacro(df, body1, body2 = {}, expr = {
            if(length(df) != 0) {
                body1
            } else {
                body2
            }
        })

#' IfLet macro
#' 
#' Eval expression x, assign it to a variable, and if that is TRUE, continue
#' to eval expression1, otherwise eval expression2. Inspired by the clojure 
#' \code{if-let} macro.
#' 
#' @param sym_str a string that will be converted to a symbol to hold value of \code{x}
#' @param x the predicate to be evalueated, and to be assigned to a temporary variable as described in \code{sym_str}
#' @param body1 expression to be evaluated when the temporary variable is TRUE.
#' @param body2 expression to be evaluated when the temporary variable is FALSE.
#' 
#' @examples 
#' ifLet(..temp.., TRUE, {print(paste("true.", as.character(..temp..)))}, 
#'      {print(paste("false.", as.character(..temp..)))})
#' ifLet("..temp..", TRUE, {print(paste("true.", as.character(..temp..)))}, 
#'      {print(paste("false.", as.character(..temp..)))})
#' 
#' @author kaiyin
#' @export
ifLet = defmacro(sym_str, x, body1, body2={}, expr = {
            stopifnot(is.character(sym_str))
            stopifnot(length(sym_str) == 1)
            assign(sym_str, x)
            if(eval(as.symbol(sym_str))) {
                body1
            } else {
                body2
            }
        })

#
#setMethod("ifLet",
#       signature(sym = "character", x = "ANY", body1 = "ANY", body2 = "ANY"),
#       function(sym, x, body1, body2 = {}) {
#           e = new.env()
#           sym_str = deparse(substitute(sym))
#           ifLet(sym_str, x, body1, body2)
#       })
#
##' TODO: doc
##' @export
#setMethod("ifLet",
#       signature(sym = "character", x = "ANY", body1 = "ANY", body2 = "ANY"),
#       function(sym, x, body1, body2 = {}) {
#           stopifnot(length(sym) == 1)
#           e = new.env()
#           assign(sym, x, envir = e)
#           if(e[[sym]]) {
#               eval(substitute(body1), e, parent.frame())
#           } else {
#               eval(substitute(body2), e, parent.frame())
#           }
#       })










#' IfLetLen macro
#' 
#' Similar to ifLet, but conditioned on whether the length of 
#' the result of \code{eval(x)} is 0.
#' 
#' 
#' @param x the predicate to be evalueated, and to be assigned to a temporary var called \code{..temp..}
#' @param body1 expression to be evaluated when \code{..temp..} is TRUE.
#' @param body2 expression to be evaluated when \code{..temp..} is FALSE.
#' 
#' @examples 
#' ifLetLen("..temp..", 1:3, {print(paste("true.", as.character(..temp..)))}, 
#'      {print(paste("false.", as.character(..temp..)))})
#' 
#' @author kaiyin
#' @export
ifLetLen = defmacro(sym_str, x, body1, body2={}, expr = {
            stopifnot(is.character(sym_str))
            stopifnot(length(sym_str) == 1)
            assign(sym_str, x)
            ifLen(eval(as.symbol(sym_str)), {
                body1
            }, {
                body2
            })
        })

如果您运行此测试：

ifLetLen("..temp..", 1:3, {print(paste("true.", as.character(..temp..)))}, 
        {print(paste("false.", as.character(..temp..)))})

您将获得object not found error。

Answer 1

您可以将环境作为属性添加到defmacro：

defmacro <- function(..., expr, env = parent.frame()){
  expr <- substitute(expr)
  a <- substitute(list(...))[-1]
  ## process the argument list
  nn <- names(a)
  if (is.null(nn)) nn <- rep("", length(a))
  nn
  for(i in seq(length=length(a))) {
    if (nn[i] == "") {
      nn[i] <- paste(a[[i]])
      msg <- paste(a[[i]], "not supplied")
      a[[i]] <- substitute(stop(foo),
                           list(foo = msg))
      print(a)
    }
  }
  names(a) = nn
  a = as.list(a)
  ff = eval(substitute( 
    function() { 
      tmp = substitute(body)
      eval(tmp, env)
    }, 
    list(body = expr)))
  formals(ff) = a
  mm = match.call()
  mm$expr = NULL
  mm[[1]] = as.name("macro")
  mm_src = c(deparse(mm), deparse(expr))
  attr(ff, "source") = mm_src
  ff
}

我们在这里使用new.env：

ifLen = defmacro(df, body1, body2 = {}, expr = {
  if(length(df) != 0) {
    body1
  } else {
    body2
  }
}, env = new.env())

但在这里我们不是：

ifLetLen = defmacro(sym_str, x, body1, body2={}, expr = {
  stopifnot(is.character(sym_str))
  stopifnot(length(sym_str) == 1)
  assign(sym_str, x)
  ifLen(eval(as.symbol(sym_str)), {
    body1
  }, {
    body2
  })
})

ifLetLen("..temp..", 1:3, {print(paste("true.", as.character(..temp..)))}, 
     {print(paste("false.", as.character(..temp..))); xxx <- 69})

# [1] "true. 1" "true. 2" "true. 3"

第一个例子：

setna = defmacro(a, b, values, expr = {a$b[a$b %in% values] = NA; a}, env = new.env())
dat = data.frame(x = 1:4, y = rep(-9, 4))

> setna(dat, y, -9)
#   x  y
# 1 1 NA
# 2 2 NA
# 3 3 NA
# 4 4 NA
> dat
#   x  y
# 1 1 -9
# 2 2 -9
# 3 3 -9
# 4 4 -9

提出的解决方案的问题在于您必须关注环境（什么功能和表达式评估的位置可见）。我认为它不是一个非常透明的编程工具。

注意：它没有解决局部变量的问题（来自原始论文） - 它只是把所有东西放在不同的环境中（就像典型的R函数一样）。

在R中使用局部变量的defmacro

1 个答案: