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

Fix substitute and add test case.

Browse Source 
original commit: 3b6168de7d2a0b25a40c391757bc71fdb272c347
This commit is contained in:
Eric Dobson 2012-08-13 21:22:40 -07:00 committed by Sam Tobin-Hochstadt
parent f071ccf186
commit 37aeb62a14
2 changed files with 29 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/tests/typed-racket/succeed/subst-poly-dots.rkt Normal file
View File

@ -0,0 +1,17 @@
#lang typed/racket
(: f (All (A B ...) (A ... B -> (List (Boxof A) ... B))))
(define (f . args)
(map (inst box A) args))
(: h (-> Nothing))
(define (h) (h))
(: g (All (A B ...) (A ... B -> (Values (Boxof A) ... B))))
(define (g . args)
(h))
(ann ((inst f String Symbol Symbol) "c" "d") (List (Boxof String) (Boxof String)))
(lambda (x)
(ann ((inst g String Symbol Symbol) "c" "d") (values (Boxof String) (Boxof String))))

23
collects/typed-racket/types/substitute.rkt
View File

@ -39,34 +39,35 @@
((simple-substitution/c Type?) (#:Un procedure?) . ->* . Type?)
(define (sb t) (substitute-many subst t #:Un Un))
(define names (hash-keys subst))
(if (ormap (lambda (name) (hash-has-key? (free-vars* target) name)) names)
(define fvs (free-vars* target))
(if (ormap (lambda (name) (hash-has-key? fvs name)) names)
(type-case (#:Type sb #:Filter (sub-f sb) #:Object (sub-o sb))
target
[#:Union tys (Un (map sb tys))]
[#:F name (hash-ref subst name target)]
[#:arr dom rng rest drest kws
(cond
((and (pair? drest) (ormap (and/c (cdr drest) (not/c bound-tvar?)) names)) =>
[(and (pair? drest) (ormap (and/c (cdr drest) (not/c bound-tvar?)) names)) =>
(lambda (name)
(int-err "substitute used on ... variable ~a in type ~a" name target)))
(else
(int-err "substitute used on ... variable ~a in type ~a" name target))]
[else
(make-arr (map sb dom)
(sb rng)
(and rest (sb rest))
(and drest (cons (sb (car drest)) (cdr drest)))
(map sb kws))))]
(map sb kws))])]
[#:ValuesDots types dty dbound
(cond
((ormap (and/c dbound (not/c bound-tvar?)) names) =>
[(ormap (and/c dbound (not/c bound-tvar?)) names) =>
(lambda (name)
(int-err "substitute used on ... variable ~a in type ~a" name target)))
(make-ValuesDots (map sb types) (sb dty) dbound))]
(int-err "substitute used on ... variable ~a in type ~a" name target))]
[else (make-ValuesDots (map sb types) (sb dty) dbound)])]
[#:ListDots dty dbound
(cond
((ormap (and/c dbound (not/c bound-tvar?)) names) =>
[(ormap (and/c dbound (not/c bound-tvar?)) names) =>
(lambda (name)
(int-err "substitute used on ... variable ~a in type ~a" name target)))
(make-ListDots (sb dty) dbound))])
(int-err "substitute used on ... variable ~a in type ~a" name target))]
[else (make-ListDots (sb dty) dbound)])])
target))