From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Thu, 10 Jun 2004 15:47:53 +0000 (+0000)
Subject: 0.8.11.6:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7abb9e44907ef12b52ac26d6482fbe21c036ee9b;p=sbcl.git

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
--- 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
--- 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
--- 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))))
 
 ;;;; magic BACKQ- versions of builtin functions
diff --git a/src/code/pp-backq.lisp b/src/code/pp-backq.lisp
index cfbb8fa..dc5d6ae 100644
--- 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
--- 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)"))
 
 ;;; 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
--- 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"