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*) (find-caller-name)
21 (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)
37 (if (null (defmacro-lambda-list-bind-error-name condition))
39 "error while parsing arguments to ~A in ~S:~%"
40 (defmacro-lambda-list-bind-error-kind condition)
41 (condition-function-name condition))
43 "error while parsing arguments to ~A ~S:~%"
44 (defmacro-lambda-list-bind-error-kind condition)
45 (defmacro-lambda-list-bind-error-name condition))))
47 (define-condition defmacro-bogus-sublist-error
48 (defmacro-lambda-list-bind-error)
49 ((object :reader defmacro-bogus-sublist-error-object :initarg :object)
50 (lambda-list :reader defmacro-bogus-sublist-error-lambda-list
51 :initarg :lambda-list))
53 (lambda (condition stream)
54 (print-defmacro-ll-bind-error-intro condition stream)
56 "bogus sublist:~% ~S~%to satisfy lambda-list:~% ~:S~%"
57 (defmacro-bogus-sublist-error-object condition)
58 (defmacro-bogus-sublist-error-lambda-list condition)))))
60 (define-condition defmacro-ll-arg-count-error (defmacro-lambda-list-bind-error)
61 ((argument :reader defmacro-ll-arg-count-error-argument :initarg :argument)
62 (lambda-list :reader defmacro-ll-arg-count-error-lambda-list
63 :initarg :lambda-list)
64 (minimum :reader defmacro-ll-arg-count-error-minimum :initarg :minimum)
65 (maximum :reader defmacro-ll-arg-count-error-maximum :initarg :maximum))
67 (lambda (condition stream)
68 (print-defmacro-ll-bind-error-intro condition stream)
70 "invalid number of elements in:~% ~:S~%~
71 to satisfy lambda-list:~% ~:S~%"
72 (defmacro-ll-arg-count-error-argument condition)
73 (defmacro-ll-arg-count-error-lambda-list condition))
74 (cond ((null (defmacro-ll-arg-count-error-maximum condition))
75 (format stream "at least ~D expected"
76 (defmacro-ll-arg-count-error-minimum condition)))
77 ((= (defmacro-ll-arg-count-error-minimum condition)
78 (defmacro-ll-arg-count-error-maximum condition))
79 (format stream "exactly ~D expected"
80 (defmacro-ll-arg-count-error-minimum condition)))
82 (format stream "between ~D and ~D expected"
83 (defmacro-ll-arg-count-error-minimum condition)
84 (defmacro-ll-arg-count-error-maximum condition))))
85 (format stream ", but ~D found"
86 (length (defmacro-ll-arg-count-error-argument condition))))))
88 (define-condition defmacro-ll-broken-key-list-error
89 (defmacro-lambda-list-bind-error)
90 ((problem :reader defmacro-ll-broken-key-list-error-problem
92 (info :reader defmacro-ll-broken-key-list-error-info :initarg :info))
93 (:report (lambda (condition stream)
94 (print-defmacro-ll-bind-error-intro condition stream)
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 "duplicate keyword: ~S")
105 "~{unknown keyword: ~S; expected one of ~{~S~^, ~}~}"))
106 (defmacro-ll-broken-key-list-error-info condition)))))