Remove unused objects from a function's parent environments

Remove unused objects from a function's parent environments

prune_fcn(
  fcn,
  search = find_object(value = fcn, from = parent.frame(), which = "last")$envir,
  globals = get_globals(fcn),
  depth = 0L
)

Arguments

fcn

A function.

search

A environment, among the parents of envir, to be replaced. It is possible to specify a list of alternative environments.

globals

A named list of variables to be part of the injected environment.

depth

Depth of recursive pruning. If depth = 0L, no globals are pruned. If depth = 1L, "first-generation" functions among the globals are pruned. If depth = 2L, functions among the globals of the first-generation functions are pruned. And, so on.

Value

A pruned version of fcn, with prune_undo attribute holding an "undo" function. WARNING: Make sure to copy this attribute and then remove it before exporting the function to an external process.

Details

An already pruned function will skipped, by returning the pruned version. This works by setting attribute pruned of the injected environment (the new environment(fcn)) to TRUE, and checking for such a flag in each call to prune_fcn().

Examples

## ------------------------------------------------------------------------
## Example how to avoid huge local objects being part of a local function,
## which might be costly if the function is serialized, e.g. exported
## to a parallel workers
## ------------------------------------------------------------------------

## Call a function with the option to replace the function
## environment with a smaller temporary environment
my_do_call <- function(fcn, args = list(), envir = parent.frame(), prune = FALSE) {
  fcn_name <- as.character(substitute(fcn))
  if (prune) {
    fcn <- prune_fcn(fcn, search = find_object(value = fcn, from = envir, which = "last")$envir)
    
    ## Important: We must drop attribute 'prune_undo' before
    ## exporting object, otherwise it will carry the pruned
    ## environment as cargo
    fcn_undo <- attr(fcn, "prune_undo")
    attr(fcn, "prune_undo") <- NULL
    
    on.exit(fcn_undo())
  }
  
  do.call(fcn, args = args, envir = envir)
}

## Report on the 'fcn' size before and after pruning
trace(
  my_do_call,
  at = 3L, tracer = quote(fcn_size <- size_of(fcn)),
  exit = quote({
    if (prune) {
      message(sprintf("Size of '%s': %s bytes (%s bytes when pruned)",
                      fcn_name, fcn_size, size_of(fcn)))
    } else {
      message(sprintf("Size of '%s': %s bytes",
                      fcn_name, fcn_size))
    }
  }),
  print = FALSE
)
#> Error in assign(what, newFun, whereF): cannot add binding of 'my_do_call' to the base environment

my_fcn <- function(g = NULL, prune = FALSE) {
  cargo <- rnorm(1e6)
  
  n <- 2

  if (is.null(g)) {
    g <- local({
      pi <- 3.14
      function() n * pi
    })
  }

  my_do_call(g, prune = prune)
}


## Non-pruned function local to a function carries also large 'cargo' object
my_fcn()
#> [1] 6.28

## Pruned function local to a function without large 'cargo' object
my_fcn(prune = TRUE)
#> [1] 6.28


## WARNING: Large objects inside local environments of
##          the function will not the pruned!
g <- local({
  cargo <- rnorm(1e6)
  n <- 2
  local({
    pi <- 3.14
    function() n * pi
  })
})

my_fcn(g)
#> [1] 6.28
my_fcn(g, prune = TRUE)
#> [1] 6.28