src/code/parse-defmacro-errors.lisp

   1 ;;;; error-handling machinery for PARSE-DEFMACRO, separated from
   2 ;;;; PARSE-DEFMACRO code itself because the happy path can be handled
   3 ;;;; earlier in the bootstrap sequence than DEFINE-CONDITION can be
   4
   5 ;;;; This software is part of the SBCL system. See the README file for
   6 ;;;; more information.
   7 ;;;;
   8 ;;;; This software is derived from the CMU CL system, which was
   9 ;;;; written at Carnegie Mellon University and released into the
  10 ;;;; public domain. The software is in the public domain and is
  11 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  12 ;;;; files for more information.
  13
  14 (in-package "SB!KERNEL")
  15
  16 ;;; We save space in macro definitions by calling this function.
  17 (defun arg-count-error (error-kind name args lambda-list minimum maximum)
  18   (let (#-sb-xc-host
  19         (sb!debug:*stack-top-hint* (nth-value 1 (find-caller-name-and-frame))))
  20     (error 'arg-count-error
  21            :kind error-kind
  22            :name name
  23            :args args
  24            :lambda-list lambda-list
  25            :minimum minimum
  26            :maximum maximum)))
  27
  28 (define-condition defmacro-lambda-list-bind-error (error)
  29   ((kind :reader defmacro-lambda-list-bind-error-kind
  30          :initarg :kind)
  31    (name :reader defmacro-lambda-list-bind-error-name
  32          :initarg :name
  33          :initform nil)))
  34
  35 ;;; shared logic for REPORTing variants of DEFMACRO-LAMBDA-LIST-BIND-ERROR:
  36 ;;; Set up appropriate prettying and indentation on STREAM, print some
  37 ;;; boilerplate related to CONDITION (an instance of
  38 ;;; DEFMACRO-LAMBDA-LIST-BIND-ERROR), then execute BODY.
  39 (defmacro !printing-defmacro-lambda-list-bind-error ((condition stream)
  40                                                      &body body)
  41   `(%printing-defmacro-lambda-list-bind-error ,condition
  42                                               ,stream
  43                                               (lambda (,stream)
  44                                                 (declare (type stream ,stream))
  45                                                 ,@body)))
  46 (defun %printing-defmacro-lambda-list-bind-error (condition stream fun)
  47   (declare (type stream stream) (type function fun))
  48   (pprint-logical-block (stream nil)
  49     (format stream
  50             "error while parsing arguments to ~A~@[ ~S~]:~2I~:@_"
  51             (defmacro-lambda-list-bind-error-kind condition)
  52             (defmacro-lambda-list-bind-error-name condition))
  53     (pprint-logical-block (stream nil)
  54       (funcall fun stream))))
  55
  56 (define-condition defmacro-bogus-sublist-error
  57                   (defmacro-lambda-list-bind-error)
  58   ((object :reader defmacro-bogus-sublist-error-object :initarg :object)
  59    (lambda-list :reader defmacro-bogus-sublist-error-lambda-list
  60                 :initarg :lambda-list))
  61   (:report
  62    (lambda (condition stream)
  63      (!printing-defmacro-lambda-list-bind-error (condition stream)
  64        (format stream
  65                "bogus sublist ~2I~_~S ~I~_to satisfy lambda-list ~2I~_~:S"
  66                (defmacro-bogus-sublist-error-object condition)
  67                (defmacro-bogus-sublist-error-lambda-list condition))))))
  68
  69 (define-condition arg-count-error (defmacro-lambda-list-bind-error)
  70   ((args :reader arg-count-error-args :initarg :args)
  71    (lambda-list :reader arg-count-error-lambda-list
  72                 :initarg :lambda-list)
  73    (minimum :reader arg-count-error-minimum :initarg :minimum)
  74    (maximum :reader arg-count-error-maximum :initarg :maximum))
  75   (:report
  76    (lambda (condition stream)
  77      (!printing-defmacro-lambda-list-bind-error (condition stream)
  78        (format stream
  79                "invalid number of elements in ~2I~_~:S ~
  80                 ~I~_to satisfy lambda list ~2I~_~:S: ~I~_"
  81                (arg-count-error-args condition)
  82                (arg-count-error-lambda-list condition))
  83        (cond ((null (arg-count-error-maximum condition))
  84               (format stream "at least ~W expected"
  85                       (arg-count-error-minimum condition)))
  86              ((= (arg-count-error-minimum condition)
  87                  (arg-count-error-maximum condition))
  88               (format stream "exactly ~W expected"
  89                       (arg-count-error-minimum condition)))
  90              (t
  91               (format stream "between ~W and ~W expected"
  92                       (arg-count-error-minimum condition)
  93                       (arg-count-error-maximum condition))))
  94        (format stream ", but ~W found"
  95                (length (arg-count-error-args condition)))))))
  96
  97 (define-condition defmacro-lambda-list-broken-key-list-error
  98                   (defmacro-lambda-list-bind-error)
  99   ((problem :reader defmacro-lambda-list-broken-key-list-error-problem
 100             :initarg :problem)
 101    (info :reader defmacro-lambda-list-broken-key-list-error-info
 102          :initarg :info))
 103   (:report (lambda (condition stream)
 104              (!printing-defmacro-lambda-list-bind-error (condition stream)
 105                (format stream
 106                        ;; FIXME: These should probably just be three
 107                        ;; subclasses of the base class, so that we don't
 108                        ;; need to maintain the set of tags both here and
 109                        ;; implicitly wherever this macro is used. (This
 110                        ;; might get easier once CLOS is initialized in
 111                        ;; cold init.)
 112                        (ecase
 113                            (defmacro-lambda-list-broken-key-list-error-problem
 114                              condition)
 115                          (:dotted-list
 116                           "dotted keyword/value list: ~S")
 117                          (:odd-length
 118                           "odd number of elements in keyword/value list: ~S")
 119                          (:unknown-keyword
 120                           "~{unknown keyword: ~S; expected one of ~
 121                            ~{~S~^, ~}~}"))
 122                        (defmacro-lambda-list-broken-key-list-error-info
 123                          condition))))))