Defmacro, which uses local variables in R

Question

Here is the code from 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 

The author forces readers to come up with a new defmacro that uses local variables instead of eval in the parent frame (which can be dangerous because it can modify objects in the parent frame).

I tried to create a new environment and copy the variables from the parent environment, and the eval body of the function is there (the code is commented out), but the result is that it does not analyze the body at all.

Can anyone help?

@bergant suggests that eval(tmp, new.env()) will do, and indeed, it works when macros are not nested, but here we have a problem:

 #' 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 }) }) 

If you run this test:

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

You will get object not found error .

Answer 1

You can add the environment as an attribute to 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 } 

Here we use new.env :

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

But here we do not have:

 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" 

First example:

 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) # xy # 1 1 NA # 2 2 NA # 3 3 NA # 4 4 NA > dat # xy # 1 1 -9 # 2 2 -9 # 3 3 -9 # 4 4 -9 

The problem with the proposed solution is that you have to take care of the environments (which shows which function and where the expressions are evaluated). I do not consider it very transparent as a programming tool.

Note. This does not solve the problem of local variables (from the original article) - it just puts everything in a separate environment (since typical R functions are all the same).