Mercurial > hg > xemacs-beta

comparison lisp/oobr/hasht.el @ 100:4be1180a9e89 r20-1b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 131b0175ea99
children
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
4 ;; SUMMARY: Create hash tables from lists and operate on them. 4 ;; SUMMARY: Create hash tables from lists and operate on them.
5 ;; USAGE: GNU Emacs Lisp Library 5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: extensions, tools 6 ;; KEYWORDS: extensions, tools
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Motorola Inc. 9 ;; ORG: InfoDock Associates
10 ;; 10 ;;
11 ;; ORIG-DATE: 16-Mar-90 at 03:38:48 11 ;; ORIG-DATE: 16-Mar-90 at 03:38:48
12 ;; LAST-MOD: 27-Sep-95 at 21:31:20 by Bob Weiner 12 ;; LAST-MOD: 20-Feb-97 at 07:04:56 by Bob Weiner
13 ;; 13 ;;
14 ;; Copyright (C) 1990-1995 Free Software Foundation, Inc. 14 ;; Copyright (C) 1990-1995, 1997 Free Software Foundation, Inc.
15 ;; See the file BR-COPY for license information. 15 ;; See the file BR-COPY for license information.
16 ;; 16 ;;
17 ;; This file is part of the OO-Browser. 17 ;; This file is part of the OO-Browser.
18 ;; 18 ;;
19 ;; DESCRIPTION: 19 ;; DESCRIPTION:
20 ;; 20 ;;
21 ;; Featureful set of hash table operators for use in personal programs. 21 ;; Featureful set of hash table operators for use in personal programs.
22 ;; 22 ;;
23 ;; 'hash-make' creates a hash table from an association list, 'hash-add' 23 ;; `hash-make' creates a hash table from an association list, `hash-add'
24 ;; adds a value-key pair to a hash table, and 'hash-lookup' finds the value 24 ;; adds a value-key pair to a hash table, and `hash-lookup' finds the value
25 ;; associated with a given key in a hash table, if any. 25 ;; associated with a given key in a hash table, if any.
26 ;; 26 ;;
27 ;; 'hash-map' does the same thing as 'mapcar' but operates on hash tables 27 ;; `hash-map' does the same thing as `mapcar' but operates on hash tables
28 ;; instead. 28 ;; instead.
29 ;; 29 ;;
30 ;; For a list of 300 items, these hash tables improve lookup times by a 30 ;; For a list of 300 items, these hash tables improve lookup times by a
31 ;; factor of between 8 and 10 to 1 over those for an unsorted list. 31 ;; factor of between 8 and 10 to 1 over those for an unsorted list.
32 ;; 32 ;;
55 (if sym (set sym value))))) 55 (if sym (set sym value)))))
56 56
57 (defun hash-copy (hash-table) 57 (defun hash-copy (hash-table)
58 "Return a copy of HASH-TABLE, list and vector elements are shared across both tables." 58 "Return a copy of HASH-TABLE, list and vector elements are shared across both tables."
59 (if (not (hashp hash-table)) 59 (if (not (hashp hash-table))
60 (error "(hash-copy): Invalid hash-table: '%s'" hash-table)) 60 (error "(hash-copy): Invalid hash-table: `%s'" hash-table))
61 (let ((htable-copy (hash-make (length (hash-obarray hash-table))))) 61 (let ((htable-copy (hash-make (length (hash-obarray hash-table)))))
62 (hash-map 62 (hash-map
63 (function (lambda (elt) (hash-add (car elt) (cdr elt) htable-copy))) 63 (function (lambda (elt) (hash-add (car elt) (cdr elt) htable-copy)))
64 hash-table) 64 hash-table)
65 htable-copy)) 65 htable-copy))
100 (setq obj (append obj nil)) 100 (setq obj (append obj nil))
101 ;; Return as a vector 101 ;; Return as a vector
102 (vconcat (mapcar 'hash-deep-copy obj))) 102 (vconcat (mapcar 'hash-deep-copy obj)))
103 ((atom obj) obj) 103 ((atom obj) obj)
104 ((nlistp obj) 104 ((nlistp obj)
105 (error "(hash-deep-copy): Invalid type, '%s'" obj)) 105 (error "(hash-deep-copy): Invalid type, `%s'" obj))
106 (t ;; list 106 (t ;; list
107 (cons (hash-deep-copy (car obj)) (hash-deep-copy (cdr obj)))))) 107 (cons (hash-deep-copy (car obj)) (hash-deep-copy (cdr obj))))))
108 108
109 (fset 'hash-get 'hash-lookup) 109 (fset 'hash-get 'hash-lookup)
110 (defun hash-key-p (key hash-table) 110 (defun hash-key-p (key hash-table)
115 (if (boundp sym) sym)))) 115 (if (boundp sym) sym))))
116 116
117 (defun hash-lookup (key hash-table) 117 (defun hash-lookup (key hash-table)
118 "Lookup KEY in HASH-TABLE and return associated value. 118 "Lookup KEY in HASH-TABLE and return associated value.
119 If value is nil, this function does not tell you whether or not KEY is in the 119 If value is nil, this function does not tell you whether or not KEY is in the
120 hash table. Use 'hash-key-p' instead for that function." 120 hash table. Use `hash-key-p' instead for that function."
121 (if (hashp hash-table) 121 (if (hashp hash-table)
122 (let* ((obarray (hash-obarray hash-table)) 122 (let* ((obarray (hash-obarray hash-table))
123 (sym (intern-soft key obarray))) 123 (sym (intern-soft key obarray)))
124 (if (boundp sym) (symbol-value sym))))) 124 (if (boundp sym) (symbol-value sym)))))
125 125
131 Optional non-nil second argument REVERSE means INITIALIZER has elements of 131 Optional non-nil second argument REVERSE means INITIALIZER has elements of
132 form (<key> . <value>)." 132 form (<key> . <value>)."
133 (if (integerp initializer) 133 (if (integerp initializer)
134 (if (>= initializer 0) 134 (if (>= initializer 0)
135 (cons 'hasht (make-vector (hash-next-prime initializer) 0)) 135 (cons 'hasht (make-vector (hash-next-prime initializer) 0))
136 (error "(hash-make): Initializer must be >= 0, not '%s'" 136 (error "(hash-make): Initializer must be >= 0, not `%s'"
137 initializer)) 137 initializer))
138 (let* ((vlen (hash-next-prime (length initializer))) 138 (let* ((vlen (hash-next-prime (length initializer)))
139 (obarray (make-vector vlen 0)) 139 (obarray (make-vector vlen 0))
140 sym) 140 sym)
141 (mapcar 141 (mapcar
152 (cons 'hasht obarray)))) 152 (cons 'hasht obarray))))
153 153
154 (defun hash-map (func hash-table) 154 (defun hash-map (func hash-table)
155 "Return result of application of FUNC to each (<value> . <key>) element of HASH-TABLE." 155 "Return result of application of FUNC to each (<value> . <key>) element of HASH-TABLE."
156 (if (not (hashp hash-table)) 156 (if (not (hashp hash-table))
157 (error "(hash-map): Invalid hash-table: '%s'" hash-table)) 157 (error "(hash-map): Invalid hash-table: `%s'" hash-table))
158 (let ((result)) 158 (let ((result))
159 (mapatoms (function 159 (mapatoms (function
160 (lambda (sym) 160 (lambda (sym)
161 (and (boundp sym) 161 (and (boundp sym)
162 sym 162 sym
230 (t (list value1 value2)))) 230 (t (list value1 value2))))
231 231
232 (make-obsolete 'hash-new 'hash-make) 232 (make-obsolete 'hash-new 'hash-make)
233 (defun hash-new (size) 233 (defun hash-new (size)
234 "Return a new hash table of SIZE elements. 234 "Return a new hash table of SIZE elements.
235 This is obsolete. Use 'hash-make' instead." 235 This is obsolete. Use `hash-make' instead."
236 (hash-make size)) 236 (hash-make size))
237 237
238 (defun hash-prin1 (hash-table &optional stream) 238 (defun hash-prin1 (hash-table &optional stream)
239 "Output the printed representation of HASH-TABLE. 239 "Output the printed representation of HASH-TABLE.
240 Quoting characters are printed when needed to make output that `read' 240 Quoting characters are printed when needed to make output that `read'
257 (if (hashp hash-table) 257 (if (hashp hash-table)
258 (let* ((obarray (hash-obarray hash-table)) 258 (let* ((obarray (hash-obarray hash-table))
259 (sym (intern-soft key obarray))) 259 (sym (intern-soft key obarray)))
260 (if (and (boundp sym) sym) 260 (if (and (boundp sym) sym)
261 (set sym value) 261 (set sym value)
262 (error "(hash-replace): '%s' key not found in hash table." key))))) 262 (error "(hash-replace): `%s' key not found in hash table." key)))))
263 263
264 (defun hash-resize (hash-table new-size) 264 (defun hash-resize (hash-table new-size)
265 "Resize HASH-TABLE to NEW-SIZE without losing any elements and return new table. 265 "Resize HASH-TABLE to NEW-SIZE without losing any elements and return new table.
266 NEW-SIZE must be greater than 0. Hashing works best if NEW-SIZE is a prime 266 NEW-SIZE must be greater than 0. Hashing works best if NEW-SIZE is a prime
267 number. See also 'hash-next-prime'." 267 number. See also `hash-next-prime'."
268 (if (< new-size 1) 268 (if (< new-size 1)
269 (error "(hash-resize): Cannot resize hash table to size %d" new-size)) 269 (error "(hash-resize): Cannot resize hash table to size %d" new-size))
270 (let ((htable (hash-make new-size))) 270 (let ((htable (hash-make new-size)))
271 (hash-map (function 271 (hash-map (function
272 (lambda (elt) 272 (lambda (elt)