Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv2468 Modified Files: named-integers.lisp Log Message: Changed the with-named-integers-syntax macro a bit, trying to make this mechanism a bit more general and useful. Date: Wed May 5 04:24:22 2004 Author: ffjeld Index: movitz/losp/lib/named-integers.lisp diff -u movitz/losp/lib/named-integers.lisp:1.3 movitz/losp/lib/named-integers.lisp:1.4 --- movitz/losp/lib/named-integers.lisp:1.3 Mon Jan 19 06:23:44 2004 +++ movitz/losp/lib/named-integers.lisp Wed May 5 04:24:21 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef@acm.org> ;;;; Created at: Fri Jan 4 16:13:46 2002 ;;;; -;;;; $Id: named-integers.lisp,v 1.3 2004/01/19 11:23:44 ffjeld Exp $ +;;;; $Id: named-integers.lisp,v 1.4 2004/05/05 08:24:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -20,13 +20,14 @@ (in-package muerte.lib) -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (:compile-toplevel :load-toplevel) (defun name->integer (map name) (if (integerp name) name - (or (etypecase map - (vector (position name map)) - (list (car (rassoc name map)))) + (or (ecase (car map) + (:enum (position name (cdr map))) + (:assoc (cdr (assoc name (cdr map)))) + (:rassoc (car (rassoc name (cdr map))))) (error "No integer named ~S in ~S." name map)))) (defun names->integer (map &rest names) (declare (dynamic-extent names)) @@ -34,11 +35,13 @@ sum (name->integer map name)))) (defmacro with-named-integers-syntax (name-maps &body body) - `(macrolet ,(mapcar (lambda (name-map) - (destructuring-bind (name map) - name-map - `(,name (&rest names) (apply 'muerte.lib:names->integer ,map names)))) - name-maps) + `(macrolet + ,(mapcar (lambda (name-map) + (destructuring-bind (name map) + name-map + `(,name (&rest names) + (apply 'muerte.lib:names->integer ,map names)))) + name-maps) ,@body)) (define-compile-time-variable *name-to-integer-tables*