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*