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