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

adjust syntax-parse's contract support to use the late-neg projections

Browse Source
This commit is contained in:
Robby Findler 2015-12-19 17:30:27 -06:00
parent 00c0ddb7f6
commit a712117030
2 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/collects/syntax/parse/experimental/provide.rkt
View File

@ -150,7 +150,7 @@
(if (flat-contract? ctc)
(flat-named-contract name (flat-contract-predicate ctc))
(let* ([ctc-fo (contract-first-order ctc)]
[proj (contract-projection ctc)])
[late-neg-proj (contract-late-neg-projection ctc)])
(make-contract #:name name
#:projection proj
#:late-neg-projection late-neg-proj
#:first-order ctc-fo)))))

10
racket/collects/syntax/parse/experimental/reflect.rkt
View File

@ -125,20 +125,20 @@
(#:<kw> any/c ...)
#:rest list?
(or/c reified-syntax-class? reified-splicing-syntax-class/c))
#:projection
#:late-neg-projection
(lambda (blame)
(let ([check-reified
((contract-projection
((contract-late-neg-projection
(or/c reified-syntax-class? reified-splicing-syntax-class?))
(blame-swap blame))])
(lambda (f)
(lambda (f neg-party)
(if (and (procedure? f)
(procedure-arity-includes? f 1))
(make-keyword-procedure
(lambda (kws kwargs r . args)
(keyword-apply f kws kwargs (check-reified r) args)))
(keyword-apply f kws kwargs (check-reified r neg-party) args)))
(raise-blame-error
blame
blame #:missing-party neg-party
f
"expected a procedure of at least one argument, given ~e"
f)))))