Simplify (and robustify) regular PACKing

[sbcl.git] / src / compiler / parse-lambda-list.lisp

diff --git a/src/compiler/parse-lambda-list.lisp b/src/compiler/parse-lambda-list.lisp
index d98953b..c906093 100644 (file)
--- a/src/compiler/parse-lambda-list.lisp
+++ b/src/compiler/parse-lambda-list.lisp
@@ -34,15 +34,15 @@
 ;;; arg specifiers are just passed through untouched. If something is
 ;;; wrong, we use COMPILER-ERROR, aborting compilation to the last
 ;;; recovery point.
-(declaim (ftype (sfunction (list)
+(declaim (ftype (sfunction (list &key (:silent boolean))
                            (values list list boolean t boolean list boolean
                                    boolean list boolean t t boolean))
                 parse-lambda-list-like-thing))
-(declaim (ftype (sfunction (list)
+(declaim (ftype (sfunction (list &key (:silent boolean))
                            (values list list boolean t boolean list boolean
                                    boolean list boolean t t))
                 parse-lambda-list))
-(defun parse-lambda-list-like-thing (list)
+(defun parse-lambda-list-like-thing (list &key silent)
   (collect ((required)
             (optional)
             (keys)
@@ -86,8 +86,9 @@
                  (compiler-error "misplaced &KEY in lambda list: ~S" list))
                #-sb-xc-host
                (when (optional)
-                 (compiler-style-warn
-                  "&OPTIONAL and &KEY found in the same lambda list: ~S" list))
+                 (unless silent
+                   (compiler-style-warn
+                    "&OPTIONAL and &KEY found in the same lambda list: ~S" list)))
                (setq keyp t
                      state :key))
               (&allow-other-keys
@@ -104,14 +105,32 @@
                  (compiler-error "multiple &AUX in lambda list: ~S" list))
                (setq auxp t
                      state :aux))
-              (t (bug "unknown LAMBDA-LIST-KEYWORD in lambda list: ~S." arg)))
+              (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) #\&))
-                    (style-warn
-                     "suspicious variable in lambda list: ~S." arg))))
+                    ;; 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))
@@ -143,12 +162,11 @@
 ;;; 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)
-
+(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)
+      (parse-lambda-list-like-thing lambda-list :silent silent)
 
     ;; Check validity of parameters.
     (flet ((need-symbol (x why)