X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fparse-lambda-list.lisp;h=c906093316e8e8f58e4509a00163c7f4d2316f9d;hb=0e8649cf907d26f111864e4e29c7f9787828efbd;hp=a8e128301fa1ce07d85a27c55177a523fa551372;hpb=c7638557b3c7b34267daba188d345f5d284f4ac3;p=sbcl.git diff --git a/src/compiler/parse-lambda-list.lisp b/src/compiler/parse-lambda-list.lisp index a8e1283..c906093 100644 --- a/src/compiler/parse-lambda-list.lisp +++ b/src/compiler/parse-lambda-list.lisp @@ -26,18 +26,23 @@ ;;; 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 - parse-lambda-list)) -(defun parse-lambda-list-like-thing (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 &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 &key silent) (collect ((required) (optional) (keys) @@ -48,7 +53,7 @@ (more-context nil) (more-count nil) (keyp nil) - (auxp nil) + (auxp nil) (allowp nil) (state :required)) (declare (type (member :allow-other-keys :aux @@ -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,11 @@ (unless (member state '(:required :optional :post-rest :post-more)) (compiler-error "misplaced &KEY in lambda list: ~S" list)) + #-sb-xc-host + (when (optional) + (unless silent + (compiler-style-warn + "&OPTIONAL and &KEY found in the same lambda list: ~S" list))) (setq keyp t state :key)) (&allow-other-keys @@ -94,86 +101,109 @@ (&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.) + state :aux)) (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))))) + ;; 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)))) + 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) - +(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) + 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)))) + (unless (symbolp x) + (compiler-error "~A is not a symbol: ~S" why x)))) (dolist (i required) - (need-symbol i "Required argument")) + (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)))) + (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")) + (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)))))) + (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))) + morep more-context more-count))) (/show0 "parse-lambda-list.lisp end of file")