[commit: ghc] wip/rae-new-coercible: Clarify "representation" from "type" in error messages (40e997c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/rae-new-coercible
Link       : http://ghc.haskell.org/trac/ghc/changeset/40e997c709a17139e4e8a8d84a69f6669f413fd0/ghc

>---------------------------------------------------------------

commit 40e997c709a17139e4e8a8d84a69f6669f413fd0
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Mon Dec 1 14:40:49 2014 -0500

    Clarify "representation" from "type" in error messages


>---------------------------------------------------------------

40e997c709a17139e4e8a8d84a69f6669f413fd0
 compiler/typecheck/TcErrors.lhs  | 36 ++++++++++++++++++++++--------------
 compiler/typecheck/TcRnTypes.lhs |  7 ++++++-
 2 files changed, 28 insertions(+), 15 deletions(-)

diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 4c829b1..072a736 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -798,7 +798,7 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
   | (implic:_) <- cec_encl ctxt
   , Implic { ic_skols = skols } <- implic
   , tv1 `elem` skols
-  = mkErrorMsg ctxt ct (vcat [ misMatchMsg oriented ty1 ty2
+  = mkErrorMsg ctxt ct (vcat [ misMatchMsg oriented eq_rel ty1 ty2
                              , extraTyVarInfo ctxt tv1 ty2
                              , extra ])
 
@@ -807,7 +807,7 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
   , Implic { ic_env = env, ic_skols = skols, ic_info = skol_info } <- implic
   , let esc_skols = filter (`elemVarSet` (tyVarsOfType ty2)) skols
   , not (null esc_skols)
-  = do { let msg = misMatchMsg oriented ty1 ty2
+  = do { let msg = misMatchMsg oriented eq_rel ty1 ty2
              esc_doc = sep [ ptext (sLit "because type variable") <> plural esc_skols
                              <+> pprQuotedList esc_skols
                            , ptext (sLit "would escape") <+>
@@ -825,7 +825,7 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
   -- Nastiest case: attempt to unify an untouchable variable
   | (implic:_) <- cec_encl ctxt   -- Get the innermost context
   , Implic { ic_env = env, ic_given = given, ic_info = skol_info } <- implic
-  = do { let msg = misMatchMsg oriented ty1 ty2
+  = do { let msg = misMatchMsg oriented eq_rel ty1 ty2
              untch_extra
                 = nest 2 $
                   sep [ quotes (ppr tv1) <+> ptext (sLit "is untouchable")
@@ -843,9 +843,10 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
         -- Not an occurs check, because F is a type function.
   where
     occ_check_expand = occurCheckExpand dflags tv1 ty2
-    k1  = tyVarKind tv1
-    k2  = typeKind ty2
-    ty1 = mkTyVarTy tv1
+    k1     = tyVarKind tv1
+    k2     = typeKind ty2
+    ty1    = mkTyVarTy tv1
+    eq_rel = ctEqRel ct
 
 mkEqInfoMsg :: Ct -> TcType -> TcType -> SDoc
 -- Report (a) ambiguity if either side is a type function application
@@ -889,7 +890,7 @@ misMatchOrCND ctxt ct oriented ty1 ty2
     isGivenCt ct
        -- If the equality is unconditionally insoluble
        -- or there is no context, don't report the context
-  = misMatchMsg oriented ty1 ty2
+  = misMatchMsg oriented (ctEqRel ct) ty1 ty2
   | otherwise
   = couldNotDeduce givens ([mkTcEqPred ty1 ty2], orig)
   where
@@ -964,23 +965,30 @@ kindErrorMsg ty1 ty2
     k2 = typeKind ty2
 
 --------------------
-misMatchMsg :: Maybe SwapFlag -> TcType -> TcType -> SDoc          -- Types are already tidy
+misMatchMsg :: Maybe SwapFlag -> EqRel -> TcType -> TcType -> SDoc
+-- Types are already tidy
 -- If oriented then ty1 is actual, ty2 is expected
-misMatchMsg oriented ty1 ty2
+misMatchMsg oriented eq_rel ty1 ty2
   | Just IsSwapped <- oriented
-  = misMatchMsg (Just NotSwapped) ty2 ty1
+  = misMatchMsg (Just NotSwapped) eq_rel ty2 ty1
   | Just NotSwapped <- oriented
-  = sep [ ptext (sLit "Couldn't match expected") <+> what <+> quotes (ppr ty2)
-        , nest 12 $   ptext (sLit "with actual") <+> what <+> quotes (ppr ty1)
+  = sep [ text "Couldn't match" <+> repr1 <+> text "expected" <+>
+          what <+> quotes (ppr ty2)
+        , nest 12 $   text "with" <+> repr2 <+> text "actual" <+>
+          what <+> quotes (ppr ty1)
         , sameOccExtra ty2 ty1 ]
   | otherwise
-  = sep [ ptext (sLit "Couldn't match") <+> what <+> quotes (ppr ty1)
-        , nest 14 $ ptext (sLit "with") <+> quotes (ppr ty2)
+  = sep [ ptext (sLit "Couldn't match") <+> repr1 <+> what <+> quotes (ppr ty1)
+        , nest 14 $ ptext (sLit "with") <+> repr2 <+> quotes (ppr ty2)
         , sameOccExtra ty1 ty2 ]
   where
     what | isKind ty1 = ptext (sLit "kind")
          | otherwise  = ptext (sLit "type")
 
+    (repr1, repr2) = case eq_rel of
+      NomEq  -> (empty, empty)
+      ReprEq -> (text "representation of", text "that of")
+
 mkExpectedActualMsg :: Type -> Type -> CtOrigin -> (Maybe SwapFlag, SDoc)
 -- NotSwapped means (actual, expected), IsSwapped is the reverse
 mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act, uo_expected = exp })
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 0f74227..713829a 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -50,7 +50,7 @@ module TcRnTypes(
         isCDictCan_Maybe, isCFunEqCan_maybe,
         isCIrredEvCan, isCNonCanonical, isWantedCt, isDerivedCt,
         isGivenCt, isHoleCt, isTypedHoleCt, isPartialTypeSigCt,
-        ctEvidence, ctLoc, ctPred, ctFlavour,
+        ctEvidence, ctLoc, ctPred, ctFlavour, ctEqRel,
         mkNonCanonical, mkNonCanonicalCt,
         ctEvPred, ctEvLoc, ctEvEqRel,
         ctEvTerm, ctEvCoercion, ctEvId, ctEvCheckDepth,
@@ -1178,9 +1178,14 @@ ctPred :: Ct -> PredType
 -- See Note [Ct/evidence invariant]
 ctPred ct = ctEvPred (cc_ev ct)
 
+-- | Get the flavour of the given 'Ct'
 ctFlavour :: Ct -> CtFlavour
 ctFlavour = ctEvFlavour . ctEvidence
 
+-- | Get the equality relation for the given 'Ct'
+ctEqRel :: Ct -> EqRel
+ctEqRel = ctEvEqRel . ctEvidence
+
 dropDerivedWC :: WantedConstraints -> WantedConstraints
 -- See Note [Dropping derived constraints]
 dropDerivedWC wc@(WC { wc_flat = flats })