Be more careful when naming TyCon binders

This patch fixes two rather gnarly test cases:
  * Trac #16342 (mutual recursion)
    See Note [Tricky scoping in generaliseTcTyCon]

  * Trac #16221 (shadowing)
    See Note [Unification variables need fresh Names]

The main changes are:

* Substantial reworking of TcTyClsDecls.generaliseTcTyCon
  This is the big change, and involves the rather tricky
  function TcHsSyn.zonkRecTyVarBndrs.

  See Note [Inferring kinds for type declarations] and
  Note [Tricky scoping in generaliseTcTyCon] for the details.

* bindExplicitTKBndrs_Tv and bindImplicitTKBndrs_Tv both now
  allocate /freshly-named/ unification variables. Indeed, more
  generally, unification variables are always fresh; see
  Note [Unification variables need fresh Names] in TcMType

* Clarify the role of tcTyConScopedTyVars.
  See Note [Scoped tyvars in a TcTyCon] in TyCon

As usual, this dragged in some more refactoring:

* Renamed TcMType.zonkTyCoVarBndr to zonkAndSkolemise

* I renamed checkValidTelescope to checkTyConTelescope;
  it's only used on TyCons, and indeed takes a TyCon as argument.

* I folded the slightly-mysterious reportFloatingKvs into
  checkTyConTelescope. (Previously all its calls immediately
  followed a call to checkTyConTelescope.)  It makes much more
  sense there.

* I inlined some called-once functions to simplify
  checkValidTyFamEqn. It's less spaghetti-like now.

* This patch also fixes Trac #16251.  I'm not quite sure why #16251
  went wrong in the first place, nor how this patch fixes it, but
  hey, it's good, and life is short.

1 files changed, 41 insertions, 15 deletions

diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index 8b815bb0e7..7755daf44b 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -34,7 +34,7 @@ module TcHsSyn (
         zonkTopBndrs,
         ZonkEnv, ZonkFlexi(..), emptyZonkEnv, mkEmptyZonkEnv, initZonkEnv,
         zonkTyVarBinders, zonkTyVarBindersX, zonkTyVarBinderX,
-        zonkTyBndrs, zonkTyBndrsX,
+        zonkTyBndrs, zonkTyBndrsX, zonkRecTyVarBndrs,
         zonkTcTypeToType,  zonkTcTypeToTypeX,
         zonkTcTypesToTypes, zonkTcTypesToTypesX,
         zonkTyVarOcc,
@@ -278,7 +278,11 @@ data ZonkFlexi   -- See Note [Un-unified unification variables]
   | RuntimeUnkFlexi -- Used in the GHCi debugger
 
 instance Outputable ZonkEnv where
-  ppr (ZonkEnv { ze_id_env =  var_env}) = pprUFM var_env (vcat . map ppr)
+  ppr (ZonkEnv { ze_tv_env = tv_env
+               , ze_id_env = id_env })
+    = text "ZE" <+> braces (vcat
+         [ text "ze_tv_env =" <+> ppr tv_env
+         , text "ze_id_env =" <+> ppr id_env ])
 
 -- The EvBinds have to already be zonked, but that's usually the case.
 emptyZonkEnv :: TcM ZonkEnv
@@ -292,9 +296,9 @@ mkEmptyZonkEnv flexi
                          , ze_id_env = emptyVarEnv
                          , ze_meta_tv_env = mtv_env_ref }) }
 
-initZonkEnv :: (ZonkEnv -> a -> TcM b) -> a -> TcM b
-initZonkEnv do_it x = do { ze <- mkEmptyZonkEnv DefaultFlexi
-                         ; do_it ze x }
+initZonkEnv :: (ZonkEnv -> TcM b) -> TcM b
+initZonkEnv thing_inside = do { ze <- mkEmptyZonkEnv DefaultFlexi
+                              ; thing_inside ze }
 
 -- | Extend the knot-tied environment.
 extendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv
@@ -324,6 +328,12 @@ extendTyZonkEnv1 :: ZonkEnv -> TyVar -> ZonkEnv
 extendTyZonkEnv1 ze@(ZonkEnv { ze_tv_env = ty_env }) tv
   = ze { ze_tv_env = extendVarEnv ty_env tv tv }
 
+extendTyZonkEnvN :: ZonkEnv -> [(Name,TyVar)] -> ZonkEnv
+extendTyZonkEnvN ze@(ZonkEnv { ze_tv_env = ty_env }) pairs
+  = ze { ze_tv_env = foldl add ty_env pairs }
+  where
+    add env (name, tv) = extendVarEnv_Directly env (getUnique name) tv
+
 setZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv
 setZonkType ze flexi = ze { ze_flexi = flexi }
 
@@ -374,7 +384,7 @@ zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
 zonkIdBndrs env ids = mapM (zonkIdBndr env) ids
 
 zonkTopBndrs :: [TcId] -> TcM [Id]
-zonkTopBndrs ids = initZonkEnv zonkIdBndrs ids
+zonkTopBndrs ids = initZonkEnv $ \ ze -> zonkIdBndrs ze ids
 
 zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTcId -> TcM (FieldOcc GhcTc)
 zonkFieldOcc env (FieldOcc sel lbl)
@@ -419,7 +429,7 @@ zonkCoreBndrsX :: ZonkEnv -> [Var] -> TcM (ZonkEnv, [Var])
 zonkCoreBndrsX = mapAccumLM zonkCoreBndrX
 
 zonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TyVar])
-zonkTyBndrs = initZonkEnv zonkTyBndrsX
+zonkTyBndrs tvs = initZonkEnv $ \ze -> zonkTyBndrsX ze tvs
 
 zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
 zonkTyBndrsX = mapAccumLM zonkTyBndrX
@@ -436,7 +446,7 @@ zonkTyBndrX env tv
 
 zonkTyVarBinders ::  [VarBndr TcTyVar vis]
                  -> TcM (ZonkEnv, [VarBndr TyVar vis])
-zonkTyVarBinders = initZonkEnv zonkTyVarBindersX
+zonkTyVarBinders tvbs = initZonkEnv $ \ ze -> zonkTyVarBindersX ze tvbs
 
 zonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis]
                              -> TcM (ZonkEnv, [VarBndr TyVar vis])
@@ -449,11 +459,27 @@ zonkTyVarBinderX env (Bndr tv vis)
   = do { (env', tv') <- zonkTyBndrX env tv
        ; return (env', Bndr tv' vis) }
 
+zonkRecTyVarBndrs :: [Name] -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
+-- This rather specialised function is used in exactly one place.
+-- See Note [Tricky scoping in generaliseTcTyCon] in TcTyClsDecls.
+zonkRecTyVarBndrs names tc_tvs
+  = initZonkEnv $ \ ze ->
+    fixM $ \ ~(_, rec_new_tvs) ->
+    do { let ze' = extendTyZonkEnvN ze $
+                   zipWithLazy (\ tc_tv new_tv -> (getName tc_tv, new_tv))
+                               tc_tvs rec_new_tvs
+       ; new_tvs <- zipWithM (zonk_one ze') names tc_tvs
+       ; return (ze', new_tvs) }
+  where
+    zonk_one ze name tc_tv
+      = do { ki <- zonkTcTypeToTypeX ze (tyVarKind tc_tv)
+           ; return (mkTyVar name ki) }
+
 zonkTopExpr :: HsExpr GhcTcId -> TcM (HsExpr GhcTc)
-zonkTopExpr e = initZonkEnv zonkExpr e
+zonkTopExpr e = initZonkEnv $ \ ze -> zonkExpr ze e
 
 zonkTopLExpr :: LHsExpr GhcTcId -> TcM (LHsExpr GhcTc)
-zonkTopLExpr e = initZonkEnv zonkLExpr e
+zonkTopLExpr e = initZonkEnv $ \ ze -> zonkLExpr ze e
 
 zonkTopDecls :: Bag EvBind
              -> LHsBinds GhcTcId
@@ -466,7 +492,7 @@ zonkTopDecls :: Bag EvBind
                      [LTcSpecPrag],
                      [LRuleDecl    GhcTc])
 zonkTopDecls ev_binds binds rules imp_specs fords
-  = do  { (env1, ev_binds') <- initZonkEnv zonkEvBinds ev_binds
+  = do  { (env1, ev_binds') <- initZonkEnv $ \ ze -> zonkEvBinds ze ev_binds
         ; (env2, binds')    <- zonkRecMonoBinds env1 binds
                         -- Top level is implicitly recursive
         ; rules' <- zonkRules env2 rules
@@ -1744,9 +1770,9 @@ Solution: (see Trac #15552 for other variants)
 
     * The map is of course stateful, held in a TcRef. (That is unlike
       the treatment of lexically-scoped variables in ze_tv_env and
-      ze_id_env.
+      ze_id_env.)
 
-    Is the extra work worth it.  Some non-sytematic perf measurements
+    Is the extra work worth it?  Some non-sytematic perf measurements
     suggest that compiler allocation is reduced overall (by 0.5% or so)
     but compile time really doesn't change.
 -}
@@ -1865,13 +1891,13 @@ zonkTcTyConToTyCon tc
 
 -- Confused by zonking? See Note [What is zonking?] in TcMType.
 zonkTcTypeToType :: TcType -> TcM Type
-zonkTcTypeToType = initZonkEnv zonkTcTypeToTypeX
+zonkTcTypeToType ty = initZonkEnv $ \ ze -> zonkTcTypeToTypeX ze ty
 
 zonkTcTypeToTypeX :: ZonkEnv -> TcType -> TcM Type
 zonkTcTypeToTypeX = mapType zonk_tycomapper
 
 zonkTcTypesToTypes :: [TcType] -> TcM [Type]
-zonkTcTypesToTypes = initZonkEnv zonkTcTypesToTypesX
+zonkTcTypesToTypes tys = initZonkEnv $ \ ze -> zonkTcTypesToTypesX ze tys
 
 zonkTcTypesToTypesX :: ZonkEnv -> [TcType] -> TcM [Type]
 zonkTcTypesToTypesX env tys = mapM (zonkTcTypeToTypeX env) tys