add on.exit expr to parent call? - r

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()

Answer 2

I was intrigued by the problem and tried a couple of ways to solve it. Unfortunately, they didn't work. I'm therefore inclined to believe that it can't be done. ...But someone else might be able to prove me wrong!
Anyway, I though I'd post my failed attempts so that they are recorded. I made them so that they would print "ONEXIT!" after "Not yet!" if they worked...
1 - First, simply try to evaluate the on.exit in the parent environment:
f <- function() { eval(on.exit(cat('ONEXIT!\n')), parent.frame()); 42 }
g <- function() { x<-f(); cat('Not yet!\n'); x }
g() # Nope, doesn't work!
This doesn't work, probably because the on.exit function adds stuff to the current stack frame, not the current environment.
2 - Step up the game and try to return an expression that is evaluated by the caller:
f <- function() { quote( {on.exit(cat('ONEXIT!\n')); 42}) }
g <- function() { x<-eval(f()); cat('Not yet!\n'); x }
g() # Nope, doesn't work!
This doesn't work either, probably because eval has its own stack frame, different from g.
3 - Bring my A-game, and try to rely on lazy evaluation:
h <- function(x) sys.frame(sys.nframe())
f <- function() { h({cat('Registering\n');on.exit(cat("ONEXIT!\n"));42}) }
g <- function() { x<-f()$x; cat('Not yet!\n'); x }
g() # Worse, "ONEXIT!" is never printed...
This one returns an environment to the caller, and when the caller accesses "x" in it, the expression including on.exit is evaluated. ...But it seems on.exit does not register at all in this case.
4 - Hmm. There is one way that might still work: a .Call to some C code that calls on.exit. It might be that calling C won't add another stack frame... This is a bit too complex for me to test now, but maybe some RAPI/RCpp guru could give it a shot?

Answer 3

I remain confused, but if Tommy can't do it, I suspect I won't be able to either. This does the first task and since it seemed so simple I thought I must be missing something:
f <- function() {
on.exit(print("B"))
print("A")
}
Second effort:
txtB <- textConnection("test b")
txt <-textConnection("test A")
f <- function(con) { df <- read.table(con);
if( isOpen(txtB)){ print("B open")
eval( close(txtB), env=.GlobalEnv ) }
return(df) }
txtB #just to make sure it's still open
# description class mode text
# "\"test b\"" "textConnection" "r" "text"
# opened can read can write
# "opened" "yes" "no"
dat <- f(txt); dat
#[1] "B open"
# V1 V2
#1 test A
txtB
#Error in summary.connection(x) : invalid connection
(OK, I edited it to close a connection within the calling environment.)
So what am I missing? (It wasn't clear to me as I tested this that connections actually have environments.)

Answer 4

Though this question is quite old, there is a simple fix for any future visitors:
Use add=TRUE (I don't find the documentation very clear.)
f <- function() {
on.exit(expr = print("B"),
add = TRUE)
print("A")
}
A another solution is using withr::defer() which has more options and better documentation.
The vignette is especially helpful.