macros - defmacro that uses local variables in R -
here code http://cran.r-project.org/doc/rnews/rnews_2001-3.pdf :
defmacro <- function(..., expr){ expr <- substitute(expr) <- substitute(list(...))[-1] ## process 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 = as.list(a) ff = eval(substitute( function() { tmp = substitute(body) # # new environment 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) = 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 come new defmacro uses local variables instead of eval in parent frame (which dangerous since modify objects in parent frame).
i tried create new environment , copy variables parent environment, , eval function body there (code commented out), result not eval body @ all.
could help?
@bergant suggests eval(tmp, new.env()) do, , indeed works when macros not nested, here have problem:
#' todo: doc #' @export defmacro <- function(..., expr){ expr <- substitute(expr) <- substitute(list(...))[-1] ## process 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 = as.list(a) ff = eval(substitute( function() { tmp = substitute(body) eval(tmp, parent.frame()) }, list(body = expr))) formals(ff) = 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 object has non-zero length, , #' eval expression accordingly. #' #' @param df object can passed \code{length} #' @param body1 if \code{length(df)} not zero, clause evaluated, otherwise, body2 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 variable, , if true, continue #' eval expression1, otherwise eval expression2. inspired clojure #' \code{if-let} macro. #' #' @param sym_str string converted symbol hold value of \code{x} #' @param x predicate evalueated, , assigned temporary variable described in \code{sym_str} #' @param body1 expression evaluated when temporary variable true. #' @param body2 expression evaluated when temporary variable 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 iflet, conditioned on whether length of #' result of \code{eval(x)} 0. #' #' #' @param x predicate evalueated, , assigned temporary var called \code{..temp..} #' @param body1 expression evaluated when \code{..temp..} true. #' @param body2 expression evaluated when \code{..temp..} 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 run test:
ifletlen("..temp..", 1:3, {print(paste("true.", as.character(..temp..)))}, {print(paste("false.", as.character(..temp..)))}) you object not found error.
you add environment attribute defmacro:
defmacro <- function(..., expr, env = parent.frame()){ expr <- substitute(expr) <- substitute(list(...))[-1] ## process 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 = as.list(a) ff = eval(substitute( function() { tmp = substitute(body) eval(tmp, env) }, list(body = expr))) formals(ff) = 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 use new.env:
iflen = defmacro(df, body1, body2 = {}, expr = { if(length(df) != 0) { body1 } else { body2 } }, env = new.env()) but here not:
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" the 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) # 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 the problem proposed solution have take care environments (what visible function , expressions evaluate). don't find transparent programming tool.
note: doesn't solve problem of local variables (from original paper) - puts in separate environment (as typical r functions anyhow).
Comments
Post a Comment