add on.exit expr to parent call?

Question

Is it possible to add an on.exit expr to the parent call? If so, how?

For example, say that parentOnExit(expr) is a function implementing this. Then for the following code:

f <- function() {
  parentOnExit(print("B"))
  print("A")
}

I want to see "A" printed, then "B".

Background: What brought this to mind was the following... we have a collection of functions, some of which call others, which require a resource that should be shared from the topmost call down and which also should be closed upon exiting the topmost function. Eg, a connection to a remote server which is expensive to open. One pattern for this is:

foo <- function(r=NULL) {
  if (is.null(r)) {  # If we weren't passed open connection, open one
    r <- openR()
    on.exit(close(r))
  }
  bar(r=r)  # Pass the open connection down
}

I was hoping to abstract those three lines down to:

r <- openIfNull(r)  # Magically call on.exit(close(r)) in scope of caller

Now that I think about it though, perhaps it's worth some repeated code to avoid anything too magical. But still I'm curious about the answer to my original question. Thank you!

Answer 1

I have seen in this recent mail discussion (https://stat.ethz.ch/pipermail/r-devel/2013-November/067874.html) that you can use do.call for this:

f <- function() { do.call("on.exit", list(quote(cat('ONEXIT!\n'))), envir = parent.frame()); 42 }
g <- function() { x <- f(); cat('Not yet!\n'); x }
g()
#Not yet!
#ONEXIT!
#[1] 42

Using this feature and an additional ugly trick to pass the R connection object to the caller environment, it seems to solve the problem:

openR <- function(id = "connection1") {
  message('openR():', id)
  list(id)
}

closeR <- function(r) {
  message('closeR():', r[[1]]) 
}

openRIfNull <- function(r) {
  if (length(r)) return(r)
  # create the connection
  r <- openR("openRIfNull")
  # save it in the parent call environment
  parent_env <- parent.frame()
  assign("..openRIfNull_r_connection..", r, envir = parent_env)
  
  do.call("on.exit", list(quote(closeR(..openRIfNull_r_connection..))), envir = parent_env)
  
  r
}

foo <- function(r = NULL) {
  message('entered foo()')
  r <- openRIfNull(r)
  bar(r = r)  # Pass the open connection down
  message('exited foo()')
}

bar <- function(r) {
  message('bar()')
}

example use:

foo()
# entered foo()
# openR():openRIfNull
# bar()
# exited foo()
# closeR():openRIfNull

foo(openR('before'))
# entered foo()
# openR():before
# bar()
# exited foo()