diff options
Diffstat (limited to 'third_party/lisp/alexandria/hash-tables.lisp')
-rw-r--r-- | third_party/lisp/alexandria/hash-tables.lisp | 101 |
1 files changed, 0 insertions, 101 deletions
diff --git a/third_party/lisp/alexandria/hash-tables.lisp b/third_party/lisp/alexandria/hash-tables.lisp deleted file mode 100644 index a9f790220405..000000000000 --- a/third_party/lisp/alexandria/hash-tables.lisp +++ /dev/null @@ -1,101 +0,0 @@ -(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)) |