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