Skip to content

Instantly share code, notes, and snippets.

@samdphillips
Created August 19, 2022 18:09
Show Gist options
  • Save samdphillips/3f7eaeeedfe67a699de5eea40115baa8 to your computer and use it in GitHub Desktop.
Save samdphillips/3f7eaeeedfe67a699de5eea40115baa8 to your computer and use it in GitHub Desktop.
One shot synchronizable variables.
#lang racket/base
(require racket/contract
racket/undefined)
(provide ivar?
exn:fail:ivar?
make-ivar
(contract-out
[ivar-put! (-> ivar? any/c any)]
[ivar-get-evt (-> ivar? any)]
[ivar-get (-> ivar? any)]))
(struct exn:fail:ivar exn:fail ())
(struct ivar (box semaphore)
#:property prop:evt (lambda (an-ivar) (ivar-get-evt an-ivar)))
(define (make-ivar)
(ivar (box undefined) (make-semaphore)))
(define (ivar-put! an-ivar value)
(cond
[(box-cas! (ivar-box an-ivar) undefined value)
(semaphore-post (ivar-semaphore an-ivar))]
[else
(raise (exn:fail:ivar "ivar-put!: ivar has already been assigned"
(current-continuation-marks)))]))
(define (ivar-get-evt an-ivar)
(wrap-evt (semaphore-peek-evt (ivar-semaphore an-ivar))
(lambda (_ignore)
(unbox (ivar-box an-ivar)))))
(define (ivar-get an-ivar)
(sync an-ivar))
@LiberalArtist
Copy link

Here's a slight variation:

#lang racket/base

(require racket/contract
         racket/match)

(provide ivar?
         exn:fail:ivar?
         make-ivar
         (contract-out
          [ivar-put!    (-> ivar? any/c any)]
          [ivar-get-evt (-> ivar? any)]
          [ivar-get     (-> ivar? any)]))

(struct exn:fail:ivar exn:fail ())

(struct ivar (box semaphore)
  #:property prop:evt (lambda (an-ivar) (ivar-get-evt an-ivar)))

(define (make-ivar)
  ;; Using the semaphore to represent the empty state
  ;; avoids restricting `ivar-put!`.
  (define sema (make-semaphore))
  (ivar (box sema) sema))

(define (ivar-put! an-ivar value)
  (match-define (ivar bx sema) an-ivar)
  (let loop ()
    (cond
      [(box-cas! bx sema value)
       (semaphore-post (ivar-semaphore an-ivar))]
      [(eq? sema (unbox bx))
       ;; spurious failure
       (loop)]
      [else
       (raise (exn:fail:ivar "ivar-put!: ivar has already been assigned"
                             (current-continuation-marks)))])))

(define (ivar-get-evt an-ivar)
  (wrap-evt (semaphore-peek-evt (ivar-semaphore an-ivar))
            (lambda (_ignore)
              (unbox (ivar-box an-ivar)))))

(define (ivar-get an-ivar)
  (sync an-ivar))

@samdphillips
Copy link
Author

Here's a slight variation:

@LiberalArtist, this is great. Much better than the newer version I have done (unpublished) with an extra semaphore to lock write access. Thanks!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment