pretty-print: fix spacing when a symbol includes a newline

Closes #3439
This commit is contained in:
Matthew Flatt 2020-10-13 16:04:18 -06:00
parent 366bdcb9e7
commit 331a710e22
2 changed files with 21 additions and 13 deletions

View File

@ -532,6 +532,13 @@
(pretty-print-newline o 17) (pretty-print-newline o 17)
(test "\n" get-output-string o)) (test "\n" get-output-string o))
;; ----------------------------------------
;; check that a symbol with a newline doesn't prevent space from being
;; includined between symbols
(test "'(12345678\n |\na|\n b)"
pretty-format (list 12345678 (string->symbol "\na") 'b) 10)
;; ---------------------------------------- ;; ----------------------------------------
(report-errs) (report-errs)

View File

@ -300,7 +300,7 @@
content))) content)))
(lambda (use-line? offset width) (lambda (use-line? offset width)
(when (and (number? width) (when (and (number? width)
(not first-line?)) < (not first-line?))
(newline p)) (newline p))
(set! first-line? #f) (set! first-line? #f)
0) 0)
@ -980,13 +980,15 @@
(let-values ([(l col p) (port-next-location pport)]) (let-values ([(l col p) (port-next-location pport)])
col)) col))
(define (indent to) (define (indent to #:need-space? [need-space? #t])
(let ([col (ccol)]) (let ([col (ccol)])
(if (< to col) (if (if need-space?
(<= to col)
(< to col))
(begin (begin
(let ([col ((printing-port-print-line pport) #t col width)]) (let ([col ((printing-port-print-line pport) #t col width)])
(spaces (- to col)))) (spaces (- to col))))
(spaces (max 0 (- to col)))))) (spaces (- to col)))))
(define (pr obj extra pp-pair depth qd) (define (pr obj extra pp-pair depth qd)
;; may have to split on multiple lines ;; may have to split on multiple lines
@ -1255,12 +1257,15 @@
(let ([col (ccol)]) (let ([col (ccol)])
(pp-down close l col col extra pp-item #f check? depth (pp-down close l col col extra pp-item #f check? depth
apair? acar acdr open close apair? acar acdr open close
qd))) qd
;; No extra space needed before the first thing:
#:need-space? #f)))
(define (pp-down closer l col1 col2 extra pp-item check-first? check-rest? depth (define (pp-down closer l col1 col2 extra pp-item check-first? check-rest? depth
apair? acar acdr open close apair? acar acdr open close
qd) qd
(let loop ([l l] [icol col1] [check? check-first?]) #:need-space? [need-space? #t])
(let loop ([l l] [icol col1] [check? check-first?] [need-space? need-space?])
(check-expr-found (check-expr-found
l pport (and check? (apair? l)) l pport (and check? (apair? l))
(lambda (s) (lambda (s)
@ -1280,9 +1285,9 @@
[(apair? l) [(apair? l)
(let ([rest (acdr l)]) (let ([rest (acdr l)])
(let ([extra (if (null? rest) (+ extra 1) 0)]) (let ([extra (if (null? rest) (+ extra 1) 0)])
(indent icol) (indent icol #:need-space? need-space?)
(pr (acar l) extra pp-item (dsub1 depth) qd) (pr (acar l) extra pp-item (dsub1 depth) qd)
(loop rest col2 check-rest?)))] (loop rest col2 check-rest? #t)))]
[(null? l) [(null? l)
(out closer)] (out closer)]
[else [else
@ -1618,7 +1623,3 @@
[else (raise-argument-error 'pretty-format "(or/c 'print 'write 'display)" mode)]) [else (raise-argument-error 'pretty-format "(or/c 'print 'write 'display)" mode)])
t op #:newline? #f) t op #:newline? #f)
(get-output-string op)))) (get-output-string op))))