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

adjust contract printing so that it looks like

Browse Source 
the constructors in print mode and so that it
cooperates with pretty printing to get some
newlines in there
This commit is contained in:
Robby Findler 2015-11-28 13:45:17 -06:00
parent c9e9b4e400
commit 86934d4a4f
1 changed files with 21 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
racket/collects/racket/contract/private/guts.rkt
View File

@ -55,14 +55,28 @@
set-some-basic-contracts!)
(define (contract-custom-write-property-proc stct port display?)
(write-string "#<" port)
(define (contract-custom-write-property-proc stct port mode)
(define (write-prefix)
(write-string "#<" port)
(cond
[(flat-contract-struct? stct) (write-string "flat-" port)]
[(chaperone-contract-struct? stct) (write-string "chaperone-" port)])
(write-string "contract: " port))
(define (write-suffix)
(write-string ">" port))
(cond
[(flat-contract-struct? stct) (write-string "flat-" port)]
[(chaperone-contract-struct? stct) (write-string "chaperone-" port)])
(write-string "contract: " port)
(write-string (format "~.s" (contract-struct-name stct)) port)
(write-string ">" port))
[(boolean? mode)
(write-prefix)
(write-string (format "~.s" (contract-struct-name stct)) port)
(write-suffix)]
[else
(cond
[(zero? mode)
(print (contract-struct-name stct) port 1)]
[else
(write-prefix)
(print (contract-struct-name stct) port 1)
(write-suffix)])]))
(define (has-contract? v)
(or (has-prop:contracted? v)