suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

pretty-print: fix 'unquote in mpair and vectors

Browse Source 
Fix misinterpretation of `'unquote` within an `mcons` or `vector`
construction in expression-printing mode.

Closes #3652
This commit is contained in:
Matthew Flatt 2021-05-05 17:10:35 -06:00
parent fc955b99f3
commit 1558e0bde4
2 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-test-core/tests/racket/print.rktl
View File

@ -670,6 +670,14 @@
"('a ,a `a ,@a #'a #,a #`a #,@a)" "('a ,a `a ,@a #'a #,a #`a #,@a)"
"'('a ,a `a ,@a #'a #,a #`a #,@a)" "'('a ,a `a ,@a #'a #,a #`a #,@a)"
"('a ,a `a ,@a #'a #,a #`a #,@a)")) "('a ,a `a ,@a #'a #,a #`a #,@a)"))
(parameterize ([print-reader-abbreviations #t])
(test-print/all (list (mcons 'unquote '()) (vector (mcons 1 2) 'unquote '()))
"({unquote} #({1 . 2} unquote ()))"
"({unquote} #({1 . 2} unquote ()))"
"({unquote} #({1 . 2} unquote ()))"
"(list (mcons 'unquote '()) (vector (mcons 1 2) 'unquote '()))"
"({unquote} #({1 . 2} unquote ()))"))
(void))) (void)))

15
racket/collects/racket/pretty.rkt
View File

@ -756,7 +756,8 @@
(lambda () (lambda ()
(cond (cond
[(pair? l) [(pair? l)
(if (and (eq? (do-remap (car l)) 'unquote) (if (and check?
(eq? (do-remap (car l)) 'unquote)
(not (equal? qd 1)) (not (equal? qd 1))
(pair? (cdr l)) (pair? (cdr l))
(null? (cdr (cdr l)))) (null? (cdr (cdr l))))
@ -806,8 +807,8 @@
#f #f #f #f
(lambda () (lambda ()
(if (and qd (zero? qd)) (if (and qd (zero? qd))
(wr-expr (list (make-unquoted 'mcons) (mcar obj) (mcdr obj)) (wr-lst (list (make-unquoted 'mcons) (mcar obj) (mcdr obj))
depth pair? car cdr "(" ")" qd) #f depth pair? car cdr "(" ")" qd)
(wr-expr obj depth mpair? mcar mcdr mpair-open mpair-close qd))))] (wr-expr obj depth mpair? mcar mcdr mpair-open mpair-close qd))))]
[(null? obj) [(null? obj)
(let ([qd (to-quoted out qd obj)]) (let ([qd (to-quoted out qd obj)])
@ -1048,8 +1049,8 @@
qd))] qd))]
[(mpair? obj) [(mpair? obj)
(if (and qd (zero? qd)) (if (and qd (zero? qd))
(pp-pair (list (make-unquoted 'mcons) (mcar obj) (mcdr obj)) (pp-list (list (make-unquoted 'mcons) (mcar obj) (mcdr obj))
extra depth extra pp-expr #f depth
pair? car cdr "(" ")" pair? car cdr "(" ")"
qd) qd)
(pp-pair obj extra depth (pp-pair obj extra depth
@ -1058,8 +1059,8 @@
[(vector? obj) [(vector? obj)
(let ([qd (to-quoted out qd obj)]) (let ([qd (to-quoted out qd obj)])
(if (and qd (zero? qd)) (if (and qd (zero? qd))
(pp-pair (cons (make-unquoted 'vector) (vector->list obj)) (pp-list (cons (make-unquoted 'vector) (vector->list obj))
extra depth extra pp-expr #f depth
pair? car cdr pair-open pair-close pair? car cdr pair-open pair-close
qd) qd)
(begin (begin