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

Last change on this file since 35340 was 35340, checked in by kon, 15 months ago

add types

File size: 3.7 KB
Line 
1;;;; message-digest-bv.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(module message-digest-bv
10
11(;export
12  ;
13  message-digest-update-blob
14  message-digest-update-string
15  message-digest-blob
16  message-digest-string
17  message-digest-blob!
18  message-digest-string!
19  ;DEPRECATED
20  message-digest-update-substring)
21
22(import scheme chicken)
23(use
24  (only srfi-13 substring/shared)
25  (only type-checks
26    check-blob check-string check-natural-fixnum check-range)
27  message-digest-primitive
28  message-digest-type
29  message-digest-support
30  typed-define)
31
32;;; Support
33
34;;
35
36(include "message-digest-types")
37
38;;
39
40(define (check-blob/slice loc blb start end)
41  (check-fixnum-range loc start end)
42  (blob/slice (check-blob loc blb) start end) )
43
44(define (check-string/slice loc str start end)
45  (check-fixnum-range loc start end)
46  (string/slice (check-string loc str) start end) )
47
48(define (check-fixnum-range loc start end)
49  (check-range loc
50    (check-natural-fixnum loc start 'start)
51    (check-natural-fixnum loc end 'end)
52    "end < start") )
53
54;;; Message Digest API
55
56;; Update
57
58;;
59
60;FIXME using & then checking !
61
62(define: (message-digest-update-blob (md message-digest) (blb blob) . (opts list)) -> void
63  (let-optionals* opts (
64    (start 0)
65    (end (blob-size blb)) )
66    (*message-digest-update-blob
67      (check-message-digest 'message-digest-update-blob md)
68      (check-blob/slice 'message-digest-update-blob blb start end)) ) )
69
70;;
71
72(define: (message-digest-update-string (md message-digest) (str string) . (opts list)) -> void
73  (let-optionals* opts (
74    (start 0)
75    (end (string-length str)) )
76    (*message-digest-update-string
77      (check-message-digest 'message-digest-update-string md)
78      (check-string/slice 'message-digest-update-string str start end)) ) )
79
80;;
81
82;; Single Source API
83
84(define: (message-digest-blob (mdp message-digest-primitive) (blb blob) . (opts list)) -> message-digest-result-form
85  (let-optionals* opts (
86    (result-type (message-digest-result-form))
87    (start 0)
88    (end (blob-size blb)) )
89    (let (
90      (md (initialize-message-digest mdp)) )
91      (message-digest-update-blob md blb start end)
92      (finalize-message-digest md result-type) ) ) )
93
94(define: (message-digest-string (mdp message-digest-primitive) (str string) . (opts list)) -> message-digest-result-form
95  (let-optionals* opts (
96    (result-type (message-digest-result-form))
97    (start 0)
98    (end (string-length str)) )
99    (let (
100      (md (initialize-message-digest mdp)) )
101      (message-digest-update-string md str start end)
102      (finalize-message-digest md result-type) ) ) )
103
104(define: (message-digest-blob! (mdp message-digest-primitive) (blb blob) (buf message-digest-buffer) . (opts list)) -> message-digest-result-form
105  (let-optionals* opts (
106    (start 0)
107    (end (blob-size blb)) )
108    (let (
109      (md (initialize-message-digest mdp)) )
110      (message-digest-update-blob md blb start end)
111      (finalize-message-digest! md buf) ) ) )
112
113(define: (message-digest-string! (mdp message-digest-primitive) (str string) (buf message-digest-buffer) . (opts list)) -> message-digest-result-form
114  (let-optionals* opts (
115    (start 0)
116    (end (string-length str)) )
117    (let (
118      (md (initialize-message-digest mdp)) )
119      (message-digest-update-string md str start end)
120      (finalize-message-digest! md buf) ) ) )
121
122;;DEPRECATED
123
124(: message-digest-update-substring deprecated)
125(define (message-digest-update-substring md str start end)
126  (*message-digest-update-string
127    (check-message-digest 'message-digest-update-substring md)
128    (substring/shared (check-string 'message-digest-update-substring str) start end)) )
129
130) ;module message-digest-bv
Note: See TracBrowser for help on using the repository browser.