activeBindingFunction.R

makeDelayedBinding <- function(sym,
                               expr,
                               eval.env = parent.frame(1),
                               assign.env = parent.frame(1)) {
  expr <- substitute(expr)

  value <- NULL
  forced <- FALSE

  forceDelayed <- function() {
    if (!forced) {
      value <- eval(expr, eval.env)
      eval.env <<- NULL # Release env for gc
      forced <<- TRUE
    }

    value
  }
  class(forceDelayed) <- c("forceDelayed", "function")

  makeActiveBinding(sym, forceDelayed, assign.env)
}

# By default, returns `FALSE` if the delayed binding has been forced.
# Pass `forced = NULL` if state doesn't matter, or `forced = TRUE`
# to return `TRUE` if the delayed binding has been forced.
bindingIsDelayed <- function(sym, env, forced = FALSE) {
  if (!bindingIsActive(sym, env)) {
    return(FALSE)
  }
  
  fn <- activeBindingFunction(sym, env)

  if (!inherits(fn, "forceDelayed"))) {
    return(FALSE)
  }

  is.null(forced) || identical(get("forced", envir = environment(fn)), forced)
}

# Can use the accessors on any delayed binding, forced or not.
# If delayed binding is forced, the environment is NULL.
delayedBindingExpression <- function(sym, env) {
  stopifnot(bindingIsDelayed(sym, env, forced = NULL))
  fn <- activeBindingFunction(sym, env)
  get("expr", envir = environment(fn))
}
delayedBindingEnvironment <- function(sym, env) {
  stopifnot(bindingIsDelayed(sym, env, forced = NULL))
  fn <- activeBindingFunction(sym, env)
  get("eval.env", envir = environment(fn))
}

activeBindingFunction() would throw if not applied of an active binding. Safe usage would be:

if (bindingIsActive(sym, env) {
  activeBindingFunction(sym, env)
}