diff options
Diffstat (limited to 'compiler/GHC/Tc/TyCl/PatSyn.hs')
| -rw-r--r-- | compiler/GHC/Tc/TyCl/PatSyn.hs | 9 |
1 files changed, 6 insertions, 3 deletions
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs index 5f511d539c..c470258e43 100644 --- a/compiler/GHC/Tc/TyCl/PatSyn.hs +++ b/compiler/GHC/Tc/TyCl/PatSyn.hs @@ -25,12 +25,14 @@ import GHC.Tc.Gen.Pat import GHC.Core.Multiplicity import GHC.Core.Type ( tidyTyCoVarBinders, tidyTypes, tidyType ) import GHC.Core.TyCo.Subst( extendTvSubstWithClone ) +import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad import GHC.Tc.Gen.Sig ( TcPragEnv, emptyPragEnv, completeSigFromId, lookupPragEnv, addInlinePrags ) import GHC.Tc.Utils.Env import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.Zonk import GHC.Builtin.Types.Prim +import GHC.Types.Error import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.SrcLoc @@ -226,6 +228,7 @@ dependentArgErr :: (Id, DTyCoVarSet) -> TcM () -- See Note [Coercions that escape] dependentArgErr (arg, bad_cos) = failWithTc $ -- fail here: otherwise we get downstream errors + TcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" , hang (text "Pattern-bound variable") 2 (ppr arg <+> dcolon <+> ppr (idType arg)) @@ -370,7 +373,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details -- The existential 'x' should not appear in the result type -- Can't check this until we know P's arity (decl_arity above) ; let bad_tvs = filter (`elemVarSet` tyCoVarsOfType pat_ty) $ binderVars explicit_ex_bndrs - ; checkTc (null bad_tvs) $ + ; checkTc (null bad_tvs) $ TcRnUnknownMessage $ mkPlainError noHints $ hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma , text "namely" <+> quotes (ppr pat_ty) ]) 2 (text "mentions existential type variable" <> plural bad_tvs @@ -645,7 +648,7 @@ addPatSynCtxt (L loc name) thing_inside wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a wrongNumberOfParmsErr name decl_arity missing - = failWithTc $ + = failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $ hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" <+> speakNOf decl_arity (text "argument")) 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") @@ -878,7 +881,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) = return emptyBag | Left why <- mb_match_group -- Can't invert the pattern - = setSrcSpan (getLocA lpat) $ failWithTc $ + = setSrcSpan (getLocA lpat) $ failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $ vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" <+> quotes (ppr ps_name) <> colon) 2 why |