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

Support ValuesDots in a typechecking a funapp

Browse Source 
Closes PR 13651

original commit: 4f3c98f7549bc0fe2641dea92bd1188bb527bfdf
This commit is contained in:
Asumu Takikawa 2014-02-24 00:26:11 -05:00
parent a8e01d8707
commit c26f9b4c73
3 changed files with 35 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-app-helper.rkt
View File

@ -19,14 +19,19 @@
(define (tc/funapp1 f-stx args-stx ftype0 argtys expected #:check [check? #t])
(match* (ftype0 argtys)
;; we check that all kw args are optional
[((arr: dom (and rng (or (AnyValues:) (Values: _))) rest #f (and kws (list (Keyword: _ _ #f) ...)))
[((arr: dom rng rest #f (and kws (list (Keyword: _ _ #f) ...)))
(list (tc-result1: t-a phi-a o-a) ...))
(when check?
(define error-ret
(match rng
((AnyValues:) tc-any-results)
((Values: (list (Result: t-r _ _) ...)) (ret t-r))))
((Values: (list (Result: t-r _ _) ...)) (ret t-r))
((ValuesDots: (list (Result: t-r _ _) ...) dty dbound)
(ret t-r
(make-list (length t-r) -no-filter)
(make-list (length t-r) -no-obj)
dty dbound))))
(cond [(and (not rest) (not (= (length dom) (length t-a))))
(tc-error/expr #:return error-ret
"Wrong number of arguments, expected ~a and got ~a" (length dom) (length t-a))]
@ -53,7 +58,13 @@
(for/lists (t-r f-r o-r)
([r (in-list results)])
(open-Result r o-a t-a)))
(ret t-r f-r o-r)))))]
(ret t-r f-r o-r))
((ValuesDots: results dty dbound)
(define-values (t-r f-r o-r)
(for/lists (t-r f-r o-r)
([r (in-list results)])
(open-Result r o-a t-a)))
(ret t-r f-r o-r dty dbound)))))]
;; this case should only match if the function type has mandatory keywords
;; but no keywords were provided in the application
[((arr: _ _ _ _

7
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
View File

@ -507,7 +507,12 @@
(let* ([ts* (do-inst form ts)]
[r (ret ts* fs os)])
(add-typeof-expr form r)
r)]))])))
r)]
[(tc-results: ts fs os dty dbound)
(define ts* (do-inst form ts))
(define r (ret ts* fs os dty dbound))
(add-typeof-expr form r)
r]))])))
(define (single-value form [expected #f])
(define t (if expected (tc-expr/check form expected) (tc-expr form)))

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

@ -2302,6 +2302,21 @@
(-filter (-val #f) (list 0 0)))
: (make-Path null (list 0 0))))
(-FS -top -bot))]
;; PR 13651 and related
[tc-e (tr:lambda #:forall (a ...) ([f : (-> String (values a ... a))])
(f "foo"))
#:ret (ret (-polydots (a)
(t:-> (t:-> -String (make-ValuesDots '() a 'a))
(make-ValuesDots '() a 'a)))
(-FS -top -bot))]
[tc-e (inst (plambda: (A B ...) ((a : A) b : B ... B)
((ann (lambda () (apply (inst values A B ... B) a b))
(-> (values A B ... B)))))
String String Symbol)
#:ret (ret (t:-> -String -String -Symbol
(-values (list -String -String -Symbol)))
(-FS -top -bot))]
)
(test-suite
"tc-literal tests"