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")
21 ;;; We save space in macro definitions by calling this function.
22 (defun do-arg-count-error (error-kind name arg lambda-list minimum maximum)
23 (multiple-value-bind (fname sb!debug:*stack-top-hint*) (find-caller-name)
24 (error 'defmacro-ll-arg-count-error
29 :lambda-list lambda-list
30 :minimum minimum :maximum maximum)))
32 (define-condition defmacro-lambda-list-bind-error (error)
33 ((kind :reader defmacro-lambda-list-bind-error-kind
35 (name :reader defmacro-lambda-list-bind-error-name
39 (defun print-defmacro-ll-bind-error-intro (condition stream)
40 (if (null (defmacro-lambda-list-bind-error-name condition))
42 "error while parsing arguments to ~A in ~S:~%"
43 (defmacro-lambda-list-bind-error-kind condition)
44 (condition-function-name condition))
46 "error while parsing arguments to ~A ~S:~%"
47 (defmacro-lambda-list-bind-error-kind condition)
48 (defmacro-lambda-list-bind-error-name condition))))
50 (define-condition defmacro-bogus-sublist-error
51 (defmacro-lambda-list-bind-error)
52 ((object :reader defmacro-bogus-sublist-error-object :initarg :object)
53 (lambda-list :reader defmacro-bogus-sublist-error-lambda-list
54 :initarg :lambda-list))
56 (lambda (condition stream)
57 (print-defmacro-ll-bind-error-intro condition stream)
59 "bogus sublist:~% ~S~%to satisfy lambda-list:~% ~:S~%"
60 (defmacro-bogus-sublist-error-object condition)
61 (defmacro-bogus-sublist-error-lambda-list condition)))))
63 (define-condition defmacro-ll-arg-count-error (defmacro-lambda-list-bind-error)
64 ((argument :reader defmacro-ll-arg-count-error-argument :initarg :argument)
65 (lambda-list :reader defmacro-ll-arg-count-error-lambda-list
66 :initarg :lambda-list)
67 (minimum :reader defmacro-ll-arg-count-error-minimum :initarg :minimum)
68 (maximum :reader defmacro-ll-arg-count-error-maximum :initarg :maximum))
70 (lambda (condition stream)
71 (print-defmacro-ll-bind-error-intro condition stream)
73 "invalid number of elements in:~% ~:S~%~
74 to satisfy lambda-list:~% ~:S~%"
75 (defmacro-ll-arg-count-error-argument condition)
76 (defmacro-ll-arg-count-error-lambda-list condition))
77 (cond ((null (defmacro-ll-arg-count-error-maximum condition))
78 (format stream "at least ~D expected"
79 (defmacro-ll-arg-count-error-minimum condition)))
80 ((= (defmacro-ll-arg-count-error-minimum condition)
81 (defmacro-ll-arg-count-error-maximum condition))
82 (format stream "exactly ~D expected"
83 (defmacro-ll-arg-count-error-minimum condition)))
85 (format stream "between ~D and ~D expected"
86 (defmacro-ll-arg-count-error-minimum condition)
87 (defmacro-ll-arg-count-error-maximum condition))))
88 (format stream ", but ~D found"
89 (length (defmacro-ll-arg-count-error-argument condition))))))
91 (define-condition defmacro-ll-broken-key-list-error
92 (defmacro-lambda-list-bind-error)
93 ((problem :reader defmacro-ll-broken-key-list-error-problem
95 (info :reader defmacro-ll-broken-key-list-error-info :initarg :info))
96 (:report (lambda (condition stream)
97 (print-defmacro-ll-bind-error-intro condition stream)
100 (defmacro-ll-broken-key-list-error-problem condition)
102 "dotted keyword/value list: ~S")
104 "odd number of elements in keyword/value list: ~S")
106 "duplicate keyword: ~S")
108 "~{unknown keyword: ~S; expected one of ~{~S~^, ~}~}"))
109 (defmacro-ll-broken-key-list-error-info condition)))))