Only report "could not deduce s~t from ..." for givens that include equalities
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 29 Oct 2014 17:49:34 +0000 (17:49 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 4 Nov 2014 10:38:00 +0000 (10:38 +0000)
This just simplifies the error message in cases where there are no useful
equalities in the context

compiler/typecheck/TcErrors.lhs

index 9a6b31f..0596e0c 100644 (file)
@@ -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)