;;;; entropy-source.scm
;;;; Kon Lovett, Oct '09

(module entropy-source

  (;export
    *make-entropy-source
    entropy-source? check-entropy-source error-entropy-source
    *entropy-source-kind
    *entropy-source-documentation
    @entropy-source-u8
    @entropy-source-f64
    @entropy-source-u8vector
    @entropy-source-f64vector
    ;
    registered-entropy-sources
    registered-entropy-source
    unregister-entropy-source
    register-entropy-source!)

  (import scheme
          chicken
          (only data-structures alist-ref alist-update!)
          (only srfi-1 alist-cons alist-delete!)
          (only type-checks define-check+error-type check-procedure check-symbol))

  (require-library data-structures srfi-1 type-checks)

;;

(define-record-type entropy-source
  (*make-entropy-source kind docu u8 f64 u8vec f64vec)
  entropy-source?
  (kind       *entropy-source-kind)
  (docu       *entropy-source-documentation)
  (u8         @entropy-source-u8)
  (f64        @entropy-source-f64)
  (u8vec      @entropy-source-u8vector)
  (f64vec     @entropy-source-f64vector) )

(define-check+error-type entropy-source)

;; Entropy Source Constructor Registry

(define +sources+ '())

(define (registered-entropy-sources) (map car +sources+))

(define (registered-entropy-source kind) (alist-ref kind +sources+ eq?))

(define (unregister-entropy-source kind) (set! +sources+ (alist-delete! kind +sources+ eq?)))

(define (register-entropy-source! kind maker)
  (check-symbol 'register-entropy-source! kind)
  (check-procedure 'register-entropy-source! maker)
  (set! +sources+ (alist-update! kind maker +sources+ eq?)) )

) ;entropy-source