From a121f45aac5d14aa411396c12179d308faf3bbc1 Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Sat, 25 May 2019 00:12:31 -0300 Subject: [PATCH] cs: use print-pair-curly-braces --- pkgs/racket-test-core/tests/racket/print.rktl | 62 ++++++++++++++++++- racket/src/io/print/list.rkt | 17 +++-- racket/src/io/print/main.rkt | 3 +- 3 files changed, 76 insertions(+), 6 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/print.rktl b/pkgs/racket-test-core/tests/racket/print.rktl index 596a591795..6c06b90f3c 100644 --- a/pkgs/racket-test-core/tests/racket/print.rktl +++ b/pkgs/racket-test-core/tests/racket/print.rktl @@ -424,8 +424,17 @@ [(_ () body ...) #'(let () body ...)])) + (define-struct a (x y)) + (define-struct b (x y) #:transparent) + (define-struct c (x y) #:prefab) + + (struct s () #:transparent) + (define x (s)) ; a shared value to use in the test + + (parameterize ([print-graph #t]) (for*/parameterize ([print-pair-curly-braces (in-list '(#t #f))] [print-mpair-curly-braces (in-list '(#t #f))]) + (parameterize ([print-mpair-curly-braces #t]) (test-print/all (mcons 1 2) "{1 . 2}" "{1 . 2}" "{1 . 2}" "(mcons 1 2)" "{1 . 2}") @@ -444,7 +453,58 @@ "(1)" "(1)" "(1)" "(mcons 1 '())" "(1)") (test-print/all (mcons 1 (mcons 2 '())) "(1 2)" "(1 2)" "(1 2)" "(mcons 1 (mcons 2 '()))" "(1 2)")) - (void))) + + (parameterize ([print-pair-curly-braces #t]) + (test-print/all (cons 1 2) + "{1 . 2}" "{1 . 2}" "{1 . 2}" "'{1 . 2}" "{1 . 2}") + (test-print/all (cons 1 (cons 2 3)) + "{1 2 . 3}" "{1 2 . 3}" "{1 2 . 3}" "'{1 2 . 3}" "{1 2 . 3}") + (test-print/all (list 1) + "{1}" "{1}" "{1}" "'{1}" "{1}") + (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#}") + (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#}") + (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#}}") + (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#}") + (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)") + (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#)")) + + (parameterize ([print-pair-curly-braces #f]) + (test-print/all (cons 1 2) + "(1 . 2)" "(1 . 2)" "(1 . 2)" "'(1 . 2)" "(1 . 2)") + (test-print/all (cons 1 (cons 2 3)) + "(1 2 . 3)" "(1 2 . 3)" "(1 2 . 3)" "'(1 2 . 3)" "(1 2 . 3)") + (test-print/all (list 1) + "(1)" "(1)" "(1)" "'(1)" "(1)") + (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#)") + (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#)") + (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#))") + (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#)") + (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)") + (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#)")) + (test-print/all (a 1 2) + "#" "#" "#" "#" "#") + + (void)))) ;; ---------------------------------------- diff --git a/racket/src/io/print/list.rkt b/racket/src/io/print/list.rkt index 8c0283a9d1..eafbce6908 100644 --- a/racket/src/io/print/list.rkt +++ b/racket/src/io/print/list.rkt @@ -13,6 +13,15 @@ (and (eq? mode PRINT-MODE/UNQUOTED) (not alt-list-constructor) (not (uninterrupted-list? v graph)))) + (define curly? (cond + [(eq? mode PRINT-MODE/UNQUOTED) + (and (not unquoted-pairs?) + alt-list-constructor + (eq? (string-ref alt-list-constructor 0) #\{))] + [alt-list-prefix + (eq? (string-ref alt-list-prefix 0) #\{)] + [else + (config-get config print-pair-curly-braces)])) (define (abbreviation v) (and (eq? mode PRINT-MODE/QUOTED) (pair? v) @@ -51,15 +60,15 @@ (cond [(null? v) max-length] [else (write-string/max " " o max-length)]))] - [else (write-string/max (or alt-list-prefix "(") o max-length)])]) + [else (write-string/max (or alt-list-prefix (if curly? "{" "(")) o max-length)])]) (let loop ([v v] [max-length max-length]) (cond [(eq? max-length 'full) 'full] - [(null? v) (write-string/max ")" o max-length)] + [(null? v) (write-string/max (if curly? "}" ")") o max-length)] [(and (null? (cdr v)) (not unquoted-pairs?)) (let ([max-length (p who (car v) mode o max-length graph config)]) - (write-string/max ")" o max-length))] + (write-string/max (if curly? "}" ")") o max-length))] [(and (pair? (cdr v)) (or (not graph) (non-graph? (hash-ref graph (cdr v) #f))) (not (abbreviation (cdr v)))) @@ -75,7 +84,7 @@ (write-string/max " " o max-length) (write-string/max " . " o max-length))] [max-length (p who (cdr v) mode o max-length graph config)]) - (write-string/max ")" o max-length))])))])) + (write-string/max (if curly? "}" ")") o max-length))])))])) (define (uninterrupted-list? v graph) (and (list? v) diff --git a/racket/src/io/print/main.rkt b/racket/src/io/print/main.rkt index 3d94a4582a..e05a75c23e 100644 --- a/racket/src/io/print/main.rkt +++ b/racket/src/io/print/main.rkt @@ -315,9 +315,10 @@ (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 "(" (substring (symbol->string (car l)) 7))) + (string-append (if curly? "{" "(") (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)