From d417ac6a5515f05ea2bf1a1f9a94b492df8ca2d2 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 22 Sep 2008 18:35:24 +0000
Subject: [PATCH] Catch error before internal error, more informative internal
 error.

svn: r11837

original commit: 88d44f9c5b37b17e43cac04d918eff5a34870334
---
 collects/typed-scheme/private/type-utils.ss     |  3 ++-
 collects/typed-scheme/typecheck/tc-expr-unit.ss | 17 ++++++++++-------
 2 files changed, 12 insertions(+), 8 deletions(-)

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