changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/obj/hash/hasher.lisp

changeset 698: 96958d3eb5b0
parent: 9fa3b9154bb2
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; lib/obj/hash/hasher.lisp --- Hash Functions
     2 
     3 ;;
     4 
     5 ;;; Code:
     6 (in-package :obj/hash)
     7 
     8 (eval-always
     9   (defvar *global-hasher* #'sxhash))
    10 
    11 ;; TODO 2024-05-24: do better
    12 (sb-ext:define-load-time-global *global-hash* (funcall *global-hasher* (get-universal-time)))
    13 
    14 (macrolet ((specialize (str body)       ; TODO 2023-12-21: test if this actually compiles to fastpath
    15              `(if (typep ,str '(simple-array character 1))
    16                   ,body
    17                   ,body)))
    18   (defun djb (string)
    19     (declare (string string)
    20              (optimize speed))
    21     (let ((hash 5381))
    22       (declare ((and unsigned-byte fixnum) hash))
    23       (specialize
    24        string
    25        (dotimes (n (min 6 (length string)))
    26          (setf hash
    27                (logand most-positive-fixnum
    28                        (logxor (* hash 33)
    29                                (char-code (schar string n)))))))
    30       hash)))
    31 
    32 (defgeneric hash-object (obj)
    33   (:method ((obj t))
    34     (hash-object-address obj)))
    35 
    36 (defun hash-object-address (obj &optional (test *global-hasher*))
    37   "Given some object OBJ, lookup the address with
    38   SB-KERNEL:GET-LISP-OBJ-ADDRESS and return a hash."
    39   (funcall test (sb-kernel:get-lisp-obj-address obj)))
    40 
    41 (defun object-address-hash-equalp (a b)
    42   (= (hash-object-address a) (hash-object-address b)))
    43 
    44 (sb-ext:define-hash-table-test object-address-hash-equalp hash-object-address)
    45 
    46 ;; from quicklisp src
    47 (defun dumb-string-hash (str)
    48   "Produce a six-character hash of STRING."
    49   (let ((hash #xD13CCD13))
    50     (loop for char across str
    51           for value = (char-code char)
    52           do
    53           (setf hash (logand #xFFFFFFFF
    54                              (logxor (ash hash 5)
    55                                      (ash hash -27)
    56                                      value))))
    57     (subseq (format nil "~(~36,6,'0R~)" (mod hash 88888901))
    58             0 6)))
    59 
    60 ;; sb-lockless::multiplicative-hash
    61 
    62 ;;; Perfect Hashes
    63 
    64 ;; (setq *h* (sb-c:make-perfect-hash-lambda
    65 ;;            (map '(array (unsigned-byte 32) 1) (lambda (x) (ldb (byte 32 0) (sxhash x)))
    66 ;;                 '(a b c d e f g h i j k l m n o p))))