From b00d7782cab0585d9adfce3f4591de0de2092667 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Mon, 11 Jan 2016 16:49:23 -0600 Subject: [PATCH] Instrumentation for parametric->/c. --- .../racket-test/tests/racket/contract/prof.rkt | 7 +++++++ .../racket/contract/private/parametric.rkt | 18 ++++++++++-------- 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/pkgs/racket-test/tests/racket/contract/prof.rkt b/pkgs/racket-test/tests/racket/contract/prof.rkt index 42ae96b69e..4d5f5344d3 100644 --- a/pkgs/racket-test/tests/racket/contract/prof.rkt +++ b/pkgs/racket-test/tests/racket/contract/prof.rkt @@ -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)) + ) diff --git a/racket/collects/racket/contract/private/parametric.rkt b/racket/collects/racket/contract/private/parametric.rkt index a0b072a104..1f6e3d4a52 100644 --- a/racket/collects/racket/contract/private/parametric.rkt +++ b/racket/collects/racket/contract/private/parametric.rkt @@ -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)