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