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 (defun print-defmacro-ll-bind-error-intro (condition stream)
  36   (format stream
  37           "error while parsing arguments to ~A~@[ ~S~]:~%"
  38           (defmacro-lambda-list-bind-error-kind condition)
  39           (defmacro-lambda-list-bind-error-name condition)))
  40
  41 (define-condition defmacro-bogus-sublist-error
  42                   (defmacro-lambda-list-bind-error)
  43   ((object :reader defmacro-bogus-sublist-error-object :initarg :object)
  44    (lambda-list :reader defmacro-bogus-sublist-error-lambda-list
  45                 :initarg :lambda-list))
  46   (:report
  47    (lambda (condition stream)
  48      (print-defmacro-ll-bind-error-intro condition stream)
  49      (format stream
  50              "bogus sublist:~%  ~S~%to satisfy lambda-list:~%  ~:S~%"
  51              (defmacro-bogus-sublist-error-object condition)
  52              (defmacro-bogus-sublist-error-lambda-list condition)))))
  53
  54 (define-condition arg-count-error (defmacro-lambda-list-bind-error)
  55   ((args :reader arg-count-error-args :initarg :args)
  56    (lambda-list :reader arg-count-error-lambda-list
  57                 :initarg :lambda-list)
  58    (minimum :reader arg-count-error-minimum :initarg :minimum)
  59    (maximum :reader arg-count-error-maximum :initarg :maximum))
  60   (:report
  61    (lambda (condition stream)
  62      (print-defmacro-ll-bind-error-intro condition stream)
  63      (format stream
  64              "invalid number of elements in:~%  ~:S~%~
  65              to satisfy lambda list:~%  ~:S~%"
  66              (arg-count-error-args condition)
  67              (arg-count-error-lambda-list condition))
  68      (cond ((null (arg-count-error-maximum condition))
  69             (format stream "at least ~W expected"
  70                     (arg-count-error-minimum condition)))
  71            ((= (arg-count-error-minimum condition)
  72                (arg-count-error-maximum condition))
  73             (format stream "exactly ~W expected"
  74                     (arg-count-error-minimum condition)))
  75            (t
  76             (format stream "between ~W and ~W expected"
  77                     (arg-count-error-minimum condition)
  78                     (arg-count-error-maximum condition))))
  79      (format stream ", but ~W found"
  80              (length (arg-count-error-args condition))))))
  81
  82 (define-condition defmacro-ll-broken-key-list-error
  83                   (defmacro-lambda-list-bind-error)
  84   ((problem :reader defmacro-ll-broken-key-list-error-problem
  85             :initarg :problem)
  86    (info :reader defmacro-ll-broken-key-list-error-info :initarg :info))
  87   (:report (lambda (condition stream)
  88              (print-defmacro-ll-bind-error-intro condition stream)
  89              (format stream
  90                      ;; FIXME: These should probably just be three
  91                      ;; subclasses of the base class, so that we don't
  92                      ;; need to maintain the set of tags both here and
  93                      ;; implicitly wherever this macro is used.
  94                      (ecase
  95                          (defmacro-ll-broken-key-list-error-problem condition)
  96                        (:dotted-list
  97                         "dotted keyword/value list: ~S")
  98                        (:odd-length
  99                         "odd number of elements in keyword/value list: ~S")
 100                        (:unknown-keyword
 101                         "~{unknown keyword: ~S; expected one of ~{~S~^, ~}~}"))
 102                      (defmacro-ll-broken-key-list-error-info condition)))))