From 5afacbbb1c45d4f5d7b8eb55e9a9b2fe9dc1be95 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 11 Mar 2011 08:02:30 -0600
Subject: [PATCH] fix `pretty-print' confusion about quasiquote  Closes PR
 11796

---
 collects/racket/pretty.rkt        | 14 +++-----------
 collects/tests/racket/pretty.rktl | 11 +++++++++++
 2 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/collects/racket/pretty.rkt b/collects/racket/pretty.rkt
index a9f4d8d40f..a90e7ee98f 100644
--- a/collects/racket/pretty.rkt
+++ b/collects/racket/pretty.rkt
@@ -750,7 +750,7 @@
                   (equal? open "("))
 	     (begin
 	       (out (read-macro-prefix expr car))
-	       (wr (read-macro-body expr car cdr) depth (reader-adjust-qd (car expr) qd)))
+	       (wr (read-macro-body expr car cdr) depth qd))
 	     (wr-lst expr #t depth pair? car cdr open close qd)))
 
        (define (wr-lst l check? depth pair? car cdr open close qd)
@@ -784,8 +784,7 @@
                                    (null? (cdr (cdr l))))
                               (begin
                                 (out " . ,")
-                                (wr (car (cdr l)) (dsub1 depth)
-                                    (reader-adjust-qd (car l) qd))
+                                (wr (car (cdr l)) (dsub1 depth) qd)
                                 (out close))
                               (begin
                                 (out " ")
@@ -1117,7 +1116,7 @@
 		   extra
 		   pp-expr
 		   depth
-                   (reader-adjust-qd (acar expr) qd)))
+                   qd))
 	     (let ((head (acar expr)))
 	       (if (or (and (symbol? head)
                             (not (size-hook head display?)))
@@ -1485,13 +1484,6 @@
                 unquote unquote-splicing)
                (length1? tail))
               (else #f)))))
-
-  (define (reader-adjust-qd v qd)
-    (and qd
-         (case (do-remap v)
-           [(quasiquote) (add1 qd)]
-           [(unquote unquote-splciing) (sub1 qd)]
-           [else qd])))
             
    (define (read-macro-body l car cdr)
      (car (cdr l)))
diff --git a/collects/tests/racket/pretty.rktl b/collects/tests/racket/pretty.rktl
index c8de8bfa77..ff2f4bf1b0 100644
--- a/collects/tests/racket/pretty.rktl
+++ b/collects/tests/racket/pretty.rktl
@@ -416,6 +416,17 @@
 
 ;; ----------------------------------------
 
+;; make sure pretty printer isn't confised about
+;; quasiquote
+(let ([p (open-output-string)])
+  (pretty-print '(quote ,x ,4) p)
+  (test "'(quote ,x ,4)\n" get-output-string p))
+(let ([p (open-output-string)])
+  (pretty-print '```(quote ,,,,,x ,4) p)
+  (test "'```(quote ,,,,,x ,4)\n" get-output-string p))
+
+;; ----------------------------------------
+
 (parameterize ([print-boolean-long-form #f])
   (test "#t" pretty-format #t)
   (test "#f" pretty-format #f))