barrier.rkt

#lang racket/base

(require syncvar/mvar)

(provide make-barrier
         barrier-wait-evt
         barrier-wait
         log-barrier-info)

(define-logger barrier)

(struct barrier (count ready-sema))

(define (make-barrier count)
  (barrier (make-mvar count) (make-semaphore 0)))

(define (barrier-wait-evt a-barrier)
  (nack-guard-evt
   (λ (nack-evt)
     (define count (barrier-count a-barrier))
     (mvar-update! count sub1)
     (thread (λ ()
               (sync nack-evt)
               (mvar-update! count add1)))
     (cond
       [(<= (mvar-get count) 0)
        (wrap-evt
         always-evt
         (λ (v) (semaphore-post (barrier-ready-sema a-barrier))))]
       [else
        (wrap-evt (semaphore-peek-evt (barrier-ready-sema a-barrier))
                  void)]))))

(define (barrier-wait a-barrier)
  (sync (barrier-wait-evt a-barrier)))