;;;; message-digest-parameters.scm
;;;; Kon Lovett, Jan '06 (message-digest.scm)
;;;; Kon Lovett, May '10 (message-digest.scm)
;;;; Kon Lovett, Apr '12

;; Issues
;;
;; - Uses 'context-info' to determine whether active context is "own" allocation or
;; callers. Again, a kludge.
;;
;; - Passes u8vector to update phase as a blob.

(module message-digest-parameters

(;export
  ; Parameters
  message-digest-chunk-size
  message-digest-chunk-read-maker
  message-digest-chunk-converter)

(import scheme)

(import
  chicken
  (only srfi-4
    u8vector->blob/shared subu8vector
    read-u8vector! make-u8vector))
(require-library
  srfi-4)

(require-extension
  miscmacros)

;;; Update Phase Helpers

;;

(define (positive-fixnum? obj)
  (and (fixnum? obj) (positive? obj)) )

;;

(define (default-chunk-read-maker in #!optional (size (message-digest-chunk-size)))
  (let ((u8buf (make-u8vector size)))
    (lambda ()
      (let ((len (read-u8vector! size u8buf in)))
        (and
          (positive? len)
          (let ((u8buf (if (fx= len size) u8buf (subu8vector u8buf 0 len))))
            (u8vector->blob/shared u8buf) ) ) ) ) ) )

;;

(define-constant DEFAULT-CHUNK-SIZE 1024)

;;; Message Digest "Parameters"

;;

(define-parameter message-digest-chunk-size DEFAULT-CHUNK-SIZE
  (lambda (x)
    (cond
      ((positive-fixnum? x)   x )
      ((not x)                DEFAULT-CHUNK-SIZE )
      (else
        (warning 'message-digest-chunk-size "invalid positive-fixnum" x)
        (message-digest-chunk-size) ) ) ) )

;;

(define-parameter message-digest-chunk-read-maker default-chunk-read-maker
  (lambda (x)
    (cond
      ((procedure? x)   x )
      ((not x)          default-chunk-read-maker )
      (else
        (warning 'message-digest-chunk-read-maker "invalid procedure" x)
        (message-digest-chunk-read-maker) ) ) ) )

;;

(define-parameter message-digest-chunk-converter #f
  (lambda (x)
    (if (or (not x) (procedure? x))
      x
      (begin
        (warning 'message-digest-chunk-converter "invalid procedure or #f" x)
        (message-digest-chunk-converter) ) ) ) )

) ;module message-digest-parameters