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 ;;;; and because some of the error handling depends on SBCL
   5 ;;;; extensions, while PARSE-DEFMACRO needs to run in the
   6 ;;;; cross-compiler on the host Common Lisp
   7
   8 ;;;; This software is part of the SBCL system. See the README file for
   9 ;;;; more information.
  10 ;;;;
  11 ;;;; This software is derived from the CMU CL system, which was
  12 ;;;; written at Carnegie Mellon University and released into the
  13 ;;;; public domain. The software is in the public domain and is
  14 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  15 ;;;; files for more information.
  16
  17 (in-package "SB!KERNEL")
  18
  19 ;;; We save space in macro definitions by calling this function.
  20 (defun do-arg-count-error (error-kind name arg lambda-list minimum maximum)
  21   (multiple-value-bind (fname sb!debug:*stack-top-hint*)
  22       (find-caller-name-and-frame)
  23     (declare (ignorable fname))
  24     (error 'defmacro-ll-arg-count-error
  25            :kind error-kind
  26            :name name
  27            :argument arg
  28            :lambda-list lambda-list
  29            :minimum minimum :maximum maximum)))
  30
  31 (define-condition defmacro-lambda-list-bind-error (error)
  32   ((kind :reader defmacro-lambda-list-bind-error-kind
  33          :initarg :kind)
  34    (name :reader defmacro-lambda-list-bind-error-name
  35          :initarg :name
  36          :initform nil)))
  37
  38 (defun print-defmacro-ll-bind-error-intro (condition stream)
  39   (format stream
  40           "error while parsing arguments to ~A~@[ ~S~]:~%"
  41           (defmacro-lambda-list-bind-error-kind condition)
  42           (defmacro-lambda-list-bind-error-name condition)))
  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      (print-defmacro-ll-bind-error-intro condition stream)
  52      (format stream
  53              "bogus sublist:~%  ~S~%to satisfy lambda-list:~%  ~:S~%"
  54              (defmacro-bogus-sublist-error-object condition)
  55              (defmacro-bogus-sublist-error-lambda-list condition)))))
  56
  57 (define-condition defmacro-ll-arg-count-error (defmacro-lambda-list-bind-error)
  58   ((argument :reader defmacro-ll-arg-count-error-argument :initarg :argument)
  59    (lambda-list :reader defmacro-ll-arg-count-error-lambda-list
  60                 :initarg :lambda-list)
  61    (minimum :reader defmacro-ll-arg-count-error-minimum :initarg :minimum)
  62    (maximum :reader defmacro-ll-arg-count-error-maximum :initarg :maximum))
  63   (:report
  64    (lambda (condition stream)
  65      (print-defmacro-ll-bind-error-intro condition stream)
  66      (format stream
  67              "invalid number of elements in:~%  ~:S~%~
  68              to satisfy lambda-list:~%  ~:S~%"
  69              (defmacro-ll-arg-count-error-argument condition)
  70              (defmacro-ll-arg-count-error-lambda-list condition))
  71      (cond ((null (defmacro-ll-arg-count-error-maximum condition))
  72             (format stream "at least ~D expected"
  73                     (defmacro-ll-arg-count-error-minimum condition)))
  74            ((= (defmacro-ll-arg-count-error-minimum condition)
  75                (defmacro-ll-arg-count-error-maximum condition))
  76             (format stream "exactly ~D expected"
  77                     (defmacro-ll-arg-count-error-minimum condition)))
  78            (t
  79             (format stream "between ~D and ~D expected"
  80                     (defmacro-ll-arg-count-error-minimum condition)
  81                     (defmacro-ll-arg-count-error-maximum condition))))
  82      (format stream ", but ~D found"
  83              (length (defmacro-ll-arg-count-error-argument condition))))))
  84
  85 (define-condition defmacro-ll-broken-key-list-error
  86                   (defmacro-lambda-list-bind-error)
  87   ((problem :reader defmacro-ll-broken-key-list-error-problem
  88             :initarg :problem)
  89    (info :reader defmacro-ll-broken-key-list-error-info :initarg :info))
  90   (:report (lambda (condition stream)
  91              (print-defmacro-ll-bind-error-intro condition stream)
  92              (format stream
  93                      ;; FIXME: These should probably just be three
  94                      ;; subclasses of the base class, so that we don't
  95                      ;; need to maintain the set of tags both here and
  96                      ;; implicitly wherever this macro is used.
  97                      (ecase
  98                          (defmacro-ll-broken-key-list-error-problem condition)
  99                        (:dotted-list
 100                         "dotted keyword/value list: ~S")
 101                        (:odd-length
 102                         "odd number of elements in keyword/value list: ~S")
 103                        (:unknown-keyword
 104                         "~{unknown keyword: ~S; expected one of ~{~S~^, ~}~}"))
 105                      (defmacro-ll-broken-key-list-error-info condition)))))