0.8.11.6:

	Fix countless bugs in backquote printing.
	... descend quoted list structure, necessary in nested
		backquotes;
	... fix the fix to Brian Downing's bug: MAPCAR is not
		sufficiently like MAPCAN.
	... add a couple of tests, but frankly we need some more.  If
		someone out there has a test suite for backquote
		behaviour, that would be rather nice.

diff --git a/BUGS b/BUGS
index 3385eaa..31e0925 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -414,15 +414,6 @@ WORKAROUND:
   forever, even when it is uninterned and all other references to it
   are lost.
 
-141: "pretty printing and backquote"
-  a.
-    * '``(FOO ,@',@S)
-    ``(FOO SB-IMPL::BACKQ-COMMA-AT S)
-
-  c. (reported by Paul F. Dietz)
-     * '`(lambda ,x)
-     `(LAMBDA (SB-IMPL::BACKQ-COMMA X))
-
 143:
   (reported by Jesse Bouwman 2001-10-24 through the unfortunately
   prominent SourceForge web/db bug tracking system, which is 

diff --git a/NEWS b/NEWS
index 67a24b2..5ba9e90 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2527,8 +2527,11 @@ changes in sbcl-0.8.12 relative to sbcl-0.8.11:
     Peter van Eynde, Eric Marsden and Bruno Haible)
   * fixed bug 335: ATANH now computes the inverse hyperbolic tangent
     even for difficult arguments.  (reported by Peter Graves)
-  * fixed a bug in backquote printing: no more modification of the
-    form's list structure.  (reported by Brian Downing)
+  * fixed bug 141a: the backquote printer now descends quoted
+    structure.
+  * fixed another bug in backquote printing: no more destructive
+    modification of the form's list structure.  (reported by Brian
+    Downing)
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/backq.lisp b/src/code/backq.lisp
index b82b464..49d1ba8 100644 (file)
--- a/src/code/backq.lisp
+++ b/src/code/backq.lisp
@@ -186,13 +186,10 @@
                (cons 'backq-list* thing))))
        ((eq flag 'vector)
         (list 'backq-vector thing))
-       (t (cons (cdr
-                 (assoc flag
-                        '((cons . backq-cons)
-                          (list . backq-list)
-                          (append . backq-append)
-                          (nconc . backq-nconc))
-                        :test #'equal))
+       (t (cons (ecase flag
+                  ((list) 'backq-list)
+                  ((append) 'backq-append)
+                  ((nconc) 'backq-nconc))
                 thing))))
 \f
 ;;;; magic BACKQ- versions of builtin functions

diff --git a/src/code/pp-backq.lisp b/src/code/pp-backq.lisp
index cfbb8fa..dc5d6ae 100644 (file)
--- a/src/code/pp-backq.lisp
+++ b/src/code/pp-backq.lisp
@@ -49,18 +49,26 @@
                   (backq-unparse (car tail) t)))
         (push (backq-unparse (car tail)) accum)))
       (backq-append
-       (mapcar (lambda (el) (backq-unparse el t))
-              (cdr form)))
+       (apply #'append
+             (mapcar (lambda (el) (backq-unparse el t))
+                     (cdr form))))
       (backq-nconc
-       (mapcar (lambda (el) (backq-unparse el :nconc))
-              (cdr form)))
+       (apply #'append
+             (mapcar (lambda (el) (backq-unparse el :nconc))
+                     (cdr form))))
       (backq-cons
        (cons (backq-unparse (cadr form) nil)
             (backq-unparse (caddr form) t)))
       (backq-vector
        (coerce (backq-unparse (cadr form)) 'vector))
       (quote
-       (cadr form))
+       (cond
+        ((atom (cadr form)) (cadr form))
+        ((and (consp (cadr form))
+              (member (caadr form) *backq-tokens*))
+         (backq-unparse-expr form splicing))
+        (t (cons (backq-unparse `(quote ,(caadr form)))
+                 (backq-unparse `(quote ,(cdadr form)))))))
       (t
        (backq-unparse-expr form splicing))))))
 

diff --git a/tests/pprint.impure.lisp b/tests/pprint.impure.lisp
index 5317d7a..66efdc1 100644 (file)
--- a/tests/pprint.impure.lisp
+++ b/tests/pprint.impure.lisp
@@ -135,6 +135,25 @@
         (with-output-to-string (s)
           (write '`(lambda (,x)) :stream s :pretty t :readably t))
         "`(LAMBDA (,X))"))
+;;; more backquote printing brokenness, fixed quasi-randomly by CSR.
+;;; NOTE KLUDGE FIXME: because our backquote optimizes at read-time,
+;;; these assertions, like the ones above, are fragile.  Likewise, it
+;;; is very possible that at some point READABLY printing backquote
+;;; expressions will have to change to printing the low-level conses,
+;;; since the magical symbols are accessible though (car '`(,foo)) and
+;;; friends.  HATE HATE HATE.  -- CSR, 2004-06-10
+(assert (equal
+        (with-output-to-string (s)
+          (write '``(foo ,@',@bar) :stream s :pretty t))
+        "``(FOO ,@',@BAR)"))
+(assert (equal
+        (with-output-to-string (s)
+          (write '``(,,foo ,',foo foo) :stream s :pretty t))
+        "``(,,FOO ,',FOO FOO)"))
+(assert (equal
+        (with-output-to-string (s)
+          (write '``(((,,foo) ,',foo) foo) :stream s :pretty t))
+        "``(((,,FOO) ,',FOO) FOO)"))
 \f
 ;;; SET-PPRINT-DISPATCH should accept function name arguments, and not
 ;;; rush to coerce them to functions.

diff --git a/version.lisp-expr b/version.lisp-expr
index dec6ac4..0501bdf 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".)
-"0.8.11.5"
+"0.8.11.6"