+ (values (required) (optional) restp rest keyp (keys) allowp auxp (aux)
+ morep more-context more-count
+ (neq state :required)))))
+
+;;; like PARSE-LAMBDA-LIST-LIKE-THING, except our LAMBDA-LIST argument
+;;; really *is* a lambda list, not just a "lambda-list-like thing", so
+;;; can barf on things which're illegal as arguments in lambda lists
+;;; even if they could conceivably be legal in not-quite-a-lambda-list
+;;; weirdosities
+(defun parse-lambda-list (lambda-list)
+ ;; Classify parameters without checking their validity individually.
+ (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux
+ morep more-context more-count)
+ (parse-lambda-list-like-thing lambda-list)
+
+ ;; Check validity of parameters.
+ (flet ((need-symbol (x why)
+ (unless (symbolp x)
+ (compiler-error "~A is not a symbol: ~S" why x))))
+ (dolist (i required)
+ (need-symbol i "Required argument"))
+ (dolist (i optional)
+ (typecase i
+ (symbol)
+ (cons
+ (destructuring-bind (var &optional init-form supplied-p) i
+ (declare (ignore init-form supplied-p))
+ (need-symbol var "&OPTIONAL parameter name")))
+ (t
+ (compiler-error "&OPTIONAL parameter is not a symbol or cons: ~S"
+ i))))
+ (when restp
+ (need-symbol rest "&REST argument"))
+ (when keyp
+ (dolist (i keys)
+ (typecase i
+ (symbol)
+ (cons
+ (destructuring-bind (var-or-kv &optional init-form supplied-p) i
+ (declare (ignore init-form supplied-p))
+ (if (consp var-or-kv)
+ (destructuring-bind (keyword-name var) var-or-kv
+ (declare (ignore keyword-name))
+ (need-symbol var "&KEY parameter name"))
+ (need-symbol var-or-kv "&KEY parameter name"))))
+ (t
+ (compiler-error "&KEY parameter is not a symbol or cons: ~S"
+ i))))))
+
+ ;; Voila.
+ (values required optional restp rest keyp keys allowp auxp aux
+ morep more-context more-count)))
+
+(/show0 "parse-lambda-list.lisp end of file")