[racket] silly toy code to simulate semaphores

From: Danny Yoo (dyoo at cs.wpi.edu)
Date: Sun Jul 4 16:52:28 EDT 2010

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

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

Posted on the users mailing list.