diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
commit | 5145dd3aa0c02c9fc496d1432fc4410674206e1d (patch) | |
tree | 540afc30c51da085f5bd8ec3f4c89f6496e7900d /hash.scm | |
parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
download | slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.tar.gz slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.zip |
Import Upstream version 3a2upstream/3a2
Diffstat (limited to 'hash.scm')
-rw-r--r-- | hash.scm | 46 |
1 files changed, 7 insertions, 39 deletions
@@ -1,5 +1,5 @@ ; "hash.scm", hashing functions for Scheme. -; Copyright (c) 1992, 1993, 1995, 2003 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 @@ -96,52 +96,20 @@ ((input-port? obj) 260) ((output-port? obj) 261) ((procedure? obj) 262) - ((and (provided? 'RECORD) (record? obj)) - (let* ((rtd (record-type-descriptor obj)) - (fns (record-type-field-names rtd)) - (len (length fns))) - (if (> len 5) - (let lp ((h (modulo 266 n)) (i (quotient d 2))) - (if (positive? i) - (lp (modulo - (+ (* h 256) - (hs 2 ((record-accessor - rtd (list-ref fns (modulo h len))) - obj))) - n) - (- i 1)) - h)) - (let loop ((h (- n 1)) (i (- len 1))) - (if (>= i 0) - (loop (modulo - (+ (* h 256) - (hs (quotient d len) - ((record-accessor - rtd (list-ref fns (modulo h len))) - obj))) - n) - (- i 1)) - h))))) (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, -;;; vectors, and records. This also allows us to use it for both -;;; hashq and hashv. +;;; 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) - (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)))) + (lambda (obj k) + (if (or (string? obj) (pair? obj) (vector? obj)) + (modulo (object-hash obj) k) + (hash:hash obj k))) hash)) (define hashq hashv) |