racket-ssh-2012/blocking-box.rkt

#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 (thread set-ch get-ch))

(define (make-blocking-box)
  (define set-ch (make-channel))
  (define get-ch (make-channel))
  (blocking-box (thread/suspend-to-kill (lambda () (manager set-ch get-ch)))
		set-ch
		get-ch))

(define (manager s g)
  (define v (channel-get s))
  (let loop ()
    (sync s (channel-put-evt g v)) ;; ignore any future settings, answer all future gettings
    (loop)))

(define (blocking-box-evt b)
  (guard-evt
   (lambda ()
     ;; Ensure the manager is running within our custodian:
     (thread-resume (blocking-box-thread b) (current-thread))
     (blocking-box-get-ch b))))

(define (blocking-box-value b)
  (sync (blocking-box-evt b)))

(define (set-blocking-box! b v)
  ;; Ensure the manager is running within our custodian:
  (thread-resume (blocking-box-thread b) (current-thread))
  (channel-put (blocking-box-set-ch b) v))