mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-22 12:30:32 +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
(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*))