add neg-party arg to id-set-contract-check

This commit is contained in:
Stephen Chang 2017-05-23 16:59:39 -04:00 committed by Stephen Chang
parent 6a145244d6
commit 42152ed31c

View File

@ -81,23 +81,23 @@
(lambda (s)
(and (id-set? s) (idsettype? s) (mutability? s))))
(define (id-set-contract-check idsettype mutability b s)
(define (id-set-contract-check idsettype mutability b s neg-party)
(unless (id-set? s)
(raise-blame-error b s "expected either a free or bound identifier set"))
(raise-blame-error b #:missing-party neg-party s "expected either a free or bound identifier set"))
(case idsettype
[(free)
(unless (free-id-set? s)
(raise-blame-error b s "expected a free-identifier set"))]
(raise-blame-error b #:missing-party neg-party s "expected a free-identifier set"))]
[(bound)
(unless (bound-id-set? s)
(raise-blame-error b s "expected a bound-identifier set"))])
(raise-blame-error b #:missing-party neg-party s "expected a bound-identifier set"))])
(case mutability
[(mutable)
(unless (mutable-id-set? s)
(raise-blame-error b s "expected a mutable id set"))]
(raise-blame-error b #:missing-party neg-party s "expected a mutable id set"))]
[(immutable)
(unless (immutable-id-set? s)
(raise-blame-error b s "expected an immutable id set"))]))
(raise-blame-error b #:missing-party neg-party s "expected an immutable id set"))]))
(define (flat-id-set-contract-first-order ctc)
(define set-passes? (id-set-contract-first-order ctc))