1.0.37.57: better DEFMETHOD pretty-printing

 No more #'FOO in lambda-lists.

diff --git a/NEWS b/NEWS
index cd74af3..fa4088d 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -40,6 +40,7 @@ changes relative to sbcl-1.0.37:
     ** bug fix: whenever a profiling counter wrapped into overflow mode, it
        incurred an off-by-one miscount.
   * enhancement: improved MAKE-HASH-TABLE documentation (lp#543473)
+  * enhancement: improved DEFMETHOD pretty-printing.
   * bug fix: correct restart text for the continuable error in MAKE-PACKAGE.
   * bug fix: a rare case of startup-time page table corruption.
   * bug fix: a semaphore with multiple waiters and some of them unwinding due

diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index d0f7b57..f938d30 100644 (file)
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -1261,6 +1261,15 @@ line break."
            stream
            list))
 
+(defun pprint-defmethod (stream list &rest noise)
+  (declare (ignore noise))
+  (if (consp (third list))
+      (pprint-defun stream list)
+      (funcall (formatter
+                "~:<~^~W~^ ~@_~:I~W~^ ~W~^ ~:_~/SB!PRETTY:PPRINT-LAMBDA-LIST/~1I~@{ ~_~W~}~:>")
+               stream
+               list)))
+
 (defun pprint-defpackage (stream list &rest noise)
   (declare (ignore noise))
   (funcall  (formatter
@@ -1518,6 +1527,7 @@ line break."
                           (define-modify-macro pprint-defun)
                           (define-setf-expander pprint-defun)
                           (defmacro pprint-defun)
+                          (defmethod pprint-defmethod)
                           (defpackage pprint-defpackage)
                           (defparameter pprint-block)
                           (defsetf pprint-defun)

diff --git a/tests/pprint.impure.lisp b/tests/pprint.impure.lisp
index 2a98b0b..29a3e93 100644 (file)
--- a/tests/pprint.impure.lisp
+++ b/tests/pprint.impure.lisp
@@ -215,5 +215,15 @@
                        :no-error)
          (sb-int:standard-pprint-dispatch-table-modified-error ()
            :error)))))
+
+(with-test (:name :pprint-defmethod-lambda-list-function)
+  (flet ((to-string (form)
+           (let ((string (with-output-to-string (s) (pprint form s))))
+             (assert (eql #\newline (char string 0)))
+             (subseq string 1))))
+    (assert (equal "(DEFMETHOD FOO ((FUNCTION CONS)) FUNCTION)"
+                   (to-string `(defmethod foo ((function cons)) function))))
+    (assert (equal "(DEFMETHOD FOO :AFTER (FUNCTION CONS) FUNCTION)"
+                   (to-string `(defmethod foo :after (function cons) function))))))
 \f
 ;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index a686ca3..afd03dc 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.37.56"
+"1.0.37.57"