mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
Allow customizing which exception types are show-stopping
This commit is contained in:
parent
2781739291
commit
7c3f16be8f
3 changed files with 41 additions and 1 deletions
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue