hash-tables.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) 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 DEFAULT
            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-threshold table)))
           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 TABLE."
           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 TABLE."
           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 table
           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 association list
           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 list
           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))