#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))