fix hash-table pretty printing when the value part of a mapping is a pair

svn: r7600

original commit: 07d9a8130b91ecdf831acdab43de942c5bba1240
This commit is contained in:
Matthew Flatt 2007-10-31 11:25:00 +00:00
parent 204dee9ec5
commit 1de83175c9

View File

@ -231,6 +231,7 @@
(define pretty-display (make-pretty-print #t)) (define pretty-display (make-pretty-print #t))
(define-struct mark (str def)) (define-struct mark (str def))
(define-struct hide (val))
(define (make-tentative-output-port pport width esc) (define (make-tentative-output-port pport width esc)
(let* ([content null] (let* ([content null]
@ -641,8 +642,11 @@
(out ")")])))))))) (out ")")]))))))))
(out "()"))) (out "()")))
(pre-print pport obj) (unless (hide? obj)
(if (and depth (negative? depth)) (pre-print pport obj))
(if (and depth
(negative? depth)
(not (hide? obj)))
(out "...") (out "...")
(cond (cond
@ -702,9 +706,13 @@
(out (if (hash-table? obj 'equal) (out (if (hash-table? obj 'equal)
"#hash" "#hash"
"#hasheq")) "#hasheq"))
(wr-lst (hash-table-map obj cons) #f depth))) (wr-lst (hash-table-map obj (lambda (k v)
(cons k (make-hide v))))
#f depth)))
(parameterize ([print-hash-table #f]) (parameterize ([print-hash-table #f])
((if display? orig-display orig-write) obj pport)))] ((if display? orig-display orig-write) obj pport)))]
[(hide? obj)
(wr* pport (hide-val obj) depth display?)]
[(boolean? obj) [(boolean? obj)
(out (if obj "#t" "#f"))] (out (if obj "#t" "#f"))]
[(number? obj) [(number? obj)
@ -720,7 +728,8 @@
(out ".")] (out ".")]
[else [else
((if display? orig-display orig-write) obj pport)])) ((if display? orig-display orig-write) obj pport)]))
(post-print pport obj)) (unless (hide? obj)
(post-print pport obj)))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
;; pp: write on (potentially) multiple lines ;; pp: write on (potentially) multiple lines