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

added prop:print-converter

Browse Source 
svn: r13938
This commit is contained in:
Matthew Flatt 2009-03-04 02:54:22 +00:00
parent 976ec00702
commit b4f6c524a1
4 changed files with 67 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/mzlib/pconvert-prop.ss
View File

@ -3,7 +3,10 @@
(provide prop:print-convert-constructor-name
print-convert-named-constructor?
print-convert-constructor-name)
print-convert-constructor-name
prop:print-converter
print-converter?
print-converter-proc)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; property recognized by print convert to set a value's constructor name:
@ -18,4 +21,16 @@
(raise-type-error '|prop:print-convert-constructor-name guard|
"symbol"
s))
s))))
s)))
(define-values (prop:print-converter
print-converter?
print-converter-proc)
(make-struct-type-property 'print-converter
(lambda (p info)
(unless (and (procedure? p)
(procedure-arity-includes? p 2))
(raise-type-error '|prop:print-converter|
"procedure (arity 2)"
p))
p))))

5
collects/mzlib/pconvert.ss
View File

@ -115,6 +115,9 @@
expr
(lambda (expr)
(cond
[(print-converter? expr)
(unless (build-sub expr)
((print-converter-proc expr) expr build))]
[(or (number? expr)
(symbol? expr)
(boolean? expr)
@ -322,6 +325,8 @@
expr
(lambda (expr)
(cond
[(print-converter? expr)
((print-converter-proc expr) expr recur)]
[(null? expr) (guard/quasiquote (lambda () 'empty))]
[(and (abbreviate-cons-as-list)
(list? expr)

32
collects/mzlib/scribblings/pconvert-prop.scrbl
View File

@ -5,21 +5,45 @@
@mzlib[#:mode title pconvert-prop]
@deftogether[(
@defthing[prop:print-converter property?]
@defproc[(print-converter? [v any/c]) any]
@defproc[(print-converter-proc [v print-converter?]) (any/c (any/c . -> . any/c) . -> . any/c)]
)]{
The @scheme[prop:print-converter] property can be given a procedure
value for a structure type. In that case, for constructor-style print
conversion via @scheme[print-convert], instances of the structure are
converted by calling the procedure that is the property's value. The
procedure is called with the value to convert and a procedure to
recursively convert nested values. The result should be an
S-expression for the converted value.
The @scheme[print-converter?] predicate recognizes instances of
structure types that have the @scheme[prop:print-converter] property,
and @scheme[print-converter-proc] extracts the property value.}
@deftogether[(
@defthing[prop:print-convert-constructor-name property?]
@defproc[(print-convert-named-constructor? [v any/c]) any]
@defproc[(print-convert-constructor-name [v any/c]) any]
@defproc[(print-convert-constructor-name [v print-convert-named-constructor?]) any]
)]{
The @scheme[prop:print-convert-constructor-name] property can be given
a symbol value for a structure type. In that case, for
constructor-style print conversion via @scheme[print-convert],
instances of the structure are shown using the symbol as the
constructor name. Otherwise, the constructor name is determined by
prefixing @schemeidfont{make-} onto the result of @scheme[object-name].
constructor name.
The @scheme[prop:print-converter] property takes precedence over
@scheme[prop:print-convert-constructor-name]. If neither is attached
to a structure type, its instances are converted using a constructor
name that is @schemeidfont{make-} prefixed onto the result of
@scheme[object-name].
The @scheme[print-convert-named-constructor?] predicate recognizes
instances of structure types that have the
@scheme[prop:print-convert-constructor-name] property, and
@scheme[print-convert-constructor-name] extracts the property value.}

18
collects/tests/mzscheme/pconvert.ss
View File

@ -5,7 +5,8 @@
(require mzlib/file
mzlib/class
mzlib/pconvert)
mzlib/pconvert
mzlib/pconvert-prop)
(constructor-style-printing #t)
(quasi-read-style-printing #f)
@ -399,4 +400,19 @@
(pc #t)
(let ([g (lambda (y) (let ([f (lambda (x) y)]) f))]) (list (g 1) (g 2)))))
;; ----------------------------------------
(let ()
(define-struct pt (x [y #:mutable])
#:property prop:print-converter (lambda (v recur)
`(PT! ,(recur (pt-y v))
,(recur (pt-x v)))))
(test '(PT! 2 3) print-convert (make-pt 3 2))
(test '(PT! 2 (list 3)) print-convert (make-pt '(3) 2))
(let ([p (make-pt 1 2)])
(set-pt-y! p p)
(test '(shared ([-0- (PT! -0- 1)]) -0-) print-convert p)))
;; ----------------------------------------
(report-errs)