racket-ssh-2012/blocking-box.rkt

31 lines
828 B
Racket

#lang racket/base
;; A box whose value can only be set once, that starts life with no
;; value, and that supports an event waiting for a value to arrive.
(provide make-blocking-box
blocking-box-evt
blocking-box-value
set-blocking-box!)
(struct blocking-box (semaphore ch))
(define (make-blocking-box)
(blocking-box (make-semaphore 1) (make-channel)))
(define (blocking-box-evt b)
;; wrap the event to avoid exposing too much authority
(wrap-evt (blocking-box-ch b) values))
(define (blocking-box-value b)
(sync (blocking-box-evt b)))
(define (set-blocking-box! b v)
(define c (blocking-box-ch b))
(thread (lambda ()
(when (semaphore-try-wait? (blocking-box-semaphore b))
;; We are first (and therefore only) claimant of the box.
(let loop ()
(channel-put c v)
(loop)))))
(void))