suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Stephen Chang 2017-05-23 16:59:39 -04:00 committed by Stephen Chang
parent 6a145244d6
commit 42152ed31c
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
racket/collects/syntax/id-set.rkt
View File

@ -81,23 +81,23 @@
(lambda (s) (lambda (s)
(and (id-set? s) (idsettype? s) (mutability? 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) (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 (case idsettype
[(free) [(free)
(unless (free-id-set? s) (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) [(bound)
(unless (bound-id-set? s) (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 (case mutability
[(mutable) [(mutable)
(unless (mutable-id-set? s) (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) [(immutable)
(unless (immutable-id-set? s) (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 (flat-id-set-contract-first-order ctc)
(define set-passes? (id-set-contract-first-order ctc)) (define set-passes? (id-set-contract-first-order ctc))