39 lines
1.1 KiB
Racket
39 lines
1.1 KiB
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 (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))
|