hash-tables.lisp - clic - Clic is an command line interactive client for gopher… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
hash-tables.lisp (3755B) | |
--- | |
1 (in-package :alexandria) | |
2 | |
3 (defmacro ensure-gethash (key hash-table &optional default) | |
4 "Like GETHASH, but if KEY is not found in the HASH-TABLE saves the DEF… | |
5 under key before returning it. Secondary return value is true if key was | |
6 already in the table." | |
7 (once-only (key hash-table) | |
8 (with-unique-names (value presentp) | |
9 `(multiple-value-bind (,value ,presentp) (gethash ,key ,hash-table) | |
10 (if ,presentp | |
11 (values ,value ,presentp) | |
12 (values (setf (gethash ,key ,hash-table) ,default) nil)))))) | |
13 | |
14 (defun copy-hash-table (table &key key test size | |
15 rehash-size rehash-threshold) | |
16 "Returns a copy of hash table TABLE, with the same keys and values | |
17 as the TABLE. The copy has the same properties as the original, unless | |
18 overridden by the keyword arguments. | |
19 | |
20 Before each of the original values is set into the new hash-table, KEY | |
21 is invoked on the value. As KEY defaults to CL:IDENTITY, a shallow | |
22 copy is returned by default." | |
23 (setf key (or key 'identity)) | |
24 (setf test (or test (hash-table-test table))) | |
25 (setf size (or size (hash-table-size table))) | |
26 (setf rehash-size (or rehash-size (hash-table-rehash-size table))) | |
27 (setf rehash-threshold (or rehash-threshold (hash-table-rehash-thresho… | |
28 (let ((copy (make-hash-table :test test :size size | |
29 :rehash-size rehash-size | |
30 :rehash-threshold rehash-threshold))) | |
31 (maphash (lambda (k v) | |
32 (setf (gethash k copy) (funcall key v))) | |
33 table) | |
34 copy)) | |
35 | |
36 (declaim (inline maphash-keys)) | |
37 (defun maphash-keys (function table) | |
38 "Like MAPHASH, but calls FUNCTION with each key in the hash table TABL… | |
39 (maphash (lambda (k v) | |
40 (declare (ignore v)) | |
41 (funcall function k)) | |
42 table)) | |
43 | |
44 (declaim (inline maphash-values)) | |
45 (defun maphash-values (function table) | |
46 "Like MAPHASH, but calls FUNCTION with each value in the hash table TA… | |
47 (maphash (lambda (k v) | |
48 (declare (ignore k)) | |
49 (funcall function v)) | |
50 table)) | |
51 | |
52 (defun hash-table-keys (table) | |
53 "Returns a list containing the keys of hash table TABLE." | |
54 (let ((keys nil)) | |
55 (maphash-keys (lambda (k) | |
56 (push k keys)) | |
57 table) | |
58 keys)) | |
59 | |
60 (defun hash-table-values (table) | |
61 "Returns a list containing the values of hash table TABLE." | |
62 (let ((values nil)) | |
63 (maphash-values (lambda (v) | |
64 (push v values)) | |
65 table) | |
66 values)) | |
67 | |
68 (defun hash-table-alist (table) | |
69 "Returns an association list containing the keys and values of hash ta… | |
70 TABLE." | |
71 (let ((alist nil)) | |
72 (maphash (lambda (k v) | |
73 (push (cons k v) alist)) | |
74 table) | |
75 alist)) | |
76 | |
77 (defun hash-table-plist (table) | |
78 "Returns a property list containing the keys and values of hash table | |
79 TABLE." | |
80 (let ((plist nil)) | |
81 (maphash (lambda (k v) | |
82 (setf plist (list* k v plist))) | |
83 table) | |
84 plist)) | |
85 | |
86 (defun alist-hash-table (alist &rest hash-table-initargs) | |
87 "Returns a hash table containing the keys and values of the associatio… | |
88 ALIST. Hash table is initialized using the HASH-TABLE-INITARGS." | |
89 (let ((table (apply #'make-hash-table hash-table-initargs))) | |
90 (dolist (cons alist) | |
91 (ensure-gethash (car cons) table (cdr cons))) | |
92 table)) | |
93 | |
94 (defun plist-hash-table (plist &rest hash-table-initargs) | |
95 "Returns a hash table containing the keys and values of the property l… | |
96 PLIST. Hash table is initialized using the HASH-TABLE-INITARGS." | |
97 (let ((table (apply #'make-hash-table hash-table-initargs))) | |
98 (do ((tail plist (cddr tail))) | |
99 ((not tail)) | |
100 (ensure-gethash (car tail) table (cadr tail))) | |
101 table)) |