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

Last change on this file since 35341 was 35341, checked in by Kon Lovett, 20 months ago

add types, message-digest-result-form -> -type, -form is symbol, -byte-order is symbol, do not type check-/error- (no no no no no)

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;FIXME do not 'type' check-/error- procs
41
42(define (check-blob/slice loc blb start end)
43  (check-fixnum-range loc start end)
44  (blob/slice (check-blob loc blb) start end) )
45
46(define (check-string/slice loc str start end)
47  (check-fixnum-range loc start end)
48  (string/slice (check-string loc str) start end) )
49
50(define (check-fixnum-range loc start end)
51  (check-range loc
52    (check-natural-fixnum loc start 'start)
53    (check-natural-fixnum loc end 'end)
54    "end < start") )
55
56;;; Message Digest API
57
58;; Update
59
60;;
61
62;FIXME using & then checking !
63
64(define: (message-digest-update-blob (md message-digest) (blb blob) . (opts list)) -> void
65  (let-optionals* opts (
66    (start 0)
67    (end (blob-size blb)) )
68    (*message-digest-update-blob
69      (check-message-digest 'message-digest-update-blob md)
70      (check-blob/slice 'message-digest-update-blob blb start end)) ) )
71
72;;
73
74(define: (message-digest-update-string (md message-digest) (str string) . (opts list)) -> void
75  (let-optionals* opts (
76    (start 0)
77    (end (string-length str)) )
78    (*message-digest-update-string
79      (check-message-digest 'message-digest-update-string md)
80      (check-string/slice 'message-digest-update-string str start end)) ) )
81
82;;
83
84;; Single Source API
85
86(define: (message-digest-blob (mdp message-digest-primitive) (blb blob) . (opts list)) -> message-digest-result-type
87  (let-optionals* opts (
88    (restyp (message-digest-result-form))
89    (start 0)
90    (end (blob-size blb)) )
91    (let (
92      (md (initialize-message-digest mdp)) )
93      (message-digest-update-blob md blb start end)
94      (finalize-message-digest md restyp) ) ) )
95
96(define: (message-digest-string (mdp message-digest-primitive) (str string) . (opts list)) -> message-digest-result-type
97  (let-optionals* opts (
98    (restyp (message-digest-result-form))
99    (start 0)
100    (end (string-length str)) )
101    (let (
102      (md (initialize-message-digest mdp)) )
103      (message-digest-update-string md str start end)
104      (finalize-message-digest md restyp) ) ) )
105
106(define: (message-digest-blob! (mdp message-digest-primitive) (blb blob) (buf message-digest-buffer) . (opts list)) -> message-digest-result-type
107  (let-optionals* opts (
108    (start 0)
109    (end (blob-size blb)) )
110    (let (
111      (md (initialize-message-digest mdp)) )
112      (message-digest-update-blob md blb start end)
113      (finalize-message-digest! md buf) ) ) )
114
115(define: (message-digest-string! (mdp message-digest-primitive) (str string) (buf message-digest-buffer) . (opts list)) -> message-digest-result-type
116  (let-optionals* opts (
117    (start 0)
118    (end (string-length str)) )
119    (let (
120      (md (initialize-message-digest mdp)) )
121      (message-digest-update-string md str start end)
122      (finalize-message-digest! md buf) ) ) )
123
124;;DEPRECATED
125
126(: message-digest-update-substring deprecated)
127(define (message-digest-update-substring md str start end)
128  (*message-digest-update-string
129    (check-message-digest 'message-digest-update-substring md)
130    (substring/shared (check-string 'message-digest-update-substring str) start end)) )
131
132) ;module message-digest-bv
Note: See TracBrowser for help on using the repository browser.