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 ;;; Break a lambda-list into its component parts. We return eleven
  13 ;;; values:
  14 ;;;  1. A list of the required args.
  15 ;;;  2. A list of the optional arg specs.
  16 ;;;  3. True if a rest arg was specified.
  17 ;;;  4. The rest arg.
  18 ;;;  5. A boolean indicating whether keywords args are present.
  19 ;;;  6. A list of the keyword arg specs.
  20 ;;;  7. True if &allow-other-keys was specified.
  21 ;;;  8. A list of the &aux specifiers.
  22 ;;;  9. True if a more arg was specified.
  23 ;;; 10. The &more context var
  24 ;;; 11. The &more count var
  25 ;;;
  26 ;;; The top-level lambda-list syntax is checked for validity, but the
  27 ;;; arg specifiers are just passed through untouched. If something is
  28 ;;; wrong, we use Compiler-Error, aborting compilation to the last
  29 ;;; recovery point.
  30 (declaim (ftype (function (list)
  31                           (values list list boolean t boolean list boolean
  32                                   list boolean t t))
  33                 parse-lambda-list))
  34 (defun parse-lambda-list (list)
  35   (collect ((required)
  36             (optional)
  37             (keys)
  38             (aux))
  39     (let ((restp nil)
  40           (rest nil)
  41           (morep nil)
  42           (more-context nil)
  43           (more-count nil)
  44           (keyp nil)
  45           (allowp nil)
  46           (state :required))
  47       (declare (type (member :allow-other-keys :aux
  48                              :key
  49                              :more-context :more-count
  50                              :optional
  51                              :post-more :post-rest
  52                              :required :rest)
  53                      state))
  54       (dolist (arg list)
  55         (if (and (symbolp arg)
  56                  (let ((name (symbol-name arg)))
  57                    (and (plusp (length name))
  58                         (char= (char name 0) #\&))))
  59             (case arg
  60               (&optional
  61                (unless (eq state :required)
  62                  (compiler-error "misplaced &OPTIONAL in lambda list: ~S"
  63                                  list))
  64                (setq state :optional))
  65               (&rest
  66                (unless (member state '(:required :optional))
  67                  (compiler-error "misplaced &REST in lambda list: ~S" list))
  68                (setq state :rest))
  69               (sb!c:&more
  70                (unless (member state '(:required :optional))
  71                  (compiler-error "misplaced &MORE in lambda list: ~S" list))
  72                (setq morep t
  73                      state :more-context))
  74               (&key
  75                (unless (member state
  76                                '(:required :optional :post-rest :post-more))
  77                  (compiler-error "misplaced &KEY in lambda list: ~S" list))
  78                (setq keyp t
  79                      state :key))
  80               (&allow-other-keys
  81                (unless (eq state ':key)
  82                  (compiler-error "misplaced &ALLOW-OTHER-KEYS in ~
  83                                   lambda list: ~S"
  84                                  list))
  85                (setq allowp t
  86                      state :allow-other-keys))
  87               (&aux
  88                (when (member state '(:rest :more-context :more-count))
  89                  (compiler-error "misplaced &AUX in lambda list: ~S" list))
  90                (setq state :aux))
  91               ;; FIXME: I don't think ANSI says this is an error. (It
  92               ;; should certainly be good for a STYLE-WARNING,
  93               ;; though.)
  94               (t
  95                (compiler-error "unknown &KEYWORD in lambda list: ~S" arg)))
  96             (case state
  97               (:required (required arg))
  98               (:optional (optional arg))
  99               (:rest
 100                (setq restp t
 101                      rest arg
 102                      state :post-rest))
 103               (:more-context
 104                (setq more-context arg
 105                      state :more-count))
 106               (:more-count
 107                (setq more-count arg
 108                      state :post-more))
 109               (:key (keys arg))
 110               (:aux (aux arg))
 111               (t
 112                (compiler-error "found garbage in lambda list when expecting ~
 113                                 a keyword: ~S"
 114                                arg)))))
 115
 116       (values (required) (optional) restp rest keyp (keys) allowp (aux)
 117               morep more-context more-count))))