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

Handle apply for functions with no rest arguments.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2011-08-17 17:16:39 -04:00
parent cfec4280d3
commit bdcc63b229
2 changed files with 15 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
View File

@ -1327,6 +1327,8 @@
[tc-e (#%variable-reference) -Variable-Reference]
[tc-e (#%variable-reference x) -Variable-Reference]
[tc-e (#%variable-reference +) -Variable-Reference]
[tc-e (apply (λ: ([x : String] [y : String]) (string-append x y)) (list "foo" "bar")) -String]
[tc-e (apply (plambda: (a) ([x : a] [y : a]) x) (list "foo" "bar")) -String]
)
(test-suite
"check-type tests"

12
collects/typed-scheme/typecheck/tc-apply.rkt
View File

@ -75,6 +75,11 @@
(subtype tail-ty (car (car drests*))))]
[_ #f]))
(do-ret (car rngs*))]
;; the function has no rest argument, but provides all the necessary fixed arguments
[(and (not (car rests*)) (not (car drests*))
(subtype (apply -lst* arg-tys #:tail tail-ty)
(apply -lst* (car doms*))))
(do-ret (car rngs*))]
;; otherwise, nothing worked, move on to the next case
[else (loop (cdr doms*) (cdr rngs*) (cdr rests*) (cdr drests*))])))]
;; apply of simple polymorphic function
@ -107,6 +112,13 @@
(car rests*)
(car rngs*)))
=> (lambda (substitution) (do-ret (subst-all substitution (car rngs*))))]
;; the function has no rest argument, but provides all the necessary fixed arguments
[(and (not (car rests*)) (not (car drests*)) (not tail-bound)
(infer vars null
(list (apply -lst* arg-tys #:tail tail-ty))
(list (apply -lst* (car doms*)))
(car rngs*)))
=> (lambda (substitution) (do-ret (subst-all substitution (car rngs*))))]
;; actual work, when we have a * function and ... final arg
[(and (car rests*)
tail-bound