-setCtFlavorLoc (Wanted loc) thing = setCtLoc loc thing
-setCtFlavorLoc (Derived loc) thing = setCtLoc loc thing
-setCtFlavorLoc (Given loc) thing = setCtLoc loc thing
-
-getEqExtra :: TidyEnv -> CtFlavor -> TcType -> TcType -> TcM (TidyEnv, SDoc)
-getEqExtra env (Wanted loc) ty1 ty2 = getWantedEqExtra env (ctLocOrigin loc) ty1 ty2
-getEqExtra env (Derived loc) ty1 ty2 = getWantedEqExtra env (ctLocOrigin loc) ty1 ty2
-getEqExtra env (Given _) _ _ = return (env, empty)
- -- We could print more info, but it seems to be already coming out
-
-getWantedEqExtra :: TidyEnv -> CtOrigin -> TcType -> TcType -> TcM (TidyEnv, SDoc)
-getWantedEqExtra env0 (TypeEqOrigin item) ty1 ty2
+setCtFlavorLoc (Wanted loc) thing = setCtLoc loc thing
+setCtFlavorLoc (Derived loc _) thing = setCtLoc loc thing
+setCtFlavorLoc (Given loc) thing = setCtLoc loc thing
+
+wrapEqErrTcS :: CtFlavor -> TcType -> TcType
+ -> (TidyEnv -> TcType -> TcType -> SDoc -> TcM a)
+ -> TcS a
+wrapEqErrTcS fl ty1 ty2 thing_inside
+ = do { ty_binds_var <- getTcSTyBinds
+ ; wrapErrTcS $ setCtFlavorLoc fl $
+ do { -- Apply the current substitition
+ -- and zonk to get rid of flatten-skolems
+ ; ty_binds_map <- readTcRef ty_binds_var
+ ; let subst = mkOpenTvSubst (mapVarEnv snd ty_binds_map)
+ ; env0 <- tcInitTidyEnv
+ ; (env1, ty1) <- zonkSubstTidy env0 subst ty1
+ ; (env2, ty2) <- zonkSubstTidy env1 subst ty2
+ ; let do_wanted loc = do { (env3, extra) <- getWantedEqExtra subst env2
+ (ctLocOrigin loc) ty1 ty2
+ ; thing_inside env3 ty1 ty2 extra }
+ ; case fl of
+ Wanted loc -> do_wanted loc
+ Derived loc _ -> do_wanted loc
+ Given {} -> thing_inside env2 ty1 ty2 empty
+ -- We could print more info, but it
+ -- seems to be coming out already
+ } }
+ where
+
+getWantedEqExtra :: TvSubst -> TidyEnv -> CtOrigin -> TcType -> TcType
+ -> TcM (TidyEnv, SDoc)
+getWantedEqExtra subst env0 (TypeEqOrigin item) ty1 ty2