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

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

Browse Source 
svn: r1370

original commit: 9fae17c411bdcb5221933576b0a0f8251937b09e
This commit is contained in:
Matthew Flatt 2005-11-22 15:08:23 +00:00
parent eb4453a16b
commit dd3c8a4365
1 changed files with 14 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/mzlib/pretty.ss
View File

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