hi,
i'd like switch to, just like case and typecase do, allow multiple
values in the 'value' position of the condition:
(switch (foo)
((bar baz) ...))
So the attached patch checks for the key form being a cons and, if so,
expands into a (member value :test test) instead of (test value)
form. Of course, this means that your key values can no longer be
forms, so this may break existing code. I don't have any code which
actually uses a function call in the value form of the clause (and a
quick grep over my locally installed lisp libs shows nobody else does
either), so i'm ok with the change, but i can understand if others
don't agree.
>From 59ec2cc21b43eb9037758d2b5494206b4e464f11 Mon Sep 17 00:00:00 2001
From: Marco Baringer <m...@bese.it>
Date: Sun, 11 Nov 2012 14:49:41 +0100
Subject: [PATCH 1/2] Support multiple keys in switch clauses (similar to how
case works).
---
control-flow.lisp | 42 ++++++++++++++++++++++--------------------
1 file changed, 22 insertions(+), 20 deletions(-)
diff --git a/control-flow.lisp b/control-flow.lisp
index f262443..0175a17 100644
--- a/control-flow.lisp
+++ b/control-flow.lisp
@@ -10,26 +10,28 @@ like #'eq and 'eq."
(defun generate-switch-body (whole object clauses test key &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)))))
+ (let ((test-name (extract-function-name test))
+ (key-function-name (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-name)))
+ `(let ((,value (,key-function-name ,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
+ (let ((condition (if (consp key-form)
+ `(member ,value ',key-form :test ,test)
+ `(,test-name ,value ,key-form))))
+ `(,condition ,@forms)))))
+ clauses)
+ (t ,default))))))
(defmacro switch (&whole whole (object &key (test 'eql) (key 'identity))
&body clauses)
--
1.7.12.3
--
-marco
_______________________________________________
alexandria-devel mailing list
alexandria-devel@common-lisp.net
http://lists.common-lisp.net/cgi-bin/mailman/listinfo/alexandria-devel
