/usr/share/slib/hash.scm is in slib 3b1-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | ; "hash.scm", hashing functions for Scheme.
; Copyright (C) 1992, 1993, 1995, 2003 Aubrey Jaffer
;
;Permission to copy this software, to modify it, to redistribute it,
;to distribute modified versions, and to use it for any purpose is
;granted, subject to the following restrictions and understandings.
;
;1. Any copy made of this software must include this copyright notice
;in full.
;
;2. I have made no warranty or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
;3. In conjunction with products arising from the use of this
;material, there shall be no use of my name in any advertising,
;promotional, or sales literature without prior written consent in
;each case.
(define (hash:hash-string-ci str n)
(let ((len (string-length str)))
(if (> len 5)
(let loop ((h (modulo 264 n)) (i 5))
(if (positive? i)
(loop (modulo (+ (* h 256)
(char->integer
(char-downcase
(string-ref str (modulo h len)))))
n)
(- i 1))
h))
(let loop ((h 0) (i (- len 1)))
(if (>= i 0)
(loop (modulo (+ (* h 256)
(char->integer
(char-downcase (string-ref str i))))
n)
(- i 1))
h)))))
(define hash:hash-string hash:hash-string-ci)
(define (hash:hash-symbol sym n)
(hash:hash-string (symbol->string sym) n))
;;; This can overflow on implemenatations where inexacts have a larger
;;; range than exact integers.
(define hash:hash-number
(if (provided? 'inexact)
(lambda (num n)
(if (integer? num)
(modulo (if (exact? num) num (inexact->exact num)) n)
(hash:hash-string-ci
(number->string (if (exact? num) (exact->inexact num) num))
n)))
(lambda (num n)
(if (integer? num)
(modulo num n)
(hash:hash-string-ci (number->string num) n)))))
;@
(define (hash obj n)
(let hs ((d 10) (obj obj))
(cond
((number? obj) (hash:hash-number obj n))
((char? obj) (modulo (char->integer (char-downcase obj)) n))
((symbol? obj) (hash:hash-symbol obj n))
((string? obj) (hash:hash-string obj n))
((vector? obj)
(let ((len (vector-length obj)))
(if (> len 5)
(let lp ((h 1) (i (quotient d 2)))
(if (positive? i)
(lp (modulo (+ (* h 256)
(hs 2 (vector-ref obj (modulo h len))))
n)
(- i 1))
h))
(let loop ((h (- n 1)) (i (- len 1)))
(if (>= i 0)
(loop (modulo (+ (* h 256) (hs (quotient d len)
(vector-ref obj i)))
n)
(- i 1))
h)))))
((pair? obj)
(if (positive? d) (modulo (+ (hs (quotient d 2) (car obj))
(hs (quotient d 2) (cdr obj)))
n)
1))
(else
(modulo
(cond
((null? obj) 256)
((boolean? obj) (if obj 257 258))
((eof-object? obj) 259)
((input-port? obj) 260)
((output-port? obj) 261)
((procedure? obj) 262)
(else 263))
n)))))
(define hash:hash hash)
;;; Object-hash is somewhat expensive on copying GC systems (like
;;; PC-Scheme and MITScheme). We use it only on strings, pairs, and
;;; vectors. This also allows us to use it for both hashq and hashv.
;@
(define hashv
(if (provided? 'object-hash)
(lambda (obj k)
(if (or (string? obj) (pair? obj) (vector? obj))
(modulo (object-hash obj) k)
(hash:hash obj k)))
hash))
(define hashq hashv)
|