source: project/release/4/message-digest/trunk/message-digest-support.scm @ 35338

Last change on this file since 35338 was 35338, checked in by kon, 5 months ago

use typed-define, add types

File size: 3.4 KB
Line 
1;;;; message-digest-support.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;; - Uses 'context-info' to determine whether active context is "own" allocation or
10;; callers. Again, a kludge.
11;;
12;; - Passes u8vector to update phase as a blob.
13
14(module message-digest-support
15
16(;export
17  ; Support
18  packed-vector->blob/shared
19  ;
20  u8vector/slice blob/slice string/slice
21  ;
22  *message-digest-update-blob
23  *message-digest-update-string)
24
25(import scheme chicken)
26
27(use
28  (only lolevel number-of-bytes)
29  (only srfi-4
30    s8vector?
31    u8vector?
32    s16vector?
33    u16vector?
34    s32vector?
35    u32vector?
36    #;u64vector?
37    #;u64vector?
38    f32vector?
39    f64vector?
40    u8vector->blob/shared
41    s8vector->blob/shared
42    s16vector->blob/shared
43    u16vector->blob/shared
44    s32vector->blob/shared
45    u32vector->blob/shared
46    #;s64vector->blob/shared
47    #;u64vector->blob/shared
48    f32vector->blob/shared
49    f64vector->blob/shared
50    subu8vector u8vector-length)
51  message-digest-primitive
52  message-digest-type
53  fx-utils
54  typed-define)
55
56;;; Support
57
58;;
59
60(define-type srfi4vector (or u8vector s8vector u16vector s16vector u32vector s32vector f32vector f64vector))
61
62(define-type message-digest (struct message-digest))
63
64;;
65
66;Used by update-item & srfi-4 modules
67
68(define: (packed-vector->blob/shared (obj srfi4vector)) -> (or boolean blob)
69  (cond
70    ((u8vector? obj)        (u8vector->blob/shared obj))
71    ((s8vector? obj)        (s8vector->blob/shared obj))
72    ((u16vector? obj)       (u16vector->blob/shared obj))
73    ((s16vector? obj)       (s16vector->blob/shared obj))
74    ((u32vector? obj)       (u32vector->blob/shared obj))
75    ((s32vector? obj)       (s32vector->blob/shared obj))
76    #;((u64vector? obj)       (u64vector->blob/shared obj))
77    #;((s64vector? obj)       (s64vector->blob/shared obj))
78    ((f32vector? obj)       (f32vector->blob/shared obj))
79    ((f64vector? obj)       (f64vector->blob/shared obj))
80    (else                   #f ) ) )
81
82;;
83
84(define: (u8vector/slice (u8vec u8vector) (start fixnum) (end (or boolean fixnum))) -> u8vector
85   (let ((end (or end (u8vector-length u8vec))))
86    (if (and (fxzero? start) (fx= end (u8vector-length u8vec)))
87      u8vec
88      (subu8vector u8vec start end) ) ) )
89
90(define: (blob/slice (blb blob) (start fixnum) (end (or boolean fixnum))) -> blob
91  (let (
92    (end (or end (blob-size blb))) )
93    (if (and (fxzero? start) (fx= end (blob-size blb)))
94      blb
95      (string->blob (##sys#substring (blob->string blb) start end)) ) ) )
96
97(define: (string/slice (str string) (start fixnum) (end (or boolean fixnum))) -> string
98  (let (
99    (end (or end (string-length str))) )
100    (if (and (fxzero? start) (fx= end (string-length str)))
101      str
102      (##sys#substring str start end) ) ) )
103
104;;
105
106(define: (*message-digest-update-blob (md message-digest) (blb blob) . (opts (list-of fixnum))) -> void
107  (let (
108    (siz (optional opts (blob-size blb))) )
109    ((message-digest-algorithm-update md)
110      (message-digest-context md)
111      blb
112      siz) ) )
113
114(define: (*message-digest-update-string (md message-digest) (str string)) -> void
115        (*message-digest-update-blob md (string->blob str)) )
116
117(define: (message-digest-algorithm-update (md message-digest)) -> procedure
118  (message-digest-primitive-update (message-digest-algorithm md)) )
119
120) ;module message-digest-support
Note: See TracBrowser for help on using the repository browser.