X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fparse-lambda-list.lisp;h=31d7f5c3f62cbbff39c0cf51c3fc5ffb601c09cb;hb=6ab9c60f1c53cc7cc912d644658bc23453a82ac4;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..31d7f5c 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 @@ -57,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) @@ -80,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 @@ -92,36 +100,41 @@ (&aux (when (member state '(:rest :more-context :more-count)) (compiler-error "misplaced &AUX in lambda list: ~S" list)) - (setq 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))))) + (setq auxp t + state :aux)) + (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 (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 +144,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 +183,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")