История изменений
Исправление den73, (текущая версия) :
Так сделано в SBCL 1.4.2:
(defun %sxhash-substring (string &optional (count (length string)))
(declare (optimize (speed 3) (safety 0)))
(declare (type string string))
(declare (type index count))
(macrolet ((set-result (form)
`(setf result (ldb (byte #.sb!vm:n-word-bits 0) ,form))))
(let ((result 0))
(declare (type (unsigned-byte #.sb!vm:n-word-bits) result))
(unless (typep string '(vector nil))
(dotimes (i count)
(declare (type index i))
(set-result (+ result (char-code (aref string i))))
(set-result (+ result (ash result 10)))
(set-result (logxor result (ash result -6)))))
(set-result (+ result (ash result 3)))
(set-result (logxor result (ash result -11)))
(set-result (logxor result (ash result 15)))
(logand result most-positive-fixnum))))
;;; test:
;;; (let ((ht (make-hash-table :test 'equal)))
;;; (do-all-symbols (symbol)
;;; (let* ((string (symbol-name symbol))
;;; (hash (%sxhash-substring string)))
;;; (if (gethash hash ht)
;;; (unless (string= (gethash hash ht) string)
;;; (format t "collision: ~S ~S~%" string (gethash hash ht)))
;;; (setf (gethash hash ht) string))))
;;; (format t "final count=~W~%" (hash-table-count ht)))
Но в Активном Обероне нет LOGXOR.
Исходная версия den73, :
Так сделано в SBCL 1.4.2:
(defun %sxhash-substring (string &optional (count (length string)))
(declare (optimize (speed 3) (safety 0)))
(declare (type string string))
(declare (type index count))
(macrolet ((set-result (form)
`(setf result (ldb (byte #.sb!vm:n-word-bits 0) ,form))))
(let ((result 0))
(declare (type (unsigned-byte #.sb!vm:n-word-bits) result))
(unless (typep string '(vector nil))
(dotimes (i count)
(declare (type index i))
(set-result (+ result (char-code (aref string i))))
(set-result (+ result (ash result 10)))
(set-result (logxor result (ash result -6)))))
(set-result (+ result (ash result 3)))
(set-result (logxor result (ash result -11)))
(set-result (logxor result (ash result 15)))
(logand result most-positive-fixnum))))
;;; test:
;;; (let ((ht (make-hash-table :test 'equal)))
;;; (do-all-symbols (symbol)
;;; (let* ((string (symbol-name symbol))
;;; (hash (%sxhash-substring string)))
;;; (if (gethash hash ht)
;;; (unless (string= (gethash hash ht) string)
;;; (format t "collision: ~S ~S~%" string (gethash hash ht)))
;;; (setf (gethash hash ht) string))))
;;; (format t "final count=~W~%" (hash-table-count ht)))