1.0.21.25: LOAD-SHARED-OBJECT and logical pathnames
[sbcl.git] / 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        (format stream
67                "invalid number of elements in ~2I~_~:S ~
68                 ~I~_to satisfy lambda list ~2I~_~:S: ~I~_"
69                (arg-count-error-args condition)
70                (arg-count-error-lambda-list condition))
71        (cond ((null (arg-count-error-maximum condition))
72               (format stream "at least ~W expected"
73                       (arg-count-error-minimum condition)))
74              ((= (arg-count-error-minimum condition)
75                  (arg-count-error-maximum condition))
76               (format stream "exactly ~W expected"
77                       (arg-count-error-minimum condition)))
78              (t
79               (format stream "between ~W and ~W expected"
80                       (arg-count-error-minimum condition)
81                       (arg-count-error-maximum condition))))
82        (format stream ", but ~W found"
83                (length (arg-count-error-args condition)))))))
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                           "~{unknown keyword: ~S; expected one of ~
109                            ~{~S~^, ~}~}"))
110                        (defmacro-lambda-list-broken-key-list-error-info
111                          condition))))))