From fe91df69dbf65c4a4c011bf1a7ee33100a50e711 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Sat, 14 Apr 2007 09:27:22 +0000 Subject: [PATCH] 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 --- NEWS | 8 +++++++- src/code/target-hash-table.lisp | 11 ++++++++++- src/code/target-sxhash.lisp | 29 ++++++++++++----------------- tests/hash.pure.lisp | 13 +++++++++++++ version.lisp-expr | 2 +- 5 files changed, 43 insertions(+), 20 deletions(-) diff --git a/NEWS b/NEWS index 73d1b01..a16f505 100644 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4