source: project/release/4/message-digest/trunk/message-digest-srfi-4.scm @ 35339

Last change on this file since 35339 was 35339, checked in by kon, 7 months ago

add define-types include, add types, reflow

File size: 3.1 KB
Line 
1;;;; message-digest-srfi-4.scm
2;;;; Kon Lovett, Jan '06 (message-digest.scm)
3;;;; Kon Lovett, May '10 (message-digest.scm)
4;;;; Kon Lovett, Apr '12
5;;;; Kon Lovett, Aug '17
6
7;; Issues
8;;
9;; - Passes u8vector to update phase as a blob.
10
11(module message-digest-srfi-4
12
13(;export
14  message-digest-update-u8vector
15  message-digest-update-packed-vector
16  message-digest-u8vector message-digest-u8vector!
17  ;DEPRECATED
18  message-digest-update-bytevector
19  message-digest-update-subu8vector
20  )
21
22(import scheme chicken)
23(use
24  data-structures
25  srfi-4
26  (only lolevel number-of-bytes)
27  (only srfi-4-checks check-u8vector)
28  (only type-errors error-argument-type)
29  message-digest-primitive
30  message-digest-type
31  message-digest-support
32  message-digest-bv
33  typed-define)
34
35;;; Support
36
37;;
38
39(include "message-digest-types")
40
41;;
42
43(define: (get-bytevector-object (loc symbol) (obj *)) -> blob
44        (cond
45                ((string? obj)
46                  (string->blob obj) )
47                ((blob? obj)
48                  obj )
49                ((packed-vector->blob/shared obj) )
50                (else
51        (error-argument-type loc obj "string, blob, or SRFI 4 vector" obj) ) ) )
52
53;;; Update API
54
55;;
56
57(define: (message-digest-update-u8vector (md message-digest) (u8vec u8vector) . (opts list)) -> void
58  (let-optionals* opts (
59    (start 0)
60    (end (u8vector-length u8vec)) )
61    (message-digest-update-blob md
62      (u8vector->blob/shared (u8vector/slice u8vec start end))) ) )
63
64;;; Single Source API
65
66(define: (message-digest-u8vector (mdp message-digest-primitive) (u8vec u8vector) . (opts list)) -> message-digest-result-form
67  (let-optionals* opts (
68    (result-type (message-digest-result-form))
69    (start 0)
70    (end (u8vector-length u8vec)) )
71    (let ((md (initialize-message-digest mdp)))
72      (message-digest-update-u8vector md u8vec start end)
73      (finalize-message-digest md result-type) ) ) )
74
75(define: (message-digest-u8vector! (mdp message-digest-primitive) (u8vec u8vector) (buffer message-digest-buffer) . (opts list)) -> message-digest-result-form
76  (let-optionals* opts (
77    (start 0)
78    (end (u8vector-length u8vec)) )
79    (let ((md (initialize-message-digest mdp)))
80      (message-digest-update-u8vector md u8vec start end)
81      (finalize-message-digest! md buffer) ) ) )
82
83;;DEPRECATED
84
85(: message-digest-update-subu8vector deprecated)
86(define (message-digest-update-subu8vector md u8vec start end)
87  (message-digest-update-blob md (u8vector->blob/shared (subu8vector u8vec start end))) )
88
89(: message-digest-update-packed-vector deprecated)
90(define (message-digest-update-packed-vector md pkdvec)
91  (let ((blb (packed-vector->blob/shared pkdvec)))
92    (if blb
93      (message-digest-update-blob md blb)
94      (error-argument-type 'message-digest-update-packed-vector pkdvec "SRFI 4 vector") ) ) )
95
96(: message-digest-update-bytevector deprecated)
97(define (message-digest-update-bytevector md bv #!optional (len (number-of-bytes bv)))
98  (check-message-digest 'message-digest-update-bytevector md)
99  (let ((mdp (message-digest-algorithm md))
100        (ctx (message-digest-context md)) )
101    ((message-digest-primitive-update mdp)
102        ctx
103        (get-bytevector-object 'message-digest-update-bytevector bv)
104        len) ) )
105
106) ;module message-digest-srfi-4
Note: See TracBrowser for help on using the repository browser.