A Prototype of a Condition System for R

Robert Gentleman and Luke Tierney

Introduction

This note implements a prototype for a condition system with calling and exiting handlers. It is available as a package. The package requires the dynamic variable package.

Exiting handlers provide a structured exception handling mechanism much like the one in Java. Calling handlers allow the error option and the warning mechanism to be handled as part of the system, and also allow for the creation of programmable recovery mechanisms.

Once loaded, the code in this package will take over handling of errors, both those signaled with stop and internal ones. This is accomplished using some hooks that have been added to errors.c for this purpose. These hooks are temporary and will most likely be removed once a new error handling system has been finalized. So this code requires at least R 1.3, but may stop working (and no longer be needed) with later versions of R.

There are a couple of rough edges. One is that internal errors in this package could disable the new exception handling mechanism and return to the standard one. If this happens, evaluating the expression EnableErrorHooks() should reinstate the new system. To make it easier to identify when this has occurred, the new system pre-pends an underscore to the error message, as in

> stop("A")
_Error: A
The underscore can be turned off by setting the add.error.underscore option to false:
> options(add.error.underscore=FALSE)
> stop("A")
Error: A
A proper internal implementation would avoid this issue, but it is too early for that. Adding another hook in the longjmp code would also prevent this, but that seemed excessive.

A second issue is the integration with restart and browser. For the most part these should now behave as onemight expect, (to the extent that it is clear what is expected) since error-related jumps are set to stop at intervening frames that have had restart called on them. But there may be some wrinkles here.

Interface

Conditions are unusual situations that might occur and should be addressed in some way. Errors are one example, situations that require a warning are another.

A condition system allows handlers for different kids of conditions to be registered. When an unusual situation occurs, code can signal an appropriate condition. The condition system is then responsible for finding and invoking an appropriate handler for the condition.

Condition handlers come in two flavors: exiting and calling. Exiting handlers are like catch clauses in a Java try/catch block: dynamic state is unwound and control is transferred back to the context where the handler was established (the try/catch block). Thus a non-local transfer of control (a longjmp in C terms) occurs before the handler code is executed. Calling handlers are like UNIX signal handlers. They are called in the context of the code that signaled the condition, much like an ordinary function call.

Most errors will eventually need to be handled by an exiting handler, since continuing after an error is usually not a good idea. Warnings on the other hand are often benign and should therefore typically use a calling handler. But even for errors calling handlers are useful: If you want to use a handler to enter the browser at the point where an error occurs, then a calling handler is needed.

Exiting Handlers

Exiting handlers are primarily used for handling exceptions. The mechanism implemented here is quite similar in many ways to Java's mechanism. Exceptions are objects inheriting from the abstract class exception. The class simple.exception is the class currently used by stop and all internal error signals. The constructor by the same name takes a string describing the exception as argument and an optional call and returns a simple.exception object.

> simple.exception("bad foo")
<simple.exception: bad foo>
> simple.exception("bad foo", quote(foo()))
<simple.exception in foo(): bad foo>

The function stop has been modified to accept exception objects in addition to strings as its argument:

> stop(simple.exception("bad foo"))
_Error: bad foo
> stop(simple.exception("bad foo", quote(foo())))
_Error in foo() : bad foo

The function try.catch is used to establish exiting handlers. Its usage is

try.catch(expr, ..., finally = NULL)
It evaluates its expression argument in a context where the handlers provided in the ... argument are available. Handlers are specified as
name = fun
where name specifies an exception class and fun is a function of one argument, the condition that is to be handled. When an exception is signaled, the most recently established handler that matches the exception (for which the exception inherits from the specified class) is chosen, control transfers back to the try.catch expression, the handler function is called, and the value returned by the handler function is returned by the try.catch call.

As an example, here the handler catches the exception signaled with stop and returns it:

> try.catch(stop("A"), exception = function(e) e)
<simple.exception in try.catch(stop("A"), exception = function(e) e): A>
A finally clause, if provided, will be evaluated before the try.catch call returns:
>  try.catch(stop(simple.exception("A")), exception = function(e) e,
+            finally = print("B"))
[1] "B"
<simple.exception: A>
>  try.catch("A", exception = function(e) e, finally = print("B"))
[1] "B"
[1] "A"

The handler calls and the finally expression are evaluated in the context in which try.catch was called; that is, the handlers supplied to the current try.catch call are not active during these evaluations.

Using try.catch we can define a function ignore.errors that is essentially the equivalent of try:

<establishing handlers>= (U->) [D->]
ignore.errors <- function(expr)
    try.catch(expr, exception = function(e) e)
Defines ignore.errors (links are to index).

For example,

> ignore.errors(1+2)
[1] 3
> ignore.errors(ts(1:2) + 1:3)
<simple.exception in ts(1:2) + 1:3: time-series/vector length mismatch>
Lazy evaluation is critical in making this simple definition work.

Calling Handlers

The exception hierarchy is contained in the condition hierarchy, which also includes warnings:

                    condition
                   /    |    \
                  /     |     \
                 /      |      \
                /       |       \
simple.condition    exception    warning
                        |           |
                  simple.exception  |
                                    |
                             simple.warning
The condition class is analogous to the Java Throwable class.

Exiting handlers can also be used with non-exception throwables, but calling handlers are probably more useful there. The calling handlers system is very close to the Common Lisp approach. The Dylan approach seemed a bit cleaner at first but there are too many problems with it, at least for an interactive language like R.

Conditions are signaled by signal.condition, and calling handlers get established by with.handlers. A simple example:

<example>= [D->]
f <- function() {
    n <- 0
    h <- function(c) {
        n <<- n + 1
        cat("handler call", n, "\n")
    }
    with.handlers(for (i in 1:5)
                      signal.condition("a condition"),
                  simple.condition = h)
}

produces

> f()
handler call 1 
handler call 2 
handler call 3 
handler call 4 
handler call 5 

The internal warning mechanism has been modified to signal a warning condition, so we can define a function to suppress warnings for a particular computation as

<establishing handlers>+= (U->) [<-D->]
muffle.warnings <- function(expr)
    with.handlers(expr, warning = function(w) {})
Defines muffle.warnings (links are to index).

For example,

> { warning("A"); 1+2 }
[1] 3
Warning message: 
A 
> muffle.warnings({ warning("A"); 1+2 })
[1] 3

We could also use a calling handler to enter the browser on warnings:

<browse on warnings>=
browse.on.warnings <- function(expr)
    with.handlers(expr, warning=function(w) browser())

Browse[1]> browse.on.warnings({ warning("A"); 1+2 })
Called from: h$handler(c)
Browse[2]> cont
[1] 3
Calling handlers are pushed on a stack as they are established. When a calling handler is invoked, the handler stack for the call of the handler is the portion of the handler stack below where the handler was found. A handler can therefore pass control to another handler established below it by re-signaling the condition. If a calling handler returns, then the returned value is returned from the signal call.

Recovery Mechanisms

With calling handlers we can also make available a rich structure for programmable recovery mechanisms. These will be called resets. Dylan and Common Lisp use the term restarts, but for us that would cause some confusion. The mechanism described here is based on the Common Lisp mechanism.

One reset that will always be available is the abort reset. This reset can be invoked by calling abort(). The default handler does a jump to top level, but will stop at any intervening restarts. The default error handlers call abort; establishing a new abort reset will therefore intercept their transfer of control.

The functions find.reset and compute.resets can be used to locate available resets. find.reset takes a reset name and an optional condition as arguments. The first reset matching the name and condition, if supplied, is returned. For example, we can find the first available abort reset with

> find.reset("abort")
<reset: abort >
compute.resets takes an optional condition and returns a list of resets applicable to the condition (or all resets if no condition is specified):

<example>+= [<-D->]
> compute.resets()
[[1]]
<reset: abort >

compute.resets could be used by browser or, in a GUI framework, by a menu for choosing a reset to invoke.

Resets can be invoked with invoke.reset. This takes a reset name or a reset object, as returned by find.reset for example, and any other arguments needed by the reset handler, transfers control to the point where the handler was established, and calls the handler with the specified arguments. Thus the abort function is just a convenient shorthand for

invoke.reset("abort")
or
invoke.reset(find.reset("abort"))

Resets are established using with.resets. This is called as

with.resets(expr, name1 = spec1, name2 = spec2, ...)
The spec values can take several forms. The can be a function of any number of arguments, which is used as the handler. They can be a string, which is used as a message along with a handler that ignores its arguments and returns NULL. Or they can be a list with any of the following named fields:
handler
a function of any number of arguments to be used as the handler.
test
a function of one argument, a condition, that should return a logical value indicating whether this reset is applicable to the specified condition.
message
a message that is stored in the message field of resets returned by find.reset and compute.resets. The default function returns TRUE for all conditions.
restarts.honored
a logical indicating whether or not a transfer of control should stop at any intervening call frames that have had restart called on them. The default is FALSE, but it is TRUE for the default abort reset.
interactive
a function of no arguments that returns a list of arguments to be used by invoke.restart. This is used by invoke.restart.interactively that could be called from a menu of available restarts in a GUI framework.

Here is an an outline of how this framework might be used. Suppose we are writing a function maximizer. To allow for flexible recovery when the function causes an error we might do something like this:

<resets example>=
myopt <- function(x, fun) {
    repeat {
        with.resets(return(do.opt(x, fun)),
                    restart.opt = function(new.x) x <<- new.x)
    }
}
do.opt <- function(x, fun) {
    ...
    fval <- with.resets(with.handlers(fun(x),
                                      exception = function(e)
                                      signal.condition(optfun.error(e, x))),
                        use.value = function(val) val)
    ...
}

With a call like

with.handlers(myopt(x, fun), optfun.error = function(e) browser())
we would enter the browser when calling the function to be optimized creates an error. From the browser we could then interactively decide to return a particular value, say 3, from the call with
invoke.reset("use.value", 3)
or we could restart the optimization at a new initial value with
invoke.reset("restart.opt", new.x = ...)
Alternatively, this could be handled programatically with something like
with.handlers(myopt(x, fun),
              optfun.error = function(e) {
                 if (e$x < 0)
                     invoke.reset("use.value", 3)
                 else
                     invoke.reset("restart.opt", abs(rnorm(1)))
              })

Some Issues

Minor Issues

How To Integrate The restart Function

The restart function is currently the primitive building block for error handling mechanisms. When called, it marks the frame of its function for intercepting certain transfers of control. [Currently the frame that is restarted is the one where the restart expression is evaluated. This is probably not what we want when a restart ends up in a promise.]

Conceptually there seem to be two ways to fit restart into this condition system:

Currently, in both R and Splus the error option is called even if a restart frame is on the stack---only the jump to top level is affected. This seems consistent with the second approach. This package is kind of in between. Following either would require an internal implementation.

Implementing either approach will complicate fully integrating the condition mechanism. The existence of restart in its current form also complicates the internal evaluation mechanism and makes byte code compilation harder. Since anything that can be done with restart can be done (better) with exception handling, it seems like a good idea to consider eliminating restart entirely.

To allow existing code using restart to be easily converted, we could provide a mechanism something like

<possible restart changes>= [D->]
restartable <- function(expr) {
    restart.called <- FALSE
    assign("restart", function() { restart.called <<- TRUE },
           env = parent.frame())
    repeat
        with.resets(return(eval(substitute(expr), env = parent.frame())),
                    abort = function() if (! restart.called) abort())
}
Defines restartable (links are to index).

An interpretation that makes restart insert an exception handler would use try.catch instead of with.resets. The eval(substitute(... construct is needed since the expression is potentially evaluated more than once. Perhaps a test function should be added that only makes the abort reset visible if it is active.

Using this mechanism, a function with a body that uses restart could then be re-written as

function(...) restartable(body)
For example,

<example>+= [<-D->]
f<-function(x, y = TRUE) {
    restart()
    if (y) {
        y <- FALSE
        stop("A")
    }
    else x
}

would be rewritten as

<example>+= [<-D]
new.f<-function(x, y = TRUE)
  restartable({
    restart()
    if (y) {
        y <- FALSE
        stop("A")
    }
    else x
})

To insure that code using restart is changed, we could define restart in the base package as

<possible restart changes>+= [<-D]
restart <- function()
    stop(paste("restart no longer supported.\n",
               "convert to using the exception handling system or",
               "use `restartable'")
Defines restart (links are to index).

Implementation

<simpcond.R>=
<global variables>
<call with current continuation>
<handler stack management>
<invoking handlers>
<signaling conditions>
<establishing handlers>
<condition objects>
<default handlers>
<internal error conversion>
<resets>
.First.lib <- function(lib, pkg) {
    library.dynam(pkg, pkg, lib)

    require(dynvars)
    <global variable initialization>
    EnableErrorHooks()    
}

*

<simpcond.c>=
#include "Rinternals.h"
<declarations for hooks in errors.c>
<ReturnOrRestart definition>
<JumpToToplevel definition>
<EnableExceptionHooks definition>
<PrintDeferredWarnings definition>
<GetTraceback definition>
<SetErrmessage definition>
<InternalWarningCall definition>

*

<NAMESPACE>=
import(dynvars)
export(default.handler, default.handler.warning, default.handler.exception)
export(simple.exception, simple.condition, simple.warning)
export(signal.condition, stop, warning)
export(try.catch, with.handlers, muffle.warnings, ignore.errors)
export(abort, with.resets, invoke.reset, find.reset, compute.resets)

Call With Current Continuation

For handling the transfer of control to exiting handlers we can use a simplified variant of Scheme's call with current continuation, callcc. This function is called as callcc(fun) where fun is a function of one argument. callcc calls this function with one argument, an exit function. If the exit function is not used in the body of fun, then the result returned by callcc is the result returned by fun. Calling the exit function has the effect of returning immediately from the callcc call with the argument to the exit function as the return value of the callcc call. This implementation only allows the exit function to be used within the body of fun, which makes it like a Dylan block; Scheme's call with current continuation is quite a bit more general.

We can almost implement what we need in pure R code by using a combination of environments and lazy evaluation. A pure R implementation would look like this:

<pure R implementation of call with current continuation>=
callcc <- function(fun) {
    make.thrower <- function(expr) function() expr
    value <- NULL;
    thrower <- make.thrower(return(value))
    k <- function(v) {
        value <<- v
        thrower()
    }
    fun(k)
}
Defines callcc (links are to index).

Some examples:

> callcc(function(k) 1)
[1] 1
> callcc(function(k) k(1))
[1] 1
> callcc(function(k) {k(1); 2})
[1] 1
> callcc(function(k) {on.exit(cat("A\n")); k(1); 2})
A
[1] 1
> callcc(function(k) {try(k(1)); 2})
[1] 1

The final example illustrates a problem for using this pure R approach for error handling: try is implemented with restart, and restart is supposed to catch errors but nor return's. Since we use return to implement the jump, we jump straight through the restart frame.

There does not seem to be a pure R solution to this, so there is now a hook available (at lest temporarily) that will handle this. The hook is provided by a C function declared as

<declarations for hooks in errors.c>= (U->) [D->]
void R_ReturnOrRestart(SEXP val, SEXP env, Rboolean restart);
Defines R_ReturnOrRestart (links are to index).

At the moment this declaration is not in any header files, so we need to add it to our sources. This function takes the value to return and the environment indicating the call to return from as arguments. If the third argument is true, then the jump will stop at a restarted call if there is one on the stack ahead of the target. Otherwise restarted calls are ignored, as by return. We can define .Call interfaces to these two settings:

<ReturnOrRestart definition>= (U->)
SEXP DoReturnOrRestart(SEXP val, SEXP env)
{
    R_ReturnOrRestart(val, env, TRUE);
    return R_NilValue;
}
SEXP DoReturn(SEXP val, SEXP env)
{
    R_ReturnOrRestart(val, env, FALSE);
    return R_NilValue;
}
Defines DoReturn, DoReturnOrRestart (links are to index).

Now we can modify callcc to allow exit functions to take an additional argument that specifies whether restarts on the stack are to be honored or ignored:

<call with current continuation>= (<-U)
callcc <- function(fun) {
    env <- environment()
    k <- function(v, restarts.honored = FALSE) {
        if (restarts.honored)
            .Call("DoReturnOrRestart", v, env)
        else
            .Call("DoReturn", v, env)
    }
    fun(k)
}
Defines callcc (links are to index).

Some examples:

> callcc(function(k) {try(k(1)); 2})
[1] 1
> callcc(function(k) {try(k(1, T)); 2})
[1] 2

Handler Stack Management

The handler stack is managed using a dynamic variable, handler.stack.

<global variables>= (<-U) [D->]
handler.stack <- NULL  ## place holder for .First.lib
Defines handler.stack (links are to index).

<global variable initialization>= (<-U) [D->]
handler.stack <<- dynamic.variable()
Defines handler.stack (links are to index).

The handler stack is managed as a linked list. An internal implementation could use one cons cell per handler.

<handler stack management>= (<-U) [D->]
add.to.handler.stack <- function(handler, class, exit, stack) {
    list(handler = handler, class = class, exit = exit,
         next.handler = stack)
}
Defines add.to.handler.stack (links are to index).

Default handlers can be added to the handler stack with add.default.handler.

<handler stack management>+= (<-U) [<-D]
add.default.handler <- function(handler, class)
    handler.stack(add.to.handler.stack(handler, class, NULL, handler.stack()))
Defines add.default.handler (links are to index).

Handling Conditions

Invoking handlers is done one of two ways. If the exit function in NULL then the handler is a calling handler. It is called with the handler stack bound to the rest of the handler stack below the handler called. If the exit function is not NULL then the handler is exiting. The exit function is used to transfer control to the try.catch call where the handlers was established. Restarts on the stack will be honored if the condition signaled is an exception (this also includes stopping the transfer at a browser). For calling handlers we must re-enable the internal error processing hooks just before calling the handler. For exiting handlers the hooks should ideally be re-enabled after the jump, but we need to do it here in case the jump is intercepted by a restarted call. This minimizes the chance of recursion; with an internal implementation this can be done to eliminate the chance of recursion entirely.

<invoking handlers>= (<-U) [D->]
handle.condition <- function(c) {
    h <- handler.stack()
    if (is.null(h))
         FailsafeErrorHandler(c)
    while (! is.null(h))
        if (inherits(c, h$class))
            break
        else h <- h$next.handler
    if (is.null(h)) {
        EnableErrorHooks()
        my.stop(no.condition.handler.exception(c)) #****
    }
    if (is.null(h$exit))
        dynamic.bind({
            EnableErrorHooks()
            h$handler(c)
        }, handler.stack = h$next.handler)
    else {
        restarts.honored <- inherits(c, "exception")
        result <- list(throw = TRUE, handler = h$handler, condition = c)
        EnableErrorHooks()
        h$exit(result, restarts.honored)
    }
}
Defines handle.condition (links are to index).

The fail-safe error handler should ideally be implemented internally so that transfer of control via an internal call to abort is guaranteed to happen. It will only be reached if the default exception handler fails.

<invoking handlers>+= (<-U) [<-D]
FailsafeErrorHandler <- function(c) {
    errcat("Error: error in default exception handler\n")
    EnableErrorHooks()
    abort()
}
Defines FailsafeErrorHandler (links are to index).

<internal error conversion>= (<-U) [D->]
errcat<- function(s) cat(s, file=stderr())
Defines errcat (links are to index).

Signaling Conditions

Conditions are signaled by finding and calling a handler. As a convenience, non-condition arguments are converted to simple conditions.

<signaling conditions>= (<-U) [D->]
signal.condition <- function(c) {
    if (! inherits(c, "condition"))
        c <- simple.condition(c)
    handle.condition(c)
}
Defines signal.condition (links are to index).

The stop function needs to signal a condition but it must not return. If the condition handler returns, we call abort. For now we'll define an internal version my.stop as well as redefining stop.

<signaling conditions>+= (<-U) [<-D->]
my.stop <- function(e, call. = TRUE) {
    if (! is.condition(e))
        e <- simple.exception(e, if (call.) sys.call(1) else NULL)
    signal.condition(e)
    errcat("aborting ...\n")
    abort()
}
stop <- my.stop
Defines my.stop, stop (links are to index).

The warning function currently does not include a call. argument (should it?) and seems to always include the call in its message. Again, we'll define an internal version my.warning and use it to redefine warning.

<signaling conditions>+= (<-U) [<-D]
my.warning <- function(w) {
    if (! inherits(w, "warning"))
       w <- simple.warning(w, sys.call(1))
    signal.condition(w)
}
warning <- my.warning
Defines my.warning, warning (links are to index).

Establishing Handlers

Calling handlers are established using with.handlers. The definition is quite simple.

<establishing handlers>+= (<-U) [<-D->]
with.handlers <- function(expr, ...) {
    stack <- handler.stack()
    handlers <- rev(list(...))
    classes <- names(handlers)
    for (i in seq(along = handlers))
        stack <- add.to.handler.stack(handlers[[i]], classes[i], NULL, stack)
    dynamic.bind(expr, handler.stack = stack)
}
Defines with.handlers (links are to index).

Exiting handlers are established by try.catch. A callcc call is used to obtain an exit function that will transfer control back to the try.catch call. Setting up the handlers is analogous to with.handlers. The result of the callcc call will always be wrapped in a list with a throw element to distinguish a normal return and a throw return. For an internal implementation this flag could be passed as a (thread-local) global, a field in the context structure, or the setjmp return value. The rest of the result list's fields depends on whether the result represents a normal return or a throw to a handler. For a throw the result contains the handler to call and the condition to call it with. The handler is called in the handler context that exists outside the try.catch call. The finally clause is handled by an on.exit call (which will work properly with recent changes to the R internals.

<establishing handlers>+= (<-U) [<-D]
try.catch <- function(expr, ..., finally = NULL) {
    on.exit(finally)
    result <- callcc(function(k) {
        stack <- handler.stack()
        handlers <- rev(list(...))
        classes <- names(handlers)
        for (i in seq(along = handlers))
            stack <- add.to.handler.stack(handlers[[i]], classes[i], k, stack)
        dynamic.bind(list(throw = FALSE, value = expr), handler.stack = stack)
    })
    if (result$throw)
        result$handler(result$condition)
    else
        result$value
}
Defines try.catch (links are to index).

Perhaps the finally expression should be evaluated in a try.

Condition Objects

Conditions are objects that inherit from "condition".

<condition objects>= (<-U) [D->]
is.condition <- function(c) inherits(c, "condition")
Defines is.condition (links are to index).

Two generic functions are defined on condition objects. condition.message should return the message string associated with a condition. condition.call should return the call associated with the condition, or NULL if there is none. The print method for conditions is defined in terms of these generic functions:

<condition objects>+= (<-U) [<-D->]
print.condition <- function(c, ...) {
    msg <- condition.message(c)
    call <- condition.call(c)
    class <- class(c)[1]
    if (! is.null(call))
        cat("<", class, " in ", deparse(call), ": ", msg, ">\n", sep="")
    else
        cat("<", class, ": ", msg, ">\n", sep="")
}

condition.message <- function(c) UseMethod("condition.message", c)
condition.call <- function(c) UseMethod("condition.call", c)

condition.message.condition <- function(c) c$message
condition.call.condition <- function(c) c$call
Defines condition.call, condition.call.condition, condition.message, condition.message.condition, print.condition (links are to index).

The signal.condition function will convert non-condition arguments to simple conditions by calling simple.condition. Similarly, stop converts non-condition arguments to simple exceptions and warning makes simple warnings.

<condition objects>+= (<-U) [<-D->]
simple.condition <- function(message, call = NULL) {
    class <- c("simple.condition", "condition")
    structure(list(message=as.character(message), call = call), class=class)
}

simple.exception <- function(message, call = NULL) {
    class <- c("simple.exception", "exception", "condition")
    structure(list(message=as.character(message), call = call), class=class)
}

simple.warning <- function(message, call = NULL) {
    class <- c("simple.warning", "warning", "condition")
    structure(list(message=as.character(message), call = call), class=class)
}
Defines simple.condition, simple.exception, simple.warning (links are to index).

The condition system uses one condition of its own, an exception for signaling unhandled conditions. This contains a field for recording the condition that did not have a matching handler.

<condition objects>+= (<-U) [<-D]
no.condition.handler.exception <- function(c)
    structure(list(message = paste("no condition handler for", class(c)[1]),
                   condition = c),
              class = c("no.condition.handler.exception",
                        "exception", "condition"))
Defines "no.condition.handler.exception" (links are to index).

Default Handlers

Default calling handlers are provided for exceptions and warnings. Both are provided as methods on the generic function default.handler. Defining methods for subtypes of exceptions and warnings allows the default handling to be tuned somewhat.

<default handlers>= (<-U) [D->]
default.handler <- function(e) {
    UseMethod("default.handler", e)
}
Defines default.handler (links are to index).

<global variable initialization>+= (<-U) [<-D->]
add.default.handler(default.handler, "exception")
add.default.handler(default.handler, "warning")

Default Handler For Exceptions

The default handler for exceptions reproduces at the R level much of the functionality in the errorcall and jump_to_toplevel functions in errors.c.

<default handlers>+= (<-U) [<-D->]
default.handler.exception <- function(e) {
    call <- condition.call(e)
    message <- condition.message(e)
    op <- getOption("add.error.underscore")
    if (is.null(op) || op)
        us <- "_"
    else
        us <- ""
    if (is.null(call))
        emsg <- paste(us, "Error: ", message, "\n", sep = "")
    else {
        dcall <- deparse(call)
        if (nchar(dcall) > 30)
            emsg <- paste(us, "Error in ", dcall[1], " :\n\t", message, "\n",
                          sep = "")
        else
            emsg <- paste(us, "Error in ", dcall[1], " : ", message, "\n",
                          sep = "")
    }

    seterrmessage(emsg)
    if (getOption("error.messages")) {
        errcat(emsg)
        PrintDeferredWarnings()
    }

    handler <- getOption("error")
    if (! is.null(handler))
        eval(handler, R_GlobalEnv)
    else if (! interactive()) {
        errcat("Execution halted\n")
        q("no", 1, FALSE)  # quit, no save, no .Last, status=1
    }

    tb <- getTraceback()
    tb <- trim.traceback(tb)
    assign(".Traceback", tb, env = .GlobalEnv)
    abort()
}
Defines default.handler.exception (links are to index).

To make the traceback result a little cleaner we trim off some of the leading stuff that represents the error handling code that is on the stack. We trim down at least to the leading signal.condition call. For calls generated by the internal error handling code we also trim off the next two frames.

<default handlers>+= (<-U) [<-D->]
trim.traceback <- function(t) {
    n <- length(t)
    pos <- NULL
    for (i in seq(along=t))
        if (pmatch("signal.condition(", t[[i]], 0)) {
            pos <- i
            break
        }
    if (is.null(pos))
        t
    else {
        if (pos < n - 1 &&
            pmatch("my.stop(", t[[pos + 1]], 0) &&
            pmatch("error.hook(", t[[pos + 2]], 0))
            pos <- pos + 2
        if (pos == n)
            NULL
        else
            t[(pos+1):n]
    }
}
Defines trim.traceback (links are to index).

Deferred warnings are printed by a hook into the internals provided in errors.c. This hook is temporary and hence not declared in the header files, so we need to declare it here.

<default handlers>+= (<-U) [<-D->]
PrintDeferredWarnings <- function() .Call("PrintDeferredWarnings")
Defines PrintDeferredWarnings (links are to index).

<declarations for hooks in errors.c>+= (U->) [<-D->]
void R_PrintDeferredWarnings(void);
Defines R_PrintDeferredWarnings (links are to index).

<PrintDeferredWarnings definition>= (U->)
SEXP PrintDeferredWarnings(void)
{
    R_PrintDeferredWarnings();
    return R_NilValue;
}
Defines PrintDeferredWarnings (links are to index).

The traceback is also generated by a hook function in errors.c. This hook allows us to exclude a specified number of frames on the top of the stack, but it isn't clear if this is useful.

<default handlers>+= (<-U) [<-D->]
getTraceback <- function(skip = 1)
    .Call("GetTraceback", as.integer(skip))
Defines getTraceback (links are to index).

<declarations for hooks in errors.c>+= (U->) [<-D->]
SEXP R_GetTraceback(int);
Defines R_GetTraceback (links are to index).

<GetTraceback definition>= (U->)
SEXP GetTraceback(SEXP skip)
{
    if (TYPEOF(skip) != INTSXP || LENGTH(skip) != 1)
        error("bad skip argument");
    return R_GetTraceback(INTEGER(skip)[0]);
}
Defines GetTraceback (links are to index).

Finally, the default handler needs to be able to place the error message in the internal error buffer (just for consistency with existing code---this can probably be dropped eventually, or at least it would need to be made thread-safe).

<default handlers>+= (<-U) [<-D->]
seterrmessage <- function(s)
    .C("SetErrmessage", as.character(s))
Defines seterrmessage (links are to index).

<declarations for hooks in errors.c>+= (U->) [<-D->]
void R_SetErrmessage(char *s);
Defines R_SetErrmessage (links are to index).

<SetErrmessage definition>= (U->)
void SetErrmessage(char **s)
{
    R_SetErrmessage(*s);
}
Defines SetErrmessage (links are to index).

Default Handler For Warnigs

As a temporary hack, we can use the internal code for warningcall to implement the default warning handler. We need to turn the hook off around the call. If there is an error in the call, then the hooks will be reset along with the error hook by the calls to EnableErrorHooks. There may be a flaw in this, but for now it should do.

<default handlers>+= (<-U) [<-D]
default.handler.warning <- function(w) {
    .Call("InternalWarningCall", condition.call(w), condition.message(w))
}
Defines default.handler.warning (links are to index).

<InternalWarningCall definition>= (U->)
SEXP InternalWarningCall(SEXP call, SEXP msg)
{
    if (TYPEOF(msg) != STRSXP || LENGTH(msg) != 1)
        error("invalid warning message");
    R_SetWarningHook(NULL);
    Rf_warningcall(call, "%s", CHAR(STRING_ELT(msg, 0)));
    R_SetWarningHook(warnhook);
    return R_NilValue;
}
Defines InternalWarningCall (links are to index).

Internal Error Conversion

The error handling mechanism of this package is activated by installing some hook functions. The R interface for this is EnableErrorHooks.

<internal error conversion>+= (<-U) [<-D->]
EnableErrorHooks <- function() {
    .Call("EnableExceptionHooks")
}
Defines EnableErrorHooks (links are to index).

The hooks provided in errors.c are declares as

<declarations for hooks in errors.c>+= (U->) [<-D->]
void R_SetErrorHook(void (*hook)(SEXP, char *));
void R_SetWarningHook(void (*hook)(SEXP, char *));
Defines R_SetErrorHook, R_SetWarningHook (links are to index).

Both hooks are installed by a common mechanism. They call back into R using R functions called error.hook and warning.hook, respectively.

<EnableExceptionHooks definition>= (U->)
static void hook(SEXP fun, SEXP call, char *s)
{
    SEXP expr, msg, qsym = install("quote");
    PROTECT(msg = allocVector(STRSXP, 1));
    SET_STRING_ELT(msg, 0, mkChar(s));
    PROTECT(call = LCONS(qsym, LCONS(call, R_NilValue)));
    expr = LCONS(msg, R_NilValue);
    expr = LCONS(call, expr);
    PROTECT(expr = LCONS(fun, expr));
    eval(expr, R_GlobalEnv);
    UNPROTECT(3);
}

static void errhook(SEXP call, char *s)
{
    hook(install("error.hook"), call, s);
}

static void warnhook(SEXP call, char *s)
{
    hook(install("warning.hook"), call, s);
}

SEXP EnableExceptionHooks(void)
{
    R_SetErrorHook(errhook);
    R_SetWarningHook(warnhook);
    return R_NilValue;
}
Defines EnableExceptionHooks, errhook, hook, warnhook (links are to index).

The R hook functions in turn just call my.stop and my.warn. This is all quite a lot of overhead that could be avoided in an internal implementation, but the only real issue is that it might create problems if the error being signaled is about resource exhaustion of some kind.

<internal error conversion>+= (<-U) [<-D]
error.hook <- function(call, msg)
     my.stop(simple.exception(msg, call))

warning.hook <- function(call, msg)
     my.warning(simple.warning(msg, call))
Defines error.hook, warning.hook (links are to index).

The reset mechanism needs to be able to jump to top level. The .Call interface for this is provided by JumpToToplevel.

<declarations for hooks in errors.c>+= (U->) [<-D]
void R_JumpToToplevel(Rboolean restart);
Defines R_JumpToToplevel (links are to index).

<JumpToToplevel definition>= (U->)
SEXP JumpToToplevel(SEXP restart)
{
  if (TYPEOF(restart) != LGLSXP || LENGTH(restart) != 1)
        error("bad restarts.honored argument");
  R_JumpToToplevel(LOGICAL(restart)[0]);
}
Defines R_JumpToToplevel (links are to index).

Resets

Resets are stored as objects of class reset with fields containing all the settings for the reset.

<resets>= (<-U) [D->]
make.reset <- function(name = "",
                       handler = function(...) NULL,
                       message = NULL,
                       test = function(c) TRUE,
                       interactive = function() NULL,
                       restarts.honored = FALSE) {
    structure(list(name = name, handler = handler, message = message,
                   test = test, interactive = interactive,
                   restarts.honored = restarts.honored),
              class = "reset")
}

print.reset <- function(r)
     cat(paste("<reset:", r$name, ">\n"))

is.reset <- function(x) inherits(x, "reset")
Defines is.reset, make.reset, print.reset (links are to index).

Resets are maintained in a stack. The function add.to.reset.stack creates the reset object, adds a name field to it, and also adds an exit function. The reset is then linked on the front of the specified stack.

<resets>+= (<-U) [<-D->]
add.to.reset.stack <- function(spec, name, exit, stack) {
    if (is.function(spec))
        reset <- make.reset(handler = spec)
    else if (is.character(spec))
        reset <- make.reset(message = spec)
    else if (is.list(spec))
        reset <- do.call("make.reset", spec)
    else
        stop("not a valid reset specification")
    reset$name <- name
    list(reset = reset, exit = exit, next.reset = stack)
}
Defines add.to.reset.stack (links are to index).

The reset stack is maintained as a dynamic variable. The initial stack contains a handler for abort resets that jumps to top level, but honors any restarts that might be on the stack.

<global variables>+= (<-U) [<-D]
reset.stack <- NULL  ## place holder for .First.lib
Defines reset.stack (links are to index).

<global variable initialization>+= (<-U) [<-D]
reset.stack <<- dynamic.variable(
    add.to.reset.stack(list(handler = function() {},
                            restarts.honored = TRUE),
                       "abort",
                       function(result, restarts.honored)
                           .Call("JumpToToplevel", restarts.honored),
                       NULL))
Defines reset.stack (links are to index).

The function with.resets for establishing (exiting) resets is analogous to try.catch. Since the number of arguments to the handler is not known, we need to call it with do.call. We have to first store the handler in a variable, since do.call does not allow a computed function as its first argument---it has to be a string.

<resets>+= (<-U) [<-D->]
with.resets <- function(expr, ...) {
    result <- callcc(function(k) {
        stack <- reset.stack()
        specs <- rev(list(...))
        names <- names(specs)
        for (i in seq(along = specs))
            stack <- add.to.reset.stack(specs[[i]], names[i], k, stack)
        dynamic.bind(list(throw = FALSE, value = expr), reset.stack = stack)
    })
    if (result$throw) {
        h <- result$handler
        do.call("h", result$args)
    }
    else
        result$value
}
Defines with.resets (links are to index).

find.reset walks down the reset stack looking for the first one that matches the name and accepts the condition, if one is specified.

<resets>+= (<-U) [<-D->]
find.reset <- function(name, cond = NULL) {
    r <- reset.stack()
    while (! is.null(r))
        if (name == r$reset$name && (is.null(cond) || r$reset$test(cond))) {
            res <- r$reset
            res$exit <- r$exit
            return(res)
        }
        else
            r <- r$next.reset
    NULL
}
Defines find.reset (links are to index).

Similarly, compute.restarts walks down the sestart stack and accumulates all elligible restarts into a list.

<resets>+= (<-U) [<-D->]
compute.resets <- function(cond = NULL) {
    r <- reset.stack()
    val <- NULL
    while (! is.null(r)) {
        if (is.null(cond) || r$reset$test(cond)) {
            res <- r$reset
            res$exit <- r$exit
            val <- c(val, list(res))
        }
        r <- r$next.reset
    }
    val
}
Defines compute.resets (links are to index).

invoke.restart accpets either a string, which is passed to find.restart, or a reset as its first argument. The remaining arguments, if any, are packed up as a list, along with the reset's handler and a throw flag, into a result list which is then passed to the exit function stored in the reset object. The reset object's restarts.honored field determines whether the transfer of control stops at intervening restarted call frames or not.

<resets>+= (<-U) [<-D->]
invoke.reset <- function(r, ...) {
    if (! is.reset(r))
        r <- find.reset(r)
    if (is.null(r$exit))
        stop("calling resets not supported (yet)")
    result <- list(throw = TRUE, handler = r$handler, args = list(...))
    r$exit(result, r$restarts.honored)
}
Defines invoke.reset (links are to index).

The abort function is just a simple shorthand for invoking an abort reset.

<resets>+= (<-U) [<-D->]
abort <- function()
     invoke.reset("abort")
Defines abort (links are to index).

The invoke.reset.interactively function differs from invoke.reset only in the fact that it computes the arguments for the reset handler by calling the reset's interactive function.

<resets>+= (<-U) [<-D]
invoke.reset.interactively <- function(r) {
    if (! is.reset(r))
        r <- find.reset(r)
    if (is.null(r$exit))
        stop("calling resets not supported (yet)")
    args <- r$interactive()
    result <- list(throw = TRUE, handler = r$handler, args = args)
    r$exit(result, r$restarts.honored)
}
Defines invoke.reset.interactively (links are to index).

Tests

<tests>=
.lib.loc <- c("lib",.lib.loc)
library(simpcond)
try.catch(1, finally=print("Hello"))
e<-simple.exception("test exception")
stop(e)
try.catch(stop(e), finally=print("Hello"))
try.catch(stop("fred"), finally=print("Hello"))
try.catch(stop(e), exception = function(e) e, finally=print("Hello"))
try.catch(stop("fred"),  exception = function(e) e, finally=print("Hello"))
muffle.warnings({my.warning("Hello"); 1})

Dylan Condition Handling

Dylan was designed after Common Lisp and had the opportunity to make improvements. At first glance it seemed that their condition system was as powerfull but rather simpler than the CL one because it merged restarts and conditions into a single hierarchy. Unfortunately there seems to be a problem with this approach: For this to work the handler stack must not be unwound before a handler is called, otherwise restarts established after the handler won't be available. But if the handler stack is not unwound, then it would seem that an error in the handler will cause the handler to be called again and again and ...

Just to make sure I installed mindy and ran this Dylan program:

<hello.dyl>=
module: dylan-user

define method main(name :: <string>, #rest arguments)
  let handler <error> = method (c, next)
    puts("handled the error\n");
    error(c);
  end;
  error("an error");
end;

Compile and run gives:

luke@nokomis2 ~% mindycomp hello.dyl
luke@nokomis2 ~% mindy -f hello.dbc
handled the error
handled the error
...
handled the error
Segmentation fault (core dumped)
So their design really is hosed: if there is an error in a calling handler for <error> you blow out the top.

It looks like CL got this right (or at least more so than Dylan did).