From f357d4c0ce141b4a85b608f9c57fb1462ca28d0e Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sat, 2 Jul 2011 23:06:37 -0400 Subject: [PATCH] Fix typechecking of call-with-values. Closes PR11709. original commit: 0b761781380ba23a6e363798ad39049a8d4e6eb6 --- .../tests/typed-scheme/succeed/pr11709.rkt | 19 +++++++++++++++++++ collects/typed-scheme/typecheck/tc-app.rkt | 2 +- 2 files changed, 20 insertions(+), 1 deletion(-) create mode 100644 collects/tests/typed-scheme/succeed/pr11709.rkt diff --git a/collects/tests/typed-scheme/succeed/pr11709.rkt b/collects/tests/typed-scheme/succeed/pr11709.rkt new file mode 100644 index 00000000..f6bdbd0b --- /dev/null +++ b/collects/tests/typed-scheme/succeed/pr11709.rkt @@ -0,0 +1,19 @@ +#lang typed/racket + +(define stop-value (gensym)) + +(: an-alist : (All (A B) (Listof (Pair A B)) -> (Rec R (-> (values (-> (values A B)) (-> R)))))) +(define (an-alist lst) + (lambda: () + (if (null? lst) (raise stop-value) + (let ([first (car lst)] + [rest (cdr lst)]) + (values + (lambda: () (values (car first) (cdr first))) + (lambda: () (an-alist rest))))))) + +(define alist (an-alist (list (cons 1 2) (cons 3 4) (cons 5 6)))) + +(call-with-values alist values) ; this works + +(call-with-values alist (λ (e a) a)) diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt index e4878944..09149bba 100644 --- a/collects/typed-scheme/typecheck/tc-app.rkt +++ b/collects/typed-scheme/typecheck/tc-app.rkt @@ -503,7 +503,7 @@ [(#%plain-app 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)])] ;; in eq? cases, call tc/eq [(#%plain-app eq?:comparator v1 v2) ;; make sure the whole expression is type correct