Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
Straight-forward thread pool implementation in Racket
#lang racket/base
(require racket/match
(define urls '(["" "/"]
["" "/"]
["" "/"]))
(define (main)
(define p (new-pool 4))
(displayln "Sending thunks")
(for ([url urls])
(match-let ([(list host path) url])
(pool-put p (λ ()
(match-let-values ([(status _ port) (http-sendrecv host path)])
(displayln status)
(port-count-chars port))))))
(displayln "Reading results")
(for ([_ urls])
(displayln (pool-get p)))
(pool-close p))
(struct pool (in-ch out-ch threads))
(define (new-pool number-of-threads [out-ch-limit #f])
(define in-ch (make-channel))
(define out-ch (make-async-channel out-ch-limit))
(define threads (for/list ([_ (in-range number-of-threads)])
(thread (λ ()
(define (get) (channel-get in-ch))
(define (put smth) (async-channel-put out-ch smth))
(let loop ([thunk (get)])
(unless (eq? thunk 'close)
(put (thunk))
(loop (get))))))))
(pool in-ch out-ch threads))
(define (pool-put pool thunk)
(channel-put (pool-in-ch pool) thunk))
(define (pool-get pool)
(async-channel-get (pool-out-ch pool)))
(define (pool-close pool)
(define in-ch (pool-in-ch pool))
(define threads (pool-threads pool))
(for-each (λ (_) (channel-put in-ch 'close)) threads)
(for-each thread-wait threads))
(define (port-count-chars input-port)
(define (read) (read-char input-port))
(let loop ([char (read)]
[result 0])
(if (eof-object? char)
(loop (read) (add1 result)))))
(module+ test
(require rackunit)
(check-equal? (port-count-chars (open-input-string "abcdefg")) 7))
(module+ main
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment