summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc/Errors.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Tc/Errors.hs')
-rw-r--r--compiler/GHC/Tc/Errors.hs72
1 files changed, 44 insertions, 28 deletions
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index d597c95b72..93c047ca32 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -69,7 +69,7 @@ import GHC.Utils.FV ( fvVarList, unionFV )
import Control.Monad ( when )
import Data.Foldable ( toList )
-import Data.List ( partition, mapAccumL, nub, sortBy, unfoldr )
+import Data.List ( partition, mapAccumL, sortBy, unfoldr )
import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits )
@@ -215,7 +215,13 @@ report_unsolved type_errors expr_holes
-- If we are deferring we are going to need /all/ evidence around,
-- including the evidence produced by unflattening (zonkWC)
; let tidy_env = tidyFreeTyCoVars emptyTidyEnv free_tvs
- free_tvs = tyCoVarsOfWCList wanted
+ free_tvs = filterOut isCoVar $
+ tyCoVarsOfWCList wanted
+ -- tyCoVarsOfWC returns free coercion *holes*, even though
+ -- they are "bound" by other wanted constraints. They in
+ -- turn may mention variables bound further in, which makes
+ -- no sense. Really we should not return those holes at all;
+ -- for now we just filter them out.
; traceTc "reportUnsolved (after zonking):" $
vcat [ text "Free tyvars:" <+> pprTyVars free_tvs
@@ -832,7 +838,11 @@ eq_lhs_type ct1 ct2
_ -> pprPanic "mkSkolReporter" (ppr ct1 $$ ppr ct2)
cmp_loc :: Ct -> Ct -> Ordering
-cmp_loc ct1 ct2 = ctLocSpan (ctLoc ct1) `compare` ctLocSpan (ctLoc ct2)
+cmp_loc ct1 ct2 = get ct1 `compare` get ct2
+ where
+ get ct = realSrcSpanStart (ctLocSpan (ctLoc ct))
+ -- Reduce duplication by reporting only one error from each
+ -- /starting/ location even if the end location differs
reportGroup :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg) -> Reporter
reportGroup mk_err ctxt cts =
@@ -1451,14 +1461,15 @@ mkTyVarEqErr dflags ctxt report ct tv1 ty2
; mkTyVarEqErr' dflags ctxt report ct tv1 ty2 }
mkTyVarEqErr' dflags ctxt report ct tv1 ty2
- | isUserSkolem ctxt tv1 -- ty2 won't be a meta-tyvar; we would have
- -- swapped in Solver.Canonical.canEqTyVarHomo
+ | isSkolemTyVar tv1 -- ty2 won't be a meta-tyvar; we would have
+ -- swapped in Solver.Canonical.canEqTyVarHomo
|| isTyVarTyVar tv1 && not (isTyVarTy ty2)
|| ctEqRel ct == ReprEq
-- The cases below don't really apply to ReprEq (except occurs check)
= mkErrorMsgFromCt ctxt ct $ mconcat
[ headline_msg
, extraTyVarEqInfo ctxt tv1 ty2
+ , suggestAddSig ctxt ty1 ty2
, report
]
@@ -1594,17 +1605,6 @@ mkEqInfoMsg ct ty1 ty2
<+> text "is a non-injective type family"
| otherwise = empty
-isUserSkolem :: ReportErrCtxt -> TcTyVar -> Bool
--- See Note [Reporting occurs-check errors]
-isUserSkolem ctxt tv
- = isSkolemTyVar tv && any is_user_skol_tv (cec_encl ctxt)
- where
- is_user_skol_tv (Implic { ic_skols = sks, ic_info = skol_info })
- = tv `elem` sks && is_user_skol_info skol_info
-
- is_user_skol_info (InferSkol {}) = False
- is_user_skol_info _ = True
-
misMatchOrCND :: Bool -> ReportErrCtxt -> Ct
-> TcType -> TcType -> Report
-- If oriented then ty1 is actual, ty2 is expected
@@ -1724,21 +1724,29 @@ extraTyVarInfo ctxt tv
suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> Report
-- See Note [Suggest adding a type signature]
-suggestAddSig ctxt ty1 ty2
- | null inferred_bndrs
+suggestAddSig ctxt ty1 _ty2
+ | null inferred_bndrs -- No let-bound inferred binders in context
= mempty
| [bndr] <- inferred_bndrs
= important $ text "Possible fix: add a type signature for" <+> quotes (ppr bndr)
| otherwise
= important $ text "Possible fix: add type signatures for some or all of" <+> (ppr inferred_bndrs)
where
- inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2)
- get_inf ty | Just tv <- tcGetTyVar_maybe ty
- , isSkolemTyVar tv
- , ((InferSkol prs, _) : _) <- getSkolemInfo (cec_encl ctxt) [tv]
- = map fst prs
- | otherwise
- = []
+ inferred_bndrs = case tcGetTyVar_maybe ty1 of
+ Just tv | isSkolemTyVar tv -> find (cec_encl ctxt) False tv
+ _ -> []
+
+ -- 'find' returns the binders of an InferSkol for 'tv',
+ -- provided there is an intervening implication with
+ -- ic_no_eqs = False (i.e. a GADT match)
+ find [] _ _ = []
+ find (implic:implics) seen_eqs tv
+ | tv `elem` ic_skols implic
+ , InferSkol prs <- ic_info implic
+ , seen_eqs
+ = map fst prs
+ | otherwise
+ = find implics (seen_eqs || not (ic_no_eqs implic)) tv
--------------------
misMatchMsg :: ReportErrCtxt -> Ct -> TcType -> TcType -> Report
@@ -2183,9 +2191,8 @@ sameOccExtra ty1 ty2
mod = nameModule nm
loc = nameSrcSpan nm
-{-
-Note [Suggest adding a type signature]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Suggest adding a type signature]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The OutsideIn algorithm rejects GADT programs that don't have a principal
type, and indeed some that do. Example:
data T a where
@@ -2199,6 +2206,15 @@ untouchable type variable. So suggestAddSig sees if the offending
type variable is bound by an *inferred* signature, and suggests
adding a declared signature instead.
+More specifically, we suggest adding a type sig if we have p ~ ty, and
+p is a skolem bound by an InferSkol. Those skolems were created from
+unification variables in simplifyInfer. Why didn't we unify? It must
+have been because of an intervening GADT or existential, making it
+untouchable. Either way, a type signature would help. For GADTs, it
+might make it typeable; for existentials the attempt to write a
+signature will fail -- or at least will produce a better error message
+next time
+
This initially came up in #8968, concerning pattern synonyms.
Note [Disambiguating (X ~ X) errors]