(in-package "SB!KERNEL")
-;;; We save space in macro definitions by calling this function.
-(defun arg-count-error (error-kind name args lambda-list minimum maximum)
- (let (#-sb-xc-host
- (sb!debug:*stack-top-hint* (nth-value 1 (find-caller-name-and-frame))))
- (error 'arg-count-error
- :kind error-kind
- :name name
- :args args
- :lambda-list lambda-list
- :minimum minimum
- :maximum maximum)))
-
(define-condition defmacro-lambda-list-bind-error (error)
((kind :reader defmacro-lambda-list-bind-error-kind
- :initarg :kind)
+ :initarg :kind)
(name :reader defmacro-lambda-list-bind-error-name
- :initarg :name
- :initform nil)))
+ :initarg :name
+ :initform nil)))
-(defun print-defmacro-ll-bind-error-intro (condition stream)
- (format stream
- "error while parsing arguments to ~A~@[ ~S~]:~%"
- (defmacro-lambda-list-bind-error-kind condition)
- (defmacro-lambda-list-bind-error-name condition)))
+;;; shared logic for REPORTing variants of DEFMACRO-LAMBDA-LIST-BIND-ERROR:
+;;; Set up appropriate prettying and indentation on STREAM, print some
+;;; boilerplate related to CONDITION (an instance of
+;;; DEFMACRO-LAMBDA-LIST-BIND-ERROR), then execute BODY.
+(defmacro !printing-defmacro-lambda-list-bind-error ((condition stream)
+ &body body)
+ `(%printing-defmacro-lambda-list-bind-error ,condition
+ ,stream
+ (lambda (,stream)
+ (declare (type stream ,stream))
+ ,@body)))
+(defun %printing-defmacro-lambda-list-bind-error (condition stream fun)
+ (declare (type stream stream) (type function fun))
+ (pprint-logical-block (stream nil)
+ (format stream
+ "error while parsing arguments to ~A~@[ ~S~]:~2I~:@_"
+ (defmacro-lambda-list-bind-error-kind condition)
+ (defmacro-lambda-list-bind-error-name condition))
+ (pprint-logical-block (stream nil)
+ (funcall fun stream))))
(define-condition defmacro-bogus-sublist-error
- (defmacro-lambda-list-bind-error)
+ (defmacro-lambda-list-bind-error)
((object :reader defmacro-bogus-sublist-error-object :initarg :object)
(lambda-list :reader defmacro-bogus-sublist-error-lambda-list
- :initarg :lambda-list))
+ :initarg :lambda-list))
(:report
(lambda (condition stream)
- (print-defmacro-ll-bind-error-intro condition stream)
- (format stream
- "bogus sublist:~% ~S~%to satisfy lambda-list:~% ~:S~%"
- (defmacro-bogus-sublist-error-object condition)
- (defmacro-bogus-sublist-error-lambda-list condition)))))
+ (!printing-defmacro-lambda-list-bind-error (condition stream)
+ (format stream
+ "bogus sublist ~2I~_~S ~I~_to satisfy lambda-list ~2I~_~:S"
+ (defmacro-bogus-sublist-error-object condition)
+ (defmacro-bogus-sublist-error-lambda-list condition))))))
(define-condition arg-count-error (defmacro-lambda-list-bind-error)
((args :reader arg-count-error-args :initarg :args)
(lambda-list :reader arg-count-error-lambda-list
- :initarg :lambda-list)
+ :initarg :lambda-list)
(minimum :reader arg-count-error-minimum :initarg :minimum)
(maximum :reader arg-count-error-maximum :initarg :maximum))
(:report
(lambda (condition stream)
- (print-defmacro-ll-bind-error-intro condition stream)
- (format stream
- "invalid number of elements in:~% ~:S~%~
- to satisfy lambda list:~% ~:S~%"
- (arg-count-error-args condition)
- (arg-count-error-lambda-list condition))
- (cond ((null (arg-count-error-maximum condition))
- (format stream "at least ~W expected"
- (arg-count-error-minimum condition)))
- ((= (arg-count-error-minimum condition)
- (arg-count-error-maximum condition))
- (format stream "exactly ~W expected"
- (arg-count-error-minimum condition)))
- (t
- (format stream "between ~W and ~W expected"
- (arg-count-error-minimum condition)
- (arg-count-error-maximum condition))))
- (format stream ", but ~W found"
- (length (arg-count-error-args condition))))))
+ (!printing-defmacro-lambda-list-bind-error (condition stream)
+ (format stream
+ "invalid number of elements in ~2I~_~:S ~
+ ~I~_to satisfy lambda list ~2I~_~:S: ~I~_"
+ (arg-count-error-args condition)
+ (arg-count-error-lambda-list condition))
+ (cond ((null (arg-count-error-maximum condition))
+ (format stream "at least ~W expected"
+ (arg-count-error-minimum condition)))
+ ((= (arg-count-error-minimum condition)
+ (arg-count-error-maximum condition))
+ (format stream "exactly ~W expected"
+ (arg-count-error-minimum condition)))
+ (t
+ (format stream "between ~W and ~W expected"
+ (arg-count-error-minimum condition)
+ (arg-count-error-maximum condition))))
+ (format stream ", but ~a found"
+ (if (null (cdr (last (arg-count-error-args condition))))
+ (length (arg-count-error-args condition))
+ "not a proper list"))))))
-(define-condition defmacro-ll-broken-key-list-error
- (defmacro-lambda-list-bind-error)
- ((problem :reader defmacro-ll-broken-key-list-error-problem
- :initarg :problem)
- (info :reader defmacro-ll-broken-key-list-error-info :initarg :info))
+(define-condition defmacro-lambda-list-broken-key-list-error
+ (defmacro-lambda-list-bind-error)
+ ((problem :reader defmacro-lambda-list-broken-key-list-error-problem
+ :initarg :problem)
+ (info :reader defmacro-lambda-list-broken-key-list-error-info
+ :initarg :info))
(:report (lambda (condition stream)
- (print-defmacro-ll-bind-error-intro condition stream)
- (format stream
- ;; FIXME: These should probably just be three
- ;; subclasses of the base class, so that we don't
- ;; need to maintain the set of tags both here and
- ;; implicitly wherever this macro is used.
- (ecase
- (defmacro-ll-broken-key-list-error-problem condition)
- (:dotted-list
- "dotted keyword/value list: ~S")
- (:odd-length
- "odd number of elements in keyword/value list: ~S")
- (:unknown-keyword
- "~{unknown keyword: ~S; expected one of ~{~S~^, ~}~}"))
- (defmacro-ll-broken-key-list-error-info condition)))))
+ (!printing-defmacro-lambda-list-bind-error (condition stream)
+ (format stream
+ ;; FIXME: These should probably just be three
+ ;; subclasses of the base class, so that we don't
+ ;; need to maintain the set of tags both here and
+ ;; implicitly wherever this macro is used. (This
+ ;; might get easier once CLOS is initialized in
+ ;; cold init.)
+ (ecase
+ (defmacro-lambda-list-broken-key-list-error-problem
+ condition)
+ (:dotted-list
+ "dotted keyword/value list: ~S")
+ (:odd-length
+ "odd number of elements in keyword/value list: ~S")
+ (:unknown-keyword
+ "~{unknown keyword: ~S; expected one of ~
+ ~{~S~^, ~}~}"))
+ (defmacro-lambda-list-broken-key-list-error-info
+ condition))))))