[Guile-commits] 09/17: srfi-18: Inline uses of srfi-18-exception-preserver.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit c3f08aa866f285fd944f998646b8a38c41df4575
Author: Andy Wingo <address@hidden>
Date:   Sun Oct 30 22:37:49 2016 +0100

    srfi-18: Inline uses of srfi-18-exception-preserver.
    
    * module/srfi/srfi-18.scm (srfi-18-exception-preserver): Inline into
      call sites.
---
 module/srfi/srfi-18.scm |   29 +++++++++++++----------------
 1 file changed, 13 insertions(+), 16 deletions(-)

diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm
index 8e5956b..d2a7fc0 100644
--- a/module/srfi/srfi-18.scm
+++ b/module/srfi/srfi-18.scm
@@ -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*))