pretty-print needs to combine custom-write? with not-struct-type?

svn: r1370
This commit is contained in:
Matthew Flatt 2005-11-22 15:08:23 +00:00
parent 5250e0ac57
commit 9fae17c411

View File

@ -411,7 +411,8 @@
(and (or (vector? obj)
(pair? obj)
(box? obj)
(custom-write? obj)
(and (custom-write? obj)
(not (struct-type? obj)))
(and (struct? obj) print-struct?)
(and (hash-table? obj) print-hash-table?))
(or (hash-table-get table obj (lambda () #f))
@ -430,7 +431,8 @@
(or (loop (car obj))
(loop (cdr obj)))]
[(box? obj) (loop (unbox obj))]
[(custom-write? obj)
[(and (custom-write? obj)
(not (struct-type? obj)))
(loop (extract-sub-objects obj pport))]
[(struct? obj)
(ormap loop
@ -453,7 +455,8 @@
(if (or (vector? obj)
(pair? obj)
(box? obj)
(custom-write? obj)
(and (custom-write? obj)
(not (struct-type? obj)))
(and (struct? obj) print-struct?)
(and (hash-table? obj) print-hash-table?))
;; A little confusing: use #t for not-found
@ -473,7 +476,8 @@
(loop (car obj))
(loop (cdr obj))]
[(box? obj) (loop (unbox obj))]
[(custom-write? obj)
[(and (custom-write? obj)
(not (struct-type? obj)))
(loop (extract-sub-objects obj pport))]
[(struct? obj)
(for-each loop
@ -640,7 +644,8 @@
(lambda ()
(out "#&")
(wr (unbox obj) (dsub1 depth))))]
[(custom-write? obj)
[(and (custom-write? obj)
(not (struct-type? obj)))
(check-expr-found
obj pport #t
#f #f
@ -718,7 +723,8 @@
(let* ([can-multi (and width
(or (pair? obj) (vector? obj)
(box? obj)
(custom-write? obj)
(and (custom-write? obj)
(not (struct-type? obj)))
(and (struct? obj) print-struct?)
(and (hash-table? obj) print-hash-table?)))]
[graph-ref (if can-multi
@ -757,7 +763,8 @@
(when print-vec-length?
(out (number->string (vector-length obj))))
(pp-list (vector->repeatless-list obj) extra pp-expr #f depth)]
[(custom-write? obj)
[(and (custom-write? obj)
(not (struct-type? obj)))
(write-custom pp* obj pport depth display? width)]
[(struct? obj) ; print-struct is on if we got here
(out "#")