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    (make-lookup-name name "*" name "*"))
               (reader (make-lookup-name name "GET-" name))
               (writer (make-lookup-name name "GET-" name))
               (rem-er (make-lookup-name name "REM-" name))
               (documentation
                (format nil "Global var for the ~S lookup table" name))
               (test 'eql)
               (initial-contents nil))
  "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 make-lookup-name (name &rest parts)
  (funcall #'intern-concat parts (symbol-package name)))

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