+ list))
+ (setq allowp t
+ state :allow-other-keys))
+ (&aux
+ (when (member state '(:rest :more-context :more-count))
+ (compiler-error "misplaced &AUX in lambda list: ~S" list))
+ (when auxp
+ (compiler-error "multiple &AUX in lambda list: ~S" list))
+ (setq auxp t
+ state :aux))
+ (t
+ ;; It could be argued that &WHOLE and friends would be
+ ;; just ordinary variables in an ordinary lambda-list,
+ ;; but since (1) that seem exceedingly to have been the
+ ;; programmers intent and (2) the spec can be
+ ;; interpreted as giving as licence to signal an
+ ;; error[*] that is what we do.
+ ;;
+ ;; [* All lambda list keywords used in the
+ ;; implementation appear in LAMBDA-LIST-KEYWORDS. Each
+ ;; member of a lambda list is either a parameter
+ ;; specifier ot a lambda list keyword. Ergo, symbols
+ ;; appearing in LAMBDA-LIST-KEYWORDS cannot be
+ ;; parameter specifiers.]
+ (compiler-error 'simple-program-error
+ :format-control "Bad lambda list keyword ~S in: ~S"
+ :format-arguments (list arg list))))
+ (progn
+ (when (symbolp arg)
+ (let ((name (symbol-name arg)))
+ (when (and (plusp (length name))
+ (char= (char name 0) #\&))
+ ;; Should this be COMPILER-STYLE-WARN?
+ (unless silent
+ (style-warn
+ "suspicious variable in lambda list: ~S." arg)))))
+ (case state
+ (:required (required arg))
+ (:optional (optional arg))
+ (:rest
+ (setq restp t
+ rest arg
+ state :post-rest))
+ (:more-context
+ (setq more-context arg
+ state :more-count))
+ (:more-count
+ (setq more-count arg
+ state :post-more))
+ (:key (keys arg))
+ (:aux (aux arg))
+ (t
+ (compiler-error "found garbage in lambda list when expecting ~
+ a keyword: ~S"
+ arg))))))
+ (when (eq state :rest)
+ (compiler-error "&REST without rest variable"))
+
+ (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 &key silent)
+ ;; 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 :silent silent)
+
+ ;; 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)))