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

Added automatic blame-tracking to poly/c contract in unstable (and updated use in Typed Scheme).

Browse Source 
svn: r18075

original commit: 1b28ea1a6c1c499d0d4f5d0a13d2496c2bfc0ec8
This commit is contained in:
Carl Eastlund 2010-02-12 23:03:11 +00:00
parent a61aef0339
commit 05c08898a6
1 changed files with 4 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/typed-scheme/private/type-contract.ss
View File

@ -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))])