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

io: conform to print-vector-length and print-struct

Browse Source
This commit is contained in:
Matthew Flatt 2019-01-16 21:14:54 -07:00
parent 11f12d69bd
commit a044c2ad05
2 changed files with 26 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -184,7 +184,8 @@
(checking! v) (checking! v)
((custom-write-accessor v) v checking-port mode) ((custom-write-accessor v) v checking-port mode)
(done! v unquoted?)] (done! v unquoted?)]
[(struct? v) [(and (struct? v)
(config-get config print-struct))
(checking! v) (checking! v)
(define unquoted? (define unquoted?
(or (for/fold ([unquoted? #f]) ([e (in-vector (struct->vector v))]) (or (for/fold ([unquoted? #f]) ([e (in-vector (struct->vector v))])

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

@ -239,7 +239,28 @@
[(pair? v) [(pair? v)
(print-list p who v mode o max-length graph config #f #f)] (print-list p who v mode o max-length graph config #f #f)]
[(vector? v) [(vector? v)
(print-list p who (vector->list v) mode o max-length graph config "#(" "(vector")] (cond
[(and (not (eq? mode PRINT-MODE/UNQUOTED))
(config-get config print-vector-length))
(define len (vector-length v))
(define same-n
(cond
[(zero? len) 0]
[else
(let loop ([i (sub1 len)] [accum 0])
(cond
[(zero? i) accum]
[(eq? (vector-ref v (sub1 i)) (vector-ref v i))
(loop (sub1 i) (add1 accum))]
[else accum]))]))
(define lst (if (zero? same-n)
(vector->list v)
(for/list ([e (in-vector v 0 (- len same-n))])
e)))
(define lbl (string-append "#" (number->string len) "("))
(print-list p who lst mode o max-length graph config lbl "(vector")]
[else
(print-list p who (vector->list v) mode o max-length graph config "#(" "(vector")])]
[(flvector? v) [(flvector? v)
(define l (for/list ([e (in-flvector v)]) e)) (define l (for/list ([e (in-flvector v)]) e))
(print-list p who l mode o max-length graph config "#fl(" "(flvector")] (print-list p who l mode o max-length graph config "#fl(" "(flvector")]
@ -291,7 +312,8 @@
(p who v mode o (output-port/max-max-length o/m max-length) graph config))) (p who v mode o (output-port/max-max-length o/m max-length) graph config)))
((custom-write-accessor v) v o/m mode) ((custom-write-accessor v) v o/m mode)
(output-port/max-max-length o/m max-length))] (output-port/max-max-length o/m max-length))]
[(struct? v) [(and (struct? v)
(config-get config print-struct))
(cond (cond
[(eq? mode PRINT-MODE/UNQUOTED) [(eq? mode PRINT-MODE/UNQUOTED)
(define l (vector->list (struct->vector v))) (define l (vector->list (struct->vector v)))