From 86934d4a4fbb3e45f01482b8a3ac0c23555ab0ee Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 28 Nov 2015 13:45:17 -0600 Subject: [PATCH] adjust contract printing so that it looks like the constructors in print mode and so that it cooperates with pretty printing to get some newlines in there --- .../collects/racket/contract/private/guts.rkt | 28 ++++++++++++++----- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/racket/collects/racket/contract/private/guts.rkt b/racket/collects/racket/contract/private/guts.rkt index 417b8a7cf6..aa57721056 100644 --- a/racket/collects/racket/contract/private/guts.rkt +++ b/racket/collects/racket/contract/private/guts.rkt @@ -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)