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

cs: use print-pair-curly-braces

Browse Source
This commit is contained in:
Gustavo Massaccesi 2019-05-25 00:12:31 -03:00
parent 006265e447
commit a121f45aac
3 changed files with 76 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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)
"#<a>" "#<a>" "#<a>" "#<a>" "#<a>")
(void))))
;; ----------------------------------------

17
racket/src/io/print/list.rkt
View File

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

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

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