Instrumentation for parametric->/c.

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

View File

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

View File

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