From 18d4eb51351bb265f69f16b825932d93b228e69e Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Wed, 16 Oct 2013 14:37:40 -0400
Subject: [PATCH] Abstract out "Expected foo, but got bar" errors

Use the new helper function to report errors more
helpfully when two identically named type variables
from different scopes are encountered.
---
 .../typed-racket/typecheck/check-below.rkt    | 40 ++++++++++++++-----
 1 file changed, 29 insertions(+), 11 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt
index f989da4ff9..0cd788d65e 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt
@@ -22,6 +22,24 @@
 (define (cond-check-below tr1 expected)
   (if expected (check-below tr1 expected) tr1))
 
+;; expected-but-got : (U Type String) (U Type String) -> Void
+;;
+;; Helper to print messages of the form
+;;   "Expected a, but got b"
+;;
+;; Also handles cases like two type variables that
+;; have the same name.
+(define (expected-but-got t1 t2)
+  (match* (t1 t2)
+    [((F: s1) (F: s2))
+     (=> fail)
+     (unless (string=? (symbol->string s1) (symbol->string s2))
+       (fail))
+     (tc-error/expr "Expected ~a, but got a different ~a (bound in another scope)"
+                    t1 t2)]
+    [(_ _)
+     (tc-error/expr "Expected ~a, but got ~a" t1 t2)]))
+
 ;; check-below : (/\ (Results Type -> Result)
 ;;                   (Results Results -> Result)
 ;;                   (Type Results -> Type)
@@ -51,19 +69,19 @@
      (unless (= (length ts) (length ts2))
        (tc-error/expr "Expected ~a values, but got ~a" (length ts2) (length ts)))
      (unless (for/and ([t (in-list ts)] [s (in-list ts2)]) (subtype t s))
-       (tc-error/expr "Expected ~a, but got ~a" (stringify ts2) (stringify ts)))
+       (expected-but-got (stringify ts2) (stringify ts)))
      (if (= (length ts) (length ts2))
          (ret ts2 fs os)
          (ret ts2))]
     [((tc-result1: t1 f1 o1) (tc-result1: t2 (FilterSet: (Top:) (Top:)) (Empty:)))
      (cond
        [(not (subtype t1 t2))
-        (tc-error/expr "Expected ~a, but got ~a" t2 t1)])
+        (expected-but-got t2 t1)])
      expected]
     [((tc-result1: t1 f1 o1) (tc-result1: t2 f2 o2))
      (cond
        [(not (subtype t1 t2))
-        (tc-error/expr "Expected ~a, but got ~a" t2 t1)]
+        (expected-but-got t2 t1)]
        [(and (not (filter-better? f1 f2))
              (object-better? o1 o2))
         (tc-error/expr "Expected result with filter ~a, got filter ~a" f2 f1)]
@@ -80,7 +98,7 @@
        (tc-error/expr "Expected ~a values and ~a ..., but got ~a values"
                       (length t2) dty (length t1)))
      (unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
-       (tc-error/expr "Expected ~a, but got ~a" (stringify t2) (stringify t1)))
+       (expected-but-got (stringify t2) (stringify t1)))
      expected]
     ;; case where you have (Values a ... a) but expected something else
     [((tc-results: t1 f o dty dbound) (tc-results: t2 f o))
@@ -88,13 +106,13 @@
        (tc-error/expr "Expected ~a values, but got ~a values and ~a ..."
                       (length t2) (length t1) dty))
      (unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
-       (tc-error/expr "Expected ~a, but got ~a" (stringify t2) (stringify t1)))
+       (expected-but-got (stringify t2) (stringify t1)))
      expected]
     [((tc-results: t1 f o dty1 dbound) (tc-results: t2 f o dty2 dbound))
      (unless (= (length t1) (length t2))
        (tc-error/expr "Expected ~a non dotted values, but got ~a" (length t2) (length t1)))
      (unless (andmap subtype t1 t2)
-       (tc-error/expr "Expected ~a, but got ~a" (stringify t2) (stringify t1)))
+       (expected-but-got (stringify t2) (stringify t1)))
      (unless (subtype dty1 dty2)
        (tc-error/expr "Expected ~a in ..., but got ~a" dty2 dty1))
      expected]
@@ -102,7 +120,7 @@
      (unless (= (length t1) (length t2))
        (tc-error/expr "Expected ~a values, but got ~a" (length t2) (length t1)))
      (unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
-       (tc-error/expr "Expected ~a, but got ~a" (stringify t2) (stringify t1)))
+       (expected-but-got (stringify t2) (stringify t1)))
      expected]
     [((tc-any-results:) (or (? Type/c? t) (tc-result1: t _ _)))
      (tc-error/expr "Expected 1 value, but got unknown number")
@@ -113,26 +131,26 @@
 
     [((tc-result1: t1 f o) (? Type/c? t2))
      (unless (subtype t1 t2)
-       (tc-error/expr "Expected ~a, but got ~a" t2 t1))
+       (expected-but-got t2 t1))
      (ret t2 f o)]
 
 
     [((? Type/c? t1) (tc-any-results:)) t1]
     [((? Type/c? t1) (tc-result1: t2 (FilterSet: (list) (list)) (Empty:)))
      (unless (subtype t1 t2)
-       (tc-error/expr "Expected ~a, but got ~a" t2 t1))
+       (expected-but-got t2 t1))
      t1]
     [((? Type/c? t1) (tc-result1: t2 f o))
      (if (subtype t1 t2)
          (tc-error/expr "Expected result with filter ~a and ~a, got ~a" f (print-object o) t1)
-         (tc-error/expr "Expected ~a, but got ~a" t2 t1))
+         (expected-but-got t2 t1))
      t1]
     [((? Type/c? t1) (tc-results: ts2 fs os))
        (tc-error/expr "Expected one value, but got ~a" (length ts2))
        t1]
     [((? Type/c? t1) (? Type/c? t2))
      (unless (subtype t1 t2)
-       (tc-error/expr "Expected ~a, but got ~a" t2 t1))
+       (expected-but-got t2 t1))
      expected]
     [((tc-results: ts fs os dty dbound) (tc-results: ts* fs* os* dty* dbound*))
      (int-err "dotted types with different bounds/filters/objects in check-below nyi: ~a ~a" tr1 expected)]