/usr/share/scheme48-1.9/big/constant-table.scm is in scheme48 1.9-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 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Mike Sperber
; Looking up in an eq? table that's known in advance.
; Keys can't be #f.
; Based on the idea described in Will Clinger's paper at the
; 2005 Scheme Workshop.
(define-record-type constant-table :constant-table
(really-make-constant-table hash-function
keys values
max-work)
constant-table?
(hash-function constant-table-hash-function)
(keys constant-table-keys)
(values constant-table-values)
(max-work constant-table-max-work))
(define (table-bits entry-count)
;; upper approximation for log2(entry-count)
(inexact->exact (round (* 2 (log (+ entry-count 1))))))
(define (shorten-vector vec size)
(if (= size (vector-length vec))
vec
(do ((new (make-vector size))
(i 0 (+ 1 i)))
((= i size) new)
(vector-set! new i (vector-ref vec i)))))
(define (make-constant-table entries-alist hash-function)
(let* ((entry-count (length entries-alist))
(bit-count (table-bits entry-count))
(modulus (expt 2 bit-count))
(size (* 2 modulus))
(mask (- modulus 1))
(keys (make-vector size #f))
(values (make-vector size #f))
(max-index 0)
(max-work 0))
(define (compute-index key)
(let loop ((index (bitwise-and (hash-function key) mask))
(work 0))
(if (not (vector-ref keys index))
(begin
(set! max-work (max work max-work))
(set! max-index (max index max-index))
index)
(loop (+ 1 index) (+ 1 work)))))
(for-each (lambda (p)
(let ((key (car p))
(val (cdr p)))
(let ((index (compute-index key)))
(vector-set! keys index key)
(vector-set! values index val))))
entries-alist)
(really-make-constant-table
(lambda (key)
(bitwise-and (hash-function key) mask))
(shorten-vector keys (+ 1 max-index))
(shorten-vector values (+ 1 max-index))
max-work)))
(define (constant-table-lookup table key)
(let ((hash ((constant-table-hash-function table) key))
(keys (constant-table-keys table)))
(let ((max-index (min (+ hash (constant-table-max-work table))
(- (vector-length keys) 1))))
(let loop ((index hash))
(cond
((> index max-index) #f)
((eq? key (vector-ref keys index))
(vector-ref (constant-table-values table) index))
(else
(loop (+ 1 index))))))))
|