changelog shortlog graph tags branches changeset files revisions annotate raw help

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

changeset 207: e48427b30ecd
parent: 85f27597cf60
child: 1741660af6e9
author: Richard Westhaver <ellis@rwest.io>
date: Thu, 15 Feb 2024 20:35:16 -0500
permissions: -rw-r--r--
description: lisp stuff, nu test stuff, back on stable support for rust 
     1 ;;; lib/obj/hash/hasher.lisp --- Hash Functions
     2 
     3 ;;
     4 
     5 ;;; Code:
     6 (in-package :obj/hash)
     7 (eval-always
     8   (defvar *global-hasher* #'sxhash))
     9 
    10 (defconstant +global-hash+ 
    11   (if (boundp '+global-hash+)
    12       +global-hash+
    13       (funcall *global-hasher* (get-universal-time))))
    14 
    15 (macrolet ((specialize (str body)       ; TODO 2023-12-21: test if this actually compiles to fastpath
    16              `(if (typep ,str '(simple-array character 1))
    17                   ,body
    18                   ,body)))
    19   (defun djb (string)
    20     (declare (string string)
    21              (optimize speed))
    22     (let ((hash 5381))
    23       (declare ((and unsigned-byte fixnum) hash))
    24       (specialize
    25        string
    26        (dotimes (n (min 6 (length string)))
    27          (setf hash
    28                (logand most-positive-fixnum
    29                        (logxor (* hash 33)
    30                                (char-code (schar string n)))))))
    31       hash)))
    32 
    33 (defun hash-object-address (obj &optional (test *global-hasher*))
    34   "Given some object OBJ, lookup the address with
    35   SB-KERNEL:GET-LISP-OBJ-ADDRESS and return a hash."
    36   (funcall test (sb-kernel:get-lisp-obj-address obj)))
    37 
    38 (defun object-address-hash-equalp (a b)
    39   (= (hash-object-address a) (hash-object-address b)))
    40 
    41 ;; from quicklisp
    42 (defun dumb-string-hash (string)
    43   "Produce a six-character hash of STRING."
    44   (let ((hash #xD13CCD13))
    45     (loop for char across string
    46           for value = (char-code char)
    47           do
    48           (setf hash (logand #xFFFFFFFF
    49                              (logxor (ash hash 5)
    50                                      (ash hash -27)
    51                                      value))))
    52     (subseq (format nil "~(~36,6,'0R~)" (mod hash 88888901))
    53             0 6)))
    54 
    55 (sb-ext:define-hash-table-test object-address-hash-equalp hash-object-address)
    56 
    57 (defgeneric hash-object (obj))