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 (define-condition defmacro-lambda-list-bind-error (error)
  17   ((kind :reader defmacro-lambda-list-bind-error-kind
  18          :initarg :kind)
  19    (name :reader defmacro-lambda-list-bind-error-name
  20          :initarg :name
  21          :initform nil)))
  22
  23 ;;; shared logic for REPORTing variants of DEFMACRO-LAMBDA-LIST-BIND-ERROR:
  24 ;;; Set up appropriate prettying and indentation on STREAM, print some
  25 ;;; boilerplate related to CONDITION (an instance of
  26 ;;; DEFMACRO-LAMBDA-LIST-BIND-ERROR), then execute BODY.
  27 (defmacro !printing-defmacro-lambda-list-bind-error ((condition stream)
  28                                                      &body body)
  29   `(%printing-defmacro-lambda-list-bind-error ,condition
  30                                               ,stream
  31                                               (lambda (,stream)
  32                                                 (declare (type stream ,stream))
  33                                                 ,@body)))
  34 (defun %printing-defmacro-lambda-list-bind-error (condition stream fun)
  35   (declare (type stream stream) (type function fun))
  36   (pprint-logical-block (stream nil)
  37     (format stream
  38             "error while parsing arguments to ~A~@[ ~S~]:~2I~:@_"
  39             (defmacro-lambda-list-bind-error-kind condition)
  40             (defmacro-lambda-list-bind-error-name condition))
  41     (pprint-logical-block (stream nil)
  42       (funcall fun stream))))
  43
  44 (define-condition defmacro-bogus-sublist-error
  45                   (defmacro-lambda-list-bind-error)
  46   ((object :reader defmacro-bogus-sublist-error-object :initarg :object)
  47    (lambda-list :reader defmacro-bogus-sublist-error-lambda-list
  48                 :initarg :lambda-list))
  49   (:report
  50    (lambda (condition stream)
  51      (!printing-defmacro-lambda-list-bind-error (condition stream)
  52        (format stream
  53                "bogus sublist ~2I~_~S ~I~_to satisfy lambda-list ~2I~_~:S"
  54                (defmacro-bogus-sublist-error-object condition)
  55                (defmacro-bogus-sublist-error-lambda-list condition))))))
  56
  57 (define-condition arg-count-error (defmacro-lambda-list-bind-error)
  58   ((args :reader arg-count-error-args :initarg :args)
  59    (lambda-list :reader arg-count-error-lambda-list
  60                 :initarg :lambda-list)
  61    (minimum :reader arg-count-error-minimum :initarg :minimum)
  62    (maximum :reader arg-count-error-maximum :initarg :maximum))
  63   (:report
  64    (lambda (condition stream)
  65     (!printing-defmacro-lambda-list-bind-error (condition stream)
  66       (let ((min (arg-count-error-minimum condition))
  67             (max (arg-count-error-maximum condition))
  68             (actual (arg-count-error-args condition)))
  69        (format stream
  70                "invalid number of elements in ~2I~_~:S ~
  71                 ~I~_to satisfy lambda list ~2I~_~:S: ~I~_"
  72                actual (arg-count-error-lambda-list condition))
  73        (format stream
  74                (cond ((null max) "at least ~W expected")
  75                      ((= min max) "exactly ~W expected")
  76                      (t "between ~W and ~W expected"))
  77                min max)
  78        (cond ((and (atom actual) actual)
  79               (format stream ", but got a non-list"))
  80              ((cdr (last actual))
  81               (format stream ", but got an improper list"))
  82              (t
  83               (format stream ", but got ~d" (length actual)))))))))
  84
  85 (define-condition defmacro-lambda-list-broken-key-list-error
  86                   (defmacro-lambda-list-bind-error)
  87   ((problem :reader defmacro-lambda-list-broken-key-list-error-problem
  88             :initarg :problem)
  89    (info :reader defmacro-lambda-list-broken-key-list-error-info
  90          :initarg :info))
  91   (:report (lambda (condition stream)
  92              (!printing-defmacro-lambda-list-bind-error (condition stream)
  93                (format stream
  94                        ;; FIXME: These should probably just be three
  95                        ;; subclasses of the base class, so that we don't
  96                        ;; need to maintain the set of tags both here and
  97                        ;; implicitly wherever this macro is used. (This
  98                        ;; might get easier once CLOS is initialized in
  99                        ;; cold init.)
 100                        (ecase
 101                            (defmacro-lambda-list-broken-key-list-error-problem
 102                              condition)
 103                          (:dotted-list
 104                           "dotted keyword/value list: ~S")
 105                          (:odd-length
 106                           "odd number of elements in keyword/value list: ~S")
 107                          (:unknown-keyword
 108                           ;; Todo: print the keyword portion of the actual args
 109                           ;;  "unknown keyword foo in (:A 1 :B ...);
 110                           ;;   expected one of ..."
 111                           "~{unknown keyword: ~S; expected one of ~
 112                            ~{~S~^, ~}~}"))
 113                        (defmacro-lambda-list-broken-key-list-error-info
 114                          condition))))))