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