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
8 ;;;; This software is part of the SBCL system. See the README file for
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.
17 (in-package "SB!KERNEL")
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 (error 'defmacro-ll-arg-count-error
27 :lambda-list lambda-list
28 :minimum minimum :maximum maximum)))
30 (define-condition defmacro-lambda-list-bind-error (error)
31 ((kind :reader defmacro-lambda-list-bind-error-kind
33 (name :reader defmacro-lambda-list-bind-error-name
37 (defun print-defmacro-ll-bind-error-intro (condition stream)
39 "error while parsing arguments to ~A~@[ ~S~]:~%"
40 (defmacro-lambda-list-bind-error-kind condition)
41 (defmacro-lambda-list-bind-error-name condition)))
43 (define-condition defmacro-bogus-sublist-error
44 (defmacro-lambda-list-bind-error)
45 ((object :reader defmacro-bogus-sublist-error-object :initarg :object)
46 (lambda-list :reader defmacro-bogus-sublist-error-lambda-list
47 :initarg :lambda-list))
49 (lambda (condition stream)
50 (print-defmacro-ll-bind-error-intro condition stream)
52 "bogus sublist:~% ~S~%to satisfy lambda-list:~% ~:S~%"
53 (defmacro-bogus-sublist-error-object condition)
54 (defmacro-bogus-sublist-error-lambda-list condition)))))
56 (define-condition defmacro-ll-arg-count-error (defmacro-lambda-list-bind-error)
57 ((argument :reader defmacro-ll-arg-count-error-argument :initarg :argument)
58 (lambda-list :reader defmacro-ll-arg-count-error-lambda-list
59 :initarg :lambda-list)
60 (minimum :reader defmacro-ll-arg-count-error-minimum :initarg :minimum)
61 (maximum :reader defmacro-ll-arg-count-error-maximum :initarg :maximum))
63 (lambda (condition stream)
64 (print-defmacro-ll-bind-error-intro condition stream)
66 "invalid number of elements in:~% ~:S~%~
67 to satisfy lambda-list:~% ~:S~%"
68 (defmacro-ll-arg-count-error-argument condition)
69 (defmacro-ll-arg-count-error-lambda-list condition))
70 (cond ((null (defmacro-ll-arg-count-error-maximum condition))
71 (format stream "at least ~D expected"
72 (defmacro-ll-arg-count-error-minimum condition)))
73 ((= (defmacro-ll-arg-count-error-minimum condition)
74 (defmacro-ll-arg-count-error-maximum condition))
75 (format stream "exactly ~D expected"
76 (defmacro-ll-arg-count-error-minimum condition)))
78 (format stream "between ~D and ~D expected"
79 (defmacro-ll-arg-count-error-minimum condition)
80 (defmacro-ll-arg-count-error-maximum condition))))
81 (format stream ", but ~D found"
82 (length (defmacro-ll-arg-count-error-argument condition))))))
84 (define-condition defmacro-ll-broken-key-list-error
85 (defmacro-lambda-list-bind-error)
86 ((problem :reader defmacro-ll-broken-key-list-error-problem
88 (info :reader defmacro-ll-broken-key-list-error-info :initarg :info))
89 (:report (lambda (condition stream)
90 (print-defmacro-ll-bind-error-intro condition stream)
92 ;; FIXME: These should probably just be three
93 ;; subclasses of the base class, so that we don't
94 ;; need to maintain the set of tags both here and
95 ;; implicitly wherever this macro is used.
97 (defmacro-ll-broken-key-list-error-problem condition)
99 "dotted keyword/value list: ~S")
101 "odd number of elements in keyword/value list: ~S")
103 "~{unknown keyword: ~S; expected one of ~{~S~^, ~}~}"))
104 (defmacro-ll-broken-key-list-error-info condition)))))