+(defmacro defenum (name (&key export) &body values)
+ "Set up symbol properties for manifest constants.
+
+ The VALUES are a list of (TAG VALUE) pairs. Each TAG is a symbol; we set
+ the NAME property on TAG to VALUE, and export TAG. There are also handy
+ hash-tables mapping in the forward and reverse directions, in the name
+ symbol's `enum-forward' and `enum-reverse' properties."
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ ,(let*/gensyms (export)
+ (with-gensyms (forward reverse valtmp)
+ `(let ((,forward (make-hash-table))
+ (,reverse (make-hash-table)))
+ (when ,export (export ',name))
+ ,@(mapcar (lambda (item)
+ (destructuring-bind (tag value) item
+ (let ((constant
+ (intern (concatenate 'string
+ (symbol-name name)
+ "/"
+ (symbol-name tag)))))
+ `(let ((,valtmp ,value))
+ (when ,export
+ (export ',constant)
+ (when (eq (symbol-package ',tag) *package*)
+ (export ',tag)))
+ (defconstant ,constant ,valtmp)
+ (setf (get ',tag ',name) ,value
+ (gethash ',tag ,forward) ,valtmp
+ (gethash ,valtmp ,reverse) ',tag)))))
+ values)
+ (setf (get ',name 'enum-forward) ,forward
+ (get ',name 'enum-reverse) ,reverse))))))
+
+(defun lookup-enum (name tag &key min max)
+ "Look up a TAG in an enumeration.
+
+ If TAG is a symbol, check its NAME property; if it's a fixnum then take it
+ as it is. Make sure that it's between MIN and MAX, if they're not nil."
+ (let ((value (etypecase tag
+ (fixnum tag)
+ (symbol (or (get tag name)
+ (error "~S is not a known ~A" tag name))))))
+ (unless (and (or (null min) (<= min value))
+ (or (null max) (<= value max)))
+ (error "Value ~S out of range for ~A" value name))
+ value))
+
+(defun reverse-enum (name value)
+ "Reverse-lookup of a VALUE in enumeration NAME.
+
+ If a tag for the VALUE is found, return it and `t'; otherwise return VALUE
+ unchanged and `nil'."
+ (multiple-value-bind (tag foundp) (gethash value (get name 'enum-reverse))
+ (if foundp
+ (values tag t)
+ (values value nil))))
+
+(defun mapenum (func name)
+ "Call FUNC on TAG/VALUE pairs from the enumeration called NAME."
+ (maphash func (get name 'enum-forward)))
+