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 | 525178581e263d109f4620f742714ab3679ddf14 (patch) | |
| tree | f06553cce23adac93b6c604f8d7df344082ed393 | |
| parent | 5100f0be7352d604e487ff3d26250edaa09d262f (diff) | |
| download | txr-525178581e263d109f4620f742714ab3679ddf14.tar.gz txr-525178581e263d109f4620f742714ab3679ddf14.tar.bz2 txr-525178581e263d109f4620f742714ab3679ddf14.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.
| -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) |