Skip to content

Commit

Permalink
Allow customizing which exception types are show-stopping
Browse files Browse the repository at this point in the history
  • Loading branch information
dpk committed Nov 2, 2024
1 parent 2781739 commit 7c3f16b
Show file tree
Hide file tree
Showing 3 changed files with 41 additions and 1 deletion.
35 changes: 35 additions & 0 deletions lib/init-7.scm
Original file line number Diff line number Diff line change
Expand Up @@ -1160,6 +1160,41 @@
(define (raise-continuable exn)
(raise (make-exception 'continuable "" exn #f #f)))

;; Support continuing certain exception types at the top level, but
;; still allow their subtypes to define themselves as serious and
;; require exiting
(define non-serious-exception-predicates '())
(define serious-exception-predicates '())

(define (register-non-serious-exception-predicate! pred)
(set! non-serious-exception-predicates (cons pred non-serious-exception-predicates)))
(define (register-serious-exception-predicate! pred)
(set! serious-exception-predicates (cons pred serious-exception-predicates)))

(define (default-exception-handler exn)
(%with-exception-handler
#f
(lambda ()
(define continuable-exception?
(and (exception? exn)
(eq? 'continuable (exception-kind exn))))
(define underlying-exn
(if continuable-exception?
(exception-irritants exn)
exn))
(if (and continuable-exception?
(find (lambda (f) (f underlying-exn))
non-serious-exception-predicates))
(if (find (lambda (f) (f underlying-exn))
serious-exception-predicates)
(raise underlying-exn)
(begin
(display "NON-SERIOUS EXCEPTION: " (current-error-port))
(write underlying-exn (current-error-port))
(display "\n" (current-error-port))))
(raise underlying-exn)))))
(current-exception-handler default-exception-handler)

(cond-expand
(threads
(define (%with-exception-handler handler thunk)
Expand Down
3 changes: 3 additions & 0 deletions lib/srfi/35/internal.scm
Original file line number Diff line number Diff line change
Expand Up @@ -204,6 +204,9 @@
(define-condition-type/constructor &error &serious
make-error error?)

(register-non-serious-exception-predicate! condition?)
(register-serious-exception-predicate! serious-condition?)

;; (chibi repl) support
(define-method (repl-print-exception (exn condition?) (out output-port?))
(define components (simple-conditions exn))
Expand Down
4 changes: 3 additions & 1 deletion lib/srfi/35/internal.sld
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,9 @@
(scheme write)
(only (chibi)
slot-ref
is-a?)
is-a?
register-non-serious-exception-predicate!
register-serious-exception-predicate!)
(only (chibi repl) repl-print-exception)
(only (chibi generic) define-method)
;; don’t let people go messing with a compound condition
Expand Down

0 comments on commit 7c3f16b

Please sign in to comment.