[commit: ghc] wip/new-flatten-skolems-Oct14: Only report "could not deduce s~t from ..." for givens that include equalities (394ca3b)

[git at git.haskell.org]

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

On branch  : wip/new-flatten-skolems-Oct14
Link       : http://ghc.haskell.org/trac/ghc/changeset/394ca3be64d101e30fb4f47de88afd3d55615309/ghc

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

commit 394ca3be64d101e30fb4f47de88afd3d55615309
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Oct 29 17:49:34 2014 +0000

    Only report "could not deduce s~t from ..." for givens that include equalities
    
    This just simplifies the error message in cases where there are no useful
    equalities in the context


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

394ca3be64d101e30fb4f47de88afd3d55615309
 compiler/typecheck/TcErrors.lhs | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 9a6b31f..0596e0c 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -424,14 +424,15 @@ mkErrorMsg ctxt ct msg
        ; err_info <- mkErrInfo (cec_tidy ctxt) (tcl_ctxt tcl_env)
        ; mkLongErrAt (tcl_loc tcl_env) msg err_info }
 
-type UserGiven = ([EvVar], SkolemInfo, SrcSpan)
+type UserGiven = ([EvVar], SkolemInfo, Bool, SrcSpan)
 
 getUserGivens :: ReportErrCtxt -> [UserGiven]
 -- One item for each enclosing implication
 getUserGivens (CEC {cec_encl = ctxt})
   = reverse $
-    [ (givens, info, tcl_loc env)
-    | Implic {ic_given = givens, ic_env = env, ic_info = info } <- ctxt
+    [ (givens, info, no_eqs, tcl_loc env)
+    | Implic { ic_given = givens, ic_env = env
+             , ic_no_eqs = no_eqs, ic_info = info } <- ctxt
     , not (null givens) ]
 \end{code}
 
@@ -795,7 +796,8 @@ misMatchOrCND ctxt ct oriented ty1 ty2
   | otherwise
   = couldNotDeduce givens ([mkTcEqPred ty1 ty2], orig)
   where
-    givens = getUserGivens ctxt
+    givens = [ given | given@(_, _, no_eqs, _) <- getUserGivens ctxt, not no_eqs]
+             -- Keep only UserGivens that have some equalities
     orig   = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2 }
 
 couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> SDoc
@@ -810,7 +812,7 @@ pp_givens givens
          (g:gs) ->      ppr_given (ptext (sLit "from the context")) g
                  : map (ppr_given (ptext (sLit "or from"))) gs
     where
-       ppr_given herald (gs, skol_info, loc)
+       ppr_given herald (gs, skol_info, _, loc)
            = hang (herald <+> pprEvVarTheta gs)
                 2 (sep [ ptext (sLit "bound by") <+> ppr skol_info
                        , ptext (sLit "at") <+> ppr loc])
@@ -1135,7 +1137,7 @@ mk_dict_err fam_envs ctxt (ct, (matches, unifiers, safe_haskell))
             givens = getUserGivens ctxt
             matching_givens = mapMaybe matchable givens
 
-            matchable (evvars,skol_info,loc)
+            matchable (evvars,skol_info,_,loc)
               = case ev_vars_matching of
                      [] -> Nothing
                      _  -> Just $ hang (pprTheta ev_vars_matching)