[racket] silly toy code to simulate semaphores

That looks like the right idea to me, but I would have made
server-loop be a recursive function whose argument was 'n' and where
the function you pass to handle-event would recur with the new value
of 'n'.

Robby

On Sun, Jul 4, 2010 at 3:52 PM, Danny Yoo <dyoo at cs.wpi.edu> wrote:
> 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)])
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> _________________________________________________
>  For list-related administrative tasks:
>  http://lists.racket-lang.org/listinfo/users
>