From b4f6c524a13fd3a0ac20d04f54724643628ccae4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 4 Mar 2009 02:54:22 +0000 Subject: [PATCH] added prop:print-converter svn: r13938 --- collects/mzlib/pconvert-prop.ss | 19 +++++++++-- collects/mzlib/pconvert.ss | 5 +++ .../mzlib/scribblings/pconvert-prop.scrbl | 32 ++++++++++++++++--- collects/tests/mzscheme/pconvert.ss | 18 ++++++++++- 4 files changed, 67 insertions(+), 7 deletions(-) diff --git a/collects/mzlib/pconvert-prop.ss b/collects/mzlib/pconvert-prop.ss index 461d72335c..dfbff03317 100644 --- a/collects/mzlib/pconvert-prop.ss +++ b/collects/mzlib/pconvert-prop.ss @@ -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)))) diff --git a/collects/mzlib/pconvert.ss b/collects/mzlib/pconvert.ss index d8b9d23aaa..847363efe2 100644 --- a/collects/mzlib/pconvert.ss +++ b/collects/mzlib/pconvert.ss @@ -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) diff --git a/collects/mzlib/scribblings/pconvert-prop.scrbl b/collects/mzlib/scribblings/pconvert-prop.scrbl index 943be116ef..c052e9b28b 100644 --- a/collects/mzlib/scribblings/pconvert-prop.scrbl +++ b/collects/mzlib/scribblings/pconvert-prop.scrbl @@ -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.} - diff --git a/collects/tests/mzscheme/pconvert.ss b/collects/tests/mzscheme/pconvert.ss index ed186dce16..628b6e4462 100644 --- a/collects/tests/mzscheme/pconvert.ss +++ b/collects/tests/mzscheme/pconvert.ss @@ -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)