fix `pretty-print' confusion about quasiquote

Closes PR 11796
This commit is contained in:
Matthew Flatt 2011-03-11 08:02:30 -06:00
parent ae8705611b
commit 5afacbbb1c
2 changed files with 14 additions and 11 deletions

View File

@ -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)))

View File

@ -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))