Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv27432

Modified Files: parse.lisp Log Message: parse-macro-lambda-list.

--- /project/movitz/cvsroot/movitz/parse.lisp 2007/02/01 19:37:41 1.7 +++ /project/movitz/cvsroot/movitz/parse.lisp 2008/04/21 19:46:12 1.8 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:49:17 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: parse.lisp,v 1.7 2007/02/01 19:37:41 ffjeld Exp $ +;;;; $Id: parse.lisp,v 1.8 2008/04/21 19:46:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -38,6 +38,33 @@ (parse-declarations-and-body forms declare-symbol) (values body declarations docstring))))

+(defun parse-macro-lambda-list (lambda-list) + (let* ((whole-var (when (eq '&whole (car lambda-list)) + (pop lambda-list) + (pop lambda-list))) + (env-var nil) + (operator-var (gensym)) + (destructuring-lambda-list + (do ((l lambda-list) + (r nil)) + ((atom l) + (cons operator-var + (nreconc r l))) + (let ((x (pop l))) + (if (eq x '&environment) + (setf env-var (pop l)) + (push x r))))) + (ignore-env-var + (when (not env-var) + (gensym)))) + (values destructuring-lambda-list + whole-var + (or env-var + ignore-env-var) + (when ignore-env-var + (list ignore-env-var)) + (list operator-var)))) + (defun unfold-circular-list (list) "If LIST is circular (through cdr), return (a copy of) the non-circular portion of LIST, and the index (in LIST) of the cons-cell pointed to by (cdr (last LIST))." (flet ((find-cdr (l c end)