X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fparse-lambda-list.lisp;h=78b4379e4bd5f27d763232b0a1b5434b99d2a84e;hb=20b2378572cf7378f3f267e2234c4234dacfbdc9;hp=998d2cbc06f41a7070a98468647bb89cc73fd187;hpb=56f96e77ade913d6363a3068c94e60f44ae9b3e7;p=sbcl.git

diff --git a/src/compiler/parse-lambda-list.lisp b/src/compiler/parse-lambda-list.lisp
index 998d2cb..78b4379 100644
--- a/src/compiler/parse-lambda-list.lisp
+++ b/src/compiler/parse-lambda-list.lisp
@@ -14,7 +14,7 @@
 ;;; Break something like a lambda list (but not necessarily actually a
 ;;; lambda list, e.g. the representation of argument types which is
 ;;; used within an FTYPE specification) into its component parts. We
-;;; return eleven values:
+;;; return twelve values:
 ;;;  1. a list of the required args;
 ;;;  2. a list of the &OPTIONAL arg specs;
 ;;;  3. true if a &REST arg was specified;
@@ -22,19 +22,25 @@
 ;;;  5. true if &KEY args are present;
 ;;;  6. a list of the &KEY arg specs;
 ;;;  7. true if &ALLOW-OTHER-KEYS was specified.;
-;;;  8. a list of the &AUX specifiers;
-;;;  9. true if a &MORE arg was specified;
-;;; 10. the &MORE context var;
-;;; 11. the &MORE count var.
+;;;  8. true if any &AUX is present (new in SBCL vs. CMU CL);
+;;;  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;
+;;; 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
-				  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)
@@ -47,6 +53,7 @@
           (more-context nil)
           (more-count nil)
           (keyp nil)
+	  (auxp nil)
           (allowp nil)
           (state :required))
       (declare (type (member :allow-other-keys :aux
@@ -92,7 +99,8 @@
               (&aux
                (when (member state '(:rest :more-context :more-count))
                  (compiler-error "misplaced &AUX in lambda list: ~S" list))
-               (setq state :aux))
+               (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.)
@@ -119,9 +127,10 @@
                                arg)))))
       (when (eq state :rest)
         (compiler-error "&REST without rest variable"))
-      
-      (values (required) (optional) restp rest keyp (keys) allowp (aux)
-              morep more-context more-count))))
+
+      (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
@@ -131,7 +140,7 @@
 (defun parse-lambda-list (lambda-list)
 
   ;; Classify parameters without checking their validity individually.
-  (multiple-value-bind (required optional restp rest keyp keys allowp aux
+  (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux
 			morep more-context more-count)
       (parse-lambda-list-like-thing lambda-list)
 
@@ -170,7 +179,7 @@
 			     i))))))
 
     ;; Voila.
-    (values required optional restp rest keyp keys allowp aux
+    (values required optional restp rest keyp keys allowp auxp aux
 	    morep more-context more-count)))
 
 (/show0 "parse-lambda-list.lisp end of file")