1.0.4.84: better EQUAL hash-tables, revert 0.9.15.21 (non-compliant SXHASH)

        * The value of SXHASH on non-string/bitvector arrays should not
          change when the contents of the array change (clhs sxhash,
          clhs 18.1.2.2). So the commit in 0.9.15.21 is invalid.
        * But luckily nothing requires us to use SXHASH for our own
          tables. Change the definition of EQUAL-HASH to punt to EQ-HASH
          for data types where EQUAL == EQL

diff --git a/NEWS b/NEWS
index 73d1b01..a16f505 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -49,8 +49,14 @@ changes in sbcl-1.0.5 relative to sbcl-1.0.4:
   * bug fix: an &environment argument with the correct variable information
     is passed to macros that are expanded during byte compilation
     (reported by Samium Gromoff)
-  * bug fix: a logical error was causing the hash function for bignums to
+  * bug fix: a logic error was causing the hash function for bignums to
     have excessive amounts of collisions (reported by Faré Rideau)
+  * bug fix: modifying the contents of an array could change the return
+    value of SXHASH on that array, which is only allowed for strings 
+    and bit vectors (bug introduced in 0.9.16)
+  * optimization: EQUAL hash tables no longer use SXHASH for objects
+    of all data types, but instead use an EQL hash for types for which
+    EQUAL is the same as EQL
   * improvement: the x86-64/darwin port now passes all tests and
     should be considered non-experimental.
   * improvement: a style-warning is signaled for CASE (etc) clauses with

diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp
index 18a50c9..d6c7560 100644 (file)
--- a/src/code/target-hash-table.lisp
+++ b/src/code/target-hash-table.lisp
@@ -64,7 +64,16 @@
 #!-sb-fluid (declaim (inline equal-hash))
 (defun equal-hash (key)
   (declare (values hash (member t nil)))
-  (values (sxhash key) nil))
+  (typecase key
+    ;; For some types the definition of EQUAL implies a special hash
+    ((or string cons number bit-vector pathname)
+     (values (sxhash key) nil))
+    ;; Otherwise use an EQ hash, rather than SXHASH, since the values
+    ;; of SXHASH will be extremely badly distributed due to the
+    ;; requirements of the spec fitting badly with our implementation
+    ;; strategy.
+    (t
+     (eq-hash key))))
 
 #!-sb-fluid (declaim (inline eql-hash))
 (defun eql-hash (key)

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index dbe9d23..a58beb2 100644 (file)
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -143,20 +143,6 @@
 (declaim (ftype (sfunction (t) (integer 0 #.sb!xc:most-positive-fixnum))
                 sxhash-instance))
 
-(defmacro hash-array-using (recurse array depthoid)
-  ;; Any other array can be hashed by working with its underlying
-  ;; one-dimensional physical representation. Used by both SXHASH and
-  ;; PSXHASH.
-  (once-only ((array array) (depthoid depthoid))
-    `(let ((result 60828123))
-       (declare (type fixnum result))
-       (dotimes (i (min ,depthoid (array-rank ,array)))
-         (mixf result (array-dimension ,array i)))
-       (dotimes (i (min ,depthoid (array-total-size ,array)))
-         (mixf result
-               (,recurse (row-major-aref ,array i) (- ,depthoid 1 i))))
-       result)))
-
 (defun sxhash (x)
   ;; profiling SXHASH is hard, but we might as well try to make it go
   ;; fast, in case it is the bottleneck somewhere.  -- CSR, 2003-03-14
@@ -215,8 +201,7 @@
                    ;; work needs to be done using the %RAW-BITS
                    ;; approach.  This will probably do for now.
                    (sxhash-recurse (copy-seq x) depthoid))
-                  (t
-                   (hash-array-using sxhash-recurse x depthoid))))
+                  (t (logxor 191020317 (sxhash (array-rank x))))))
                (character
                 (logxor 72185131
                         (sxhash (char-code x)))) ; through DEFTRANSFORM
@@ -281,8 +266,18 @@
           ;;(format t "~&SIMPLE-VECTOR special case~%")
           (frob))
          (t (frob)))))
+    ;; Any other array can be hashed by working with its underlying
+    ;; one-dimensional physical representation.
     (t
-     (hash-array-using psxhash key depthoid))))
+     (let ((result 60828))
+       (declare (type fixnum result))
+       (dotimes (i (min depthoid (array-rank key)))
+         (mixf result (array-dimension key i)))
+       (dotimes (i (min depthoid (array-total-size key)))
+         (mixf result
+               (psxhash (row-major-aref key i)
+                        (- depthoid 1 i))))
+       result))))
 
 (defun structure-object-psxhash (key depthoid)
   (declare (optimize speed))

diff --git a/tests/hash.pure.lisp b/tests/hash.pure.lisp
index 0d2dabd..a7d195e 100644 (file)
--- a/tests/hash.pure.lisp
+++ b/tests/hash.pure.lisp
@@ -16,3 +16,16 @@
 ;;; of SXHASH. The range of SXHASH is the non-negative fixnums.
 (assert (not (typep sb-impl::+magic-hash-vector-value+
                     '(and fixnum unsigned-byte))))
+
+;;; The return value of SXHASH on non-string/bitvector arrays should not
+;;; change when the contents of the array change.
+(let* ((a (make-array '(1) :initial-element 1))
+       (sxhash (sxhash a))
+       (hash (make-hash-table :test 'equal)))
+  (setf (gethash a hash) t)
+  (setf (aref a 0) 0)
+  (assert (= sxhash (sxhash a)))
+  ;; Need to make another access to the hash to disable the last-seen-element
+  ;; cache.
+  (setf (gethash 'y hash) t)
+  (assert (gethash a hash)))
\ No newline at end of file

diff --git a/version.lisp-expr b/version.lisp-expr
index 1136f4f..fb9d26e 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.4.83"
+"1.0.4.84"