src/compiler/parse-lambda-list.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB!C")
  11
  12 (/show0 "parse-lambda-list.lisp 12")
  13
  14 ;;; Break something like a lambda list (but not necessarily actually a
  15 ;;; lambda list, e.g. the representation of argument types which is
  16 ;;; used within an FTYPE specification) into its component parts. We
  17 ;;; return twelve values:
  18 ;;;  1. a list of the required args;
  19 ;;;  2. a list of the &OPTIONAL arg specs;
  20 ;;;  3. true if a &REST arg was specified;
  21 ;;;  4. the &REST arg;
  22 ;;;  5. true if &KEY args are present;
  23 ;;;  6. a list of the &KEY arg specs;
  24 ;;;  7. true if &ALLOW-OTHER-KEYS was specified.;
  25 ;;;  8. true if any &AUX is present (new in SBCL vs. CMU CL);
  26 ;;;  9. a list of the &AUX specifiers;
  27 ;;; 10. true if a &MORE arg was specified;
  28 ;;; 11. the &MORE context var;
  29 ;;; 12. the &MORE count var.
  30 ;;;
  31 ;;; The top level lambda list syntax is checked for validity, but the
  32 ;;; arg specifiers are just passed through untouched. If something is
  33 ;;; wrong, we use COMPILER-ERROR, aborting compilation to the last
  34 ;;; recovery point.
  35 (declaim (ftype (function (list)
  36                           (values list list boolean t boolean list boolean
  37                                   boolean list boolean t t))
  38                 parse-lambda-list-like-thing
  39                 parse-lambda-list))
  40 (defun parse-lambda-list-like-thing (list)
  41   (collect ((required)
  42             (optional)
  43             (keys)
  44             (aux))
  45     (let ((restp nil)
  46           (rest nil)
  47           (morep nil)
  48           (more-context nil)
  49           (more-count nil)
  50           (keyp nil)
  51           (auxp nil)
  52           (allowp nil)
  53           (state :required))
  54       (declare (type (member :allow-other-keys :aux
  55                              :key
  56                              :more-context :more-count
  57                              :optional
  58                              :post-more :post-rest
  59                              :required :rest)
  60                      state))
  61       (dolist (arg list)
  62         (if (and (symbolp arg)
  63                  (let ((name (symbol-name arg)))
  64                    (and (plusp (length name))
  65                         (char= (char name 0) #\&))))
  66             (case arg
  67               (&optional
  68                (unless (eq state :required)
  69                  (compiler-error "misplaced &OPTIONAL in lambda list: ~S"
  70                                  list))
  71                (setq state :optional))
  72               (&rest
  73                (unless (member state '(:required :optional))
  74                  (compiler-error "misplaced &REST in lambda list: ~S" list))
  75                (setq state :rest))
  76               (&more
  77                (unless (member state '(:required :optional))
  78                  (compiler-error "misplaced &MORE in lambda list: ~S" list))
  79                (setq morep t
  80                      state :more-context))
  81               (&key
  82                (unless (member state
  83                                '(:required :optional :post-rest :post-more))
  84                  (compiler-error "misplaced &KEY in lambda list: ~S" list))
  85                (setq keyp t
  86                      state :key))
  87               (&allow-other-keys
  88                (unless (eq state ':key)
  89                  (compiler-error "misplaced &ALLOW-OTHER-KEYS in ~
  90                                   lambda list: ~S"
  91                                  list))
  92                (setq allowp t
  93                      state :allow-other-keys))
  94               (&aux
  95                (when (member state '(:rest :more-context :more-count))
  96                  (compiler-error "misplaced &AUX in lambda list: ~S" list))
  97                (setq auxp t
  98                      state :aux))
  99               ;; FIXME: I don't think ANSI says this is an error. (It
 100               ;; should certainly be good for a STYLE-WARNING,
 101               ;; though.)
 102               (t
 103                (compiler-error "unknown &KEYWORD in lambda list: ~S" arg)))
 104             (case state
 105               (:required (required arg))
 106               (:optional (optional arg))
 107               (:rest
 108                (setq restp t
 109                      rest arg
 110                      state :post-rest))
 111               (:more-context
 112                (setq more-context arg
 113                      state :more-count))
 114               (:more-count
 115                (setq more-count arg
 116                      state :post-more))
 117               (:key (keys arg))
 118               (:aux (aux arg))
 119               (t
 120                (compiler-error "found garbage in lambda list when expecting ~
 121                                 a keyword: ~S"
 122                                arg)))))
 123       (when (eq state :rest)
 124         (compiler-error "&REST without rest variable"))
 125
 126       (values (required) (optional) restp rest keyp (keys) allowp auxp (aux)
 127               morep more-context more-count))))
 128
 129 ;;; like PARSE-LAMBDA-LIST-LIKE-THING, except our LAMBDA-LIST argument
 130 ;;; really *is* a lambda list, not just a "lambda-list-like thing", so
 131 ;;; can barf on things which're illegal as arguments in lambda lists
 132 ;;; even if they could conceivably be legal in not-quite-a-lambda-list
 133 ;;; weirdosities
 134 (defun parse-lambda-list (lambda-list)
 135
 136   ;; Classify parameters without checking their validity individually.
 137   (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux
 138                         morep more-context more-count)
 139       (parse-lambda-list-like-thing lambda-list)
 140
 141     ;; Check validity of parameters.
 142     (flet ((need-symbol (x why)
 143              (unless (symbolp x)
 144                (compiler-error "~A is not a symbol: ~S" why x))))
 145       (dolist (i required)
 146         (need-symbol i "Required argument"))
 147       (dolist (i optional)
 148         (typecase i
 149           (symbol)
 150           (cons
 151            (destructuring-bind (var &optional init-form supplied-p) i
 152              (declare (ignore init-form supplied-p))
 153              (need-symbol var "&OPTIONAL parameter name")))
 154           (t
 155            (compiler-error "&OPTIONAL parameter is not a symbol or cons: ~S"
 156                            i))))
 157       (when restp
 158         (need-symbol rest "&REST argument"))
 159       (when keyp
 160         (dolist (i keys)
 161           (typecase i
 162             (symbol)
 163             (cons
 164              (destructuring-bind (var-or-kv &optional init-form supplied-p) i
 165                (declare (ignore init-form supplied-p))
 166                (if (consp var-or-kv)
 167                    (destructuring-bind (keyword-name var) var-or-kv
 168                      (declare (ignore keyword-name))
 169                      (need-symbol var "&KEY parameter name"))
 170                    (need-symbol var-or-kv "&KEY parameter name"))))
 171             (t
 172              (compiler-error "&KEY parameter is not a symbol or cons: ~S"
 173                              i))))))
 174
 175     ;; Voila.
 176     (values required optional restp rest keyp keys allowp auxp aux
 177             morep more-context more-count)))
 178
 179 (/show0 "parse-lambda-list.lisp end of file")