[movitz-cvs] CVS movitz/losp/muerte - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

8 Mar 2008

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv12745
Modified Files:
    more-macros.lisp 
Log Message:
Add support for &aux in destructuring-bind.

--- /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp	2008/03/07 23:38:21	1.37
+++ /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp	2008/03/08 13:59:48	1.38
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld frodef@acm.org
 ;;;; Created at:    Fri Jun  7 15:05:57 2002
 ;;;;                
-;;;; $Id: more-macros.lisp,v 1.37 2008/03/07 23:38:21 ffjeld Exp $
+;;;; $Id: more-macros.lisp,v 1.38 2008/03/08 13:59:48 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
@@ -170,6 +170,9 @@
    	(gen-optvars var sub-lambda-list))
           ((pop-match '&rest sub-lambda-list)
    	(gen-restvar var sub-lambda-list))
+	       ((pop-match '&aux sub-lambda-list)
+		(dolist (b sub-lambda-list)
+		  (push b bindings)))
           ((consp (car sub-lambda-list)) ; recursive lambda-list?
    	(let ((sub-var (gensym)))
    	  (push (list sub-var `(pop ,var))
@@ -194,6 +197,9 @@
    	(gen-restvar var sub-lambda-list))
           ((pop-match '&key sub-lambda-list)
    	(gen-keyvars var sub-lambda-list))
+	       ((pop-match '&aux sub-lambda-list)
+		(dolist (b sub-lambda-list)
+		  (push b bindings)))
           (t (multiple-value-bind (opt-var init-form supplied-var)
    	      (let ((b (pop sub-lambda-list)))
    		(if (atom b)
@@ -212,8 +218,12 @@
         (let ((rest-var (pop* sub-lambda-list)))
           (push (list rest-var var)
    	     bindings))
-	     (when (pop-match '&key sub-lambda-list)
-	       (gen-keyvars var sub-lambda-list)))
+	     (cond
+	       ((pop-match '&key sub-lambda-list)
+		(gen-keyvars var sub-lambda-list))
+	       ((pop-match '&aux sub-lambda-list)
+		(dolist (b sub-lambda-list)
+		  (push b bindings)))))
       (gen-keyvars (var sub-lambda-list &optional keys)
         (cond
           ((endp sub-lambda-list)
@@ -225,6 +235,9 @@
           ((pop-match '&allow-other-keys sub-lambda-list)
    	(when sub-lambda-list
    	  (error "Bad destructuring lambda-list; junk after ~S." '&allow-other-keys)))
+	       ((pop-match '&aux sub-lambda-list)
+		(dolist (b sub-lambda-list)
+		  (push b bindings)))
           (t (multiple-value-bind (key-var key-name init-form supplied-var)
    	      (let ((b (pop sub-lambda-list)))
    		(cond

    