mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

srfi-18: Inline uses of srfi-18-exception-preserver.

Browse source 
* module/srfi/srfi-18.scm (srfi-18-exception-preserver): Inline into
  call sites.
This commit is contained in:
Andy Wingo 2016-10-30 22:37:49 +01:00
parent 177a058a40
commit c3f08aa866
1 changed files with 13 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

29
module/srfi/srfi-18.scm
View file

@ -117,15 +117,11 @@
;; EXCEPTIONS ;; EXCEPTIONS
(define (initial-handler obj) (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 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) (define (srfi-18-exception-handler key . args)
;; SRFI 34 exceptions continue to bubble up no matter who handles them, so ;; SRFI 34 exceptions continue to bubble up no matter who handles them, so
@ -133,8 +129,8 @@
;; `initial-handler'. ;; `initial-handler'.
(unless (eq? key 'srfi-34) (unless (eq? key 'srfi-34)
(srfi-18-exception-preserver (set! (thread->exception (threads:current-thread))
(condition (&uncaught-exception (reason (cons key args))))))) (condition (&uncaught-exception (reason (cons key args)))))))
(define current-exception-handler (make-parameter initial-handler)) (define current-exception-handler (make-parameter initial-handler))
@ -244,14 +240,15 @@
(let ((current-handler (threads:thread-cleanup thread))) (let ((current-handler (threads:thread-cleanup thread)))
(threads:set-thread-cleanup! (threads:set-thread-cleanup!
thread thread
(if (thunk? current-handler) (let ((handler (lambda ()
(lambda () (set! (thread->exception (threads:current-thread))
(with-exception-handler initial-handler (condition (&terminated-thread-exception))))))
current-handler) (if (thunk? current-handler)
(srfi-18-exception-preserver (lambda ()
(condition (&terminated-thread-exception)))) (with-exception-handler initial-handler
(lambda () (srfi-18-exception-preserver current-handler)
(condition (&terminated-thread-exception)))))) (handler))
handler)))
(threads:cancel-thread thread) (threads:cancel-thread thread)
*unspecified*)) *unspecified*))