fix set/c name method

This commit is contained in:
Robby Findler 2015-12-29 06:56:20 -06:00
parent a44ce40b56
commit d4ca825640

View File

@ -16,9 +16,7 @@
real-set/c-name (set/c elem/c real-set/c-name (set/c elem/c
#:cmp [cmp 'dont-care] #:cmp [cmp 'dont-care]
#:kind [kind 'immutable] #:kind [kind 'immutable]
#:lazy? [_lazy? #:lazy? [_lazy? (lazy-default kind elem/c)])
(not (and (equal? kind 'immutable)
(flat-contract? elem/c)))])
(define lazy? (and _lazy? #t)) (define lazy? (and _lazy? #t))
(define cmp/c (define cmp/c
(case cmp (case cmp
@ -62,6 +60,10 @@
(struct set-contract [elem/c cmp kind lazy?]) (struct set-contract [elem/c cmp kind lazy?])
(define (lazy-default kind elem/c)
(not (and (equal? kind 'immutable)
(flat-contract? elem/c))))
(define (set-contract-name ctc) (define (set-contract-name ctc)
(define elem/c (set-contract-elem/c ctc)) (define elem/c (set-contract-elem/c ctc))
(define cmp (set-contract-cmp ctc)) (define cmp (set-contract-cmp ctc))
@ -74,7 +76,7 @@
`[] `[]
`[#:kind (quote ,kind)]) `[#:kind (quote ,kind)])
,@(if (equal? (set-contract-lazy? ctc) ,@(if (equal? (set-contract-lazy? ctc)
(flat-contract? elem/c)) (lazy-default kind elem/c))
'() '()
`(#:lazy? ,(set-contract-lazy? ctc))))) `(#:lazy? ,(set-contract-lazy? ctc)))))