Tidy up tidySkolemInfo

Previously tidySkolemInfo used tidyOpenType, and returned a new
TidyEnv.  But that's not needed any more, because all the skolems
should be in scope in the constraint tree.

I also removed a (now-unnecessary) field of UnifyForAllSkol

6 files changed, 26 insertions, 40 deletions

diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index cebb6737ff..522089fb55 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -298,11 +298,11 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given
   where
     insoluble    = isInsolubleStatus status
     (env1, tvs') = mapAccumL tidyTyCoVarBndr (cec_tidy ctxt) tvs
-    (env2, info') = tidySkolemInfo env1 info
+    info'        = tidySkolemInfo env1 info
     implic' = implic { ic_skols = tvs'
-                     , ic_given = map (tidyEvVar env2) given
+                     , ic_given = map (tidyEvVar env1) given
                      , ic_info  = info' }
-    ctxt' = ctxt { cec_tidy     = env2
+    ctxt' = ctxt { cec_tidy     = env1
                  , cec_encl     = implic' : cec_encl ctxt
                  , cec_suppress = insoluble  -- Suppress inessential errors if there
                                              -- are are insolubles anywhere in the
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index cacaab23d8..ae8923d6e6 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -1207,8 +1207,8 @@ mkTypeErrorThingArgs ty num_args
 zonkTidyOrigin :: TidyEnv -> CtOrigin -> TcM (TidyEnv, CtOrigin)
 zonkTidyOrigin env (GivenOrigin skol_info)
   = do { skol_info1 <- zonkSkolemInfo skol_info
-       ; let (env1, skol_info2) = tidySkolemInfo env skol_info1
-       ; return (env1, GivenOrigin skol_info2) }
+       ; let skol_info2 = tidySkolemInfo env skol_info1
+       ; return (env, GivenOrigin skol_info2) }
 zonkTidyOrigin env orig@(TypeEqOrigin { uo_actual   = act
                                       , uo_expected = exp
                                       , uo_thing    = m_thing })
@@ -1267,25 +1267,9 @@ tidyEvVar :: TidyEnv -> EvVar -> EvVar
 tidyEvVar env var = setVarType var (tidyType env (varType var))
 
 ----------------
-tidySkolemInfo :: TidyEnv -> SkolemInfo -> (TidyEnv, SkolemInfo)
-tidySkolemInfo env (SigSkol cx ty)
-  = (env', SigSkol cx ty')
-  where
-    (env', ty') = tidyOpenType env ty
-
-tidySkolemInfo env (InferSkol ids)
-  = (env', InferSkol ids')
-  where
-    (env', ids') = mapAccumL do_one env ids
-    do_one env (name, ty) = (env', (name, ty'))
-       where
-         (env', ty') = tidyOpenType env ty
-
-tidySkolemInfo env (UnifyForAllSkol skol_tvs ty)
-  = (env1, UnifyForAllSkol skol_tvs' ty')
-  where
-    env1 = tidyFreeTyCoVars env (tyCoVarsOfType ty `delVarSetList` skol_tvs)
-    (env2, skol_tvs') = tidyTyCoVarBndrs env1 skol_tvs
-    ty'               = tidyType env2 ty
-
-tidySkolemInfo env info = (env, info)
+tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo
+tidySkolemInfo env (DerivSkol ty)       = DerivSkol (tidyType env ty)
+tidySkolemInfo env (SigSkol cx ty)      = SigSkol cx (tidyType env ty)
+tidySkolemInfo env (InferSkol ids)      = InferSkol (mapSnd (tidyType env) ids)
+tidySkolemInfo env (UnifyForAllSkol ty) = UnifyForAllSkol (tidyType env ty)
+tidySkolemInfo _   info                 = info
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 457e6f8426..d15e5bb9b4 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -2513,7 +2513,6 @@ data SkolemInfo
   | BracketSkol         -- Template Haskell bracket
 
   | UnifyForAllSkol     -- We are unifying two for-all types
-       [TcTyVar]        -- The instantiated skolem variables
        TcType           -- The instantiated type *inside* the forall
 
   | UnkSkol             -- Unhelpful info (until I improve it)
@@ -2539,7 +2538,7 @@ pprSkolInfo (PatSkol cl mc)   = sep [ pprPatSkolInfo cl
 pprSkolInfo (InferSkol ids)   = sep [ ptext (sLit "the inferred type of")
                                     , vcat [ ppr name <+> dcolon <+> ppr ty
                                            | (name,ty) <- ids ]]
-pprSkolInfo (UnifyForAllSkol tvs ty) = ptext (sLit "the type") <+> ppr (mkInvForAllTys tvs ty)
+pprSkolInfo (UnifyForAllSkol ty) = ptext (sLit "the type") <+> ppr ty
 
 -- UnkSkol
 -- For type variables the others are dealt with by pprSkolTvBinding.
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index c508bb1e08..697f3f9032 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -1513,10 +1513,12 @@ addInertSafehask _ item
   = pprPanic "addInertSafehask: can't happen! Inserting " $ ppr item
 
 insertSafeOverlapFailureTcS :: Ct -> TcS ()
+-- See Note [Safe Haskell Overlapping Instances Implementation] in TcSimplify
 insertSafeOverlapFailureTcS item
   = updInertCans (\ics -> addInertSafehask ics item)
 
 getSafeOverlapFailures :: TcS Cts
+-- See Note [Safe Haskell Overlapping Instances Implementation] in TcSimplify
 getSafeOverlapFailures
  = do { IC { inert_safehask = safehask } <- getInertCans
       ; return $ foldDicts consCts safehask emptyCts }
@@ -3027,7 +3029,7 @@ deferTcSForAllEq role loc kind_cos (bndrs1,body1) (bndrs2,body2)
       ; (subst, skol_tvs) <- wrapTcS $ TcM.tcInstSkolTyVars tvs1
       ; let phi1  = Type.substTy subst body1
             phi2  = Type.substTy subst body2'
-            skol_info = UnifyForAllSkol skol_tvs phi1
+            skol_info = UnifyForAllSkol phi1
 
       ; (ctev, hole_co) <- newWantedEq loc role phi1 phi2
       ; env <- getLclEnv
diff --git a/testsuite/tests/deriving/should_fail/T7148a.stderr b/testsuite/tests/deriving/should_fail/T7148a.stderr
index 8dd23aa034..9a6ea41d96 100644
--- a/testsuite/tests/deriving/should_fail/T7148a.stderr
+++ b/testsuite/tests/deriving/should_fail/T7148a.stderr
@@ -1,10 +1,11 @@
 
 T7148a.hs:19:50: error:
-    Couldn't match representation of type ‘b’ with that of ‘Result a b’
-      arising from the coercion of the method ‘coerce’
-        from type ‘forall b. Proxy b -> a -> Result a b’
-          to type ‘forall b.
-                   Proxy b -> IS_NO_LONGER a -> Result (IS_NO_LONGER a) b’
-    ‘b’ is a rigid type variable bound by
-        the type forall b1. Proxy b1 -> a -> Result a b1 at T7148a.hs:19:50
-    When deriving the instance for (Convert (IS_NO_LONGER a))
+    • Couldn't match representation of type ‘b’
+                               with that of ‘Result a b’
+        arising from the coercion of the method ‘coerce’
+          from type ‘forall b. Proxy b -> a -> Result a b’
+            to type ‘forall b.
+                     Proxy b -> IS_NO_LONGER a -> Result (IS_NO_LONGER a) b’
+      ‘b’ is a rigid type variable bound by
+        the type Proxy b -> a -> Result a b at T7148a.hs:19:50
+    • When deriving the instance for (Convert (IS_NO_LONGER a))
diff --git a/testsuite/tests/typecheck/should_fail/tcfail174.stderr b/testsuite/tests/typecheck/should_fail/tcfail174.stderr
index e7ad3ca813..9c473e9884 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail174.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail174.stderr
@@ -3,7 +3,7 @@ tcfail174.hs:14:14: error:
     • Couldn't match type ‘a’ with ‘a1’
         because type variable ‘a1’ would escape its scope
       This (rigid, skolem) type variable is bound by
-        the type forall a2. a2 -> a2
+        the type a1 -> a1
         at tcfail174.hs:14:1-14
       Expected type: Capture (forall x. x -> a)
         Actual type: Capture (forall a. a -> a)
@@ -16,7 +16,7 @@ tcfail174.hs:14:14: error:
 tcfail174.hs:17:14: error:
     • Couldn't match type ‘a’ with ‘b’
       ‘a’ is a rigid type variable bound by
-        the type forall a1. a1 -> a1 at tcfail174.hs:1:1
+        the type a -> a at tcfail174.hs:1:1
       ‘b’ is a rigid type variable bound by
         the type signature for:
           h2 :: forall b. Capture b