From ffjeld at common-lisp.net  Tue Nov 10 20:19:57 2009
From: ffjeld at common-lisp.net (ffjeld)
Date: Tue, 10 Nov 2009 15:19:57 -0500
Subject: [movitz-cvs] CVS movitz/losp/muerte
Message-ID: <E1N7xC1-00082F-O8@common-lisp.net>

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory cl-net:/tmp/cvs-serv30887

Modified Files:
	basic-macros.lisp 
Log Message:
Get back ecase, it was lost!?


--- /project/movitz/cvsroot/movitz/losp/muerte/basic-macros.lisp	2009/07/19 18:49:22	1.78
+++ /project/movitz/cvsroot/movitz/losp/muerte/basic-macros.lisp	2009/11/10 20:19:57	1.79
@@ -9,7 +9,7 @@
 ;;;; Created at:    Wed Nov  8 18:44:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: basic-macros.lisp,v 1.78 2009/07/19 18:49:22 ffjeld Exp $
+;;;; $Id: basic-macros.lisp,v 1.79 2009/11/10 20:19:57 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -375,6 +375,19 @@
 		`(compiled-case ,keyform , at clauses))))))
     (t `(compiled-case ,keyform , at clauses))))
 
+(defmacro ecase (keyform &rest clauses) 	 
+  (let ((ecase-var (gensym))) 	 
+    `(let ((,ecase-var ,keyform)) 	 
+       (case ,ecase-var 	 
+	 , at clauses 	 
+	 (t (ecase-error ,ecase-var 	 
+			 ',(mapcan (lambda (clause) 	 
+				     (let ((x (car clause))) 	 
+				       (if (atom x) 	 
+					   (list x) 	 
+					   (copy-list x)))) 	 
+				   clauses)))))))
+
 (define-compiler-macro asm-register (register-name)
   (if (member register-name '(:eax :ebx :ecx :untagged-fixnum-ecx :edx))
       `(with-inline-assembly (:returns ,register-name) ())