source: project/release/4/message-digest/trunk/message-digest-bv.scm @ 35044

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

;; Issues

(module message-digest-bv

(;export
  ;
  message-digest-update-blob
  message-digest-update-string
  message-digest-blob
  message-digest-string
  message-digest-blob!
  message-digest-string!
  ;DEPRECATED
  message-digest-update-substring)

(import scheme chicken)

(use
  (only srfi-13 substring/shared)
  (only type-checks
    check-blob check-string check-natural-fixnum check-range)
  message-digest-primitive
  message-digest-type
  message-digest-support)

(declare
  (bound-to-procedure ##sys#substring))

;;; Message Digest API

;; Update

;;

(define (message-digest-update-blob md blb #!optional (start 0) (end (blob-size blb)))
  (*message-digest-update-blob
    (check-message-digest 'message-digest-update-blob md)
    (check-blob/slice 'message-digest-update-blob blb start end)) )

;;

(define (message-digest-update-string md str #!optional (start 0) (end (string-length str)))
  (*message-digest-update-string
    (check-message-digest 'message-digest-update-string md)
    (check-string/slice 'message-digest-update-string str start end)) )

;;

;DEPRECATED
(define (message-digest-update-substring md str start end)
  (*message-digest-update-string
    (check-message-digest 'message-digest-update-substring md)
    (substring/shared (check-string 'message-digest-update-substring str) start end)) )

;; Single Source API

(define (message-digest-blob mdp blb
            #!optional
            (result-type (message-digest-result-form))
            (start 0) (end (blob-size blb)))
  (let ((md (initialize-message-digest mdp)))
    (message-digest-update-blob md blb start end)
    (finalize-message-digest md result-type) ) )

(define (message-digest-string mdp str
            #!optional
            (result-type (message-digest-result-form))
            (start 0) (end (string-length str)))
  (let ((md (initialize-message-digest mdp)))
    (message-digest-update-string md str start end)
    (finalize-message-digest md result-type) ) )

(define (message-digest-blob! mdp blb result-buffer
            #!optional
            (start 0) (end (blob-size blb)))
  (let ((md (initialize-message-digest mdp)))
    (message-digest-update-blob md blb start end)
    (finalize-message-digest! md result-buffer) ) )

(define (message-digest-string! mdp str result-buffer
            #!optional
            (start 0) (end (string-length str)))
  (let ((md (initialize-message-digest mdp)))
    (message-digest-update-string md str start end)
    (finalize-message-digest! md result-buffer) ) )

;;;

(define (check-blob/slice loc blb start end)
  (check-blob loc blb)
  (check-fixnum-range loc start end)
  (blob/slice blb start end) )

(define (check-string/slice loc str start end)
  (check-string loc str)
  (check-fixnum-range loc start end)
  (string/slice str start end) )

(define (check-fixnum-range loc start end)
  (check-range loc
    (check-natural-fixnum loc start 'start)
    (check-natural-fixnum loc end 'end)
    "end < start") )

) ;module message-digest-bv