;;;; synch-object.scm
;;;; Kon Lovett, Dec '18

(module synch-object

(;export
  datum-unbound-value?
  mutex-with-object?
  make-synch-with-object
  synch-with-object? check-synch-with-object error-synch-with-object)

(import scheme)
(import (chicken base))
(import (only (srfi 18)
  make-mutex mutex?
  mutex-specific mutex-specific-set!))
(import (only type-checks define-check+error-type))

;;;

;;

(define (datum-unbound-value? datum)
  (or (eq? (void) datum) (not datum)) )

(define (mutex-with-object? obj)
  (and
    (mutex? obj)
    (not (datum-unbound-value? (mutex-specific obj))) ) )

;;

(define (make-synch-with-object obj #!optional (name '(synchobj)))
  (let* (
    (name (if (pair? name) (gensym (car name)) name) )
    (mutex (make-mutex name) ) )
    (mutex-specific-set! mutex obj)
    mutex ) )

(define (synch-with-object? obj #!optional pred)
  (and
    (mutex-with-object? obj)
    (or
      (not pred)
      (pred (mutex-specific obj)) ) ) )

(define-check+error-type synch-with-object)

) ;module synch-object