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

Fix apply with (Listof A) args.

Browse Source 
Closes PR 14465.

original commit: b42e0d8d68f19c4cc80bb23f1cb1a383edeba322
This commit is contained in:
Eric Dobson 2014-04-25 21:30:38 -07:00
parent de03b2dee5
commit fcb558d2b1
2 changed files with 20 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
View File

@ -203,15 +203,24 @@
(cons (make-ListDots (car (car drests*)) (cdr (car drests*))) (car doms*))
(car rngs*)))))
=> finish]
;; ... function, (List A B C etc) arg
;; ... function, (Listof A) or (List A B C etc) arg
[(and (car drests*)
(not tail-bound)
(eq? (cdr (car drests*)) dotted-var)
(= (length (car doms*))
(length arg-tys))
(untuple tail-ty)
(infer/dots fixed-vars dotted-var (append arg-tys (untuple tail-ty)) (car doms*)
(car (car drests*)) (car rngs*) (fv (car rngs*))))
(match tail-ty
[(Listof: tail-arg-ty)
(infer/vararg
fixed-vars (list dotted-var)
(cons tail-arg-ty arg-tys)
(cons (car (car drests*)) (car doms*))
(car rests*)
(car rngs*))]
[(List: tail-arg-tys)
(infer/dots fixed-vars dotted-var (append arg-tys tail-arg-tys) (car doms*)
(car (car drests*)) (car rngs*) (fv (car rngs*)))]
[_ #f]))
=> finish]
;; if nothing matches, around the loop again
[else (loop (cdr doms*) (cdr rngs*) (cdr rests*) (cdr drests*))])))]

7
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -2825,6 +2825,13 @@
[tc-err (string-append (typecheck-fail #'stx "typecheck-fail") "bar")
#:ret (ret -String)
#:msg #rx"typecheck-fail"]
[tc-e
(let: ([f : (All (b ...) (Any ... b -> Any)) (lambda x 'x)])
(lambda xs (apply f xs)))
#:ret (ret (->* (list) Univ Univ))
#:expected (ret (->* (list) Univ Univ))]
)
(test-suite
"tc-literal tests"