diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt index ee33b5b9..9a27e117 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt @@ -973,7 +973,11 @@ (-> (-values null)) (->acc (list a) a null) ((list a) (b b) . ->... . (make-ValuesDots (list (-result a)) b 'b))))] -[call-with-values (-polydots (b a) ((-> (make-ValuesDots null a 'a)) (null (a a) . ->... . b) . -> . b))] +[call-with-values + (-polydots (b a) + (cl->* + ((-> (make-ValuesDots null a 'a)) (null (a a) . ->... . b) . -> . b) + ((-> ManyUniv) ((list) Univ . ->* . b) . -> . b)))] ;; Section 10.2 [raise (cl->* (Univ . -> . (Un)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-combined.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-combined.rkt index 6e7f4527..c207871d 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-combined.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-combined.rkt @@ -20,5 +20,7 @@ (export tc-app^) (link tc-app-main@ - tc-app-hetero@ tc-app-list@ tc-app-apply@ tc-app-values@ tc-app-keywords@ + tc-app-hetero@ tc-app-list@ tc-app-apply@ + (() tc-app-values@) + tc-app-keywords@ tc-app-objects@ tc-app-eq@ tc-app-lambda@ tc-app-special@)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt index f1c33cf0..e4f853da 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt @@ -10,7 +10,7 @@ (for-template racket/base)) -(import tc-expr^) +(import tc-expr^ tc-app^) (export tc-app-values^) (define-tc/app-syntax-class (tc/app-values expected) @@ -19,8 +19,9 @@ (pattern (call-with-values prod con) (match (tc/funapp #'prod #'() (single-value #'prod) null #f) [(tc-results: ts fs os) - (tc/funapp #'con #'(prod) (single-value #'con) (map ret ts fs os) expected)])) - + (tc/funapp #'con #'(prod) (single-value #'con) (map ret ts fs os) expected)] + [(tc-any-results:) + (tc/app-regular this-syntax expected)])) ;; special case for `values' with single argument ;; we just ignore the values, except that it forces arg to return one value (pattern (values arg) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt index 1e8c1523..e43f97d3 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -1915,6 +1915,11 @@ (getter 'bad 0))] [tc-err (struct-type-make-constructor 'bad)] [tc-err (struct-type-make-predicate 'bad)] + + [tc-e + (call-with-values (lambda () (eval #'(+ 1 2))) (inst list Any)) + (-lst Univ)] + ) (test-suite "tc-literal tests"