defmacro that 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 challenges readers to come up with an new defmacro that uses local variables instead of eval in the parent frame (which could be dangerous since it could modify objects in the parent frame).

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

Could 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 an object not found error.

defmacro that uses local variables in R

Answers (1)

Related Questions