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

make contract structs print a little bit more nicely.

Browse Source
This commit is contained in:
Robby Findler 2013-04-23 16:58:32 -05:00
parent 58869e41af
commit 8f792ca123
1 changed files with 15 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/racket/contract/private/prop.rkt
View File

@ -274,6 +274,11 @@
(define-struct make-contract [ name first-order projection stronger generate exercise ] (define-struct make-contract [ name first-order projection stronger generate exercise ]
#:omit-define-syntaxes #:omit-define-syntaxes
#:property prop:custom-write
(λ (stct port display?)
(write-string "#<contract: " port)
(write-string (format "~.s" (make-contract-name stct)) port)
(write-string ">" port))
#:property prop:contract #:property prop:contract
(build-contract-property (build-contract-property
#:name (lambda (c) (make-contract-name c)) #:name (lambda (c) (make-contract-name c))
@ -285,6 +290,11 @@
(define-struct make-chaperone-contract [ name first-order projection stronger generate exercise ] (define-struct make-chaperone-contract [ name first-order projection stronger generate exercise ]
#:omit-define-syntaxes #:omit-define-syntaxes
#:property prop:custom-write
(λ (stct port display?)
(write-string "#<chaperone-contract: " port)
(write-string (format "~.s" (make-chaperone-contract-name stct)) port)
(write-string ">" port))
#:property prop:chaperone-contract #:property prop:chaperone-contract
(build-chaperone-contract-property (build-chaperone-contract-property
#:name (lambda (c) (make-chaperone-contract-name c)) #:name (lambda (c) (make-chaperone-contract-name c))
@ -296,6 +306,11 @@
(define-struct make-flat-contract [ name first-order projection stronger generate exercise ] (define-struct make-flat-contract [ name first-order projection stronger generate exercise ]
#:omit-define-syntaxes #:omit-define-syntaxes
#:property prop:custom-write
(λ (stct port display?)
(write-string "#<flat-contract: " port)
(write-string (format "~.s" (make-flat-contract-name stct)) port)
(write-string ">" port))
#:property prop:flat-contract #:property prop:flat-contract
(build-flat-contract-property (build-flat-contract-property
#:name (lambda (c) (make-flat-contract-name c)) #:name (lambda (c) (make-flat-contract-name c))