diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2014-10-29 17:49:34 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2014-10-31 09:08:50 +0000 |
| commit | 394ca3be64d101e30fb4f47de88afd3d55615309 (patch) | |
| tree | 522f4934f5a6f01e1e7725f4659f8bdf238f04de | |
| parent | 69cdebf66ea6f062d7b0906f3d60d6dc54b9b48a (diff) | |
| download | haskell-394ca3be64d101e30fb4f47de88afd3d55615309.tar.gz | |
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
| -rw-r--r-- | compiler/typecheck/TcErrors.lhs | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index 9a6b31fdf8..0596e0c4e6 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) |