mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 04:40:29 +02:00
srfi-18: Inline uses of srfi-18-exception-preserver.
* module/srfi/srfi-18.scm (srfi-18-exception-preserver): Inline into call sites.
This commit is contained in:
parent
177a058a40
commit
c3f08aa866
1 changed files with 13 additions and 16 deletions
|
@ -117,15 +117,11 @@
|
|||
;; EXCEPTIONS
|
||||
|
||||
(define (initial-handler obj)
|
||||
(srfi-18-exception-preserver (condition (&uncaught-exception (reason obj)))))
|
||||
(set! (thread->exception (threads:current-thread))
|
||||
(condition (&uncaught-exception (reason obj)))))
|
||||
|
||||
(define thread->exception (make-object-property))
|
||||
|
||||
(define (srfi-18-exception-preserver obj)
|
||||
(when (or (terminated-thread-exception? obj)
|
||||
(uncaught-exception? obj))
|
||||
(set! (thread->exception (threads:current-thread)) obj)))
|
||||
|
||||
(define (srfi-18-exception-handler key . args)
|
||||
|
||||
;; SRFI 34 exceptions continue to bubble up no matter who handles them, so
|
||||
|
@ -133,8 +129,8 @@
|
|||
;; `initial-handler'.
|
||||
|
||||
(unless (eq? key 'srfi-34)
|
||||
(srfi-18-exception-preserver
|
||||
(condition (&uncaught-exception (reason (cons key args)))))))
|
||||
(set! (thread->exception (threads:current-thread))
|
||||
(condition (&uncaught-exception (reason (cons key args)))))))
|
||||
|
||||
(define current-exception-handler (make-parameter initial-handler))
|
||||
|
||||
|
@ -244,14 +240,15 @@
|
|||
(let ((current-handler (threads:thread-cleanup thread)))
|
||||
(threads:set-thread-cleanup!
|
||||
thread
|
||||
(if (thunk? current-handler)
|
||||
(lambda ()
|
||||
(with-exception-handler initial-handler
|
||||
current-handler)
|
||||
(srfi-18-exception-preserver
|
||||
(condition (&terminated-thread-exception))))
|
||||
(lambda () (srfi-18-exception-preserver
|
||||
(condition (&terminated-thread-exception))))))
|
||||
(let ((handler (lambda ()
|
||||
(set! (thread->exception (threads:current-thread))
|
||||
(condition (&terminated-thread-exception))))))
|
||||
(if (thunk? current-handler)
|
||||
(lambda ()
|
||||
(with-exception-handler initial-handler
|
||||
current-handler)
|
||||
(handler))
|
||||
handler)))
|
||||
(threads:cancel-thread thread)
|
||||
*unspecified*))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue