1 files changed, 20 insertions, 86 deletions

diff --git a/guix-qa-frontpage/utils.scm b/guix-qa-frontpage/utils.scm
index 60f8bc0..8009b59 100644
--- a/guix-qa-frontpage/utils.scm
+++ b/guix-qa-frontpage/utils.scm
@@ -21,13 +21,13 @@
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 threads)
-  #:use-module (zlib)
   #:use-module (fibers)
   #:use-module (fibers channels)
-  #:use-module (knots timeout)
+  #:use-module (knots)
+  #:use-module (zlib)
   #:export (fiberize
-            call-with-zlib-input-port*
-            non-blocking))
+            non-blocking
+            call-with-zlib-input-port*))
 
 (define* (fiberize proc #:key (parallelism 1))
   (let ((channel (make-channel)))
@@ -64,91 +64,25 @@
           (('result . vals) (apply values vals))
           (('exception . exn) (raise-exception exn)))))))
 
-(define (fibers-map proc . lists)
-  (let ((channels
-         (apply
-          map
-          (lambda args
-            (let ((channel (make-channel)))
-              (spawn-fiber
-               (lambda ()
-                 (put-message
-                  channel
-                  (with-exception-handler
-                      (lambda (exn)
-                        (cons 'exception exn))
-                    (lambda ()
-                      (with-throw-handler #t
-                        (lambda ()
-                          (call-with-values
-                              (lambda ()
-                                (apply proc args))
-                            (lambda val
-                              (cons 'result val))))
-                        (lambda _
-                          (backtrace))))
-                    #:unwind? #t))))
-              channel))
-          lists)))
-    (map
-     (match-lambda
-       (('result . val) val)
-       (('exception . exn) (raise-exception exn)))
-     (map get-message channels))))
-
-(define (fibers-batch-for-each proc batch-size . lists)
-  ;; Like split-at, but don't care about the order of the resulting lists, and
-  ;; don't error if the list is shorter than i elements
-  (define (split-at* lst i)
-    (let lp ((l lst) (n i) (acc '()))
-      (if (or (<= n 0) (null? l))
-          (values (reverse! acc) l)
-          (lp (cdr l) (- n 1) (cons (car l) acc)))))
-
-  ;; As this can be called with lists with tens of thousands of items in them,
-  ;; batch the
-  (define (get-batch lists)
-    (let ((split-lists
-           (map (lambda (lst)
-                  (let ((batch rest (split-at* lst batch-size)))
-                    (cons batch rest)))
-                lists)))
-      (values (map car split-lists)
-              (map cdr split-lists))))
-
-  (let loop ((lists lists))
-    (call-with-values
-        (lambda ()
-          (get-batch lists))
-      (lambda (batch rest)
-        (apply fibers-map proc batch)
-        (unless (null? (car rest))
-          (loop  rest)))))
-  *unspecified*)
-
-(define (fibers-for-each proc . lists)
-  (apply fibers-batch-for-each proc 20 lists))
-
 (define (non-blocking thunk)
   (let ((channel (make-channel)))
-    (call-with-new-thread
+    (call-with-default-io-waiters
      (lambda ()
-       (with-exception-handler
-           (lambda (exn)
-             (put-message channel `(exception ,exn)))
-         (lambda ()
-           (with-throw-handler #t
-             (lambda ()
-               (call-with-values
-                   (lambda ()
-                     ;; This is mostly to set non fibers IO waiters
-                     (with-port-timeouts thunk #:timeout 300))
-                 (lambda values
-                   (put-message channel `(values ,@values)))))
-             (lambda args
-               (display (backtrace) (current-error-port))
-               (newline (current-error-port)))))
-         #:unwind? #t)))
+       (call-with-new-thread
+        (lambda ()
+          (with-exception-handler
+              (lambda (exn)
+                (put-message channel `(exception ,exn)))
+            (lambda ()
+              (with-throw-handler #t
+                (lambda ()
+                  (call-with-values thunk
+                    (lambda values
+                      (put-message channel `(values ,@values)))))
+                (lambda args
+                  (display (backtrace) (current-error-port))
+                  (newline (current-error-port)))))
+            #:unwind? #t)))))
     (match (get-message channel)
       (('values . results)
        (apply values results))