Implement lifetime support for thread pools

knots/thread-pool.scm

@@ -270,7 +270,7 @@ from there, or #f if that would be an empty string."
             (destructor/safe args)))))
 
   (define (process thread-index channel args)
-    (let loop ()
+    (let loop ((lifetime thread-lifetime))
       (match (get-message channel)
         ('destroy #f)
         ((reply sent-time proc)
@@ -342,7 +342,11 @@ from there, or #f if that would be an empty string."
              (if (and exception?
                       expire-on-exception?)
                  #t
-                 (loop))))))))
+                 (if lifetime
+                     (if (<= 1 lifetime)
+                         #t
+                         (loop (- lifetime 1)))
+                     (loop lifetime)))))))))
 
   (define (start-thread index channel)
     (call-with-new-thread
@@ -416,7 +420,6 @@ arguments of the thread pool procedure."
              1
              #:thread-initializer thread-initializer
              #:thread-destructor thread-destructor
-             #:thread-lifetime thread-lifetime
              #:expire-on-exception? expire-on-exception?
              #:name name
              #:use-default-io-waiters? use-default-io-waiters?))
@@ -424,6 +427,7 @@ arguments of the thread pool procedure."
           #:destructor destroy-thread-pool
           #:min-size min-size
           #:delay-logger delay-logger
+          #:lifetime thread-lifetime
           #:scheduler scheduler
           #:duration-logger duration-logger
           #:default-checkout-timeout default-checkout-timeout