[no subject]

[Christopher Baines]

branch: master
commit faf4bfdfcb124306abe0d1a5be0176a286535c51
Author: Christopher Baines <address@hidden>
AuthorDate: Fri Jan 24 19:13:39 2020 +0000

    Enable make-worker-thread-channel to create multiple worker threads.
    
    This will allow running multiple threads, that all listen on the same 
channel,
    enabling processing multiple jobs at one time.
    
    * src/cuirass/utils.scm (make-worker-thread-channel): Add a #:parallelism
    argument, and create as many threads as the given parallelism.
---
 src/cuirass/utils.scm | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index dfed4a9..f3ba18d 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -99,20 +99,24 @@ delimited continuations and fibers."
 (define %worker-thread-args
   (make-parameter #f))
 
-(define (make-worker-thread-channel initializer)
+(define* (make-worker-thread-channel initializer
+                                     #:key (parallelism 1))
   "Return a channel used to offload work to a dedicated thread.  ARGS are the
 arguments of the worker thread procedure."
   (parameterize (((@@ (fibers internal) current-fiber) #f))
     (let ((channel (make-channel)))
-      (let ((args (initializer)))
-        (call-with-new-thread
-         (lambda ()
-           (parameterize ((%worker-thread-args args))
-             (let loop ()
-               (match (get-message channel)
-                 (((? channel? reply) . (? procedure? proc))
-                  (put-message reply (apply proc args))))
-               (loop))))))
+      (for-each
+       (lambda _
+         (let ((args (initializer)))
+           (call-with-new-thread
+            (lambda ()
+              (parameterize ((%worker-thread-args args))
+                (let loop ()
+                  (match (get-message channel)
+                    (((? channel? reply) . (? procedure? proc))
+                     (put-message reply (apply proc args))))
+                  (loop)))))))
+       (iota parallelism))
       channel)))
 
 (define (call-with-worker-thread channel proc)