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

Make apply of poly functions more like regular functions.

Browse Source 
original commit: 362747bfcdb8ceecd36b7e40d76de671b43d46e1
This commit is contained in:
Eric Dobson 2014-04-27 14:41:16 -07:00
parent 61ceccf36b
commit 27cabe8618
2 changed files with 18 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -91,15 +91,12 @@
[drest (in-list drests)])
(define (finish substitution) (do-ret (subst-all substitution range)))
(cond
;; the actual work, when we have a * function and a list final argument
;; the actual work, when we have a * function
[(and rest
(not tail-bound)
(<= (length domain) (length arg-tys))
(infer/vararg vars null
(cons full-tail-ty arg-tys)
(cons (make-Listof rest) domain)
rest
range))
(infer vars null
(list (-Tuple* arg-tys full-tail-ty))
(list (-Tuple* domain (make-Listof rest)))
range))
=> finish]
;; the function has no rest argument, but provides all the necessary fixed arguments
[(and (not rest) (not drest) (not tail-bound)
@ -108,16 +105,6 @@
(list (-Tuple domain))
range))
=> finish]
;; actual work, when we have a * function and ... final arg
[(and rest
tail-bound
(<= (length domain) (length arg-tys))
(infer/vararg vars null
(cons (make-Listof tail-ty) arg-tys)
(cons (make-Listof rest) domain)
rest
range))
=> finish]
;; ... function, ... arg
[(and drest
tail-bound

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

@ -1001,8 +1001,8 @@
[tc-err (apply append (list 1) (list 2) (list 3) (list (list 1) "foo"))]
[tc-e (apply append (list 1) (list 2) (list 3) (list (list 1) (list 1))) (-lst -PosByte)]
[tc-e (apply append (list 1) (list 2) (list 3) (list (list 1) (list "foo"))) (-lst (t:Un -String -PosByte))]
[tc-err (plambda: (b ...) [y : b ... b] (apply append (map list y)))
#:ret (ret (-polydots (b) (->... (list) (b b) -Bottom)) -true-filter)]
[tc-e (plambda: (b ...) [y : b ... b] (apply append (map list y)))
#:ret (ret (-polydots (b) (->... (list) (b b) (-lst Univ))) -true-filter)]
[tc-e/t (plambda: (b ...) [y : (Listof Integer) ... b] (apply append y))
(-polydots (b) (->... (list) ((-lst -Integer) b) (-lst -Integer)))]
@ -2897,6 +2897,17 @@
#:ret (ret -Bottom)
#:msg #rx"has no cases"]
[tc-e/t
(let: ([f : (All (a) (a a * -> Void)) (λ _ (void))])
(plambda: (A B ...) ([xs : (List Any A ... B)])
(apply f xs)))
(-polydots (a b) (t:-> (-pair Univ (make-ListDots a 'b)) -Void))]
[tc-e/t
(let: ([f : (All (a) (a a * -> Void)) (λ _ (void))])
(plambda: (A B ...) ([xs : (List A ... B)])
(apply f (first xs) xs)))
(-polydots (a b) (t:-> (make-ListDots a 'b) -Void))]
[tc-e
(let ()
(: a Symbol)