Permalink
Browse files

make DEFINE-DIGEST-FINALIZER generate PRODUCE-DIGEST directly

There's no need for the extra layer of indirection to FINALIZE-DIGEST.
  • Loading branch information...
1 parent f6510a1 commit fd1f7a9057cfebbff3c9b02c4c2911a0695c49d0 @froydnj committed Jun 25, 2012
Showing with 28 additions and 26 deletions.
  1. +6 −4 src/digests/adler32.lisp
  2. +6 −4 src/digests/crc24.lisp
  3. +6 −4 src/digests/crc32.lisp
  4. +10 −14 src/digests/digest.lisp
@@ -67,9 +67,11 @@
(adler32-s1 state)))
digest))
(declare (inline stuff-state))
- (cond
- (%buffer (stuff-state state %buffer buffer-start))
- (t (stuff-state state
- (make-array 4 :element-type '(unsigned-byte 8)) 0)))))
+ (etypecase digest
+ ((simple-array (unsigned-byte 8) (*))
+ (stuff-state state digest digest-start))
+ (cl:null
+ (stuff-state state
+ (make-array 4 :element-type '(unsigned-byte 8)) 0)))))
(defdigest adler32 :digest-length 4 :block-length 1)
@@ -92,9 +92,11 @@
(aref digest (+ start 2)) (ldb (byte 8 0) crc))
digest))
(declare (inline stuff-state))
- (cond
- (%buffer (stuff-state (crc24-crc state) %buffer buffer-start))
- (t (stuff-state (crc24-crc state)
- (make-array 3 :element-type '(unsigned-byte 8)) 0)))))
+ (etypecase digest
+ ((simple-array (unsigned-byte 8) (*))
+ (stuff-state (crc24-crc state) digest digest-start))
+ (cl:null
+ (stuff-state (crc24-crc state)
+ (make-array 3 :element-type '(unsigned-byte 8)) 0)))))
(defdigest crc24 :digest-length 3 :block-length 1)
@@ -89,9 +89,11 @@
digest))
(declare (inline stuff-state))
(let ((result (logxor #xffffffff (crc32-crc state))))
- (cond
- (%buffer (stuff-state result %buffer buffer-start))
- (t (stuff-state result
- (make-array 4 :element-type '(unsigned-byte 8)) 0))))))
+ (etypecase digest
+ ((simple-array (unsigned-byte 8) (*))
+ (stuff-state result digest digest-start))
+ (cl:null
+ (stuff-state result
+ (make-array 4 :element-type '(unsigned-byte 8)) 0))))))
(defdigest crc32 :digest-length 4 :block-length 1)
@@ -148,11 +148,11 @@
(inner-fun-name (intern (format nil "%~A-~A-~A" '#:finalize (caar specs) '#:state))))
(destructuring-bind (maybe-doc-string &rest rest) body
(let ((primary-digest (caar specs)))
- `(defmethod finalize-digest ((state ,primary-digest)
- &optional buffer buffer-start)
+ `(defmethod produce-digest ((state ,primary-digest)
+ &key digest (digest-start 0))
,@(when (stringp maybe-doc-string)
`(,maybe-doc-string))
- (flet ((,inner-fun-name (state %buffer buffer-start)
+ (flet ((,inner-fun-name (state digest digest-start)
;; CCL requires special treatment to not introduce
;; array indexing errors.
,(cond
@@ -166,7 +166,7 @@
collect `(,digest-name
(,(intern (format nil "~A~A"
digest-name '#:regs-digest))
- ,regs %buffer buffer-start)))))
+ ,regs digest digest-start)))))
(if ,single-digest-p
(second (first clauses))
(list* 'etypecase state
@@ -178,15 +178,14 @@
(second (first specs))
`(etypecase state
,@(reverse specs)))))
- (etypecase buffer
+ (etypecase digest
((simple-array (unsigned-byte 8) (*))
;; verify that the buffer is large enough
- (let ((buffer-start (or buffer-start 0)))
- (if (<= digest-size (- (length buffer) buffer-start))
- (,inner-fun-name state buffer buffer-start)
- (error 'insufficient-buffer-space
- :buffer buffer :start buffer-start
- :length digest-size))))
+ (if (<= digest-size (- (length digest) digest-start))
+ (,inner-fun-name state digest digest-start)
+ (error 'insufficient-buffer-space
+ :buffer digest :start digest-start
+ :length digest-size)))
(cl:null
(,inner-fun-name state
(make-array digest-size
@@ -371,9 +370,6 @@ DIGESTER so far. This function modifies the internal state of DIGESTER.
If DIGEST is provided, the hash will be placed into DIGEST starting at
DIGEST-START. DIGEST must be a (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)).
An error will be signaled if there is insufficient room in DIGEST."))
-
-(defmethod produce-digest (digester &key digest (digest-start 0))
- (finalize-digest digester digest digest-start))
;;; the digest-defining macro

0 comments on commit fd1f7a9

Please sign in to comment.