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))
(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
print-graph? print-struct? print-hash-table? print-vec-length? print-box?
depth size-hook)
@ -713,7 +720,10 @@
#f #f
(lambda ()
(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])
((if display? orig-display orig-write) obj pport)))]
[(hash-table? obj)
@ -832,7 +842,10 @@
(write-custom pp* obj pport depth display? width)]
[(struct? obj) ; print-struct is on if we got here
(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)
(out (if (hash-table? obj 'equal)
"#hash"