[racket] silly toy code to simulate semaphores

I was just reading though John Reppy's "Concurrent Programming in ML"
and wanted to play with some code.  Out of curiosity, I wrote the
following code to try to see what it would look like to simulate
semaphores using channels.  How does it look?


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#lang scheme/base

(require scheme/contract)

;; Perverse toy code: how would one implement semaphores using channels?

(define-struct simulated-semaphore (post-channel wait-channel) #:mutable)

;; make-simulated-semaphore: [exact-number? 0] -> simulated-semaphore
(define (-make-simulated-semaphore (n 0))
  (define post-channel (make-channel))
  (define wait-channel (make-channel))
  (define (server-loop)
    (sync (handle-evt post-channel
                      (lambda (_)
                        (set! n (add1 n))))
          (if (> n 0)
              (handle-evt (channel-put-evt wait-channel (void))
                          (lambda (_)
                            (set! n (sub1 n))))
              never-evt))
    (server-loop))
  (begin
    (thread server-loop)
    (make-simulated-semaphore post-channel wait-channel)))

;; simulated-semaphore-post: simulated-semaphore -> void
(define (simulated-semaphore-post a-sema)
  (channel-put (simulated-semaphore-post-channel a-sema) #t))

;; simulated-semaphore-wait: simulated-semaphore -> void
(define (simulated-semaphore-wait a-sema)
  (channel-get (simulated-semaphore-wait-channel a-sema)))

(provide/contract
 [rename -make-simulated-semaphore
         make-simulated-semaphore
         (() (exact-integer?). ->* . any)]
 [simulated-semaphore? (any/c . -> . boolean?)]
 [simulated-semaphore-post (simulated-semaphore? . -> . any)]
 [simulated-semaphore-wait (simulated-semaphore? . -> . any)])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;