diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 |
commit | 8466d8cfa486fb30d1755c4261b781135083787b (patch) | |
tree | c8c12c67246f543c3cc4f64d1c07e003cb1d45ae /hash.scm | |
parent | 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff) | |
download | slib-8466d8cfa486fb30d1755c4261b781135083787b.tar.gz slib-8466d8cfa486fb30d1755c4261b781135083787b.zip |
Import Upstream version 3a1upstream/3a1
Diffstat (limited to 'hash.scm')
-rw-r--r-- | hash.scm | 42 |
1 files changed, 18 insertions, 24 deletions
@@ -1,5 +1,5 @@ ; "hash.scm", hashing functions for Scheme. -; Copyright (c) 1992, 1993, 1995 Aubrey Jaffer +; 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 @@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;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. ; @@ -17,11 +17,6 @@ ;promotional, or sales literature without prior written consent in ;each case. -(define (hash:hash-char-ci char n) - (modulo (char->integer (char-downcase char)) n)) - -(define hash:hash-char hash:hash-char-ci) - (define (hash:hash-symbol sym n) (hash:hash-string (symbol->string sym) n)) @@ -62,8 +57,8 @@ h))))) (define hash:hash-string hash:hash-string-ci) - -(define (hash:hash obj n) +;@ +(define (hash obj n) (let hs ((d 10) (obj obj)) (cond ((number? obj) (hash:hash-number obj n)) @@ -130,24 +125,23 @@ (else 263)) n))))) -(define hash hash:hash) -(define hashv hash:hash) +(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, ;;; vectors, and records. This also allows us to use it for both ;;; hashq and hashv. - -(if (provided? 'object-hash) - (set! hashv - (if (provided? 'record) - (lambda (obj k) - (if (or (string? obj) (pair? obj) (vector? obj) (record? obj)) - (modulo (object-hash obj) k) - (hash:hash obj k))) - (lambda (obj k) - (if (or (string? obj) (pair? obj) (vector? obj)) - (modulo (object-hash obj) k) - (hash:hash obj k)))))) - +;@ +(define hashv + (if (provided? 'object-hash) + (if (provided? 'record) + (lambda (obj k) + (if (or (string? obj) (pair? obj) (vector? obj) (record? obj)) + (modulo (object-hash obj) k) + (hash:hash obj k))) + (lambda (obj k) + (if (or (string? obj) (pair? obj) (vector? obj)) + (modulo (object-hash obj) k) + (hash:hash obj k)))) + hash)) (define hashq hashv) |