--- old-alexandria-darcs/control-flow.lisp	2008-06-09 01:07:04.000000000 +0300
+++ new-alexandria-darcs/control-flow.lisp	2008-06-09 01:07:04.000000000 +0300
@@ -1,51 +1,106 @@
 (in-package :alexandria)
 
-(defun extract-function-name (spec)
-  "Useful for macros that want to mimic the functional interface for functions
-like #'eq and 'eq."
-  (if (and (consp spec)
-           (member (first spec) '(quote function)))
-      (second spec)
-      spec))
-
-(defun generate-switch-body (whole object clauses test key &optional default)
+(defun generate-switch-body (whole keyform clauses test key name &optional default)
   (with-gensyms (value)
-    (setf test (extract-function-name test))
-    (setf key (extract-function-name key))
-    (when (and (consp default)
-               (member (first default) '(error cerror)))
-      (setf default `(,@default "No keys match in SWITCH. Testing against ~S with ~S."
-                      ,value ',test)))
-    `(let ((,value (,key ,object)))
-      (cond ,@(mapcar (lambda (clause)
-                        (if (member (first clause) '(t otherwise))
-                            (progn
-                              (when default
-                                (error "Multiple default clauses or illegal use of a default clause in ~S."
-                                       whole))
-                              (setf default `(progn ,@(rest clause)))
-                              '(()))
-                            (destructuring-bind (key-form &body forms) clause
-                              `((,test ,value ,key-form)
-                                ,@forms))))
-                      clauses)
-            (t ,default)))))
-
-(defmacro switch (&whole whole (object &key (test 'eql) (key 'identity))
-                         &body clauses)
-  "Evaluates first matching clause, returning its values, or evaluates and
-returns the values of DEFAULT if no keys match."
-  (generate-switch-body whole object clauses test key))
-
-(defmacro eswitch (&whole whole (object &key (test 'eql) (key 'identity))
-                          &body clauses)
-  "Like SWITCH, but signals an error if no key matches."
-  (generate-switch-body whole object clauses test key '(error)))
-
-(defmacro cswitch (&whole whole (object &key (test 'eql) (key 'identity))
-                          &body clauses)
-  "Like SWITCH, but signals a continuable error if no key matches."
-  (generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH.")))
+    (let ((eqlp (member test '('eql #'eql) :test 'equal))
+          (idp (member key '(nil 'identity #'identity) :test 'equal))
+          (otherwise
+           (when (and (consp default)
+                      (member (first default) '(error cerror)))
+             `((t (,@default "No keys match in ~S Testing against ~S with ~S."
+                      ',name ,value ',test)))))
+          (otherwise-seen nil))
+      `(let ((,value ,(if idp keyform `(funcall ,key ,keyform))))
+         (cond ,@(mapcar (lambda (clause)
+                           (destructuring-bind (clause-key &body clause-forms) 
+                               clause
+                             (cond ((member clause-key '(t otherwise))
+                                    (cond ((member name '(cswitch eswitch))
+                                           (error "~S clause in ~S:~%  ~S"
+                                                  'otherwise name whole))
+                                          (otherwise-seen
+                                           (error "Multiple ~S clauses in ~S:~%  ~S"
+                                                  'otherwise name whole))
+                                          (t
+                                           (setf otherwise-seen t)
+                                           `(t ,@clause-forms))))
+                                   (otherwise-seen
+                                    (error "Normal clauses after ~S in ~S:~%  ~S"
+                                           'otherwise name whole))
+                                   (t
+                                    `(,(if eqlp 
+                                           `(eql ,value ,clause-key)
+                                           ;; Don't replace with (TEST ...) in general case, since
+                                           ;; it breaks (FLET ((FOO ...)) (FUNCALL 'FOO ...)).
+                                           `(funcall ,test ,value ,clause-key))
+                                       ,@clause-forms)))))
+                         clauses)
+               ,@(unless otherwise-seen otherwise))))))
+
+(defmacro switch (&whole whole (keyform &key (test #'eql) key) &body clauses)
+  "Conditionally executes one of the clauses, and returns its values. KEYFORM
+is first evaluated, and if KEY is given and non-null, it is used to extract a
+comparison value from the result of evaluating KEYFORM.
+
+Clauses are of the form:
+
+  (CLAUSE-KEY &BODY CLAUSE-FORMS)
+
+Each clause is tested in turn. The first clause for which
+
+  (FUNCALL TEST COMPARISON-VALUE CLAUSE-KEY)
+
+evaluates to true has its CLAUSE-FORMS executed as an implicit PROGN, and the
+values returned. No further clauses are executed.
+
+If no clause matches, and the final clause has the symbol OTHERWISE or T as
+its CLAUSE-KEY, it is executed. If no OTHERWISE clause exists, NIL is
+returned.
+
+To use T as a regular CLAUSE-KEY, quote it:
+
+  (switch (foo)
+    ('t   1)
+    (t    0))    ; evaluates to 1 if FOO evaluates to T, and 0 otherwise."
+  (generate-switch-body whole keyform clauses test key 'switch))
+
+(defmacro eswitch (&whole whole (keyform &key (test #'eql) key) &body clauses)
+  "Conditionally executes one of the clauses, and returns its values. KEYFORM
+is first evaluated, and if KEY is given and non-null, it is used to extract a
+comparison value from the result of evaluating KEYFORM.
+
+Clauses are of the form:
+
+  (CLAUSE-KEY &BODY CLAUSE-FORMS)
+
+Each clause is tested in turn. The first clause for which
+
+  (FUNCALL TEST COMPARISON-VALUE CLAUSE-KEY)
+
+evaluates to true has its CLAUSE-FORMS executed as an implicit PROGN, and the
+values returned. No further clauses are executed.
+
+If no clause matches, an error is signalled."
+  (generate-switch-body whole keyform clauses test key 'eswitch '(error)))
+
+(defmacro cswitch (&whole whole (keyform &key (test #'eql) key) &body clauses)
+  "Conditionally executes one of the clauses, and returns its values. KEYFORM
+is first evaluated, and if KEY is given and non-null, it is used to extract a
+comparison value from the result of evaluating KEYFORM.
+
+Clauses are of the form:
+
+  (CLAUSE-KEY &BODY CLAUSE-FORMS)
+
+Each clause is tested in turn. The first clause for which
+
+  (FUNCALL TEST COMPARISON-VALUE CLAUSE-KEY)
+
+evaluates to true has its CLAUSE-FORMS executed as an implicit PROGN, and the
+values returned. No further clauses are executed.
+
+If no clause matches, a continuable error is signalled."
+  (generate-switch-body whole keyform clauses test key 'cswitch '(cerror "Return NIL from CSWITCH.")))
 
 (defmacro whichever (&rest possibilities &environment env)
   "Evaluates exactly one of POSSIBILITIES, chosen at random."

--- old-alexandria-darcs/tests.lisp	2008-06-09 01:07:04.000000000 +0300
+++ new-alexandria-darcs/tests.lisp	2008-06-09 01:07:04.000000000 +0300
@@ -100,7 +100,7 @@
 ;;;; Control flow
 
 (deftest switch.1
-    (switch (13 :test =)
+    (switch (13 :test #'=)
       (12 :oops)
       (13.0 :yay))
   :yay)
@@ -114,26 +114,26 @@
 
 (deftest eswitch.1
     (let ((x 13))
-      (eswitch (x :test =)
+      (eswitch (x :test #'=)
         (12 :oops)
         (13.0 :yay)))
   :yay)
 
 (deftest eswitch.2
     (let ((x 13))
-      (eswitch (x :key 1+)
+      (eswitch (x :key #'1+)
         (11 :oops)
         (14 :yay)))
   :yay)
 
 (deftest cswitch.1
-    (cswitch (13 :test =)
+    (cswitch (13 :test #'=)
       (12 :oops)
       (13.0 :yay))
   :yay)
 
 (deftest cswitch.2
-    (cswitch (13 :key 1-)
+    (cswitch (13 :key #'1-)
       (12 :yay)
       (13.0 :oops))
   :yay)

