fix custom printer attached to *SL structure types

This commit is contained in:
Matthew Flatt 2010-08-24 06:23:22 -06:00
parent 31f6a0da4e
commit 0955ed6e8b

View File

@ -821,16 +821,20 @@
#`(recur (raw-generic-access r #,i))) #`(recur (raw-generic-access r #,i)))
fields)))) fields))))
(cons prop:custom-write (cons prop:custom-write
(let ((n (string->symbol (string-append "struct:" ;; Need a transparent-like printer, but hide auto field.
(symbol->string 'name_))))) ;; This simplest way to do that is to create an instance
(lambda (r port write?) ;; of a transparet structure with the same name and field values.
(let ((v (vector n (let-values ([(struct:plain make-plain plain? plain-ref plain-set)
#,@(map-with-index (lambda (i _) (make-struct-type 'name_ #f #,field-count 0 #f null #f)])
#`(raw-generic-access r #,i)) (lambda (r port mode)
fields)))) (let ((v (make-plain
(if write? #,@(map-with-index (lambda (i _)
(write v port) #`(raw-generic-access r #,i))
(display v port)))))) fields))))
(cond
[(eq? mode #t) (write v port)]
[(eq? mode #f) (display v port)]
[else (print v port mode)])))))
(cons prop:equal+hash (cons prop:equal+hash
(list (list
(lambda (r1 r2 equal?) (lambda (r1 r2 equal?)