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.