mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +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)
|
(define (raise-continuable exn)
|
||||||
(raise (make-exception 'continuable "" exn #f #f)))
|
(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
|
(cond-expand
|
||||||
(threads
|
(threads
|
||||||
(define (%with-exception-handler handler thunk)
|
(define (%with-exception-handler handler thunk)
|
||||||
|
|
|
@ -204,6 +204,9 @@
|
||||||
(define-condition-type/constructor &error &serious
|
(define-condition-type/constructor &error &serious
|
||||||
make-error error?)
|
make-error error?)
|
||||||
|
|
||||||
|
(register-non-serious-exception-predicate! condition?)
|
||||||
|
(register-serious-exception-predicate! serious-condition?)
|
||||||
|
|
||||||
;; (chibi repl) support
|
;; (chibi repl) support
|
||||||
(define-method (repl-print-exception (exn condition?) (out output-port?))
|
(define-method (repl-print-exception (exn condition?) (out output-port?))
|
||||||
(define components (simple-conditions exn))
|
(define components (simple-conditions exn))
|
||||||
|
|
|
@ -6,7 +6,9 @@
|
||||||
(scheme write)
|
(scheme write)
|
||||||
(only (chibi)
|
(only (chibi)
|
||||||
slot-ref
|
slot-ref
|
||||||
is-a?)
|
is-a?
|
||||||
|
register-non-serious-exception-predicate!
|
||||||
|
register-serious-exception-predicate!)
|
||||||
(only (chibi repl) repl-print-exception)
|
(only (chibi repl) repl-print-exception)
|
||||||
(only (chibi generic) define-method)
|
(only (chibi generic) define-method)
|
||||||
;; don’t let people go messing with a compound condition
|
;; don’t let people go messing with a compound condition
|
||||||
|
|
Loading…
Add table
Reference in a new issue