From c3f08aa866f285fd944f998646b8a38c41df4575 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sun, 30 Oct 2016 22:37:49 +0100
Subject: [PATCH] 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 8e5956bcf..d2a7fc018 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*))