(in-package "SB!IMPL")
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defconstant max-hash sb!xc:most-positive-fixnum))
+
+(deftype hash ()
+ `(integer 0 ,max-hash))
+
+(defun pointer-hash (key)
+ (pointer-hash key))
+
;;; the depthoid explored when calculating hash values
;;;
;;; "Depthoid" here is a sort of mixture of what Common Lisp ordinarily calls
(and fixnum unsigned-byte))
(and fixnum unsigned-byte))
mix))
+(declaim (inline mix))
(defun mix (x y)
;; FIXME: We wouldn't need the nasty (SAFETY 0) here if the compiler
;; were smarter about optimizing ASH. (Without the THE FIXNUM below,
;;;; <http://burtleburtle.net/bob/hash/doobs.html> for some more
;;;; information).
-#!-sb-fluid (declaim (inline %sxhash-substring))
+(declaim (inline %sxhash-substring))
(defun %sxhash-substring (string &optional (count (length string)))
;; FIXME: As in MIX above, we wouldn't need (SAFETY 0) here if the
;; cross-compiler were smarter about ASH, but we need it for
(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 somwhere. -- CSR, 2003-03-14
+ ;; fast, in case it is the bottleneck somewhere. -- CSR, 2003-03-14
(declare (optimize speed))
(labels ((sxhash-number (x)
(etypecase x
;; 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
(structure-object (structure-object-psxhash key depthoid))
(cons (list-psxhash key depthoid))
(number (number-psxhash key))
- (character (sxhash (char-upcase key)))
+ (character (char-code (char-upcase key)))
(t (sxhash key))))
(defun array-psxhash (key depthoid)
'(let ((result 572539))
(declare (type fixnum result))
(mixf result (length key))
- (dotimes (i (min depthoid (length key)))
+ (when (plusp depthoid)
+ (decf depthoid)
+ (dotimes (i (length key))
(declare (type fixnum i))
(mixf result
- (psxhash (aref key i)
- (- depthoid 1 i))))
- result)))
- ;; CMU can compile SIMPLE-ARRAY operations so much more efficiently
- ;; than the general case that it's probably worth picking off the
- ;; common special cases.
- (typecase key
- (simple-string
- ;;(format t "~&SIMPLE-STRING special case~%")
- (frob))
- (simple-vector
- ;;(format t "~&SIMPLE-VECTOR special case~%")
- (frob))
- (t (frob)))))
+ (psxhash (aref key i) depthoid))))
+ result))
+ (make-dispatch (types)
+ `(typecase key
+ ,@(loop for type in types
+ collect `(,type
+ (frob))))))
+ (make-dispatch (simple-base-string
+ (simple-array character (*))
+ simple-vector
+ (simple-array (unsigned-byte 8) (*))
+ (simple-array fixnum (*))
+ t))))
+ ;; 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 (array-rank key))
+ (mixf result (array-dimension key i)))
+ (when (plusp depthoid)
+ (decf depthoid)
+ (dotimes (i (array-total-size key))
+ (mixf result
+ (psxhash (row-major-aref key i) depthoid))))
+ result))))
(defun structure-object-psxhash (key depthoid)
(declare (optimize speed))