diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2018-06-28 06:09:25 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2018-06-28 06:09:25 -0700 |
commit | ea16bdd15f75830ea9e2bebd2ea1aaa3f9bfecf6 (patch) | |
tree | f06553cce23adac93b6c604f8d7df344082ed393 /genman.txr | |
parent | 06c93195c61f38b9785ba2d603738d50dfefc1f7 (diff) | |
download | txr-ea16bdd15f75830ea9e2bebd2ea1aaa3f9bfecf6.tar.gz txr-ea16bdd15f75830ea9e2bebd2ea1aaa3f9bfecf6.tar.bz2 txr-ea16bdd15f75830ea9e2bebd2ea1aaa3f9bfecf6.zip |
genman: use hash function written in Lisp.
Planning to support seeded hashing, so the behavior of the
hashing function will change. But we need a stable hash for
the section URL's in the HTML doc; so let's preserve the
existing function as Lisp code.
* genman.txr (hash-str): New string hashing function. This
behaves like the existing hash-equal behaves on 32 bits.
(hash-title): Use hash-str instead of hash-equal.
Diffstat (limited to 'genman.txr')
-rw-r--r-- | genman.txr | 8 |
1 files changed, 6 insertions, 2 deletions
@@ -14,10 +14,14 @@ (defvarl disamb (hash :equal-based)) (defvarl dist-counter 0) - (sys:set-hash-str-limit 1000) + (defun hash-str (str) + (for ((lim (len str)) (i 0) (h 0) g) ((< i lim) h) ((inc i)) + (set h (+ (ash h 4) (int-chr [str i]))) + (set g (logand h #x7c000000)) + (set h (logtrunc (logxor h (logxor (ash g -26) g)) 32)))) (defun hash-title (title) - (let* ((h (logtrunc (hash-equal title) 32)) + (let* ((h (logtrunc (hash-str title) 32)) (existing [dupes h])) (when existing (unless (equal title existing) |