From 01fd7f5b8c30cde66da0267874ccac34d5a1b819 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 27 Aug 2010 17:42:33 -0400 Subject: [PATCH] Use `any/c' for contracts for polymorphic functions. original commit: 92ce3ca02d448df97ba8e9e2210a898848cae0f1 --- .../typed-scheme/private/type-contract.rkt | 20 +++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt index ebf7ba12..0ea776a7 100644 --- a/collects/typed-scheme/private/type-contract.rkt +++ b/collects/typed-scheme/private/type-contract.rkt @@ -139,18 +139,22 @@ #`(flat-named-contract (quote #,(syntax-e p?)) #,(cert p?))] [(F: v) (cond [(assoc v (vars)) => second] [else (int-err "unknown var: ~a" v)])] - [(Poly: vs (and b (Function: _))) - (when flat? (exit (fail))) - (match-let ([(Poly-names: vs-nm _) ty]) - (with-syntax ([(v ...) (generate-temporaries vs-nm)]) - (parameterize ([vars (append (map list vs (syntax->list #'(v ...))) - (vars))]) - #`(parametric/c (v ...) #,(t->c b)))))] + [(Poly: vs b) + (if from-typed? + ;; in positive position, no checking needed for the variables + (parameterize ([vars (append (for/list ([v vs]) (list v #'any/c)))]) + (t->c b)) + ;; in negative position, use `parameteric/c' + (match-let ([(Poly-names: vs-nm _) ty]) + (with-syntax ([(v ...) (generate-temporaries vs-nm)]) + (parameterize ([vars (append (map list vs (syntax->list #'(v ...))) + (vars))]) + #`(parametric/c (v ...) #,(t->c b))))))] [(Mu: n b) (match-let ([(Mu-name: n-nm _) ty]) (with-syntax ([(n*) (generate-temporaries (list n-nm))]) (parameterize ([vars (cons (list n #'n* #'n*) (vars))]) - #`(flat-rec-contract n* #,(t->c b)))))] + #`(flat-rec-contract n* #,(t->c b #:flat #t)))))] [(Value: #f) #'false/c] [(Instance: (Class: _ _ (list (list name fcn) ...))) (when flat? (exit (fail)))