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

(module entropy-source

  (;export
    *make-entropy-source
    entropy-source? check-entropy-source error-entropy-source
    *entropy-source-name
    *entropy-source-documentation
    @entropy-source-construtor
    @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 ctor name docu u8 f64 u8vec f64vec)
  entropy-source?
  (ctor       @entropy-source-construtor)
  (name       *entropy-source-name)
  (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 name) (alist-ref name +sources+ eq?))

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

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

) ;entropy-source