SICP 問題 3.47

#|
このような形でmake-semaphoreは使われる．
|#
(define (make-serializer)
  (let ((semaphore (make-semaphore 6)))
    (lambda (p)
      (define (serialized-p . args)
        (semaphore 'acquire)
        (let ((val (apply p args)))
          (semaphore 'release)
          val))
      serialized-p)))

(define (make-mutex)
  (let ((cell (list false)))
    (define (the-mutex m)
      (cond ((eq? m 'acquire)
             (if (test-and-set! cell)
                 (the-mutex 'acquire))) ;;retry
            ((eq? m 'release (clear! cell)))))
    the-mutex))
#|
上を見ればわかるように評価した手続きをした後はかならずreleaseしている．
それを踏まえてmake-semaphoreを実装する．

・release
(mutex 'release)をするとcellがクリアされる．
何度clear!しても問題はないのでsemaphoreがreleaseするたびに(mutex 'release)を実行して次の処理が行えるようにする．
releaseした後にはcounterから1引いておく.

・acquire
releaseはmake-serializerのようにセマフォを使う手続きから行うのでacquire内では行わない．
counterがnと同じならば(mutex 'acquire)でロックし，カウンターを１増やす．
counterがnより大きければ(mutex 'acquire)内でretryする．
ここでカウンターを１増やさないとreleaseと数が合わなくなり，counterが負になるので1増やす．
counterがnよりも小さければcounterを１増やす．処理が終われば呼び出し元からreleaseが呼ばれる．
|#


(define (make-semaphore n)
  (let ((counter 0) (mutex (make-mutex)))
    (define (acquire)
      (cond ((<= counter n)
             (mutex 'acquire)
             (set! counter (+ counter 1)))
            ((< counter n)
             (set! counter (+ counter 1)))))
    (define (release)
      (mutex 'release)
      (set! counter (- counter 1)))
    (define (dispatch m)
      (cond ((eq? m 'acquire) acquire)
            ((eq? m 'release) release)
            (else
             (error "Unknown request -- MAKE-SEMAPHORE" m))))))