1 ;;;; error-handling machinery for PARSE-DEFMACRO, separated from PARSE-DEFMACRO
2 ;;;; code itself because the happy path can be handled earlier in the bootstrap
3 ;;;; sequence than DEFINE-CONDITION can be, and because some of the error
4 ;;;; handling depends on SBCL extensions, while PARSE-DEFMACRO needs to run in
5 ;;;; the cross-compiler on the host Common Lisp
7 ;;;; This software is part of the SBCL system. See the README file for
10 ;;;; This software is derived from the CMU CL system, which was
11 ;;;; written at Carnegie Mellon University and released into the
12 ;;;; public domain. The software is in the public domain and is
13 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
14 ;;;; files for more information.
16 (in-package "SB!KERNEL")
18 ;;; We save space in macro definitions by calling this function.
19 (defun do-arg-count-error (error-kind name arg lambda-list minimum maximum)
20 (multiple-value-bind (fname sb!debug:*stack-top-hint*)
21 (find-caller-name-and-frame)
22 (error 'defmacro-ll-arg-count-error
26 :lambda-list lambda-list
27 :minimum minimum :maximum maximum)))
29 (define-condition defmacro-lambda-list-bind-error (error)
30 ((kind :reader defmacro-lambda-list-bind-error-kind
32 (name :reader defmacro-lambda-list-bind-error-name
36 (defun print-defmacro-ll-bind-error-intro (condition stream)
38 "error while parsing arguments to ~A~@[ ~S~]:~%"
39 (defmacro-lambda-list-bind-error-kind condition)
40 (defmacro-lambda-list-bind-error-name condition)))
42 (define-condition defmacro-bogus-sublist-error
43 (defmacro-lambda-list-bind-error)
44 ((object :reader defmacro-bogus-sublist-error-object :initarg :object)
45 (lambda-list :reader defmacro-bogus-sublist-error-lambda-list
46 :initarg :lambda-list))
48 (lambda (condition stream)
49 (print-defmacro-ll-bind-error-intro condition stream)
51 "bogus sublist:~% ~S~%to satisfy lambda-list:~% ~:S~%"
52 (defmacro-bogus-sublist-error-object condition)
53 (defmacro-bogus-sublist-error-lambda-list condition)))))
55 (define-condition defmacro-ll-arg-count-error (defmacro-lambda-list-bind-error)
56 ((argument :reader defmacro-ll-arg-count-error-argument :initarg :argument)
57 (lambda-list :reader defmacro-ll-arg-count-error-lambda-list
58 :initarg :lambda-list)
59 (minimum :reader defmacro-ll-arg-count-error-minimum :initarg :minimum)
60 (maximum :reader defmacro-ll-arg-count-error-maximum :initarg :maximum))
62 (lambda (condition stream)
63 (print-defmacro-ll-bind-error-intro condition stream)
65 "invalid number of elements in:~% ~:S~%~
66 to satisfy lambda-list:~% ~:S~%"
67 (defmacro-ll-arg-count-error-argument condition)
68 (defmacro-ll-arg-count-error-lambda-list condition))
69 (cond ((null (defmacro-ll-arg-count-error-maximum condition))
70 (format stream "at least ~D expected"
71 (defmacro-ll-arg-count-error-minimum condition)))
72 ((= (defmacro-ll-arg-count-error-minimum condition)
73 (defmacro-ll-arg-count-error-maximum condition))
74 (format stream "exactly ~D expected"
75 (defmacro-ll-arg-count-error-minimum condition)))
77 (format stream "between ~D and ~D expected"
78 (defmacro-ll-arg-count-error-minimum condition)
79 (defmacro-ll-arg-count-error-maximum condition))))
80 (format stream ", but ~D found"
81 (length (defmacro-ll-arg-count-error-argument condition))))))
83 (define-condition defmacro-ll-broken-key-list-error
84 (defmacro-lambda-list-bind-error)
85 ((problem :reader defmacro-ll-broken-key-list-error-problem
87 (info :reader defmacro-ll-broken-key-list-error-info :initarg :info))
88 (:report (lambda (condition stream)
89 (print-defmacro-ll-bind-error-intro condition stream)
91 ;; FIXME: These should probably just be three
92 ;; subclasses of the base class, so that we don't
93 ;; need to maintain the set of tags both here and
94 ;; implicitly wherever this macro is used.
96 (defmacro-ll-broken-key-list-error-problem condition)
98 "dotted keyword/value list: ~S")
100 "odd number of elements in keyword/value list: ~S")
102 "~{unknown keyword: ~S; expected one of ~{~S~^, ~}~}"))
103 (defmacro-ll-broken-key-list-error-info condition)))))