0.9.2.9: thread objects

[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 a8e1283..6109cbd 100644 (file)
--- a/src/compiler/parse-lambda-list.lisp
+++ b/src/compiler/parse-lambda-list.lisp
@@ -26,16 +26,21 @@
 ;;;  9. a list of the &AUX specifiers;
 ;;; 10. true if a &MORE arg was specified;
 ;;; 11. the &MORE context var;
-;;; 12. the &MORE count var.
+;;; 12. the &MORE count var;
+;;; 13. true if any lambda list keyword is present (only for
+;;;     PARSE-LAMBDA-LIST-LIKE-THING).
 ;;;
 ;;; The top level lambda list syntax is checked for validity, but the
 ;;; arg specifiers are just passed through untouched. If something is
 ;;; wrong, we use COMPILER-ERROR, aborting compilation to the last
 ;;; recovery point.
-(declaim (ftype (function (list)
-                         (values list list boolean t boolean list boolean
-                                 boolean list boolean t t))
-               parse-lambda-list-like-thing
+(declaim (ftype (sfunction (list)
+                           (values list list boolean t boolean list boolean
+                                   boolean list boolean t t boolean))
+               parse-lambda-list-like-thing))
+(declaim (ftype (sfunction (list)
+                           (values list list boolean t boolean list boolean
+                                   boolean list boolean t t))
                parse-lambda-list))
 (defun parse-lambda-list-like-thing (list)
   (collect ((required)
@@ -59,10 +64,7 @@
                              :required :rest)
                      state))
       (dolist (arg list)
-        (if (and (symbolp arg)
-                 (let ((name (symbol-name arg)))
-                   (and (plusp (length name))
-                        (char= (char name 0) #\&))))
+        (if (member arg sb!xc:lambda-list-keywords)
             (case arg
               (&optional
                (unless (eq state :required)
@@ -82,6 +84,10 @@
                (unless (member state
                                '(:required :optional :post-rest :post-more))
                  (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))
                (setq keyp t
                      state :key))
               (&allow-other-keys
@@ -94,37 +100,43 @@
               (&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))
-              ;; FIXME: I don't think ANSI says this is an error. (It
-              ;; should certainly be good for a STYLE-WARNING,
-              ;; though.)
-              (t
-               (compiler-error "unknown &KEYWORD 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)))))
+              (t (bug "unknown LAMBDA-LIST-KEYWORD in lambda list: ~S." arg)))
+           (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))))
+             (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))))
+              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