A Prototype of a Condition System for R

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

> options(add.error.underscore=FALSE)
> stop("A")
Error: A

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)

name = fun

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>

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

Calling Handlers

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

                    condition
                   /    |    \
                  /     |     \
                 /      |      \
                /       |       \
simple.condition    exception    warning
                        |           |
                  simple.exception  |
                                    |
                             simple.warning

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

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 >

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

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

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

with.resets(expr, name1 = spec1, name2 = spec2, ...)

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

invoke.reset("use.value", 3)

invoke.reset("restart.opt", new.x = ...)

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

• The interface for resets may not be quite the right interface since it is a bit too string-based to work well with name spaces, but it should end up something along these lines.

• One useful change would be to allow browser to take an optional condition argument that represents the condition, if any, that triggered the browser call.

• Things like the y/n/c options given by q(), and the internal exit code, could be handled with resets and conditions as well.

• The resets described here are all exiting. Common Lisp also allows for calling restarts (as they are called there). There are a few useful examples, but I'm not sure we need them in R. Might not hurt though. Since they are rare, we could maybe use with.calling.resets as the interface.

• Things like signal handling and process exiting could be changed to use this stuff.

• Some language is probably needed someplace to make it clear that a handler for exceptions should always end by calling abort.

• We need to improve the implementation so it is not possible to drop out of the system or get into a recursive error loop. Neither is very likely but both may be possible.

• We need some test code for the non-local control transfers in R.

How To Integrate The restart Function

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

• restart inserts an exiting exception handler into the handler stack that swallows the exception. Thus every function can be viewed as having a body that looks like this:

  try.catch(body, exception = function(e) if (! restart.called) stop(e))
  

• restart inserts an abort reset into the reset stack, so the body of a function looks like

  with.resets(body, abort = function() if (! restart.called) abort())
  

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)

<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

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

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

<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

<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

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

<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

<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

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

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)

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

• <browse on warnings>: D1
• <call with current continuation>: U1, D2
• <condition objects>: U1, D2, D3, D4, D5
• <declarations for hooks in errors.c>: U1, D2, D3, D4, D5, D6, D7
• <default handlers>: U1, D2, D3, D4, D5, D6, D7, D8
• <EnableExceptionHooks definition>: U1, D2
• <establishing handlers>: D1, D2, U3, D4, D5
• <example>: D1, D2, D3, D4
• <GetTraceback definition>: U1, D2
• <global variable initialization>: U1, D2, D3, D4
• <global variables>: U1, D2, D3
• <handler stack management>: U1, D2, D3
• <hello.dyl>: D1
• <internal error conversion>: U1, D2, D3, D4
• <InternalWarningCall definition>: U1, D2
• <invoking handlers>: U1, D2, D3
• <JumpToToplevel definition>: U1, D2
• <NAMESPACE>: D1
• <possible restart changes>: D1, D2
• <PrintDeferredWarnings definition>: U1, D2
• <pure R implementation of call with current continuation>: D1
• <resets>: U1, D2, D3, D4, D5, D6, D7, D8, D9
• <resets example>: D1
• <ReturnOrRestart definition>: U1, D2
• <SetErrmessage definition>: U1, D2
• <signaling conditions>: U1, D2, D3, D4
• <simpcond.c>: D1
• <simpcond.R>: D1
• <tests>: D1

• abort: U1, U2, U3, U4, U5, U6, U7, D8
• add.default.handler: D1, U2
• add.to.handler.stack: D1, U2, U3, U4
• add.to.reset.stack: D1, U2, U3
• callcc: D1, D2, U3, U4
• compute.resets: U1, U2, D3
• condition.call: D1, U2, U3
• condition.call.condition: D1
• condition.message: D1, U2, U3
• condition.message.condition: D1
• default.handler: U1, U2, D3, U4, U5, U6
• default.handler.exception: U1, D2
• default.handler.warning: U1, D2
• DoReturn: D1, U2
• DoReturnOrRestart: D1, U2
• EnableErrorHooks: U1, U2, U3, D4
• EnableExceptionHooks: U1, D2
• errcat: U1, D2, U3, U4
• errhook: D1
• error.hook: U1, U2, D3
• FailsafeErrorHandler: U1, D2
• find.reset: U1, D2, U3, U4
• getTraceback: U1, D2
• GetTraceback: U1, D2
• handle.condition: D1, U2
• handler.stack: D1, D2, U3, U4, U5, U6, U7
• hook: U1, U2, D3, U4
• ignore.errors: D1, U2
• InternalWarningCall: U1, D2
• invoke.reset: U1, D2, U3, U4
• invoke.reset.interactively: D1
• is.condition: U1, D2
• is.reset: D1, U2, U3
• make.reset: D1, U2
• muffle.warnings: D1, U2, U3
• my.stop: U1, D2, U3, U4
• my.warning: D1, U2, U3
• "no.condition.handler.exception": D1
• print.condition: D1
• PrintDeferredWarnings: U1, D2, D3
• print.reset: D1
• reset.stack: U1, D2, D3, U4, U5, U6
• restart: U1, U2, U3, U4, D5, U6, U7, U8
• restartable: D1, U2
• R_GetTraceback: D1, U2
• R_JumpToToplevel: D1, D2
• R_PrintDeferredWarnings: D1, U2
• R_ReturnOrRestart: D1, U2
• R_SetErrmessage: D1, U2
• R_SetErrorHook: D1, U2
• R_SetWarningHook: U1, D2, U3
• seterrmessage: U1, D2
• SetErrmessage: U1, D2
• signal.condition: U1, U2, U3, D4, U5, U6, U7
• simple.condition: U1, U2, U3, D4
• simple.exception: U1, U2, D3, U4, U5
• simple.warning: U1, U2, D3, U4
• stop: U1, U2, U3, U4, U5, D6, U7, U8, U9, U10, U11, U12
• trim.traceback: U1, D2
• try.catch: U1, U2, D3, U4
• warnhook: U1, D2
• warning: U1, U2, U3, D4, U5, U6, U7, U8, U9, U10, U11
• warning.hook: U1, D2
• with.handlers: U1, U2, U3, U4, U5, D6
• with.resets: U1, U2, U3, D4