# File src/library/base/R/eval.R # Part of the R package, http://www.R-project.org # # Copyright (C) 1995-2015 The R Core Team # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ .GlobalEnv <- environment() parent.frame <- function(n = 1) .Internal(parent.frame(n)) eval <- function(expr, envir = parent.frame(), enclos = if(is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv()) .Internal(eval(expr, envir, enclos)) eval.parent <- function(expr, n = 1) { p <- parent.frame(n + 1) eval(expr, p) } evalq <- function (expr, envir = parent.frame(), enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv()) .Internal(eval(substitute(expr), envir, enclos)) new.env <- function (hash = TRUE, parent = parent.frame(), size = 29L) .Internal(new.env(hash, parent, size)) parent.env <- function(env) .Internal(parent.env(env)) `parent.env<-` <- function(env, value) .Internal("parent.env<-"(env, value)) local <- function (expr, envir = new.env()) eval.parent(substitute(eval(quote(expr), envir))) Recall <- function(...) .Internal(Recall(...)) with <- function(data, expr, ...) UseMethod("with") within <- function(data, expr, ...) UseMethod("within") with.default <- function(data, expr, ...) eval(substitute(expr), data, enclos=parent.frame()) within.data.frame <- function(data, expr, ...) { parent <- parent.frame() e <- evalq(environment(), data, parent) eval(substitute(expr), e) l <- as.list(e) l <- l[!vapply(l, is.null, NA, USE.NAMES=FALSE)] ## del: variables to *del*ete from data[] nD <- length(del <- setdiff(names(data), (nl <- names(l)))) data[nl] <- l if(nD) data[del] <- if(nD == 1) NULL else vector("list", nD) data } within.list <- within.data.frame force <- function(x) x