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

prefab structure types (3.99.0.18)

Browse Source 
svn: r8967

original commit: 293ba025bad3b0341715153f8cbfd37f4d871a38
This commit is contained in:
Matthew Flatt 2008-03-13 20:59:22 +00:00
parent db1a358d81
commit 9cfbf28481
1 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/mzlib/pretty.ss
View File

@ -391,6 +391,13 @@
(add-spaces (- n 8) port)) (add-spaces (- n 8) port))
(write-string " " port 0 n)))) (write-string " " port 0 n))))
(define (prefab?! obj v)
(let ([d (prefab-struct-key obj)])
(and d
(begin
(vector-set! v 0 d)
#t))))
(define (generic-write obj display? width pport (define (generic-write obj display? width pport
print-graph? print-struct? print-hash-table? print-vec-length? print-box? print-graph? print-struct? print-hash-table? print-vec-length? print-box?
depth size-hook) depth size-hook)
@ -713,7 +720,10 @@
#f #f #f #f
(lambda () (lambda ()
(out "#") (out "#")
(wr-lst (vector->list (struct->vector obj)) #f (dsub1 depth) pair? car cdr "(" ")"))) (let ([v (struct->vector obj)])
(when (prefab?! obj v)
(out "s"))
(wr-lst (vector->list v) #f (dsub1 depth) pair? car cdr "(" ")"))))
(parameterize ([print-struct #f]) (parameterize ([print-struct #f])
((if display? orig-display orig-write) obj pport)))] ((if display? orig-display orig-write) obj pport)))]
[(hash-table? obj) [(hash-table? obj)
@ -832,7 +842,10 @@
(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 "#")
(pp-list (vector->list (struct->vector obj)) extra pp-expr #f depth)] (let ([v (struct->vector obj)])
(when (prefab?! obj v)
(out "s"))
(pp-list (vector->list v) extra pp-expr #f depth))]
[(hash-table? obj) [(hash-table? obj)
(out (if (hash-table? obj 'equal) (out (if (hash-table? obj 'equal)
"#hash" "#hash"