;;;; srfi.27.bernoullis.scm
;;;; Kon Lovett, Dec '17
;;;; Kon Lovett, Jun '17
;;;; Kon Lovett, May '06

; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)

(module srfi.27.bernoullis

(;export
  *make-random-bernoullis
  make-random-bernoullis)

(import scheme
  (chicken base)
  (chicken type)
  (only type-checks-structured check-procedure)
  (srfi 27)
  srfi-27-distributions-support)

;;;

(include-relative "srfi-27-common-types")

(: *make-random-bernoullis (number random-real-function -> boolean-function))
(: make-random-bernoullis (#!rest -> boolean-function procedure))

;;; Bernoulli distribution

(define (*make-random-bernoullis p randoms)
  (cond ((= 0 p) (lambda () #f))
        ((= 1 p) (lambda () #t))
        (else (lambda () (<= (randoms) p)))) )

(define (make-random-bernoullis #!key p randoms)
  ;delay the argument check until known if supplied or default
  (let ((p (if (not p) 1/2
               (check-real-unit 'make-random-bernoullis p 'p)))
        (randoms (if (not randoms) (current-random-real)
                     (check-procedure 'make-random-bernoullis randoms 'randoms))) )
    (values (*make-random-bernoullis p randoms)
            (lambda () (values p randoms))) ) )

) ;module srfi.27.bernoullis