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

Modified Files: parse.lisp Log Message: Fix bug in decode-normal-lambda-list.

--- /project/movitz/cvsroot/movitz/parse.lisp 2008/04/21 21:09:47 1.9 +++ /project/movitz/cvsroot/movitz/parse.lisp 2008/04/27 19:22:42 1.10 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:49:17 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: parse.lisp,v 1.9 2008/04/21 21:09:47 ffjeld Exp $ +;;;; $Id: parse.lisp,v 1.10 2008/04/27 19:22:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -23,9 +23,7 @@ (defun parse-declarations-and-body (forms &optional (declare-symbol 'muerte.cl::declare)) "From the list of FORMS, return first the list of non-declaration forms, ~ second the list of declaration-specifiers." - (loop for declaration-form = (when (declare-form-p (car forms) declare-symbol) - (pop forms)) - if (declare-form-p (car forms) declare-symbol) + (loop if (declare-form-p (car forms) declare-symbol) append (cdr (pop forms)) into declarations else return (values forms declarations)))

@@ -45,7 +43,7 @@ (pop lambda-list) (pop lambda-list))) (env-var nil) - (operator-var (gensym)) + (operator-var (gensym "operator-")) (destructuring-lambda-list (do ((l lambda-list) (r nil)) @@ -58,7 +56,7 @@ (push x r))))) (ignore-env-var (when (not env-var) - (gensym)))) + (gensym "ignore-env-")))) (values destructuring-lambda-list whole-var (or env-var @@ -208,14 +206,14 @@ (auxes (nreverse (getf results (aux))))) (when (> (length rests) 1) (error "There can only be one &REST formal parameter.")) - (let ((maxargs (and (null rests) ; max num. of arguments, or nil. - (null keys) - (not allow-other-keys-p) - (+ (length requireds) - (length optionals)))) - (minargs (length requireds)) - (keys-p (not (eq :missing - (getf results (key) :missing))))) + (let* ((keys-p (not (eq :missing ; &key present? + (getf results (key) :missing)))) + (maxargs (and (null rests) ; max num. of arguments, or nil. + (not keys-p) + (not allow-other-keys-p) + (+ (length requireds) + (length optionals)))) + (minargs (length requireds))) (return (values requireds optionals (first rests) @@ -223,14 +221,14 @@ auxes allow-other-keys-p minargs - (unless keys-p - maxargs) + maxargs edx-var (cond - ((or (eql maxargs minargs) - (eq :no-key (getf results (key) :no-key))) + ((or (not keys-p) + (eql maxargs minargs)) nil) - ((assert (not maxargs))) + ((assert (not maxargs) () + "Weird maxargs ~S for ~S." maxargs lambda-list)) ((evenp (+ (length requireds) (length optionals))) :even) (t :odd))