diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt index a7efd782..a2a58cc9 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt @@ -185,11 +185,11 @@ (eq? (cdr drest) dotted-var) (= (length domain) (length arg-tys)) (match full-tail-ty - [(Listof: tail-arg-ty) + [(List: tail-arg-tys #:tail (Listof: tail-arg-ty)) (infer/vararg fixed-vars (list dotted-var) - (cons tail-arg-ty arg-tys) - (cons (car drest) domain) + (cons tail-arg-ty (append tail-arg-tys arg-tys)) + (cons (car drest) (append (map (λ _ (car drest)) tail-arg-tys) domain)) rest range)] [(List: tail-arg-tys) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/match-expanders.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/match-expanders.rkt index 6e1b859e..386048b4 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/match-expanders.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/match-expanders.rkt @@ -28,16 +28,22 @@ (lambda (stx) (syntax-parse stx [(_ elem-pats) - #'(app untuple (? values elem-pats))]))) + #'(app untuple (? values elem-pats) (Value: '()))] + [(_ elem-pats #:tail tail-pat) + #'(app untuple (? values elem-pats) tail-pat)]))) +;; Type/c -> (or/c (values/c #f #f) (values/c (listof Type/c) Type/c))) +;; Returns the prefix of types that are consed on to the last type (a non finite-pair type). +;; The last type may contain pairs if it is a list type. (define (untuple t) (let loop ((t t) (seen (set))) - (and (not (set-member? seen (Type-seq t))) - (match (resolve t) - [(Value: '()) null] - [(Pair: a b) (cond [(loop b (set-add seen (Type-seq t))) => (lambda (l) (cons a l))] - [else #f])] - [_ #f])))) + (if (not (set-member? seen (Type-seq t))) + (match (resolve t) + [(Pair: a b) + (define-values (elems tail) (loop b (set-add seen (Type-seq t)))) + (values (cons a elems) tail)] + [_ (values null t)]) + (values null t)))) (define-match-expander MListof: (lambda (stx) 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 389a8589..f1733ad5 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 @@ -2851,7 +2851,13 @@ (let: ([f : (All (b ...) (Any ... b -> Any)) (lambda x 'x)]) (lambda xs (apply f xs))) #:ret (ret (->* (list) Univ Univ)) - #:expected (ret (->* (list) Univ Univ))] + #:expected (ret (->* (list) Univ Univ))] + + [tc-e + (let: ([f : (All (b ...) (Any ... b -> Any)) (lambda x 'x)]) + (lambda xs (apply f (ann (cons 'y xs) (cons Symbol (Listof Any)))))) + #:ret (ret (->* (list) Univ Univ)) + #:expected (ret (->* (list) Univ Univ))] [tc-e (let () @@ -2878,8 +2884,6 @@ -Symbol #:expected (ret -Symbol)] - - ) (test-suite "tc-literal tests"