[slime-devel] Re: patch to destructure-case

[Matthew D Swank]

Matthew D Swank wrote:
> Matthew D Swank wrote:
>> Would it be possible to have destructure-case match against arbitrary,
>> non-nil atoms (patch attached)?
>>
> Forget it. That patch obviously won't work as is, and I can't seem to
> find the patched version of slime I was using at the moment.
> 

This one should work.

Matt

-- 
"You do not really understand something unless you can explain it to
your grandmother." — Albert Einstein.
-------------- next part --------------
--- slime/swank.lisp.orig	2006-06-18 13:21:54.000000000 -0500
+++ slime/swank.lisp	2006-06-30 22:07:03.000000000 -0500
@@ -293,19 +293,22 @@
 A cross between `case' and `destructuring-bind'.
 The pattern syntax is:
   ((HEAD . ARGS) . BODY)
+or:
+  (ATOM . BODY)
 The list of patterns is searched for a HEAD `eq' to the car of
-VALUE. If one is found, the BODY is executed with ARGS bound to the
-corresponding values in the CDR of VALUE."
+VALUE (or ATOM `eq' to VALUE as the case may be). If one is 
+found, the BODY is executed with ARGS bound to the corresponding 
+values in the CDR of VALUE."
   (let ((operator (gensym "op-"))
 	(operands (gensym "rand-"))
 	(tmp (gensym "tmp-")))
     `(let* ((,tmp ,value)
-	    (,operator (car ,tmp))
-	    (,operands (cdr ,tmp)))
+	    (,operator (or (and (listp ,tmp) (car ,tmp)) ,tmp))
+	    (,operands (or (and (listp ,tmp) (cdr ,tmp)))))
        (case ,operator
          ,@(loop for (pattern . body) in patterns collect 
-                   (if (eq pattern t)
-                       `(t , at body)
+                   (if (and pattern (atom pattern))
+                       `(,pattern , at body)
                        (destructuring-bind (op &rest rands) pattern
                          `(,op (destructuring-bind ,rands ,operands 
                                  , at body)))))