diff --git a/collects/typed-scheme/private/type-utils.ss b/collects/typed-scheme/private/type-utils.ss index 8cc09a8b..f813a19e 100644 --- a/collects/typed-scheme/private/type-utils.ss +++ b/collects/typed-scheme/private/type-utils.ss @@ -163,7 +163,8 @@ (match t [(PolyDots: (list fixed ... dotted) body) (unless (= (length fixed) (length types)) - (int-err "instantiate-poly-dotted: wrong number of types: expected ~a, got ~a" (length fixed) (length types))) + (int-err "instantiate-poly-dotted: wrong number of types: expected ~a, got ~a, types were ~a" + (length fixed) (length types) types)) (let ([body* (subst-all (map list fixed types) body)]) (substitute-dotted image var dotted body*))] [_ (int-err "instantiate-poly-dotted: requires PolyDots type, got ~a" t)])) diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.ss b/collects/typed-scheme/typecheck/tc-expr-unit.ss index b9c97d48..00bcdfdd 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.ss +++ b/collects/typed-scheme/typecheck/tc-expr-unit.ss @@ -74,13 +74,16 @@ [(cons last-ty-stx (? identifier? last-id-stx)) (unless (Dotted? (lookup (current-tvars) (syntax-e last-id-stx) (lambda _ #f))) (tc-error/stx last-id-stx "~a is not a type variable bound with ..." (syntax-e last-id-stx))) - (let* ([last-id (syntax-e last-id-stx)] - [last-ty - (parameterize ([current-tvars (extend-env (list last-id) - (list (make-DottedBoth (make-F last-id))) - (current-tvars))]) - (parse-type last-ty-stx))]) - (instantiate-poly-dotted ty (map parse-type all-but-last) last-ty last-id))] + (if (= (length all-but-last) (sub1 (PolyDots-n ty))) + (let* ([last-id (syntax-e last-id-stx)] + [last-ty + (parameterize ([current-tvars (extend-env (list last-id) + (list (make-DottedBoth (make-F last-id))) + (current-tvars))]) + (parse-type last-ty-stx))]) + (instantiate-poly-dotted ty (map parse-type all-but-last) last-ty last-id)) + (tc-error/expr #:return (Un) "Wrong number of fixed type arguments to polymorphic type ~a:~nexpected: ~a~ngot: ~a" + ty (sub1 (PolyDots-n ty)) (length all-but-last)))] [_ (instantiate-poly ty (map parse-type (syntax->list inst)))]))] [else