Update Guile Knots

guix-data-service/jobs/load-new-guix-revision.scm

@@ -42,9 +42,9 @@
   #:use-module (knots)
   #:use-module (knots queue)
   #:use-module (knots promise)
+  #:use-module (knots thread-pool)
   #:use-module (knots parallelism)
   #:use-module (knots resource-pool)
-  #:use-module (knots worker-threads)
   #:use-module (guix monads)
   #:use-module (guix base32)
   #:use-module (guix store)
@@ -2271,19 +2271,17 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
                                  #:key skip-system-tests? parallelism
                                  extra-inferior-environment-variables)
   (define call-with-utility-thread
-    (let* ((worker-thread-set
+    (let* ((thread-pool
             (call-with-default-io-waiters
              (lambda ()
-               (make-worker-thread-set
-                (const '())
-                #:parallelism parallelism))))
+               (make-thread-pool parallelism))))
            (queued-channel
             ;; There might be high demand for this, so order the requests
             (spawn-queueing-fiber
-             (worker-thread-set-channel worker-thread-set))))
+             (thread-pool-channel thread-pool))))
       (lambda (thunk)
-        (call-with-worker-thread
-         worker-thread-set
+        (call-with-thread
+         thread-pool
          thunk
          #:channel queued-channel))))
 
@@ -2804,7 +2802,7 @@ SKIP LOCKED")
        ;; instances have the data updated.
        (fix-derivation-output-details-hash-encoding conn)
 
-       (%worker-thread-default-timeout #f)
+       (%thread-pool-default-timeout #f)
 
        (resource-pool-retry-checkout-timeout 120)
 

guix-data-service/utils.scm

@@ -44,8 +44,6 @@
             with-time-logging
             prevent-inlining-for-tests
 
-            fiberize
-
             chunk
             chunk!
             chunk-for-each!
@@ -77,41 +75,6 @@
 (define-syntax-rule (prevent-inlining-for-tests var)
   (set! var var))
 
-(define* (fiberize proc #:key (parallelism 1))
-  (let ((channel (make-channel)))
-    (for-each
-     (lambda _
-       (spawn-fiber
-        (lambda ()
-          (while #t
-            (let ((reply-channel args (car+cdr
-                                       (get-message channel))))
-              (put-message
-               reply-channel
-               (with-exception-handler
-                   (lambda (exn)
-                     (cons 'exception exn))
-                 (lambda ()
-                   (with-throw-handler #t
-                     (lambda ()
-                       (call-with-values
-                           (lambda ()
-                             (apply proc args))
-                         (lambda vals
-                           (cons 'result vals))))
-                     (lambda _
-                       (backtrace))))
-                 #:unwind? #t)))))
-        #:parallel? #t))
-     (iota parallelism))
-
-    (lambda args
-      (let ((reply-channel (make-channel)))
-        (put-message channel (cons reply-channel args))
-        (match (get-message reply-channel)
-          (('result . vals) (apply values vals))
-          (('exception . exn) (raise-exception exn)))))))
-
 (define (chunk lst max-length)
   (if (> (length lst)
          max-length)