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) (if (flat-contract? ctc)
(flat-named-contract name (flat-contract-predicate ctc)) (flat-named-contract name (flat-contract-predicate ctc))
(let* ([ctc-fo (contract-first-order ctc)] (let* ([ctc-fo (contract-first-order ctc)]
[proj (contract-projection ctc)]) [late-neg-proj (contract-late-neg-projection ctc)])
(make-contract #:name name (make-contract #:name name
#:projection proj #:late-neg-projection late-neg-proj
#:first-order ctc-fo))))) #:first-order ctc-fo)))))

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

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