Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv18477
Modified Files: parse.lisp Log Message: Have decode-normal-lambda-list return unlimited maxargs (nil) when &key is present (because there can always be :allow-other-keys t).
--- /project/movitz/cvsroot/movitz/parse.lisp 2008/04/21 19:46:12 1.8 +++ /project/movitz/cvsroot/movitz/parse.lisp 2008/04/21 21:09:47 1.9 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:49:17 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: parse.lisp,v 1.8 2008/04/21 19:46:12 ffjeld Exp $ +;;;; $Id: parse.lisp,v 1.9 2008/04/21 21:09:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -25,18 +25,20 @@ second the list of declaration-specifiers." (loop for declaration-form = (when (declare-form-p (car forms) declare-symbol) (pop forms)) - while declaration-form - append (cdr declaration-form) into declarations - finally (return (values forms declarations)))) + if (declare-form-p (car forms) declare-symbol) + append (cdr (pop forms)) into declarations + else return (values forms declarations)))
(defun parse-docstring-declarations-and-body (forms &optional (declare-symbol 'muerte.cl::declare)) "From the list of FORMS, return first the non-declarations forms, second the declarations, ~ and third the documentation string." - (let ((docstring (when (and (cdr forms) (stringp (car forms))) - (pop forms)))) - (multiple-value-bind (body declarations) - (parse-declarations-and-body forms declare-symbol) - (values body declarations docstring)))) + (loop with docstring = nil + if (declare-form-p (car forms) declare-symbol) + append (cdr (pop forms)) into declarations + else if (and (stringp (car forms)) + (cdr forms)) + do (setf docstring (pop forms)) + else return (values forms declarations docstring)))
(defun parse-macro-lambda-list (lambda-list) (let* ((whole-var (when (eq '&whole (car lambda-list)) @@ -153,6 +155,7 @@ (defun muerte::host-program (program) (translate-program program :muerte.cl :common-lisp)))
+ (defun decode-normal-lambda-list (lambda-list &optional host-symbols-p) "3.4.1 Ordinary Lambda Lists. Returns the requireds, &optionals, &rests, &keys, and &aux formal variables, @@ -210,7 +213,9 @@ (not allow-other-keys-p) (+ (length requireds) (length optionals)))) - (minargs (length requireds))) + (minargs (length requireds)) + (keys-p (not (eq :missing + (getf results (key) :missing))))) (return (values requireds optionals (first rests) @@ -218,7 +223,8 @@ auxes allow-other-keys-p minargs - maxargs + (unless keys-p + maxargs) edx-var (cond ((or (eql maxargs minargs) @@ -228,8 +234,7 @@ ((evenp (+ (length requireds) (length optionals))) :even) (t :odd)) - (not (eq :missing - (getf results (key) :missing))))))))))) + keys-p))))))))
(defun decode-optional-formal (formal) "3.4.1.2 Specifiers for optional parameters.
-
ffjeld