#' Quotation objects.
#'
#' `quo(expr, env)` captures `expr` without evaluating, and returns a
#' qutation object. A quotation has two parts: an
#' expression `expr(q)` with an environment `env(q)`.
#'
#' (Like in writing, an 'expression' may simply be a set of words, but
#' a 'quotation' comes bundled with a citation, to reference a context
#' in which it was said.)
#'
#' A quo is parallel to a 'promise' which is the data structure R uses
#' to hold lazily evaluated arguments. A quo is different from a
#' promise because it is an immutable data object.
#'
#' As a data object, a quo does not automatically evaluate like a
#' promise, but can be evaluated explicitly with the methods [value]
#' or [force_]. A quo is immutable, so it does not mutate into a
#' "forced" state if you choose to evaluate it; instead `force_(q)`
#' returns a new object in the forced state.
#'
#' A function can capture its arguments as quotations using [`arg`].
#'
#' A [dots] object is a list of quotations.
#'
#' @export
#' @param expr An expression. For `quo` this is taken literally and
#' not evaluated. For `quo_` this is evaluated normally.
#' @param env An [environment].
#' @param force Whether to evaluate the expression and create a
#' [forced] quotation.
#' @return `quo_` and `quo` return an object of class "quotation".
#' @aliases quotation
quo <- function(expr, env = arg_env_(quote(expr), environment()), force = FALSE) {
quo_(arg_expr_(quote(expr), environment()), env = env, force = force)
}
#' @description
#' `quo_(expr, env)` is the normally evaluating version. It
#' constructs a quotation given an expression and environment.
#' @rdname quo
#' @export
#' @useDynLib nseval _quotation
quo_ <- function(expr, env, force = FALSE) {
sigil <- function() force # to indicate missing argument
if(force) {
.Call("_quotation", sigil, expr, eval(expr, env), sigil);
} else {
.Call("_quotation", env, expr, sigil, sigil);
}
}
#' @rdname quo
#' @export
env <- function(q) UseMethod("env")
#' @export
#' @useDynLib nseval _env_quotation
env.quotation <- function(q) {
.Call("_env_quotation", q)
}
#' @rdname quo
#' @export
#' @param value An updated value.
`env<-` <- function(q, value) {
UseMethod("env<-")
}
#' @exportS3Method "env<-" quotation
`env<-.quotation` <- function(q, value) {
quo_(expr(q), value);
}
#' @rdname quo
#' @export
expr <- function(q) UseMethod("expr")
#' @rdname quo
#' @export
#' @param q A quotation object.
expr.quotation <- function(q) {
.Call("_expr_quotation", q)
}
#' @rdname quo
#' @export
`expr<-` <- function(q, value) {
UseMethod("expr<-")
}
#' @exportS3Method "expr<-" quotation
`expr<-.quotation` <- function(q, value) {
quo_(value, env(q))
}
#' @rdname quo
#' @export
#' @param x Any object.
is.quotation <- function(x) {
inherits(x, "quotation")
}
#' @rdname quo
#' @export
is.quo <- function(x) {
inherits(x, "quotation")
}
#' @description
#' `as.quo(x)` converts an object into a quotation. Closures,
#' formulas, and single-element [dots] can be converted this way.
#' @return `as.quo` returns a quotation.
#' @export
#' @rdname quo
as.quo <- function(x) {
UseMethod("as.quo")
}
#' @exportS3Method as.quo "function"
as.quo.function <- function(x) {
if (is.primitive(x)) stop("can't convert primitive to quotation")
f <- formals(x)
if (length(f) != 0) {
stop("can only convert function to quotation if it has no args")
}
quo_(body(x), environment(x))
}
#' @exportS3Method as.quo quotation
as.quo.quotation <- identity
#' @exportS3Method as.quo dots
as.quo.dots <- function(x) {
if (length(x) == 1)
x[[1]]
else
stop("can't convert nonscalar dots to a quotation")
}
#' @exportS3Method as.quo formula
as.quo.formula <- function(x) {
expr <- x[[2]]
env <- attr(x, ".Environment")
quo_(expr, env)
}
#' @exportS3Method as.quo lazy
as.quo.lazy <- function(x) {
quo_(x$expr, x$env)
}
#' @exportS3Method as.quo call
as.quo.call <- function(x) {
if (.Call("_is_plausible_quotation", x)) {
structure(x, class="quotation")
} else stop("Call doesn't look like a quotation")
}
#' @exportS3Method as.quo "if"
as.quo.if <- as.quo.call
#' @exportS3Method as.quo default
as.quo.default <- function(x) {
if (mode(x) == "list") {
expr <- x$expr
env <- x$env
} else {
stop(paste0("can't convert ", class(x)[1] ," to a quo"))
}
quo_(expr, env)
}
ifnot <- function(a, why) if (!isTRUE(a)) why else a
`%&&%` <- function(a, b) if (!isTRUE(a)) a else b
#' @exportS3Method all.equal quotation
#' @importFrom methods is
all.equal.quotation <- function(target, current, ...) {
ifnot(is(current, "quotation"), "current is not a quotation") %&&%
ifnot(all.equal(expr(target), expr(current), ...),
"target, current have different expressions") %&&%
ifnot(forced(target) == forced(current), "only one is forced") %&&%
if (forced(target))
ifnot(all.equal(value(target), value(current), ...),
"target, current have different values")
else ifnot(identical(env(target), env(current)),
"target, current have different environments")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.