1 ;;;; error-handling machinery for MAKE-MACRO-LAMBDA separated from
2 ;;;; that code because the happy path can be handled
3 ;;;; earlier in the bootstrap sequence than DEFINE-CONDITION can be
5 ;;;; This software is part of the SBCL system. See the README file for
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.
14 (in-package "SB!KERNEL")
16 (define-condition defmacro-lambda-list-bind-error
(error)
17 ((kind :reader defmacro-lambda-list-bind-error-kind
19 (name :reader defmacro-lambda-list-bind-error-name
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
)
29 `(%printing-defmacro-lambda-list-bind-error
,condition
32 (declare (type stream
,stream
))
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
)
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
))))
44 (define-condition arg-count-error
(defmacro-lambda-list-bind-error)
45 ((args :reader arg-count-error-args
:initarg
:args
)
46 (lambda-list :reader arg-count-error-lambda-list
47 :initarg
:lambda-list
)
48 (minimum :reader arg-count-error-minimum
:initarg
:minimum
)
49 (maximum :reader arg-count-error-maximum
:initarg
:maximum
))
51 (lambda (condition stream
)
52 (!printing-defmacro-lambda-list-bind-error
(condition stream
)
53 (let ((min (arg-count-error-minimum condition
))
54 (max (arg-count-error-maximum condition
))
55 (actual (arg-count-error-args condition
)))
57 "invalid number of elements in ~2I~_~:S ~
58 ~I~_to satisfy lambda list ~2I~_~:S: ~I~_"
59 actual
(arg-count-error-lambda-list condition
))
61 (cond ((null max
) "at least ~W expected")
62 ((= min max
) "exactly ~W expected")
63 (t "between ~W and ~W expected"))
65 (cond ((and (atom actual
) actual
)
66 (format stream
", but got a non-list"))
68 (format stream
", but got an improper list"))
70 (format stream
", but got ~d" (length actual
)))))))))
72 (define-condition defmacro-lambda-list-broken-key-list-error
73 (defmacro-lambda-list-bind-error)
74 ((problem :reader defmacro-lambda-list-broken-key-list-error-problem
76 (info :reader defmacro-lambda-list-broken-key-list-error-info
78 (:report
(lambda (condition stream
)
79 (!printing-defmacro-lambda-list-bind-error
(condition stream
)
81 ;; FIXME: These should probably just be three
82 ;; subclasses of the base class, so that we don't
83 ;; need to maintain the set of tags both here and
84 ;; implicitly wherever this macro is used. (This
85 ;; might get easier once CLOS is initialized in
88 (defmacro-lambda-list-broken-key-list-error-problem
91 "dotted keyword/value list: ~S")
93 "odd number of elements in keyword/value list: ~S")
95 ;; Todo: print the keyword portion of the actual args
96 ;; "unknown keyword foo in (:A 1 :B ...);
97 ;; expected one of ..."
98 "~{unknown keyword: ~S; expected one of ~
100 (defmacro-lambda-list-broken-key-list-error-info