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

Instrumentation for parametric->/c.

Browse Source
This commit is contained in:
Vincent St-Amour 2016-01-11 16:49:23 -06:00
parent 143267f1e9
commit b00d7782ca
2 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/racket-test/tests/racket/contract/prof.rkt
View File

@ -392,4 +392,11 @@
0) 0)
1)) 1))
(test/spec-passed
'contract-marks43
'((contract (parametric->/c (X) (-> pos-blame? X neg-blame?))
(lambda (x y) x)
'pos 'neg)
1 2))
) )

4
racket/collects/racket/contract/private/parametric.rkt
View File

@ -61,6 +61,8 @@
(define barrier/c (polymorphic-contract-barrier c)) (define barrier/c (polymorphic-contract-barrier c))
(define vars (polymorphic-contract-vars c)) (define vars (polymorphic-contract-vars c))
(define (wrap p neg-party) (define (wrap p neg-party)
(with-contract-continuation-mark
(cons blame neg-party)
;; values in polymorphic types come in from negative position, ;; values in polymorphic types come in from negative position,
;; relative to the poly/c contract ;; relative to the poly/c contract
(define instances (define instances
@ -68,7 +70,7 @@
(barrier/c negative? var))) (barrier/c negative? var)))
(define protector (define protector
(apply (polymorphic-contract-body c) instances)) (apply (polymorphic-contract-body c) instances))
(((get/build-late-neg-projection protector) blame) p neg-party)) (((get/build-late-neg-projection protector) blame) p neg-party)))
(lambda (p neg-party) (lambda (p neg-party)
(unless (procedure? p) (unless (procedure? p)