Log delays in the thread pool channel

As I think with lots of requests, this could become a bottleneck.

guix-data-service/utils.scm

@@ -19,6 +19,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 threads)
   #:use-module (fibers)
   #:use-module (fibers channels)
@@ -54,8 +55,14 @@
 (define-syntax-rule (prevent-inlining-for-tests var)
   (set! var var))
 
-
 (define* (make-thread-pool-channel #:key (threads 8))
+  (define (delay-logger seconds-delayed)
+    (when (> seconds-delayed 1)
+      (format
+       (current-error-port)
+       "warning: thread pool delayed by ~1,2f seconds~%"
+       seconds-delayed)))
+
   (let ((channel (make-channel)))
     (for-each
      (lambda _
@@ -63,7 +70,12 @@
         (lambda ()
           (let loop ()
             (match (get-message channel)
-              (((? channel? reply) . (? procedure? proc))
+              (((? channel? reply) sent-time (? procedure? proc))
+               (let ((time-delay
+                      (- (get-internal-real-time)
+                         sent-time)))
+                 (delay-logger (/ time-delay
+                                  internal-time-units-per-second))
                  (put-message
                   reply
                   (with-exception-handler
@@ -83,7 +95,7 @@
                               proc
                             (lambda vals
                               vals)))))
-                  #:unwind? #t))
+                    #:unwind? #t)))
                (loop))
               (_ #f))))))
      (iota threads))
@@ -106,7 +118,9 @@
   (let ((reply (make-channel)))
     (spawn-fiber
      (lambda ()
-       (put-message %thread-pool-channel (cons reply thunk))))
+       (put-message %thread-pool-channel (list reply
+                                               (get-internal-real-time)
+                                               thunk))))
     reply))
 
 (define (fetch-result-of-defered-thunk reply-channel)