From ce9add5a9a2f517939c5f134ef3c21c314b8acb6 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Fri, 14 Jan 2000 19:47:20 +0000 Subject: [PATCH] Special case bit vectors within sxhash, returning a useful hash for them rather than a hash of 1. --- code/hash-new.lisp | 30 ++++++++++++++++++++---------- code/hash.lisp | 30 ++++++++++++++++++++---------- 2 files changed, 40 insertions(+), 20 deletions(-) diff --git a/code/hash-new.lisp b/code/hash-new.lisp index 3595b9951..b40a5c154 100644 --- a/code/hash-new.lisp +++ b/code/hash-new.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.8 2000/01/13 16:55:46 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.9 2000/01/14 19:47:19 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -141,6 +141,7 @@ (values (sxhash key) nil)) (defun equalp-hash (key) + (declare (values hash (member t nil))) (values (internal-equalp-hash key 0) nil)) @@ -882,6 +883,14 @@ (sxmash hash (,(if equalp 'internal-equalp-hash 'internal-sxhash) (car sequence) ,depth))))) +(defmacro sxhash-bit-vector (vector) + `(let* ((length (length ,vector)) + (hash length)) + (declare (type index length) (type hash hash)) + (dotimes (index (min length sxhash-max-len) hash) + (declare (type index index)) + (sxmash hash (bit ,vector index))))) + ); eval-when (compile eval) @@ -933,6 +942,9 @@ (array (typecase s-expr (string (sxhash-string s-expr)) + (simple-bit-vector (sxhash-bit-vector + (truly-the simple-bit-vector s-expr))) + (bit-vector (sxhash-bit-vector (truly-the bit-vector s-expr))) (t (array-rank s-expr)))) ;; Everything else. (t 42))) @@ -970,15 +982,13 @@ (defmacro vector-equalp-hash (vector depth) `(if (= ,depth sxhash-max-depth) 0 - (let ((hash 4) - (length (length ,vector))) - (declare (type hash hash) (type index length)) - (sxmash hash length) - (let ((,depth (+ ,depth 1))) - (dotimes (index (min length sxhash-max-len) hash) - (declare (type index index)) - (sxmash hash (internal-equalp-hash (aref ,vector index) - ,depth))))))) + (let* ((length (length ,vector)) + (hash length) + (,depth (+ ,depth 1))) + (declare (type index length) (type hash hash)) + (dotimes (index (min length sxhash-max-len) hash) + (declare (type index index)) + (sxmash hash (internal-equalp-hash (aref ,vector index) ,depth)))))) (defmacro array-equalp-hash (array depth) `(if (= ,depth sxhash-max-depth) diff --git a/code/hash.lisp b/code/hash.lisp index b4dade692..befee36f9 100644 --- a/code/hash.lisp +++ b/code/hash.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.32 2000/01/13 16:55:46 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.33 2000/01/14 19:47:20 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -206,6 +206,7 @@ (values (sxhash key) nil)) (defun equalp-hash (key) + (declare (values hash (member t nil))) (values (internal-equalp-hash key 0) nil)) @@ -851,6 +852,14 @@ (sxmash hash (,(if equalp 'internal-equalp-hash 'internal-sxhash) (car sequence) ,depth))))) +(defmacro sxhash-bit-vector (vector) + `(let* ((length (length ,vector)) + (hash length)) + (declare (type index length) (type hash hash)) + (dotimes (index (min length sxhash-max-len) hash) + (declare (type index index)) + (sxmash hash (bit ,vector index))))) + ); eval-when (compile eval) @@ -902,6 +911,9 @@ (array (typecase s-expr (string (sxhash-string s-expr)) + (simple-bit-vector (sxhash-bit-vector + (truly-the simple-bit-vector s-expr))) + (bit-vector (sxhash-bit-vector (truly-the bit-vector s-expr))) (t (array-rank s-expr)))) ;; Everything else. (t 42))) @@ -939,15 +951,13 @@ (defmacro vector-equalp-hash (vector depth) `(if (= ,depth sxhash-max-depth) 0 - (let ((hash 4) - (length (length ,vector))) - (declare (type hash hash) (type index length)) - (sxmash hash length) - (let ((,depth (+ ,depth 1))) - (dotimes (index (min length sxhash-max-len) hash) - (declare (type index index)) - (sxmash hash (internal-equalp-hash (aref ,vector index) - ,depth))))))) + (let* ((length (length ,vector)) + (hash length) + (,depth (+ ,depth 1))) + (declare (type index length) (type hash hash)) + (dotimes (index (min length sxhash-max-len) hash) + (declare (type index index)) + (sxmash hash (internal-equalp-hash (aref ,vector index) ,depth)))))) (defmacro array-equalp-hash (array depth) `(if (= ,depth sxhash-max-depth) -- GitLab