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

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

@ -956,21 +956,29 @@
#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?))]
(to-quoted out qd obj) [qd (if pf?
qd)]) (to-quoted out qd obj)
(when (or (not qd) (positive? qd)) qd)]
[as-expr? (and qd (zero? qd))]
[l (cond
[as-expr?
(cons (make-unquoted (object-name obj))
(cdr (vector->list v)))]
[print-vec-length?
(vector->repeatless-list v)]
[else
(vector->list v)])])
(unless as-expr?
(out "#") (out "#")
(when pf? (out "s"))) (when pf?
(wr-lst (let ([l (vector->list v)]) (out "s"))
(if (and qd (zero? qd)) (when print-vec-length?
(cons (make-unquoted (object-name obj)) (out (number->string (vector-length v)))))
(cdr l)) (wr-lst l
l)) #f (dsub1 depth) pair? car cdr "(" ")" qd))))
#f (dsub1 depth) pair? car cdr "(" ")" (parameterize ([print-struct #f])
qd)))))
(parameterize ([print-struct #f])
((if display? orig-display orig-write) obj pport)))] ((if display? orig-display orig-write) obj pport)))]
[(hash? obj) [(hash? obj)
(if (and print-hash-table? (if (and print-hash-table?
@ -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?))]
(to-quoted out qd obj) [qd (if pf?
qd)]) (to-quoted out qd obj)
(when (or (not qd) (positive? qd)) qd)]
(out "#") [as-expr? (and qd (zero? qd))]
(when pf? (out "s"))) [l (cond
(pp-list (let ([l (vector->list v)]) [as-expr?
(if (and qd (zero? qd)) (cons (make-unquoted (object-name obj))
(cons (make-unquoted (object-name obj)) (cdr (vector->list v)))]
(cdr l)) [print-vec-length?
l)) (vector->repeatless-list v)]
extra pp-expr #f depth [else
pair? car cdr pair-open pair-close (vector->list v)])])
qd)))] (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))]
[(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))])