0.7.1.29:
[sbcl.git] / src / code / parse-defmacro-errors.lisp
index 3efcae4..b4bc377 100644 (file)
         :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))
   (: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)
    (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 ~W found"
+              (length (arg-count-error-args condition)))))))
 
-(define-condition defmacro-ll-broken-key-list-error
+(define-condition defmacro-lambda-list-broken-key-list-error
                  (defmacro-lambda-list-bind-error)
-  ((problem :reader defmacro-ll-broken-key-list-error-problem
+  ((problem :reader defmacro-lambda-list-broken-key-list-error-problem
            :initarg :problem)
-   (info :reader defmacro-ll-broken-key-list-error-info :initarg :info))
+   (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))))))