下面是从代码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
笔者鼓励读者想出了使用本地变量，而不是EVAL在父帧（这可能是危险的，因为它可以在父框架修改对象）的新defmacro。
我试图创建一个新的环境，并从父环境复制变量，和eval函数体有（代码注释掉），但结果是，它不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 。
