From 05c08898a63f1f06e0f1ca632d8fa1e2b62dec7a Mon Sep 17 00:00:00 2001 From: Carl Eastlund Date: Fri, 12 Feb 2010 23:03:11 +0000 Subject: [PATCH] Added automatic blame-tracking to poly/c contract in unstable (and updated use in Typed Scheme). svn: r18075 original commit: 1b28ea1a6c1c499d0d4f5d0a13d2496c2bfc0ec8 --- collects/typed-scheme/private/type-contract.ss | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/collects/typed-scheme/private/type-contract.ss b/collects/typed-scheme/private/type-contract.ss index 3a2fb917..5f425efc 100644 --- a/collects/typed-scheme/private/type-contract.ss +++ b/collects/typed-scheme/private/type-contract.ss @@ -122,18 +122,14 @@ #`(cons/c #,(t->c t1) #,(t->c t2))] [(Opaque: p? cert) #`(flat-named-contract (quote #,(syntax-e p?)) #,(cert p?))] - [(F: v) (cond [(assoc v (vars)) => (if pos? second third)] + [(F: v) (cond [(assoc v (vars)) => second] [else (int-err "unknown var: ~a" v)])] [(Poly: vs (and b (Function: _))) (match-let ([(Poly-names: vs-nm _) ty]) - (with-syntax ([(vs+ ...) (generate-temporaries (for/list ([v vs-nm]) (format-symbol "~a+" v)))] - [(vs- ...) (generate-temporaries (for/list ([v vs-nm]) (format-symbol "~a-" v)))]) - (parameterize ([vars (append (map list - vs - (syntax->list #'(vs+ ...)) - (syntax->list #'(vs- ...))) + (with-syntax ([(v ...) (generate-temporaries vs-nm)]) + (parameterize ([vars (append (map list vs (syntax->list #'(v ...))) (vars))]) - #`(poly/c ([vs- vs+] ...) #,(t->c b)))))] + #`(poly/c (v ...) #,(t->c b)))))] [(Mu: n b) (match-let ([(Mu-name: n-nm _) ty]) (with-syntax ([(n*) (generate-temporaries (list n-nm))])