[Recipe] Thread pool

[lassik]

Problem

I have a task queue and I want to split the work among multiple threads. There can be many more tasks than threads.

Solution

The mailbox library is Chicken only, but any other thread-safe queue could be used instead.

(import (srfi 18))
(cond-expand (chicken (import (mailbox))))

(define (map-iota proc n)
  (let loop ((new-list '()) (i 0))
    (if (= i n) (reverse new-list)
        (loop (cons (proc i) new-list) (+ i 1)))))

(define thread-pool-size (make-parameter 2))

(define (run-thread-pool thunks)
  (let ((mailbox (make-mailbox)))
    (define (worker)
      (let loop ()
        (let ((thunk (mailbox-receive! mailbox 0 (eof-object))))
          (unless (eof-object? thunk)
            (thunk)
            (loop)))))
    (define (index->thread-name i)
      (string (integer->char (+ i (char->integer #\A)))))
    (for-each (lambda (thunk) (mailbox-send! mailbox thunk))
              thunks)
    (let ((threads (map-iota (lambda (i)
                               (make-thread worker (index->thread-name i)))
                             (thread-pool-size))))
      (for-each thread-start! threads)
      (let loop ()
        (unless (mailbox-empty? mailbox)
          (thread-sleep! 0.1)
          (loop)))
      (for-each thread-join! threads))))

Credit: @lassik

Usage