101 lines
3.7 KiB
Common Lisp
101 lines
3.7 KiB
Common Lisp
(in-package :alexandria)
|
|
|
|
(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))))))
|
|
|
|
(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
|
|
as the TABLE. The copy has the same properties as the original, unless
|
|
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)))
|
|
(setf rehash-size (or rehash-size (hash-table-rehash-size table)))
|
|
(setf rehash-threshold (or rehash-threshold (hash-table-rehash-threshold table)))
|
|
(let ((copy (make-hash-table :test test :size size
|
|
:rehash-size rehash-size
|
|
:rehash-threshold rehash-threshold)))
|
|
(maphash (lambda (k v)
|
|
(setf (gethash k copy) (funcall key v)))
|
|
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)
|
|
(ensure-gethash (car cons) table (cdr cons)))
|
|
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))
|
|
(ensure-gethash (car tail) table (cadr tail)))
|
|
table))
|