fix set/c name method
This commit is contained in:
parent
a44ce40b56
commit
d4ca825640
|
@ -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)))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user