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

print-pair-curly-braces: don't affect constructor output

Browse Source 
When `print-pair-curly-braces` is true, change the built-in printer to
not use curly braces to group a constructor with its argument.
Restrict its effect to quoted lists, which is more what you expect and
more consistent with `pretty-print`.

Also, change `pretty-print` to not use `{` when using the `list`,
`list*`, `cons`, or `mcons` constructors.

Closes #2662
This commit is contained in:
Matthew Flatt 2019-05-28 19:04:18 -06:00
parent a121f45aac
commit 6381e3c009
4 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -410,9 +410,11 @@
(define (print/depth-1 v [o (current-output-port)])
(print v o 1))
(test wri in-string write x)
(test (string-append wri "\n") in-string pretty-write x)
(test dis in-string display x)
(test prn in-string print/not-expr x)
(test prx in-string print x)
(test (string-append prx "\n") in-string pretty-print x)
(test pr1 in-string print/depth-1 x))
(define-syntax (for*/parameterize stx)
@ -464,19 +466,19 @@
(test-print/all (list 1 2)
"{1 2}" "{1 2}" "{1 2}" "'{1 2}" "{1 2}")
(test-print/all (cons x x)
"{#0=#(struct:s) . #0#}" "{#0=#(struct:s) . #0#}" "{#0=#(struct:s) . #0#}" "(cons #0={s} #0#)" "{#0=#(struct:s) . #0#}")
"{#0=#(struct:s) . #0#}" "{#0=#(struct:s) . #0#}" "{#0=#(struct:s) . #0#}" "(cons #0=(s) #0#)" "{#0=#(struct:s) . #0#}")
(test-print/all (cons 1 (cons x x))
"{1 #0=#(struct:s) . #0#}" "{1 #0=#(struct:s) . #0#}" "{1 #0=#(struct:s) . #0#}" "(list* 1 #0={s} #0#)" "{1 #0=#(struct:s) . #0#}")
"{1 #0=#(struct:s) . #0#}" "{1 #0=#(struct:s) . #0#}" "{1 #0=#(struct:s) . #0#}" "(list* 1 #0=(s) #0#)" "{1 #0=#(struct:s) . #0#}")
(test-print/all (list (cons x x))
"{{#0=#(struct:s) . #0#}}" "{{#0=#(struct:s) . #0#}}" "{{#0=#(struct:s) . #0#}}" "(list (cons #0={s} #0#))" "{{#0=#(struct:s) . #0#}}")
"{{#0=#(struct:s) . #0#}}" "{{#0=#(struct:s) . #0#}}" "{{#0=#(struct:s) . #0#}}" "(list (cons #0=(s) #0#))" "{{#0=#(struct:s) . #0#}}")
(test-print/all (list x x)
"{#0=#(struct:s) #0#}" "{#0=#(struct:s) #0#}" "{#0=#(struct:s) #0#}" "(list #0={s} #0#)" "{#0=#(struct:s) #0#}")
"{#0=#(struct:s) #0#}" "{#0=#(struct:s) #0#}" "{#0=#(struct:s) #0#}" "(list #0=(s) #0#)" "{#0=#(struct:s) #0#}")
(test-print/all (b 1 2)
"#(struct:b 1 2)" "#(struct:b 1 2)" "#(struct:b 1 2)" "{b 1 2}" "#(struct:b 1 2)")
"#(struct:b 1 2)" "#(struct:b 1 2)" "#(struct:b 1 2)" "(b 1 2)" "#(struct:b 1 2)")
(test-print/all (c 1 2)
"#s(c 1 2)" "#s(c 1 2)" "#s(c 1 2)" "'#s(c 1 2)" "#s(c 1 2)")
(test-print/all (c x x)
"#s(c #0=#(struct:s) #0#)" "#s(c #0=#(struct:s) #0#)" "#s(c #0=#(struct:s) #0#)" "{c #0={s} #0#}" "#s(c #0=#(struct:s) #0#)"))
"#s(c #0=#(struct:s) #0#)" "#s(c #0=#(struct:s) #0#)" "#s(c #0=#(struct:s) #0#)" "(c #0=(s) #0#)" "#s(c #0=#(struct:s) #0#)"))
(parameterize ([print-pair-curly-braces #f])
(test-print/all (cons 1 2)

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

@ -854,10 +854,11 @@
#f #f
(lambda ()
(let* ([qd (to-quoted out qd obj)]
[pair (if (and qd (zero? qd))
[unquoted? (and qd (zero? qd))]
[pair (if unquoted?
(convert-pair obj)
obj)])
(wr-expr pair depth pair? car cdr pair-open pair-close qd))))]
(wr-expr pair depth pair? car cdr (if unquoted? "(" pair-open) (if unquoted? ")" pair-close) qd))))]
[(mpair? obj)
(check-expr-found
obj pport #t
@ -865,7 +866,7 @@
(lambda ()
(if (and qd (zero? qd))
(wr-expr (list (make-unquoted 'mcons) (mcar obj) (mcdr obj))
depth pair? car cdr pair-open pair-close qd)
depth pair? car cdr "(" ")" qd)
(wr-expr obj depth mpair? mcar mcdr mpair-open mpair-close qd))))]
[(null? obj)
(let ([qd (to-quoted out qd obj)])
@ -1089,17 +1090,18 @@
(cond
[(pair? obj)
(let* ([qd (to-quoted out qd obj)]
[pair (if (and qd (zero? qd))
[unquoted? (and qd (zero? qd))]
[pair (if unquoted?
(convert-pair obj)
obj)])
(pp-pair pair extra depth
pair? car cdr pair-open pair-close
pair? car cdr (if unquoted? "(" pair-open) (if unquoted? ")" pair-close)
qd))]
[(mpair? obj)
(if (and qd (zero? qd))
(pp-pair (list (make-unquoted 'mcons) (mcar obj) (mcdr obj))
extra depth
pair? car cdr pair-open pair-close
extra depth
pair? car cdr "(" ")"
qd)
(pp-pair obj extra depth
mpair? mcar mcdr mpair-open mpair-close
@ -1219,11 +1221,12 @@
(let ((proc (style head expr apair? acar acdr)))
(if proc
(let* ([qd (to-quoted out qd expr)]
[pair (if (and qd (zero? qd))
[unquote? (and qd (zero? qd))]
[pair (if unquote?
(cons (make-unquoted 'list) obj)
obj)])
(proc expr extra depth
apair? acar acdr open close
apair? acar acdr (if unquote? "(" open) (if unquote? ")" close)
qd))
(if (and #f
;; Why this special case? Currently disabled.

3
racket/src/io/print/main.rkt
View File

@ -315,10 +315,9 @@
(cond
[(eq? mode PRINT-MODE/UNQUOTED)
(define l (vector->list (struct->vector v)))
(define curly? (config-get config print-pair-curly-braces))
(define alt-list-constructor
;; strip "struct:" from the first element of `l`:
(string-append (if curly? "{" "(") (substring (symbol->string (car l)) 7)))
(string-append "(" (substring (symbol->string (car l)) 7)))
(print-list p who (cdr l) mode o max-length graph config #f alt-list-constructor)]
[(prefab-struct-key v)
=> (lambda (key)

2
racket/src/racket/src/print.c
View File

@ -2296,7 +2296,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
if (notdisplay == 3) {
vec = scheme_vector_to_list(vec);
vec = scheme_make_pair(scheme_object_name(obj), SCHEME_CDR(vec));
print_pair(vec, notdisplay, compact, ht, mt, pp, scheme_pair_type, !pp->print_pair_curly, 1);
print_pair(vec, notdisplay, compact, ht, mt, pp, scheme_pair_type, 1, 1);
} else {
if (SCHEME_TRUEP(prefab))
SCHEME_VEC_ELS(vec)[0] = prefab;