hash-tables.lisp 3.67 KB
Newer Older
Nikodemus Siivola's avatar
Nikodemus Siivola committed
1 2
(in-package :alexandria)

3 4 5 6 7 8 9 10 11 12 13
(defmacro ensure-gethash (key hash-table &optional default)
  "Like GETHASH, but if KEY is not found in the HASH-TABLE saves the DEFAULT
under key before returning it. Secondary return value is true if key was
already in the table."
  (once-only (key hash-table)
    (with-unique-names (value presentp)
      `(multiple-value-bind (,value ,presentp) (gethash ,key ,hash-table)
         (if ,presentp
             (values ,value ,presentp)
             (values (setf (gethash ,key ,hash-table) ,default) nil))))))

14 15 16
(defun copy-hash-table (table &key key test size
                                   rehash-size rehash-threshold)
  "Returns a copy of hash table TABLE, with the same keys and values
Nikodemus Siivola's avatar
Nikodemus Siivola committed
17
as the TABLE. The copy has the same properties as the original, unless
18 19 20 21 22 23 24 25
overridden by the keyword arguments.

Before each of the original values is set into the new hash-table, KEY
is invoked on the value. As KEY defaults to CL:IDENTITY, a shallow
copy is returned by default."
  (setf key (or key 'identity))
  (setf test (or test (hash-table-test table)))
  (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-threshold table)))
28 29
  (let ((copy (make-hash-table :test test :size size
                               :rehash-size rehash-size
Nikodemus Siivola's avatar
Nikodemus Siivola committed
30 31
                               :rehash-threshold rehash-threshold)))
    (maphash (lambda (k v)
32
               (setf (gethash k copy) (funcall key v)))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
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
             table)
    copy))

(declaim (inline maphash-keys))
(defun maphash-keys (function table)
  "Like MAPHASH, but calls FUNCTION with each key in the hash table TABLE."
  (maphash (lambda (k v)
             (declare (ignore v))
             (funcall function k))
           table))

(declaim (inline maphash-values))
(defun maphash-values (function table)
  "Like MAPHASH, but calls FUNCTION with each value in the hash table TABLE."
  (maphash (lambda (k v)
             (declare (ignore k))
             (funcall function v))
           table))

(defun hash-table-keys (table)
  "Returns a list containing the keys of hash table TABLE."
  (let ((keys nil))
    (maphash-keys (lambda (k)
                    (push k keys))
                  table)
    keys))

(defun hash-table-values (table)
  "Returns a list containing the values of hash table TABLE."
  (let ((values nil))
    (maphash-values (lambda (v)
                      (push v values))
                    table)
    values))

(defun hash-table-alist (table)
  "Returns an association list containing the keys and values of hash table
TABLE."
  (let ((alist nil))
    (maphash (lambda (k v)
               (push (cons k v) alist))
             table)
    alist))

(defun hash-table-plist (table)
  "Returns a property list containing the keys and values of hash table
TABLE."
  (let ((plist nil))
    (maphash (lambda (k v)
               (setf plist (list* k v plist)))
             table)
    plist))

(defun alist-hash-table (alist &rest hash-table-initargs)
  "Returns a hash table containing the keys and values of the association list
ALIST. Hash table is initialized using the HASH-TABLE-INITARGS."
  (let ((table (apply #'make-hash-table hash-table-initargs)))
    (dolist (cons alist)
91
      (ensure-gethash (car cons) table (cdr cons)))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
92 93 94 95 96 97 98 99
    table))

(defun plist-hash-table (plist &rest hash-table-initargs)
  "Returns a hash table containing the keys and values of the property list
PLIST. Hash table is initialized using the HASH-TABLE-INITARGS."
  (let ((table (apply #'make-hash-table hash-table-initargs)))
    (do ((tail plist (cddr tail)))
        ((not tail))
100
      (ensure-gethash (car tail) table (cadr tail)))
Nikodemus Siivola's avatar
Nikodemus Siivola committed
101
    table))