;;;; 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-constructor
    @entropy-source-u8
    @entropy-source-f64
    @entropy-source-u8vector
    @entropy-source-f64vector
    ;
    entropy-source-integer
    entropy-source-f64-integer
    ;
    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)

  (use registration)

;;

(define-record-type entropy-source
  (*make-entropy-source ctor name docu u8 f64 u8vec f64vec)
  entropy-source?
  (ctor       @entropy-source-constructor)
  (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)

;;

(define (entropy-source-integer entropy-source)
  ;ugly but ...
  (let ((get-f64 (@entropy-source-f64 entropy-source)))
    (let loop ((x (get-f64)))
      (if (integer? x)
        x
        (loop (get-f64)) ) ) ) )

(define entropy-source-f64-integer entropy-source-integer)

;; Entropy Source Constructor Registry

(define +reg+ (make-registration 'entropy-source '()))

(define (registered-entropy-sources)
  ((@registration-key +reg+)) )

(define (registered-entropy-source name)
  ((@registration-ref +reg+) name) )

(define (unregister-entropy-source name)
  ((@registration-deref! +reg+) name) )

(define (register-entropy-source! name ctor)
  ((@registration-register! +reg+) name ctor) )

) ;entropy-source