[movitz-cvs] CVS update: movitz/losp/lib/named-integers.lisp

[Frode Vatvedt Fjeld]

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 at 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)
      , at body))       
 
 (define-compile-time-variable *name-to-integer-tables*