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

fix pretty-write when print-vector-length is enabled

Browse Source 
Show "#3(struct:b 1)" instead of "#(struct:b 1 1)", so it behaves like `write`.
This commit is contained in:
Gustavo Massaccesi 2019-08-04 12:39:05 -03:00
parent 964e998d70
commit 63173a32be
1 changed files with 45 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -956,20 +956,28 @@
#f #f #f #f
(lambda () (lambda ()
(let* ([v (struct->vector obj struct-ellipses)] (let* ([v (struct->vector obj struct-ellipses)]
[pf? (prefab?! obj v)]) [pf? (prefab?! obj v)]
(let ([qd (if pf? [print-vec-length? (and print-vec-length? (not pf?))]
[qd (if pf?
(to-quoted out qd obj) (to-quoted out qd obj)
qd)]) qd)]
(when (or (not qd) (positive? qd)) [as-expr? (and qd (zero? qd))]
(out "#") [l (cond
(when pf? (out "s"))) [as-expr?
(wr-lst (let ([l (vector->list v)])
(if (and qd (zero? qd))
(cons (make-unquoted (object-name obj)) (cons (make-unquoted (object-name obj))
(cdr l)) (cdr (vector->list v)))]
l)) [print-vec-length?
#f (dsub1 depth) pair? car cdr "(" ")" (vector->repeatless-list v)]
qd))))) [else
(vector->list v)])])
(unless as-expr?
(out "#")
(when pf?
(out "s"))
(when print-vec-length?
(out (number->string (vector-length v)))))
(wr-lst l
#f (dsub1 depth) pair? car cdr "(" ")" qd))))
(parameterize ([print-struct #f]) (parameterize ([print-struct #f])
((if display? orig-display orig-write) obj pport)))] ((if display? orig-display orig-write) obj pport)))]
[(hash? obj) [(hash? obj)
@ -1162,21 +1170,29 @@
(write-custom pp* obj pport depth display? width qd #t))] (write-custom pp* obj pport depth display? width qd #t))]
[(struct? obj) ; print-struct is on if we got here [(struct? obj) ; print-struct is on if we got here
(let* ([v (struct->vector obj struct-ellipses)] (let* ([v (struct->vector obj struct-ellipses)]
[pf? (prefab?! obj v)]) [pf? (prefab?! obj v)]
(let ([qd (if pf? [print-vec-length? (and print-vec-length? (not pf?))]
[qd (if pf?
(to-quoted out qd obj) (to-quoted out qd obj)
qd)]) qd)]
(when (or (not qd) (positive? qd)) [as-expr? (and qd (zero? qd))]
(out "#") [l (cond
(when pf? (out "s"))) [as-expr?
(pp-list (let ([l (vector->list v)])
(if (and qd (zero? qd))
(cons (make-unquoted (object-name obj)) (cons (make-unquoted (object-name obj))
(cdr l)) (cdr (vector->list v)))]
l)) [print-vec-length?
(vector->repeatless-list v)]
[else
(vector->list v)])])
(unless as-expr?
(out "#")
(when pf?
(out "s"))
(when print-vec-length?
(out (number->string (vector-length v)))))
(pp-list l
extra pp-expr #f depth extra pp-expr #f depth
pair? car cdr pair-open pair-close pair? car cdr pair-open pair-close qd))]
qd)))]
[(hash? obj) [(hash? obj)
(let* ([qd (to-quoted out qd obj)] (let* ([qd (to-quoted out qd obj)]
[expr? (and qd (zero? qd))]) [expr? (and qd (zero? qd))])