/usr/share/slib/hashtab.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 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 | ; "hashtab.scm", hash tables for Scheme.
; Copyright (C) 1992, 1993, 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.
(require 'hash)
(require 'alist)
;;@code{(require 'hash-table)}
;;@ftindex hash-table
;;@body
;;Returns a hash function (like @code{hashq}, @code{hashv}, or
;;@code{hash}) corresponding to the equality predicate @var{pred}.
;;@var{pred} should be @code{eq?}, @code{eqv?}, @code{equal?}, @code{=},
;;@code{char=?}, @code{char-ci=?}, @code{string=?}, or
;;@code{string-ci=?}.
(define (predicate->hash pred)
(cond ((eq? pred eq?) hashq)
((eq? pred eqv?) hashv)
((eq? pred equal?) hash)
((eq? pred =) hashv)
((eq? pred char=?) hashv)
((eq? pred char-ci=?) hashv)
((eq? pred string=?) hash)
((eq? pred string-ci=?) hash)
(else (slib:error "unknown predicate for hash" pred))))
;;@noindent
;;A hash table is a vector of association lists.
;;@body
;;Returns a vector of @var{k} empty (association) lists.
(define (make-hash-table k) (make-vector k '()))
;;@noindent
;;Hash table functions provide utilities for an associative database.
;;These functions take an equality predicate, @var{pred}, as an argument.
;;@var{pred} should be @code{eq?}, @code{eqv?}, @code{equal?}, @code{=},
;;@code{char=?}, @code{char-ci=?}, @code{string=?}, or
;;@code{string-ci=?}.
;;@body
;;Returns a hash association function of 2 arguments, @var{key} and
;;@var{hashtab}, corresponding to @var{pred}. The returned function
;;returns a key-value pair whose key is @var{pred}-equal to its first
;;argument or @code{#f} if no key in @var{hashtab} is @var{pred}-equal to
;;the first argument.
(define (predicate->hash-asso pred)
(let ((hashfun (predicate->hash pred))
(asso (predicate->asso pred)))
(lambda (key hashtab)
(asso key
(vector-ref hashtab (hashfun key (vector-length hashtab)))))))
;;@body
;;Returns a procedure of 2 arguments, @var{hashtab} and @var{key}, which
;;returns the value associated with @var{key} in @var{hashtab} or
;;@code{#f} if @var{key} does not appear in @var{hashtab}.
(define (hash-inquirer pred)
(let ((hashfun (predicate->hash pred))
(ainq (alist-inquirer pred)))
(lambda (hashtab key)
(ainq (vector-ref hashtab (hashfun key (vector-length hashtab)))
key))))
;;@body
;;Returns a procedure of 3 arguments, @var{hashtab}, @var{key}, and
;;@var{value}, which modifies @var{hashtab} so that @var{key} and
;;@var{value} associated. Any previous value associated with @var{key}
;;will be lost.
(define (hash-associator pred)
(let ((hashfun (predicate->hash pred))
(asso (alist-associator pred)))
(lambda (hashtab key val)
(let* ((num (hashfun key (vector-length hashtab))))
(vector-set! hashtab num
(asso (vector-ref hashtab num) key val)))
hashtab)))
;;@body
;;Returns a procedure of 2 arguments, @var{hashtab} and @var{key}, which
;;modifies @var{hashtab} so that the association whose key is @var{key} is
;;removed.
(define (hash-remover pred)
(let ((hashfun (predicate->hash pred))
(arem (alist-remover pred)))
(lambda (hashtab key)
(let* ((num (hashfun key (vector-length hashtab))))
(vector-set! hashtab num
(arem (vector-ref hashtab num) key)))
hashtab)))
;;@args proc hash-table
;;Returns a new hash table formed by mapping @var{proc} over the
;;keys and values of @var{hash-table}. @var{proc} must be a function of 2
;;arguments which returns the new value part.
(define (hash-map proc ht)
(define nht (make-vector (vector-length ht)))
(do ((i (+ -1 (vector-length ht)) (+ -1 i)))
((negative? i) nht)
(vector-set!
nht i
(alist-map proc (vector-ref ht i)))))
;;@args proc hash-table
;;Applies @var{proc} to each pair of keys and values of @var{hash-table}.
;;@var{proc} must be a function of 2 arguments. The returned value is
;;unspecified.
(define (hash-for-each proc ht)
(do ((i (+ -1 (vector-length ht)) (+ -1 i)))
((negative? i))
(alist-for-each proc (vector-ref ht i))))
;;@body
;;@0 accepts a hash table predicate and returns a function of two
;;arguments @var{hashtab} and @var{new-k} which is specialized for
;;that predicate.
;;
;;This function is used for nondestrutively resizing a hash table.
;;@var{hashtab} should be an existing hash-table using @1, @var{new-k}
;;is the size of a new hash table to be returned. The new hash table
;;will have all of the associations of the old hash table.
(define (hash-rehasher pred)
(let ((hashfun (predicate->hash pred)))
(lambda (hashtab newk)
(let ((newtab (make-hash-table newk)))
(hash-for-each
(lambda (key value)
(let ((num (hashfun key newk)))
(vector-set! newtab num
(cons (cons key value)
(vector-ref newtab num)))))
hashtab)
newtab))))
|