Refactor to eliminate FamTyConShape

Consider this note (TcTyClsDecls)

  Note [Type-checking type patterns]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  When typechecking the patterns of a family instance declaration, we can't
  rely on using the family TyCon itself, because this is sometimes called
  from within a type-checking knot. (Specifically for closed type families.)
  The FamTyConShape gives just enough information to do the job.

I realised that this exact purpose can be served by TcTyCons, and
in fact rather better.  So this patch

* Refactors FamTyConShape out of existence, replacing it with TcTyCOn

* I also got rid Type.filterOutInvisibleTyVars, which was a very
  complex way to do something quite simple.  I replaced the calls
  with TyCon.tyConVisibleTyVars.

No change in behaviour.

6 files changed, 78 insertions, 105 deletions

diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index e5a747619b..179688f64b 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -612,7 +612,7 @@ tcTyFamInstDecl mb_clsinfo (L loc decl@(TyFamInstDecl { tfid_eqn = eqn }))
        ; checkTc (isOpenTypeFamilyTyCon fam_tc) (notOpenFamily fam_tc)
 
          -- (1) do the work of verifying the synonym group
-       ; co_ax_branch <- tcTyFamInstEqn (famTyConShape fam_tc) mb_clsinfo
+       ; co_ax_branch <- tcTyFamInstEqn fam_tc mb_clsinfo
                                         (L (getLoc fam_lname) eqn)
 
          -- (2) check for validity
@@ -648,7 +648,7 @@ tcDataFamInstDecl mb_clsinfo
 
          -- Kind check type patterns
        ; let mb_kind_env = thdOf3 <$> mb_clsinfo
-       ; tcFamTyPats (famTyConShape fam_tc) mb_clsinfo tv_names pats
+       ; tcFamTyPats fam_tc mb_clsinfo tv_names pats
                      (kcDataDefn mb_kind_env decl) $
              \tvs pats res_kind ->
     do { stupid_theta <- solveEqualities $ tcHsContext ctxt
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index f0236b826a..683b1865a2 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -1357,7 +1357,7 @@ reifyAxBranch fam_tc (CoAxBranch { cab_lhs = lhs, cab_rhs = rhs })
        ; rhs'  <- reifyType rhs
        ; return (TH.TySynEqn annot_th_lhs rhs') }
   where
-    fam_tvs = filterOutInvisibleTyVars fam_tc (tyConTyVars fam_tc)
+    fam_tvs = tyConVisibleTyVars fam_tc
 
 reifyTyCon :: TyCon -> TcM TH.Info
 reifyTyCon tc
@@ -1391,7 +1391,7 @@ reifyTyCon tc
                                      injRHS = map (reifyName . tyVarName)
                                                   (filterByList ms tvs)
                      in (sig, inj)
-       ; tvs' <- reifyTyVars tvs (Just tc)
+       ; tvs' <- reifyTyVars (tyConVisibleTyVars tc)
        ; let tfHead =
                TH.TypeFamilyHead (reifyName tc) tvs' resultSig injectivity
        ; if isOpenTypeFamilyTyCon tc
@@ -1408,20 +1408,19 @@ reifyTyCon tc
                       []) } }
 
   | isDataFamilyTyCon tc
-  = do { let tvs      = tyConTyVars tc
-             res_kind = tyConResKind tc
+  = do { let res_kind = tyConResKind tc
 
        ; kind' <- fmap Just (reifyKind res_kind)
 
-       ; tvs' <- reifyTyVars tvs (Just tc)
+       ; tvs' <- reifyTyVars (tyConVisibleTyVars tc)
        ; fam_envs <- tcGetFamInstEnvs
        ; instances <- reifyFamilyInstances tc (familyInstances fam_envs tc)
        ; return (TH.FamilyI
                        (TH.DataFamilyD (reifyName tc) tvs' kind') instances) }
 
-  | Just (tvs, rhs) <- synTyConDefn_maybe tc  -- Vanilla type synonym
+  | Just (_, rhs) <- synTyConDefn_maybe tc  -- Vanilla type synonym
   = do { rhs' <- reifyType rhs
-       ; tvs' <- reifyTyVars tvs (Just tc)
+       ; tvs' <- reifyTyVars (tyConVisibleTyVars tc)
        ; return (TH.TyConI
                    (TH.TySynD (reifyName tc) tvs' rhs'))
        }
@@ -1432,7 +1431,7 @@ reifyTyCon tc
               dataCons = tyConDataCons tc
               isGadt   = isGadtSyntaxTyCon tc
         ; cons <- mapM (reifyDataCon isGadt (mkTyVarTys tvs)) dataCons
-        ; r_tvs <- reifyTyVars tvs (Just tc)
+        ; r_tvs <- reifyTyVars (tyConVisibleTyVars tc)
         ; let name = reifyName tc
               deriv = []        -- Don't know about deriving
               decl | isNewTyCon tc =
@@ -1497,7 +1496,7 @@ reifyDataCon isGadtDataCon tys dc
              ret_con | null ex_tvs' && null theta' = return main_con
                      | otherwise                   = do
                          { cxt <- reifyCxt theta'
-                         ; ex_tvs'' <- reifyTyVars ex_tvs' Nothing
+                         ; ex_tvs'' <- reifyTyVars ex_tvs'
                          ; return (TH.ForallC ex_tvs'' cxt main_con) }
        ; ASSERT( arg_tys `equalLength` dcdBangs )
          ret_con }
@@ -1535,7 +1534,7 @@ reifyClass cls
         ; insts <- reifyClassInstances cls (InstEnv.classInstances inst_envs cls)
         ; assocTys <- concatMapM reifyAT ats
         ; ops <- concatMapM reify_op op_stuff
-        ; tvs' <- reifyTyVars tvs (Just $ classTyCon cls)
+        ; tvs' <- reifyTyVars (tyConVisibleTyVars (classTyCon cls))
         ; let dec = TH.ClassD cxt (reifyName cls) tvs' fds' (assocTys ++ ops)
         ; return (TH.ClassI dec insts) }
   where
@@ -1607,7 +1606,7 @@ reifyClassInstances :: Class -> [ClsInst] -> TcM [TH.Dec]
 reifyClassInstances cls insts
   = mapM (reifyClassInstance (mkIsPolyTvs tvs)) insts
   where
-    tvs = filterOutInvisibleTyVars (classTyCon cls) (classTyVars cls)
+    tvs = tyConVisibleTyVars (classTyCon cls)
 
 reifyClassInstance :: [Bool]  -- True <=> the corresponding tv is poly-kinded
                               -- includes only *visible* tvs
@@ -1635,7 +1634,7 @@ reifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec]
 reifyFamilyInstances fam_tc fam_insts
   = mapM (reifyFamilyInstance (mkIsPolyTvs fam_tvs)) fam_insts
   where
-    fam_tvs = filterOutInvisibleTyVars fam_tc (tyConTyVars fam_tc)
+    fam_tvs = tyConVisibleTyVars fam_tc
 
 reifyFamilyInstance :: [Bool] -- True <=> the corresponding tv is poly-kinded
                               -- includes only *visible* tvs
@@ -1703,7 +1702,7 @@ reify_for_all :: TyCoRep.Type -> TcM TH.Type
 reify_for_all ty
   = do { cxt' <- reifyCxt cxt;
        ; tau' <- reifyType tau
-       ; tvs' <- reifyTyVars tvs Nothing
+       ; tvs' <- reifyTyVars tvs
        ; return (TH.ForallT tvs' cxt' tau') }
   where
     (tvs, cxt, tau) = tcSplitSigmaTy ty
@@ -1721,9 +1720,9 @@ reifyPatSynType
 -- signature; see NOTE [Pattern synonym signatures and Template
 -- Haskell]
 reifyPatSynType (univTyVars, req, exTyVars, prov, argTys, resTy)
-  = do { univTyVars' <- reifyTyVars univTyVars Nothing
+  = do { univTyVars' <- reifyTyVars univTyVars
        ; req'        <- reifyCxt req
-       ; exTyVars'   <- reifyTyVars exTyVars Nothing
+       ; exTyVars'   <- reifyTyVars exTyVars
        ; prov'       <- reifyCxt prov
        ; tau'        <- reifyType (mkFunTys argTys resTy)
        ; return $ TH.ForallT univTyVars' req'
@@ -1738,16 +1737,9 @@ reifyCxt   = mapM reifyPred
 reifyFunDep :: ([TyVar], [TyVar]) -> TH.FunDep
 reifyFunDep (xs, ys) = TH.FunDep (map reifyName xs) (map reifyName ys)
 
-reifyTyVars :: [TyVar]
-            -> Maybe TyCon  -- the tycon if the tycovars are from a tycon.
-                            -- Used to detect which tvs are implicit.
-            -> TcM [TH.TyVarBndr]
-reifyTyVars tvs m_tc = mapM reify_tv tvs'
+reifyTyVars :: [TyVar] -> TcM [TH.TyVarBndr]
+reifyTyVars tvs = mapM reify_tv tvs
   where
-    tvs' = case m_tc of
-             Just tc -> filterOutInvisibleTyVars tc tvs
-             Nothing -> tvs
-
     -- even if the kind is *, we need to include a kind annotation,
     -- in case a poly-kind would be inferred without the annotation.
     -- See #8953 or test th/T8953
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index f349d002ca..8024ef570e 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -15,7 +15,7 @@ module TcTyClsDecls (
         -- Functions used by TcInstDcls to check
         -- data/type family instance declarations
         kcDataDefn, tcConDecls, dataDeclChecks, checkValidTyCon,
-        tcFamTyPats, tcTyFamInstEqn, famTyConShape,
+        tcFamTyPats, tcTyFamInstEqn,
         tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt,
         wrongKindOfFamily, dataConCtxt
     ) where
@@ -372,7 +372,6 @@ kcTyClGroup decls
                  kc_binders  = tyConBinders tc
                  kc_res_kind = tyConResKind tc
                  kc_tyvars   = tyConTyVars tc
-                 kc_flav     = tyConFlavour tc
            ; kvs <- kindGeneralize (mkTyConKind kc_binders kc_res_kind)
            ; let all_binders = mkNamedTyConBinders Inferred kvs ++ kc_binders
 
@@ -388,7 +387,7 @@ kcTyClGroup decls
 
            ; return (mkTcTyCon name all_binders' kc_res_kind'
                                (tcTyConScopedTyVars tc)
-                               kc_flav) }
+                               (tyConFlavour tc)) }
 
     generaliseTCD :: TcTypeEnv
                   -> LTyClDecl GhcRn -> TcM [TcTyCon]
@@ -617,7 +616,7 @@ kcTyClDecl (FamDecl (FamilyDecl { fdLName  = L _ fam_tc_name
   = case fd_info of
       ClosedTypeFamily (Just eqns) ->
         do { fam_tc <- kcLookupTcTyCon fam_tc_name
-           ; mapM_ (kcTyFamInstEqn (famTyConShape fam_tc)) eqns }
+           ; mapM_ (kcTyFamInstEqn fam_tc) eqns }
       _ -> return ()
 
 -------------------
@@ -824,7 +823,7 @@ tcTyClDecl1 _parent roles_info
 
 tcFamDecl1 :: Maybe Class -> FamilyDecl GhcRn -> TcM TyCon
 tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_name)
-                              , fdTyVars = tvs, fdResultSig = L _ sig
+                              , fdResultSig = L _ sig
                               , fdInjectivityAnn = inj })
   | DataFamily <- fam_info
   = tcTyClTyVars tc_name $ \ binders res_kind -> do
@@ -874,13 +873,10 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_na
            Just eqns -> do {
 
          -- Process the equations, creating CoAxBranches
-       ; let fam_tc_shape = FamTyConShape { fs_name     = tc_name
-                                          , fs_arity    = length $ hsQTvExplicit tvs
-                                          , fs_flavor   = TypeFam
-                                          , fs_binders  = binders
-                                          , fs_res_kind = res_kind }
+       ; let tc_fam_tc = mkTcTyCon tc_name binders res_kind
+                                   [] ClosedTypeFamilyFlavour
 
-       ; branches <- mapM (tcTyFamInstEqn fam_tc_shape Nothing) eqns
+       ; branches <- mapM (tcTyFamInstEqn tc_fam_tc Nothing) eqns
          -- Do not attempt to drop equations dominated by earlier
          -- ones here; in the case of mutual recursion with a data
          -- type, we get a knot-tying failure.  Instead we check
@@ -1099,8 +1095,8 @@ tcDefaultAssocDecl fam_tc [L loc (FamEqn { feqn_tycon = lname@(L _ tc_name)
     setSrcSpan loc $
     tcAddFamInstCtxt (text "default type instance") tc_name $
     do { traceTc "tcDefaultAssocDecl" (ppr tc_name)
-       ; let shape@(FamTyConShape { fs_name = fam_tc_name
-                                  , fs_arity = fam_arity }) = famTyConShape fam_tc
+       ; let fam_tc_name = tyConName fam_tc
+             fam_arity = length (tyConVisibleTyVars fam_tc)
 
        -- Kind of family check
        ; ASSERT( fam_tc_name == tc_name )
@@ -1124,7 +1120,7 @@ tcDefaultAssocDecl fam_tc [L loc (FamEqn { feqn_tycon = lname@(L _ tc_name)
           -- type default LHS can mention *different* type variables than the
           -- enclosing class. So it's treated more as a freestanding beast.
        ; (pats', rhs_ty)
-           <- tcFamTyPats shape Nothing all_vars pats
+           <- tcFamTyPats fam_tc Nothing all_vars pats
               (kcTyFamEqnRhs Nothing pp_lhs rhs) $
               \tvs pats rhs_kind ->
               do { rhs_ty <- solveEqualities $
@@ -1166,20 +1162,21 @@ message isn't great, mind you.  (Trac #11361 was caused by not doing a
 proper tcMatchTys here.)  -}
 
 -------------------------
-kcTyFamInstEqn :: FamTyConShape -> LTyFamInstEqn GhcRn -> TcM ()
-kcTyFamInstEqn fam_tc_shape@(FamTyConShape { fs_name = fam_tc_name })
+kcTyFamInstEqn :: TcTyCon -> LTyFamInstEqn GhcRn -> TcM ()
+kcTyFamInstEqn tc_fam_tc
     (L loc (HsIB { hsib_vars = tv_names
                  , hsib_body = FamEqn { feqn_tycon  = lname@(L _ eqn_tc_name)
                                       , feqn_pats   = pats
                                       , feqn_fixity = fixity
                                       , feqn_rhs    = hs_ty }}))
   = setSrcSpan loc $
-    do { checkTc (fam_tc_name == eqn_tc_name)
-                 (wrongTyFamName fam_tc_name eqn_tc_name)
+    do { checkTc (fam_name == eqn_tc_name)
+                 (wrongTyFamName fam_name eqn_tc_name)
        ; discardResult $
-         tc_fam_ty_pats fam_tc_shape Nothing -- not an associated type
+         tc_fam_ty_pats tc_fam_tc Nothing -- not an associated type
                         tv_names pats (kcTyFamEqnRhs Nothing pp_lhs hs_ty) }
   where
+    fam_name = tyConName tc_fam_tc
     pp_lhs = pprFamInstLHS lname pats fixity [] Nothing
 
 -- Infer the kind of the type on the RHS of a type family eqn. Then use
@@ -1203,19 +1200,19 @@ kcTyFamEqnRhs mb_clsinfo pp_lhs_ty rhs_hs_ty lhs_ki
 
     bogus_ty = pprPanic "kcTyFamEqnRhs" (pp_lhs_ty $$ ppr rhs_hs_ty)
 
-tcTyFamInstEqn :: FamTyConShape -> Maybe ClsInstInfo -> LTyFamInstEqn GhcRn
+tcTyFamInstEqn :: TcTyCon -> Maybe ClsInstInfo -> LTyFamInstEqn GhcRn
                -> TcM CoAxBranch
 -- Needs to be here, not in TcInstDcls, because closed families
 -- (typechecked here) have TyFamInstEqns
-tcTyFamInstEqn fam_tc_shape@(FamTyConShape { fs_name = fam_tc_name }) mb_clsinfo
+tcTyFamInstEqn fam_tc mb_clsinfo
     (L loc (HsIB { hsib_vars = tv_names
                  , hsib_body = FamEqn { feqn_tycon  = lname@(L _ eqn_tc_name)
                                       , feqn_pats   = pats
                                       , feqn_fixity = fixity
                                       , feqn_rhs    = hs_ty }}))
-  = ASSERT( fam_tc_name == eqn_tc_name )
+  = ASSERT( getName fam_tc == eqn_tc_name )
     setSrcSpan loc $
-    tcFamTyPats fam_tc_shape mb_clsinfo tv_names pats
+    tcFamTyPats fam_tc mb_clsinfo tv_names pats
                 (kcTyFamEqnRhs mb_clsinfo pp_lhs hs_ty) $
                     \tvs pats res_kind ->
     do { rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind
@@ -1223,7 +1220,7 @@ tcTyFamInstEqn fam_tc_shape@(FamTyConShape { fs_name = fam_tc_name }) mb_clsinfo
        ; (ze, tvs') <- zonkTyBndrsX emptyZonkEnv tvs
        ; pats'      <- zonkTcTypeToTypes ze pats
        ; rhs_ty'    <- zonkTcTypeToType ze rhs_ty
-       ; traceTc "tcTyFamInstEqn" (ppr fam_tc_name <+> pprTyVars tvs')
+       ; traceTc "tcTyFamInstEqn" (ppr fam_tc <+> pprTyVars tvs')
           -- don't print out the pats here, as they might be zonked inside the knot
        ; return (mkCoAxBranch tvs' [] pats' rhs_ty'
                               (map (const Nominal) tvs')
@@ -1313,9 +1310,9 @@ to generate a desugaring. It is used during type-checking (not kind-checking).
 Note [Type-checking type patterns]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When typechecking the patterns of a family instance declaration, we can't
-rely on using the family TyCon, because this is sometimes called
+rely on using the family TyCon itself, because this is sometimes called
 from within a type-checking knot. (Specifically for closed type families.)
-The type FamTyConShape gives just enough information to do the job.
+The TcTyCon gives just enough information to do the job.
 
 See also Note [tc_fam_ty_pats vs tcFamTyPats]
 
@@ -1355,27 +1352,8 @@ two bad things could happen:
 -}
 
 -----------------
-data TypeOrDataFamily = TypeFam | DataFam
-data FamTyConShape = FamTyConShape { fs_name     :: Name
-                                   , fs_arity    :: Arity -- the visible args
-                                   , fs_flavor   :: TypeOrDataFamily
-                                   , fs_binders  :: [TyConBinder]
-                                   , fs_res_kind :: Kind }
-  -- See Note [Type-checking type patterns]
-
-famTyConShape :: TyCon -> FamTyConShape
-famTyConShape fam_tc
-  = FamTyConShape { fs_name     = tyConName fam_tc
-                  , fs_arity    = length $ filterOutInvisibleTyVars fam_tc (tyConTyVars fam_tc)
-                  , fs_flavor   = flav
-                  , fs_binders  = tyConBinders fam_tc
-                  , fs_res_kind = tyConResKind fam_tc }
-  where
-    flav
-      | isTypeFamilyTyCon fam_tc = TypeFam
-      | otherwise                = DataFam
-
-tc_fam_ty_pats :: FamTyConShape
+tc_fam_ty_pats :: TcTyCon    -- The family TcTyCon
+                             -- See Note [Type-checking type patterns]
                -> Maybe ClsInstInfo
                -> [Name]              -- Bound kind/type variable names
                -> HsTyPats GhcRn      -- Type patterns
@@ -1394,23 +1372,20 @@ tc_fam_ty_pats :: FamTyConShape
 -- In that case, the type variable 'a' will *already be in scope*
 -- (and, if C is poly-kinded, so will its kind parameter).
 
-tc_fam_ty_pats (FamTyConShape { fs_name = name, fs_arity = arity
-                              , fs_flavor = flav, fs_binders = binders
-                              , fs_res_kind = res_kind })
-               mb_clsinfo tv_names arg_pats
+tc_fam_ty_pats tc_fam_tc mb_clsinfo tv_names arg_pats
                kind_checker
   = do { -- First, check the arity.
          -- If we wait until validity checking, we'll get kind
          -- errors below when an arity error will be much easier to
          -- understand.
          let should_check_arity
-               | TypeFam <- flav = True
+               | DataFamilyFlavour <- flav = False
                   -- why not check data families? See [Arity of data families] in FamInstEnv
-               | otherwise       = False
+               | otherwise                 = True
 
        ; when should_check_arity $
-         checkTc (arg_pats `lengthIs` arity) $
-         wrongNumberOfParmsErr arity
+         checkTc (arg_pats `lengthIs` vis_arity) $
+         wrongNumberOfParmsErr vis_arity
                       -- report only explicit arguments
 
          -- Kind-check and quantify
@@ -1418,22 +1393,26 @@ tc_fam_ty_pats (FamTyConShape { fs_name = name, fs_arity = arity
        ; (arg_tvs, (args, stuff)) <- tcImplicitTKBndrs tv_names $
          do { let loc          = nameSrcSpan name
                   lhs_fun      = L loc (HsTyVar NotPromoted (L loc name))
-                  bogus_fun_ty = pprPanic "tc_fam_ty_pats" (ppr name $$ ppr arg_pats)
-                  fun_kind     = mkTyConKind binders res_kind
+                  fun_ty       = mkTyConApp tc_fam_tc []
+                  fun_kind     = tyConKind tc_fam_tc
                   mb_kind_env  = thdOf3 <$> mb_clsinfo
 
             ; (_, args, res_kind_out)
                 <- tcInferApps typeLevelMode mb_kind_env
-                               lhs_fun bogus_fun_ty fun_kind arg_pats
+                               lhs_fun fun_ty fun_kind arg_pats
 
             ; stuff <- kind_checker res_kind_out
 
             ; return ((args, stuff), emptyVarSet) }
 
        ; return (arg_tvs, args, stuff) }
+  where
+    name      = tyConName tc_fam_tc
+    vis_arity = length (tyConVisibleTyVars tc_fam_tc)
+    flav      = tyConFlavour tc_fam_tc
 
 -- See Note [tc_fam_ty_pats vs tcFamTyPats]
-tcFamTyPats :: FamTyConShape
+tcFamTyPats :: TcTyCon
             -> Maybe ClsInstInfo
             -> [Name]          -- Implicitly bound kind/type variable names
             -> HsTyPats GhcRn  -- Type patterns
@@ -1445,11 +1424,11 @@ tcFamTyPats :: FamTyConShape
                 -> TcKind
                 -> TcM a)            -- NB: You can use solveEqualities here.
             -> TcM a
-tcFamTyPats fam_shape@(FamTyConShape { fs_name = name, fs_flavor = fam_flav })
-            mb_clsinfo tv_names arg_pats kind_checker thing_inside
+tcFamTyPats tc_fam_tc mb_clsinfo
+            tv_names arg_pats kind_checker thing_inside
   = do { (fam_used_tvs, typats, (more_typats, res_kind))
             <- solveEqualities $  -- See Note [Constraints in patterns]
-               tc_fam_ty_pats fam_shape mb_clsinfo
+               tc_fam_ty_pats tc_fam_tc mb_clsinfo
                               tv_names arg_pats kind_checker
 
           {- TODO (RAE): This should be cleverer. Consider this:
@@ -1482,13 +1461,12 @@ tcFamTyPats fam_shape@(FamTyConShape { fs_name = name, fs_flavor = fam_flav })
            -- above would fail. TODO (RAE): Update once the solveEqualities
            -- bit is cleverer.
 
-       ; traceTc "tcFamTyPats" (ppr name $$ ppr all_pats $$ ppr qtkvs)
+       ; traceTc "tcFamTyPats" (ppr (getName tc_fam_tc)
+                                $$ ppr all_pats $$ ppr qtkvs)
            -- Don't print out too much, as we might be in the knot
 
            -- See Note [Free-floating kind vars] in TcHsType
-       ; let tc_flav = case fam_flav of
-                         TypeFam -> OpenTypeFamilyFlavour
-                         DataFam -> DataFamilyFlavour
+       ; let tc_flav = tyConFlavour tc_fam_tc
              all_mentioned_tvs = mkVarSet qtkvs
                                    -- qtkvs has all the tyvars bound by LHS
                                    -- type patterns
@@ -1497,7 +1475,8 @@ tcFamTyPats fam_shape@(FamTyConShape { fs_name = name, fs_flavor = fam_flav })
                                    -- If there are tyvars left over, we can
                                    -- assume they're free-floating, since they
                                    -- aren't bound by a type pattern
-       ; checkNoErrs $ reportFloatingKvs name tc_flav qtkvs unmentioned_tvs
+       ; checkNoErrs $ reportFloatingKvs (getName tc_fam_tc) tc_flav
+                                         qtkvs unmentioned_tvs
 
        ; tcExtendTyVarEnv qtkvs $
             -- Extend envt with TcTyVars not TyVars, because the
@@ -2457,7 +2436,7 @@ checkValidTyConTyVars tc
                           = reverse $ nub $ reverse tvs
                           | otherwise
                           = tvs
-             vis_tvs      = filterOutInvisibleTyVars tc tvs
+             vis_tvs      = tyConVisibleTyVars tc
              extra | not (vis_tvs `equalLength` stripped_tvs)
                    = text "NB: Implicitly declared kind variables are put first."
                    | otherwise
@@ -2649,7 +2628,7 @@ checkValidClass cls
         ; mapM_ check_at at_stuff  }
   where
     (tyvars, fundeps, theta, _, at_stuff, op_stuff) = classExtraBigSig cls
-    cls_arity = length $ filterOutInvisibleTyVars (classTyCon cls) tyvars
+    cls_arity = length (tyConVisibleTyVars (classTyCon cls))
        -- Ignore invisible variables
     cls_tv_set = mkVarSet tyvars
     mini_env   = zipVarEnv tyvars (mkTyVarTys tyvars)
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 6a4ff72896..204d3ae9b5 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -73,7 +73,7 @@ module TyCon(
         tyConSkolem,
         tyConKind,
         tyConUnique,
-        tyConTyVars,
+        tyConTyVars, tyConVisibleTyVars,
         tyConCType, tyConCType_maybe,
         tyConDataCons, tyConDataCons_maybe,
         tyConSingleDataCon_maybe, tyConSingleDataCon,
@@ -418,8 +418,11 @@ isNamedTyConBinder _                        = False
 
 isVisibleTyConBinder :: TyVarBndr tv TyConBndrVis -> Bool
 -- Works for IfaceTyConBinder too
-isVisibleTyConBinder (TvBndr _ (NamedTCB vis)) = isVisibleArgFlag vis
-isVisibleTyConBinder (TvBndr _ AnonTCB)        = True
+isVisibleTyConBinder (TvBndr _ tcb_vis) = isVisibleTcbVis tcb_vis
+
+isVisibleTcbVis :: TyConBndrVis -> Bool
+isVisibleTcbVis (NamedTCB vis) = isVisibleArgFlag vis
+isVisibleTcbVis AnonTCB        = True
 
 isInvisibleTyConBinder :: TyVarBndr tv TyConBndrVis -> Bool
 -- Works for IfaceTyConBinder too
@@ -445,6 +448,11 @@ tyConTyVarBinders tc_bndrs
                 NamedTCB Required -> Specified
                 NamedTCB vis      -> vis
 
+tyConVisibleTyVars :: TyCon -> [TyVar]
+tyConVisibleTyVars tc
+  = [ tv | TvBndr tv vis <- tyConBinders tc
+         , isVisibleTcbVis vis ]
+
 {- Note [Building TyVarBinders from TyConBinders]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We sometimes need to build the quantified type of a value from
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 39529ea502..c905e34bc3 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -58,7 +58,7 @@ module Type (
         stripCoercionTy, splitCoercionType_maybe,
 
         splitPiTysInvisible, filterOutInvisibleTypes,
-        filterOutInvisibleTyVars, partitionInvisibles,
+        partitionInvisibles,
         synTyConResKind,
 
         modifyJoinResTy, setJoinResTy,
@@ -1430,10 +1430,6 @@ splitPiTysInvisible ty = split ty ty []
 filterOutInvisibleTypes :: TyCon -> [Type] -> [Type]
 filterOutInvisibleTypes tc tys = snd $ partitionInvisibles tc id tys
 
--- | Like 'filterOutInvisibles', but works on 'TyVar's
-filterOutInvisibleTyVars :: TyCon -> [TyVar] -> [TyVar]
-filterOutInvisibleTyVars tc tvs = snd $ partitionInvisibles tc mkTyVarTy tvs
-
 -- | Given a tycon and a list of things (which correspond to arguments),
 -- partitions the things into
 --      Inferred or Specified ones and
diff --git a/compiler/types/Type.hs-boot b/compiler/types/Type.hs-boot
index 375c31f38a..1c3bfa8570 100644
--- a/compiler/types/Type.hs-boot
+++ b/compiler/types/Type.hs-boot
@@ -15,8 +15,6 @@ piResultTy :: HasDebugCallStack => Type -> Type -> Type
 
 eqType :: Type -> Type -> Bool
 
-partitionInvisibles :: TyCon -> (a -> Type) -> [a] -> ([a], [a])
-
 coreView :: Type -> Maybe Type
 tcView :: Type -> Maybe Type