improvements to set/c
- use chaperone-hash-set for set/c when the contract allows only hash-sets - add a #:lazy flag to allow explicit choice of when to use laziness (but have a backwards-compatible default that, roughly, eschews laziness only when the resulting contract would be flat)
This commit is contained in:
Robby Findler
parent
bc12019af4
commit
b3d05de304
|
|
@ -203,17 +203,20 @@ named by the @racket[sym]s.
|
|||
'dont-care]
|
||||
[#:kind kind
|
||||
(or/c 'dont-care 'immutable 'mutable 'weak 'mutable-or-weak)
|
||||
'immutable])
|
||||
'immutable]
|
||||
[#:lazy? lazy? any/c
|
||||
(not (and (equal? kind 'immutable)
|
||||
(flat-contract? elem/c)))])
|
||||
contract?]{
|
||||
|
||||
Constructs a contract that recognizes sets whose elements match
|
||||
@racket[contract].
|
||||
@racket[elem/c].
|
||||
|
||||
If @racket[kind] is @racket['immutable], @racket['mutable], or
|
||||
@racket['weak], the resulting contract accepts only @tech{hash sets} that
|
||||
are respectively immutable, mutable with strongly-held keys, or mutable with
|
||||
weakly-held keys. If @racket[kind] is @racket['mutable-or-weak], the
|
||||
resulting contract accepts any mutable @racket{hash sets}, regardless of
|
||||
resulting contract accepts any mutable @tech{hash sets}, regardless of
|
||||
key-holding strength.
|
||||
|
||||
If @racket[cmp] is @racket['equal], @racket['eqv], or @racket['eq], the
|
||||
|
|
@ -221,12 +224,30 @@ named by the @racket[sym]s.
|
|||
using @racket[equal?], @racket[eqv?], or @racket[eq?], respectively.
|
||||
|
||||
If @racket[cmp] is @racket['eqv] or @racket['eq], then @racket[elem/c] must
|
||||
be a flat contract.
|
||||
be a @tech{flat contract}.
|
||||
|
||||
If @racket[cmp] and @racket[kind] are both @racket['dont-care], then the
|
||||
resulting contract will accept any kind of set, not just @tech{hash
|
||||
sets}.
|
||||
|
||||
If @racket[lazy?] is not @racket[#f], then the elements of the set are not checked
|
||||
immediately by the contract and only the set itself is checked (according to the
|
||||
@racket[cmp] and @racket[kind] arguments). If @racket[lazy?] is
|
||||
@racket[#f], then the elements are checked immediately by the contract.
|
||||
The @racket[lazy?] argument is ignored when the set contract accepts generic sets
|
||||
(i.e., when @racket[cmp] and @racket[kind] are both @racket['dont-care]); in that
|
||||
case, the value being checked in that case is a @racket[list?], then the contract
|
||||
is not lazy otherwise the contract is lazy.
|
||||
|
||||
If @racket[kind] allows mutable sets (i.e., is @racket['dont-care],
|
||||
@racket['mutable], @racket['weak], or
|
||||
@racket['mutable-or-weak]) and @racket[lazy?] is @racket[#f], then the elements
|
||||
are checked both immediately and when they are accessed from the set.
|
||||
|
||||
The result contract will be a @tech{flat contract} when @racket[elem/c] is a @tech{flat
|
||||
contract}, @racket[lazy?] is @racket[#f], and @racket[kind] is @racket['immutable].
|
||||
The result will be a @tech{chaperone contract} when @racket[elem/c] is a
|
||||
@tech{chaperone contract}.
|
||||
}
|
||||
|
||||
@section{Generic Set Interface}
|
||||
|
|
|
|||
|
|
@ -393,7 +393,8 @@
|
|||
(test-name '(set/c char? #:cmp 'eq) (set/c char? #:cmp 'eq))
|
||||
(test-name '(set/c (set/c char?) #:cmp 'eqv) (set/c (set/c char? #:cmp 'dont-care) #:cmp 'eqv))
|
||||
(test-name '(set/c (-> char? char?) #:cmp 'equal) (set/c (-> char? char?) #:cmp 'equal))
|
||||
|
||||
(test-name '(set/c (-> integer? boolean?)) (set/c (-> integer? boolean?)))
|
||||
|
||||
(test-name 'α (let ([α (new-∀/c)]) α))
|
||||
(test-name 'α (let ([α (new-∀/c #f)]) α))
|
||||
(test-name 'β (let ([α (new-∀/c 'β)]) α))
|
||||
|
|
|
|||
|
|
@ -109,4 +109,112 @@
|
|||
'(contract (set/c integer? #:kind 'mutable)
|
||||
(mutable-set 0)
|
||||
'pos 'neg)
|
||||
(contract-eval '(mutable-set 0))))
|
||||
(contract-eval '(mutable-set 0)))
|
||||
|
||||
|
||||
(test/pos-blame
|
||||
'set/c17
|
||||
'(let ()
|
||||
(struct binary-set [integer]
|
||||
#:transparent
|
||||
#:methods gen:set
|
||||
[(define (set-member? st i)
|
||||
(bitwise-bit-set? (binary-set-integer st) i))
|
||||
(define (set-add st i)
|
||||
(binary-set (bitwise-ior (binary-set-integer st)
|
||||
(arithmetic-shift 1 i))))
|
||||
(define (set-remove st i)
|
||||
(binary-set (bitwise-and (binary-set-integer st)
|
||||
(bitwise-not (arithmetic-shift 1 i)))))])
|
||||
(contract (set/c integer?)
|
||||
(binary-set 5)
|
||||
'pos 'neg)))
|
||||
|
||||
(test/spec-passed
|
||||
'set/c19
|
||||
'(let ()
|
||||
(struct binary-set [integer]
|
||||
#:transparent
|
||||
#:methods gen:set
|
||||
[(define (set-member? st i)
|
||||
(bitwise-bit-set? (binary-set-integer st) i))
|
||||
(define (set-add st i)
|
||||
(binary-set (bitwise-ior (binary-set-integer st)
|
||||
(arithmetic-shift 1 i))))
|
||||
(define (set-remove st i)
|
||||
(binary-set (bitwise-and (binary-set-integer st)
|
||||
(bitwise-not (arithmetic-shift 1 i)))))])
|
||||
(contract (set/c integer? #:kind 'dont-care)
|
||||
(binary-set 5)
|
||||
'pos 'neg)))
|
||||
|
||||
(test/spec-passed
|
||||
'set/c20
|
||||
'(let ()
|
||||
(struct binary-set [integer]
|
||||
#:transparent
|
||||
#:methods gen:set
|
||||
[(define (set-member? st i)
|
||||
(bitwise-bit-set? (binary-set-integer st) i))
|
||||
(define (set-add st i)
|
||||
(binary-set (bitwise-ior (binary-set-integer st)
|
||||
(arithmetic-shift 1 i))))
|
||||
(define (set-remove st i)
|
||||
(binary-set (bitwise-and (binary-set-integer st)
|
||||
(bitwise-not (arithmetic-shift 1 i)))))])
|
||||
(contract (set/c boolean? #:kind 'dont-care #:lazy? #t)
|
||||
(binary-set 5)
|
||||
'pos 'neg)))
|
||||
|
||||
(test/spec-passed
|
||||
'set/c21
|
||||
'(let* ([c (set/c (-> integer? integer?))]
|
||||
[s (contract c (set (λ (x) x)) 'pos 'neg)])
|
||||
(and (has-contract? s)
|
||||
(equal? (value-contract s) c))))
|
||||
|
||||
(test/spec-passed
|
||||
'set/c22
|
||||
'(contract (set/c (-> integer? integer?) #:lazy? #t)
|
||||
(set #f) 'pos 'neg))
|
||||
|
||||
(test/pos-blame
|
||||
'set/c23
|
||||
'(set-first
|
||||
(contract (set/c (-> integer? integer?) #:lazy? #t)
|
||||
(set #f) 'pos 'neg)))
|
||||
|
||||
(test/pos-blame
|
||||
'set/c24
|
||||
'(contract (set/c (-> integer? integer?) #:lazy? #f)
|
||||
(set #f) 'pos 'neg))
|
||||
|
||||
(test/spec-passed
|
||||
'set/c25
|
||||
'(contract (set/c integer? #:lazy? #t)
|
||||
(set #f) 'pos 'neg))
|
||||
|
||||
(test/pos-blame
|
||||
'set/c26
|
||||
'(set-first
|
||||
(contract (set/c integer? #:lazy? #t)
|
||||
(set #f) 'pos 'neg)))
|
||||
|
||||
(test/pos-blame
|
||||
'set/c27
|
||||
'(contract (set/c integer? #:lazy? #f)
|
||||
(set #f) 'pos 'neg))
|
||||
|
||||
(test/neg-blame
|
||||
'set/c28
|
||||
'(let ([s (contract (set/c integer? #:lazy? #t)
|
||||
(set #f) 'pos 'neg)])
|
||||
(set-add! s "x")))
|
||||
|
||||
(test/neg-blame
|
||||
'set/c29
|
||||
'(let ([s (contract (set/c integer? #:lazy? #f)
|
||||
(set 0) 'pos 'neg)])
|
||||
(set-add! s "x")))
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -12,9 +12,14 @@
|
|||
(all-from-out racket/private/set-types)
|
||||
set/c)
|
||||
|
||||
(define (set/c elem/c
|
||||
#:cmp [cmp 'dont-care]
|
||||
#:kind [kind 'immutable])
|
||||
(define/subexpression-pos-prop/name
|
||||
real-set/c-name (set/c elem/c
|
||||
#:cmp [cmp 'dont-care]
|
||||
#:kind [kind 'immutable]
|
||||
#:lazy? [_lazy?
|
||||
(not (and (equal? kind 'immutable)
|
||||
(flat-contract? elem/c)))])
|
||||
(define lazy? (and _lazy? #t))
|
||||
(define cmp/c
|
||||
(case cmp
|
||||
[(dont-care) any/c]
|
||||
|
|
@ -22,8 +27,8 @@
|
|||
[(eqv) set-eqv?]
|
||||
[(eq) set-eq?]
|
||||
[else (raise-arguments-error 'set/c
|
||||
"invalid #:cmp argument"
|
||||
"#:cmp argument" cmp)]))
|
||||
"invalid #:cmp argument"
|
||||
"#:cmp argument" cmp)]))
|
||||
(define kind/c
|
||||
(case kind
|
||||
[(dont-care) any/c]
|
||||
|
|
@ -47,14 +52,15 @@
|
|||
(raise-argument-error 'set/c "chaperone-contract?" elem/c))])
|
||||
(cond
|
||||
[(and (eq? kind 'immutable)
|
||||
(not lazy?)
|
||||
(flat-contract? elem/c))
|
||||
(flat-set-contract elem/c cmp kind)]
|
||||
(flat-set-contract elem/c cmp kind lazy?)]
|
||||
[(chaperone-contract? elem/c)
|
||||
(chaperone-set-contract elem/c cmp kind)]
|
||||
(chaperone-set-contract elem/c cmp kind lazy?)]
|
||||
[else
|
||||
(impersonator-set-contract elem/c cmp kind)]))
|
||||
(impersonator-set-contract elem/c cmp kind lazy?)]))
|
||||
|
||||
(struct set-contract [elem/c cmp kind])
|
||||
(struct set-contract [elem/c cmp kind lazy?])
|
||||
|
||||
(define (set-contract-name ctc)
|
||||
(define elem/c (set-contract-elem/c ctc))
|
||||
|
|
@ -66,7 +72,11 @@
|
|||
`[#:cmp (quote ,cmp)])
|
||||
,@(if (eq? kind 'immutable)
|
||||
`[]
|
||||
`[#:kind (quote ,kind)])))
|
||||
`[#:kind (quote ,kind)])
|
||||
,@(if (equal? (set-contract-lazy? ctc)
|
||||
(flat-contract? elem/c))
|
||||
'()
|
||||
`(#:lazy? ,(set-contract-lazy? ctc)))))
|
||||
|
||||
(define (set-contract-first-order ctc)
|
||||
(define cmp (set-contract-cmp ctc))
|
||||
|
|
@ -116,83 +126,153 @@
|
|||
|
||||
(define (set-contract-late-neg-projection chaperone-ctc?)
|
||||
(lambda (ctc)
|
||||
(define elem/c (set-contract-elem/c ctc))
|
||||
(define cmp (set-contract-cmp ctc))
|
||||
(define kind (set-contract-kind ctc))
|
||||
(lambda (blame)
|
||||
(define (method sym c)
|
||||
(define name (contract-name c))
|
||||
(define str (format "method ~a with contract ~.s" sym name))
|
||||
(define b2 (blame-add-context blame str))
|
||||
((contract-late-neg-projection c) b2))
|
||||
(define-syntax (redirect stx)
|
||||
(syntax-case stx ()
|
||||
[(_ [id expr] ...)
|
||||
(with-syntax ([(proj-id ...) (generate-temporaries #'(id ...))])
|
||||
#'(let ([proj-id (method 'id expr)] ...)
|
||||
(λ (x neg-party)
|
||||
(redirect-generics chaperone-ctc?
|
||||
gen:set x [id (λ (x) (proj-id x neg-party))] ...))))]))
|
||||
(define me (if chaperone-contract?
|
||||
(make-chaperone-contract
|
||||
#:name (set-contract-name ctc)
|
||||
#:stronger set-contract-stronger
|
||||
#:late-neg-projection
|
||||
(λ (blame) (λ (val neg-party) (do-redirect val neg-party))))
|
||||
(make-contract
|
||||
#:name (set-contract-name ctc)
|
||||
#:stronger set-contract-stronger
|
||||
#:late-neg-projection
|
||||
(λ (blame) (λ (val neg-party) (do-redirect val neg-party))))))
|
||||
(define do-redirect
|
||||
(redirect
|
||||
[set-member? (-> generic-set? elem/c boolean?)]
|
||||
[set-empty? (or/c (-> generic-set? boolean?) #f)]
|
||||
[set-count (or/c (-> generic-set? exact-nonnegative-integer?) #f)]
|
||||
[set=? (or/c (-> generic-set? me boolean?) #f)]
|
||||
[subset? (or/c (-> generic-set? me boolean?) #f)]
|
||||
[proper-subset? (or/c (-> generic-set? me boolean?) #f)]
|
||||
[set-map (or/c (-> generic-set? (-> elem/c any/c) list?) #f)]
|
||||
[set-for-each (or/c (-> generic-set? (-> elem/c any) void?) #f)]
|
||||
[set-copy (or/c (-> generic-set? generic-set?) #f)]
|
||||
[in-set (or/c (-> generic-set? sequence?) #f)]
|
||||
[set->list (or/c (-> generic-set? (listof elem/c)) #f)]
|
||||
[set->stream (or/c (-> generic-set? stream?) #f)]
|
||||
[set-first (or/c (-> generic-set? elem/c) #f)]
|
||||
[set-rest (or/c (-> generic-set? me) #f)]
|
||||
[set-add (or/c (-> generic-set? elem/c me) #f)]
|
||||
[set-remove (or/c (-> generic-set? elem/c me) #f)]
|
||||
[set-clear (or/c (-> generic-set? me) #f)]
|
||||
[set-copy-clear (or/c (-> generic-set? generic-set?) #f)]
|
||||
[set-union
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) me) #f)]
|
||||
[set-intersect
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) me) #f)]
|
||||
[set-subtract
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) me) #f)]
|
||||
[set-symmetric-difference
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) me) #f)]
|
||||
[set-add! (or/c (-> generic-set? elem/c void?) #f)]
|
||||
[set-remove! (or/c (-> generic-set? elem/c void?) #f)]
|
||||
[set-clear! (or/c (-> generic-set? void?) #f)]
|
||||
[set-union!
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) void?) #f)]
|
||||
[set-intersect!
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) void?) #f)]
|
||||
[set-subtract!
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) void?) #f)]
|
||||
[set-symmetric-difference!
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) void?) #f)]))
|
||||
(define proj
|
||||
((contract-projection elem/c)
|
||||
(blame-add-context blame "an element of")))
|
||||
(lambda (x neg-party)
|
||||
(set-contract-check cmp kind blame neg-party x)
|
||||
(cond
|
||||
[(allows-generic-sets? ctc)
|
||||
(generic-set-late-neg-projection ctc chaperone-ctc?)]
|
||||
[else
|
||||
(hash-set-late-neg-projection ctc chaperone-ctc?)])))
|
||||
|
||||
(define (allows-generic-sets? ctc)
|
||||
(and (equal? 'dont-care (set-contract-kind ctc))
|
||||
(equal? 'dont-care (set-contract-cmp ctc))))
|
||||
|
||||
(define (hash-set-late-neg-projection ctc chaperone-ctc?)
|
||||
(define elem/c (set-contract-elem/c ctc))
|
||||
(define cmp (set-contract-cmp ctc))
|
||||
(define kind (set-contract-kind ctc))
|
||||
(define late-neg-ele-proj (contract-late-neg-projection elem/c))
|
||||
(define lazy? (set-contract-lazy? ctc))
|
||||
(λ (blame)
|
||||
(define late-neg-pos-proj (late-neg-ele-proj (blame-add-element-context blame #f)))
|
||||
(define late-neg-neg-proj (late-neg-ele-proj (blame-add-element-context blame #t)))
|
||||
(define set/c-lazy-late-neg-proj
|
||||
(λ (val neg-party)
|
||||
(set-contract-check cmp kind blame neg-party val)
|
||||
(define (pos-interpose val ele) (late-neg-pos-proj ele neg-party))
|
||||
(cond
|
||||
[(list? x)
|
||||
(map proj x)]
|
||||
[(set? val)
|
||||
(chaperone-hash-set
|
||||
val
|
||||
pos-interpose
|
||||
(λ (val ele) ele)
|
||||
pos-interpose
|
||||
impersonator-prop:contracted
|
||||
ctc)]
|
||||
[else
|
||||
(do-redirect x neg-party)])))))
|
||||
(chaperone-hash-set
|
||||
val
|
||||
pos-interpose
|
||||
(λ (val ele) (late-neg-neg-proj ele neg-party))
|
||||
pos-interpose
|
||||
impersonator-prop:contracted
|
||||
ctc)])))
|
||||
(cond
|
||||
[lazy? set/c-lazy-late-neg-proj]
|
||||
[else
|
||||
(λ (val neg-party)
|
||||
(set-contract-check cmp kind blame neg-party val)
|
||||
(define w/chaperone
|
||||
(cond
|
||||
[(set? val) val]
|
||||
[else
|
||||
(chaperone-hash-set
|
||||
val
|
||||
(λ (val ele) ele)
|
||||
(λ (val ele) (late-neg-neg-proj ele neg-party))
|
||||
(λ (val ele) ele))]))
|
||||
(chaperone-hash-set
|
||||
(for/set ([ele (in-set w/chaperone)])
|
||||
(late-neg-pos-proj ele neg-party))
|
||||
(chaperone-hash-set
|
||||
val
|
||||
#f #f #f
|
||||
impersonator-prop:contracted
|
||||
ctc)))])))
|
||||
|
||||
|
||||
(define (generic-set-late-neg-projection ctc chaperone-ctc?)
|
||||
(define elem/c (set-contract-elem/c ctc))
|
||||
(define cmp (set-contract-cmp ctc))
|
||||
(define kind (set-contract-kind ctc))
|
||||
(define lazy? (set-contract-lazy? ctc))
|
||||
(lambda (blame)
|
||||
(define (method sym c)
|
||||
(define name (contract-name c))
|
||||
(define str (format "method ~a with contract ~.s" sym name))
|
||||
(define b2 (blame-add-context blame str))
|
||||
((contract-late-neg-projection c) b2))
|
||||
(define-syntax (redirect stx)
|
||||
(syntax-case stx ()
|
||||
[(_ [id expr] ...)
|
||||
(with-syntax ([(proj-id ...) (generate-temporaries #'(id ...))])
|
||||
#'(let ([proj-id (method 'id expr)] ...)
|
||||
(λ (x neg-party)
|
||||
(redirect-generics chaperone-ctc?
|
||||
gen:set x [id (λ (x) (proj-id x neg-party))] ...))))]))
|
||||
(define me (if chaperone-contract?
|
||||
(make-chaperone-contract
|
||||
#:name (set-contract-name ctc)
|
||||
#:stronger set-contract-stronger
|
||||
#:late-neg-projection
|
||||
(λ (blame) (λ (val neg-party) (do-redirect val neg-party))))
|
||||
(make-contract
|
||||
#:name (set-contract-name ctc)
|
||||
#:stronger set-contract-stronger
|
||||
#:late-neg-projection
|
||||
(λ (blame) (λ (val neg-party) (do-redirect val neg-party))))))
|
||||
(define do-redirect
|
||||
(redirect
|
||||
[set-member? (-> generic-set? elem/c boolean?)]
|
||||
[set-empty? (or/c (-> generic-set? boolean?) #f)]
|
||||
[set-count (or/c (-> generic-set? exact-nonnegative-integer?) #f)]
|
||||
[set=? (or/c (-> generic-set? me boolean?) #f)]
|
||||
[subset? (or/c (-> generic-set? me boolean?) #f)]
|
||||
[proper-subset? (or/c (-> generic-set? me boolean?) #f)]
|
||||
[set-map (or/c (-> generic-set? (-> elem/c any/c) list?) #f)]
|
||||
[set-for-each (or/c (-> generic-set? (-> elem/c any) void?) #f)]
|
||||
[set-copy (or/c (-> generic-set? generic-set?) #f)]
|
||||
[in-set (or/c (-> generic-set? sequence?) #f)]
|
||||
[set->list (or/c (-> generic-set? (listof elem/c)) #f)]
|
||||
[set->stream (or/c (-> generic-set? stream?) #f)]
|
||||
[set-first (or/c (-> generic-set? elem/c) #f)]
|
||||
[set-rest (or/c (-> generic-set? me) #f)]
|
||||
[set-add (or/c (-> generic-set? elem/c me) #f)]
|
||||
[set-remove (or/c (-> generic-set? elem/c me) #f)]
|
||||
[set-clear (or/c (-> generic-set? me) #f)]
|
||||
[set-copy-clear (or/c (-> generic-set? generic-set?) #f)]
|
||||
[set-union
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) me) #f)]
|
||||
[set-intersect
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) me) #f)]
|
||||
[set-subtract
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) me) #f)]
|
||||
[set-symmetric-difference
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) me) #f)]
|
||||
[set-add! (or/c (-> generic-set? elem/c void?) #f)]
|
||||
[set-remove! (or/c (-> generic-set? elem/c void?) #f)]
|
||||
[set-clear! (or/c (-> generic-set? void?) #f)]
|
||||
[set-union!
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) void?) #f)]
|
||||
[set-intersect!
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) void?) #f)]
|
||||
[set-subtract!
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) void?) #f)]
|
||||
[set-symmetric-difference!
|
||||
(or/c (->* [generic-set?] [] #:rest (listof me) void?) #f)]))
|
||||
(define proj
|
||||
((contract-late-neg-projection elem/c) (blame-add-element-context blame #f)))
|
||||
(lambda (x neg-party)
|
||||
(set-contract-check cmp kind blame neg-party x)
|
||||
(cond
|
||||
[(list? x)
|
||||
(for/list ([e (in-list x)])
|
||||
(proj e neg-party))]
|
||||
[else
|
||||
(do-redirect x neg-party)]))))
|
||||
|
||||
|
||||
(define (blame-add-element-context blame swap?)
|
||||
(blame-add-context blame "an element of" #:swap? swap?))
|
||||
|
||||
(define (flat-set-contract-first-order ctc)
|
||||
(define set-passes? (set-contract-first-order ctc))
|
||||
|
|
@ -206,10 +286,9 @@
|
|||
(define elem/c (set-contract-elem/c ctc))
|
||||
(define cmp (set-contract-cmp ctc))
|
||||
(define kind (set-contract-kind ctc))
|
||||
(define mk-elem/c-proj (contract-late-neg-projection elem/c))
|
||||
(lambda (b)
|
||||
(define proj
|
||||
((contract-late-neg-projection elem/c)
|
||||
(blame-add-context b "an element of")))
|
||||
(define proj (mk-elem/c-proj (blame-add-context b "an element of")))
|
||||
(lambda (x neg-party)
|
||||
(set-contract-check cmp kind b neg-party x)
|
||||
(for ([e (in-set x)])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user