Add call-with-temporary-thread

knots.scm

@@ -1,10 +1,12 @@
 (define-module (knots)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 threads)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 suspendable-ports)
   #:use-module (rnrs bytevectors)
   #:use-module (fibers)
+  #:use-module (fibers channels)
   #:use-module (fibers conditions)
   #:use-module (system repl debug)
   #:export (call-with-default-io-waiters
@@ -57,6 +59,42 @@
             ;; restore original C handler.
             (sigaction SIGINT #f))))))
 
+(define (call-with-temporary-thread thunk)
+  (let ((channel (make-channel)))
+    (call-with-new-thread
+     (lambda ()
+       (call-with-default-io-waiters
+        (lambda ()
+         (with-exception-handler
+             (lambda (exn)
+               (put-message channel `(exception . ,exn)))
+           (lambda ()
+             (with-exception-handler
+                 (lambda (exn)
+                   (let ((stack
+                          (match (fluid-ref %stacks)
+                            ((stack-tag . prompt-tag)
+                             (make-stack #t
+                                         0 prompt-tag
+                                         0 (and prompt-tag 1)))
+                            (_
+                             (make-stack #t)))))
+                     (raise-exception
+                      (make-exception
+                       exn
+                       (make-knots-exception stack)))))
+               (lambda ()
+                 (call-with-values thunk
+                   (lambda values
+                     (put-message channel `(values ,@values)))))))
+           #:unwind? #t)))))
+
+    (match (get-message channel)
+      (('values . results)
+       (apply values results))
+      (('exception . exn)
+       (raise-exception exn)))))
+
 (define* (display/knots obj #:optional (port (current-output-port)))
   (put-bytevector
    port