arnesi

Convience functions for working with hash tables. 

(defun build-hash-table (hash-spec inital-contents)
  "Create a hash table containing ``INITAL-CONTENTS``."
  (let ((ht (apply #'make-hash-table hash-spec)))[...]
    (dolist* ((key value) inital-contents)
      (setf (gethash key ht) value))
    ht))

(defmacro deflookup-table (name &key (var (intern-concat (list '#:* name '#:*)
                                                         (symbol-package name)))
                                     (reader (intern-concat (list '#:get- name)[...]
                                                            (symbol-package name)))
                                     (writer (intern-concat (list '#:get- name)
                                                            (symbol-package name)))
                                     (rem-er (intern-concat (list '#:rem- name)
                                                            (symbol-package name)))
                                     (documentation (format nil "Global var for the ~S lookup table" name))
                                     (test 'eql)
                                     (initial-contents nil))
  "
Description
-----------

Creates a hash table and the associated accessors.

"
  ;; if they explicitly pass in NIL we make the name a gensym
  (unless var    (setf var    (gensym (strcat "var for " name " lookup table "))))
  (unless reader (setf reader (gensym (strcat "reader for " name " lookup table "))))
  (unless writer (setf writer (gensym (strcat "writer for " name " lookup table "))))
  (assert (symbolp name) (name)
          "The name of the lookup table must be a symbol.")
  (assert (symbolp var) (var)
          "The name of the underlying var must be a symbol.")
  (assert (symbolp reader) (reader)
          "The name of the reader for a lookup table must be a symbol.")
  (assert (symbolp writer) (writer)
          "The name of the writer for a lookup table must be a symbol.")
  `(progn
     (defvar ,var
       (build-hash-table '(:test ,test) ,initial-contents)
       ,documentation)
     (defun ,reader (key &optional default)
       (gethash key ,var default))
     (defun (setf ,writer) (value key)
       (setf (gethash key ,var) value))
     (defun ,rem-er (key)
       (remhash key ,var))
     (list ',name ',var ',reader '(setf ,writer) ',rem-er)))

(defun hash-to-alist (hash-table)
  (loop for k being the hash-keys of hash-table
        collect (cons k (gethash k hash-table))))