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

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

add define-types include, add types, reflow

File size: 3.1 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;;; Message Digest API
39
40;; Update
41
42;;
43
44(define (message-digest-update-blob md blb #!optional (start 0) (end (blob-size blb)))
45  (*message-digest-update-blob
46    (check-message-digest 'message-digest-update-blob md)
47    (check-blob/slice 'message-digest-update-blob blb start end)) )
48
49;;
50
51(define (message-digest-update-string md str #!optional (start 0) (end (string-length str)))
52  (*message-digest-update-string
53    (check-message-digest 'message-digest-update-string md)
54    (check-string/slice 'message-digest-update-string str start end)) )
55
56;;
57
58;DEPRECATED
59(define (message-digest-update-substring md str start end)
60  (*message-digest-update-string
61    (check-message-digest 'message-digest-update-substring md)
62    (substring/shared (check-string 'message-digest-update-substring str) start end)) )
63
64;; Single Source API
65
66(define (message-digest-blob mdp blb
67            #!optional
68            (result-type (message-digest-result-form))
69            (start 0) (end (blob-size blb)))
70  (let (
71    (md (initialize-message-digest mdp)) )
72    (message-digest-update-blob md blb start end)
73    (finalize-message-digest md result-type) ) )
74
75(define (message-digest-string mdp str
76            #!optional
77            (result-type (message-digest-result-form))
78            (start 0) (end (string-length str)))
79  (let (
80    (md (initialize-message-digest mdp)) )
81    (message-digest-update-string md str start end)
82    (finalize-message-digest md result-type) ) )
83
84(define (message-digest-blob! mdp blb result-buffer
85            #!optional
86            (start 0) (end (blob-size blb)))
87  (let (
88    (md (initialize-message-digest mdp)) )
89    (message-digest-update-blob md blb start end)
90    (finalize-message-digest! md result-buffer) ) )
91
92(define (message-digest-string! mdp str result-buffer
93            #!optional
94            (start 0) (end (string-length str)))
95  (let (
96    (md (initialize-message-digest mdp)) )
97    (message-digest-update-string md str start end)
98    (finalize-message-digest! md result-buffer) ) )
99
100;;;
101
102(define (check-blob/slice loc blb start end)
103  (check-fixnum-range loc start end)
104  (blob/slice (check-blob loc blb) start end) )
105
106(define (check-string/slice loc str start end)
107  (check-fixnum-range loc start end)
108  (string/slice (check-string loc str) start end) )
109
110(define (check-fixnum-range loc start end)
111  (check-range loc
112    (check-natural-fixnum loc start 'start)
113    (check-natural-fixnum loc end 'end)
114    "end < start") )
115
116) ;module message-digest-bv
Note: See TracBrowser for help on using the repository browser.