-kindErrorTcS :: CtFlavor -> TcType -> TcType -> TcS ()
--- If there's a kind error, we don't want to blindly say "kind error"
--- We might, say, be unifying a skolem 'a' with a type 'Int',
--- in which case that's the error to report. So we set things
--- up to call reportEqErr, which does the business properly
-kindErrorTcS fl ty1 ty2
- = wrapErrTcS $
- setCtFlavorLoc fl $
- do { env0 <- tcInitTidyEnv
- ; (env1, extra) <- getEqExtra env0 fl ty1 ty2
- ; let (env2, ty1') = tidyOpenType env1 ty1
- (env3, ty2') = tidyOpenType env2 ty2
- ctxt = CEC { cec_encl = []
- , cec_extra = extra
- , cec_tidy = env3 }
- ; reportEqErr ctxt ty1' ty2' }
-
-misMatchErrorTcS :: CtFlavor -> TcType -> TcType -> TcS a
-misMatchErrorTcS fl ty1 ty2
- = wrapErrTcS $
- setCtFlavorLoc fl $
- do { env0 <- tcInitTidyEnv
- ; let (env1, ty1') = tidyOpenType env0 ty1
- (env2, ty2') = tidyOpenType env1 ty2
- (env3, msg) = misMatchMsgWithExtras env2 ty1' ty2'
- ; (env4, extra) <- getEqExtra env3 fl ty1 ty2
- ; failWithTcM (env4, inaccessible_msg $$ msg $$ extra) }
- where
- inaccessible_msg
- = case fl of
- Given loc -> hang (ptext (sLit "Inaccessible code in"))
- 2 (mk_what loc)
- _ -> empty
- mk_what loc
- = case ctLocOrigin loc of
- PatSkol dc mc -> sep [ ptext (sLit "a pattern with constructor")
- <+> quotes (ppr dc) <> comma
- , ptext (sLit "in") <+> pprMatchContext mc ]
- other_skol -> pprSkolInfo other_skol
-
-occursCheckErrorTcS :: CtFlavor -> TcTyVar -> TcType -> TcS a
-occursCheckErrorTcS fl tv ty
- = wrapErrTcS $
- setCtFlavorLoc fl $
- do { env0 <- tcInitTidyEnv
- ; let (env1, tv') = tidyOpenTyVar env0 tv
- (env2, ty') = tidyOpenType env1 ty
- extra1 = sep [ppr tv', char '=', ppr ty']
- ; (env3, extra2) <- getEqExtra env2 fl (mkTyVarTy tv) ty
- ; failWithTcM (env3, hang msg 2 (extra1 $$ extra2)) }
- where
- msg = text $ "Occurs check: cannot construct the infinite type:"
-