Code used in the reclosure tweet thread

reclosures.R

## GPL-2

## Tweet 1
## From https://github.com/djnavarro/ohno

add_with <- function(z) function(x, y) x + y + z
add_with(10)(1, 2)            # works
butcher <- function(x, y, f) {
  env <- new.env() # create a new environment
  environment(f) <- env
  f(x,y)
}
butcher(1, 2, add_with(10))   # oh no!

## Tweet 2
## Substitute an option, but not completely
## robust to pathological functions.

add_with2 <- function(z)
  eval(substitute(function(x,y) x + y + z))
butcher(1, 2, add_with2(10))  # yay

slaughter <- function(x, y, f) {
  env <- new.env()
  env[['+']] <- `-`
  environment(f) <- env
  f(x, y)
}
slaughter(1, 2, add_with2(10))

## Tweet 3
## Reclosures hold on to their enclosing env

reclosure <- function(f) {
  e <- parent.frame()
  body(f) <- bquote({
    local({
      e <- parent.env(environment())
      parent.env(e) <- .(e)
    })
    .(body(f))
  })
  f
}
add_with_rc <- function(z) {
  reclosure(function(x,y) {x + y + z})
}
butcher(1, 2, add_with_rc(10))
slaughter(1, 2, add_with_rc(10))

## Tweet 4

add_with_rc(10)

## Tweet 5

psycopath <- function(x, y, f) {
  env <- new.env()
  env[['{']] <- function(...) stop('boom smartass')
  environment(f) <- env
  f(x, y)
}
psycopath(1, 2, add_with_rc(10))

## Tweet 6

reclosure2 <- function(f) {
  e <- parent.frame()
  body(f) <- bquote(
    .(get('{'))(  # get b/c otherwise syntax highligher craps out
      .(local)(
        .(get('{'))(
          .(`<-`)(e, .(parent.env)(.(environment)(NULL))),
          .(`parent.env<-`)(e, .(e))
        )
      ),
      .(body(f))
  ) )
  f
}
add_with_rc2 <- function(z) {
  reclosure2(function(x,y) {x + y + z})
}
psycopath(1, 2, add_with_rc2(10))