在R中使用局部变量的defmacro

以下是以下代码：

如果运行此测试：

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

---

您将得到一个

未找到对象错误

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

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
}

但我们现在不是：

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"

建议的解决方案的问题在于，您必须注意环境（哪些函数可以看到哪些内容以及表达式的计算位置）。我觉得它作为编程工具不是很透明

---

注意：它没有解决局部变量的问题（从原始文件中）-它只是将所有内容放在单独的环境中（正如典型的R函数所做的那样）。

要在单独的环境中执行函数，您可以通过将

eval（tmp，parent.frame（））

更改为

eval来更改原始的
defmacro
（tmp，new.env（））

。生成的函数将使用参数，但不会更改它们。问题是-为什么需要这样一只没有牙齿的老虎？宏应该更改其参数。（如果这是个好主意，此处不讨论）。我认为原始文件更关注宏中的临时变量。这更复杂，因为您必须解释表达式（现在它只是传递给函数体）。我认为问题在于函数

ff

的参数是在定义

ff

本身之后引入的（在

formals（ff）=a

），因此很难从父帧复制这些值，因此

ff

实际上是通过引用传递的。您可以

eval（tmp，new.env（））

，但您将得到

objset not found

错误，因为新环境是空的。我无法重现错误。是关于同一个示例吗（setna）？啊，我的错。的确，

eval（tmp，new.env））

有效。你能写一个答案吗？我很乐意接受。我想要这个，因为我不想意外地覆盖父框架中的变量。

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
}

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