Warn about unused type variables in type families

The warnings are enabled with the flag -fwarn-unused-matches, the same
one that enables warnings on the term level.

Identifiers starting with an underscore are now always parsed as type
variables.  When the NamedWildCards extension is enabled, the renamer
replaces those variables with named wildcards.

An additional NameSet nwcs is added to LocalRdrEnv. It's used to keep
names of the type variables that should be replaced with wildcards.

While renaming HsForAllTy, when a name is explicitly bound it is removed
from the nwcs NameSet. As a result, the renamer doesn't replace them in
the quantifier body. (Trac #11098)

Fixes #10982, #11098

Reviewers: alanz, bgamari, hvr, austin, jstolarek

Reviewed By: jstolarek

Subscribers: goldfire, mpickering, RyanGlScott, thomie

Differential Revision: https://phabricator.haskell.org/D1576

GHC Trac Issues: #10982

39 files changed, 555 insertions, 145 deletions

diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs
index f4ca912eb5..c1ae468140 100644
--- a/compiler/basicTypes/RdrName.hs
+++ b/compiler/basicTypes/RdrName.hs
@@ -41,6 +41,7 @@ module RdrName (
         lookupLocalRdrEnv, lookupLocalRdrOcc,
         elemLocalRdrEnv, inLocalRdrEnvScope,
         localRdrEnvElts, delLocalRdrEnvList,
+        extendLocalRdrEnvNwcs, inLocalRdrEnvNwcsRdrName, delLocalRdrEnvNwcs,
 
         -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
         GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
@@ -321,34 +322,43 @@ instance Ord RdrName where
 -- | This environment is used to store local bindings (@let@, @where@, lambda, @case@).
 -- It is keyed by OccName, because we never use it for qualified names
 -- We keep the current mapping, *and* the set of all Names in scope
--- Reason: see Note [Splicing Exact Names] in RnEnv
+-- Reason: see Note [Splicing Exact names] in RnEnv
+-- The field lre_nwcs is used to keep names of type variables that should
+-- be replaced with named wildcards.
+-- See Note [Renaming named wild cards] in RnTypes
 data LocalRdrEnv = LRE { lre_env      :: OccEnv Name
-                       , lre_in_scope :: NameSet }
+                       , lre_in_scope :: NameSet
+                       , lre_nwcs     :: NameSet }
 
 instance Outputable LocalRdrEnv where
-  ppr (LRE {lre_env = env, lre_in_scope = ns})
+  ppr (LRE {lre_env = env, lre_in_scope = ns, lre_nwcs = nwcs})
     = hang (ptext (sLit "LocalRdrEnv {"))
          2 (vcat [ ptext (sLit "env =") <+> pprOccEnv ppr_elt env
-                 , ptext (sLit "in_scope =") <+> braces (pprWithCommas ppr (nameSetElems ns))
+                 , ptext (sLit "in_scope =")
+                    <+> braces (pprWithCommas ppr (nameSetElems ns))
+                 , ptext (sLit "nwcs =")
+                    <+> braces (pprWithCommas ppr (nameSetElems nwcs))
                  ] <+> char '}')
     where
       ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
                      -- So we can see if the keys line up correctly
 
 emptyLocalRdrEnv :: LocalRdrEnv
-emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv, lre_in_scope = emptyNameSet }
+emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv
+                       , lre_in_scope = emptyNameSet
+                       , lre_nwcs = emptyNameSet }
 
 extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
 -- The Name should be a non-top-level thing
-extendLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) name
+extendLocalRdrEnv lre@(LRE { lre_env = env, lre_in_scope = ns }) name
   = WARN( isExternalName name, ppr name )
-    LRE { lre_env      = extendOccEnv env (nameOccName name) name
+    lre { lre_env      = extendOccEnv env (nameOccName name) name
         , lre_in_scope = extendNameSet ns name }
 
 extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
-extendLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) names
+extendLocalRdrEnvList lre@(LRE { lre_env = env, lre_in_scope = ns }) names
   = WARN( any isExternalName names, ppr names )
-    LRE { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names]
+    lre { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names]
         , lre_in_scope = extendNameSetList ns names }
 
 lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
@@ -374,9 +384,29 @@ inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
 inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns
 
 delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
-delLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) occs
-  = LRE { lre_env = delListFromOccEnv env occs
-        , lre_in_scope = ns }
+delLocalRdrEnvList lre@(LRE { lre_env = env }) occs
+  = lre { lre_env = delListFromOccEnv env occs }
+
+extendLocalRdrEnvNwcs:: LocalRdrEnv -> [Name] -> LocalRdrEnv
+extendLocalRdrEnvNwcs lre@(LRE { lre_nwcs = nwcs }) names
+  = lre { lre_nwcs = extendNameSetList nwcs names }
+
+inLocalRdrEnvNwcs :: Name -> LocalRdrEnv -> Bool
+inLocalRdrEnvNwcs name (LRE { lre_nwcs = nwcs }) = name `elemNameSet` nwcs
+
+inLocalRdrEnvNwcsRdrName :: RdrName -> LocalRdrEnv -> Bool
+inLocalRdrEnvNwcsRdrName rdr_name lcl_env@(LRE { lre_nwcs = nwcs })
+  | isEmptyNameSet nwcs = False
+  | otherwise = case rdr_name of
+      Unqual occ -> case lookupLocalRdrOcc lcl_env occ of
+          Just name -> inLocalRdrEnvNwcs name lcl_env
+          Nothing   -> False
+      Exact name -> inLocalRdrEnvNwcs name lcl_env
+      _ -> False
+
+delLocalRdrEnvNwcs :: LocalRdrEnv -> [Name] -> LocalRdrEnv
+delLocalRdrEnvNwcs lre@(LRE { lre_nwcs = nwcs }) names
+  = lre { lre_nwcs = delListFromNameSet nwcs names }
 
 {-
 Note [Local bindings with Exact Names]
diff --git a/compiler/hsSyn/PlaceHolder.hs b/compiler/hsSyn/PlaceHolder.hs
index 97a4d7c620..8e3b9a3402 100644
--- a/compiler/hsSyn/PlaceHolder.hs
+++ b/compiler/hsSyn/PlaceHolder.hs
@@ -37,15 +37,15 @@ data PlaceHolder = PlaceHolder
 
 -- | Types that are not defined until after type checking
 type family PostTc it ty :: * -- Note [Pass sensitive types]
-type instance PostTc Id      ty = ty
-type instance PostTc Name    ty = PlaceHolder
-type instance PostTc RdrName ty = PlaceHolder
+type instance PostTc Id       ty = ty
+type instance PostTc Name    _ty = PlaceHolder
+type instance PostTc RdrName _ty = PlaceHolder
 
 -- | Types that are not defined until after renaming
 type family PostRn id ty :: * -- Note [Pass sensitive types]
-type instance PostRn Id      ty = ty
-type instance PostRn Name    ty = ty
-type instance PostRn RdrName ty = PlaceHolder
+type instance PostRn Id       ty = ty
+type instance PostRn Name     ty = ty
+type instance PostRn RdrName _ty = PlaceHolder
 
 placeHolderKind :: PlaceHolder
 placeHolderKind = PlaceHolder
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 5ba56239f1..410f4c7140 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1678,12 +1678,7 @@ tyapp :: { Located (HsAppType RdrName) }
 
 atype :: { LHsType RdrName }
         : ntgtycon                       { sL1 $1 (HsTyVar $1) }      -- Not including unit tuples
-        | tyvar                          {% do { nwc <- namedWildCardsEnabled -- (See Note [Unit tuples])
-                                               ; let tv@(L _ (Unqual name)) = $1
-                                               ; return $ if (startsWithUnderscore name && nwc)
-                                                          then (sL1 $1 (mkNamedWildCardTy tv))
-                                                          else (sL1 $1 (HsTyVar tv)) } }
-
+        | tyvar                          { sL1 $1 (HsTyVar $1) }      -- (See Note [Unit tuples])
         | strict_mark atype              {% ams (sLL $1 $> (HsBangTy (snd $ unLoc $1) $2))
                                                 (fst $ unLoc $1) }  -- Constructor sigs only
         | '{' fielddecls '}'             {% amms (checkRecordSyntax
@@ -3339,9 +3334,6 @@ hintExplicitForall span = do
       , text "extension to enable explicit-forall syntax: \x2200 <tvs>. <type>"
       ]
 
-namedWildCardsEnabled :: P Bool
-namedWildCardsEnabled = liftM ((LangExt.NamedWildCards `xopt`) . dflags) getPState
-
 {-
 %************************************************************************
 %*                                                                      *
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 7e61172d84..6de79fca3f 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -639,6 +639,7 @@ eitherToP :: Either (SrcSpan, SDoc) a -> P a
 -- Adapts the Either monad to the P monad
 eitherToP (Left (loc, doc)) = parseErrorSDoc loc doc
 eitherToP (Right thing)     = return thing
+
 checkTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsType RdrName]
             -> Either (SrcSpan, SDoc) (LHsQTyVars RdrName)
 -- Check whether the given list of type parameters are all type variables
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index d6cb2c8ce6..d139091314 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -51,7 +51,7 @@ import Digraph          ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
-import Data.List ( sortBy )
+import Data.List ( (\\), nubBy, sortBy )
 import Maybes( orElse, mapMaybe )
 import qualified Data.Set as Set ( difference, fromList, toList, null )
 #if __GLASGOW_HASKELL__ < 709
@@ -668,7 +668,13 @@ rnFamInstDecl doc mb_cls tycon (HsIB { hsib_body = pats }) payload rnPayload
                      []             -> pprPanic "rnFamInstDecl" (ppr tycon)
                      (L loc _ : []) -> loc
                      (L loc _ : ps) -> combineSrcSpans loc (getLoc (last ps))
-       ; tv_rdr_names <- extractHsTysRdrTyVars pats
+             -- Duplicates are needed to warn about unused type variables
+             -- See Note [Wild cards in family instances] in TcTyClsDecls
+       ; tv_rdr_names_all <- extractHsTysRdrTyVarsDups pats
+       ; let tv_rdr_names = rmDupsInRdrTyVars tv_rdr_names_all
+             tv_rdr_dups = nubBy eqLocated
+                (freeKiTyVarsTypeVars tv_rdr_names_all
+                 \\ freeKiTyVarsTypeVars tv_rdr_names)
 
        ; var_names <- mapM (newTyVarNameRn mb_cls . L loc . unLoc) $
                       freeKiTyVarsAllVars tv_rdr_names
@@ -679,6 +685,10 @@ rnFamInstDecl doc mb_cls tycon (HsIB { hsib_body = pats }) payload rnPayload
                  do { (pats', pat_fvs) <- rnLHsTypes (FamPatCtx tycon) pats
                     ; (payload', rhs_fvs) <- rnPayload doc payload
 
+                    ; tv_nms_dups <- mapM (lookupOccRn . unLoc) tv_rdr_dups
+                    ; let tv_nms_used = extendNameSetList rhs_fvs tv_nms_dups
+                    ; warnUnusedMatches var_names tv_nms_used
+
                          -- See Note [Renaming associated types]
                     ; let bad_tvs = case mb_cls of
                                       Nothing           -> []
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 0a1f342a83..ebcab850be 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -26,6 +26,7 @@ module RnTypes (
         warnUnusedForAlls, bindLHsTyVarBndr,
         bindSigTyVarsFV, bindHsQTyVars, bindLRdrNames,
         extractHsTyRdrTyVars, extractHsTysRdrTyVars,
+        extractHsTysRdrTyVarsDups, rmDupsInRdrTyVars,
         extractRdrKindSigVars, extractDataDefnKindVars,
         freeKiTyVarsAllVars, freeKiTyVarsKindVars, freeKiTyVarsTypeVars
   ) where
@@ -54,7 +55,7 @@ import FastString
 import Maybes
 import qualified GHC.LanguageExtensions as LangExt
 
-import Data.List        ( nubBy )
+import Data.List        ( (\\), nubBy, partition )
 import Control.Monad    ( unless, when )
 
 #if __GLASGOW_HASKELL__ < 709
@@ -102,27 +103,62 @@ rn_hs_sig_wc_type :: Bool   -- see rnImplicitBndrs
 -- rn_hs_sig_wc_type is used for source-language type signatures
 rn_hs_sig_wc_type no_implicit_if_forall ctxt
                   (HsIB { hsib_body = wc_ty }) thing_inside
-  = rnImplicitBndrs no_implicit_if_forall (hswc_body wc_ty) $ \ vars ->
-    rn_hs_wc_type ctxt wc_ty $ \ wc_ty' ->
-    thing_inside (HsIB { hsib_vars = vars
-                       , hsib_body = wc_ty' })
+  = do { let hs_ty = hswc_body wc_ty
+       ; free_vars <- extract_filtered_rdr_ty_vars hs_ty
+       ; (free_vars', nwc_rdrs) <- partition_nwcs free_vars
+       ; rnImplicitBndrs no_implicit_if_forall free_vars' hs_ty $ \ vars ->
+    do { rn_hs_wc_type ctxt wc_ty nwc_rdrs $ \ wc_ty' ->
+         thing_inside (HsIB { hsib_vars = vars
+                            , hsib_body = wc_ty' }) } }
 
 rnHsWcType :: HsDocContext -> LHsWcType RdrName -> RnM (LHsWcType Name, FreeVars)
-rnHsWcType ctxt wc_ty
-  = rn_hs_wc_type ctxt wc_ty $ \ wc_ty' ->
-    return (wc_ty', emptyFVs)
-
-rn_hs_wc_type :: HsDocContext -> LHsWcType RdrName
+rnHsWcType ctxt wc_ty@(HsWC { hswc_body = hs_ty })
+  = do { free_vars <- extract_filtered_rdr_ty_vars hs_ty
+       ; (_, nwc_rdrs) <- partition_nwcs free_vars
+       ; rn_hs_wc_type ctxt wc_ty nwc_rdrs $ \ wc_ty' ->
+         return (wc_ty', emptyFVs) }
+
+-- | Finds free type and kind variables in a type, without duplicates and
+-- variables that are already in LocalRdrEnv.
+extract_filtered_rdr_ty_vars :: LHsType RdrName -> RnM FreeKiTyVars
+extract_filtered_rdr_ty_vars hs_ty
+  = do { rdr_env <- getLocalRdrEnv
+       ; filterInScope rdr_env <$> extractHsTyRdrTyVars hs_ty }
+
+-- | When the NamedWildCards extension is enabled, removes type variables
+-- that start with an underscore from the FreeKiTyVars in the argument
+-- and returns them in a separate list.
+-- When the extension is disabled, the function returns the argument and
+-- empty list.
+-- See Note [Renaming named wild cards]
+partition_nwcs :: FreeKiTyVars -> RnM (FreeKiTyVars, [Located RdrName])
+partition_nwcs free_vars@(FKTV { fktv_tys = tys, fktv_all = all })
+  = do { wildcards_enabled <- fmap (xopt LangExt.NamedWildCards) getDynFlags
+       ; let (nwcs, no_nwcs) =
+                if wildcards_enabled
+                then partition (startsWithUnderscore . rdrNameOcc . unLoc) tys
+                else ([], tys)
+             free_vars' = free_vars { fktv_tys = no_nwcs
+                                    , fktv_all = all \\ nwcs }
+       ; return (free_vars', nwcs) }
+
+-- | Renames a type with wild card binders.
+-- Expects a list of names of type variables that should be replaced with
+-- named wild cards. (See Note [Renaming named wild cards])
+-- Although the parser does not create named wild cards, it is possible to find
+-- them in declaration splices, so the function tries to collect them.
+rn_hs_wc_type :: HsDocContext -> LHsWcType RdrName -> [Located RdrName]
               -> (LHsWcType Name -> RnM (a, FreeVars))
               -> RnM (a, FreeVars)
-rn_hs_wc_type ctxt (HsWC { hswc_body = hs_ty }) thing_inside
-  = do { let nwc_rdrs = collectNamedWildCards hs_ty
+rn_hs_wc_type ctxt (HsWC { hswc_body = hs_ty }) nwc_rdrs thing_inside
+  = do { let nwc_collected = collectNamedWildCards hs_ty
+       -- the parser doesn't generate named wcs, but they may be in splices
        ; rdr_env <- getLocalRdrEnv
        ; nwcs <- sequence [ newLocalBndrRn lrdr
-                          | lrdr@(L _ rdr) <- nwc_rdrs
+                          | lrdr@(L _ rdr) <- nwc_collected ++ nwc_rdrs
                           , not (inScope rdr_env rdr) ]
-                 -- nwcs :: [Name]   Named wildcards
-       ; bindLocalNamesFV nwcs $
+       ; setLocalRdrEnv (extendLocalRdrEnvNwcs rdr_env nwcs) $
+         bindLocalNamesFV nwcs $
     do { (wc_ty, fvs1) <- rnWcSigTy ctxt hs_ty
        ; let wc_ty' :: HsWildCardBndrs Name (LHsType Name)
              wc_ty' = wc_ty { hswc_wcs = nwcs ++ hswc_wcs wc_ty }
@@ -131,16 +167,20 @@ rn_hs_wc_type ctxt (HsWC { hswc_body = hs_ty }) thing_inside
 
 rnWcSigTy :: HsDocContext -> LHsType RdrName
           -> RnM (LHsWcType Name, FreeVars)
--- Renames just the top level of a type signature
+-- ^ Renames just the top level of a type signature
 -- It's exactly like rnHsTyKi, except that it uses rnWcSigContext
 -- on a qualified type, and return info on any extra-constraints
 -- wildcard.  Some code duplication, but no big deal.
 rnWcSigTy ctxt (L loc hs_ty@(HsForAllTy { hst_bndrs = tvs, hst_body = hs_tau }))
   = bindLHsTyVarBndrs ctxt Nothing [] tvs $ \ _ tvs' ->
+    do { lcl_env <- getLocalRdrEnv
+       ; let explicitly_bound = fmap hsLTyVarName tvs'
+       ; setLocalRdrEnv (delLocalRdrEnvNwcs lcl_env explicitly_bound) $
+           -- See Note [Renaming named wild cards]
     do { (hs_tau', fvs) <- rnWcSigTy ctxt hs_tau
        ; warnUnusedForAlls (inTypeDoc hs_ty) tvs' fvs
        ; let hs_ty' = HsForAllTy { hst_bndrs = tvs', hst_body = hswc_body hs_tau' }
-       ; return ( hs_tau' { hswc_body = L loc hs_ty' }, fvs) }
+       ; return ( hs_tau' { hswc_body = L loc hs_ty' }, fvs) } }
 
 rnWcSigTy ctxt (L loc (HsQualTy { hst_ctxt = hs_ctxt, hst_body = tau }))
   = do { (hs_ctxt', fvs1) <- rnWcSigContext ctxt hs_ctxt
@@ -163,23 +203,37 @@ rnWcSigTy ctxt hs_ty
 rnWcSigContext :: HsDocContext -> LHsContext RdrName
                -> RnM (HsWildCardBndrs Name (LHsContext Name), FreeVars)
 rnWcSigContext ctxt (L loc hs_ctxt)
-  | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt
-  , L lx (HsWildCardTy wc) <- ignoreParens hs_ctxt_last
-  = do { (hs_ctxt1', fvs) <- mapFvRn (rnLHsTyKi RnTopConstraint ctxt) hs_ctxt1
-       ; wc'              <- setSrcSpan lx $
-                             rnExtraConstraintWildCard ctxt wc
-       ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy wc')]
-             awcs     = concatMap collectAnonWildCards hs_ctxt1'
-             -- NB: *not* including the extra-constraint wildcard
-       ; return ( HsWC { hswc_wcs = awcs
-                       , hswc_ctx = Just lx
-                       , hswc_body = L loc hs_ctxt' }
-                , fvs ) }
-  | otherwise
-  = do { (hs_ctxt', fvs) <- mapFvRn (rnLHsTyKi RnTopConstraint ctxt) hs_ctxt
-       ; return (HsWC { hswc_wcs = concatMap collectAnonWildCards hs_ctxt'
-                      , hswc_ctx = Nothing
-                      , hswc_body = L loc hs_ctxt' }, fvs) }
+  = getLocalRdrEnv >>= rn_wc_sig_context
+  where
+    rn_wc_sig_context :: LocalRdrEnv
+                      -> RnM (HsWildCardBndrs Name (LHsContext Name), FreeVars)
+    rn_wc_sig_context lcl_env
+      | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt
+      , L lx (HsWildCardTy wc) <- (to_nwc lcl_env . ignoreParens) hs_ctxt_last
+      = do { (hs_ctxt1', fvs) <- mapFvRn rn_top_constraint hs_ctxt1
+           ; wc'              <- setSrcSpan lx $
+                                 rnExtraConstraintWildCard ctxt wc
+           ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy wc')]
+                 awcs     = concatMap collectAnonWildCards hs_ctxt1'
+                 -- NB: *not* including the extra-constraint wildcard
+           ; return ( HsWC { hswc_wcs = awcs
+                           , hswc_ctx = Just lx
+                           , hswc_body = L loc hs_ctxt' }
+                    , fvs ) }
+      | otherwise
+      = do { (hs_ctxt', fvs) <- mapFvRn rn_top_constraint hs_ctxt
+           ; return (HsWC { hswc_wcs = concatMap collectAnonWildCards hs_ctxt'
+                          , hswc_ctx = Nothing
+                          , hswc_body = L loc hs_ctxt' }, fvs) }
+
+    to_nwc :: LocalRdrEnv -> LHsType RdrName -> LHsType RdrName
+    to_nwc _  lnwc@(L _ (HsWildCardTy {})) = lnwc
+    to_nwc lcl_env (L loc (HsTyVar lname@(L _ rdr_name)))
+      | rdr_name `inLocalRdrEnvNwcsRdrName` lcl_env
+      = L loc (HsWildCardTy (NamedWildCard lname))
+    to_nwc _ lt = lt
+
+    rn_top_constraint = rnLHsTyKi RnTopConstraint ctxt
 
 
 {- ******************************************************
@@ -193,24 +247,23 @@ rnHsSigType :: HsDocContext -> LHsSigType RdrName
 -- Used for source-language type signatures
 -- that cannot have wildcards
 rnHsSigType ctx (HsIB { hsib_body = hs_ty })
-  = rnImplicitBndrs True hs_ty $ \ vars ->
+  = do { vars <- extract_filtered_rdr_ty_vars hs_ty
+       ; rnImplicitBndrs True vars hs_ty $ \ vars ->
     do { (body', fvs) <- rnLHsType ctx hs_ty
        ; return (HsIB { hsib_vars = vars
-                      , hsib_body = body' }, fvs) }
+                      , hsib_body = body' }, fvs) } }
 
 rnImplicitBndrs :: Bool    -- True <=> no implicit quantification
                            --          if type is headed by a forall
                            -- E.g.  f :: forall a. a->b
                            -- Do not quantify over 'b' too.
+                -> FreeKiTyVars
                 -> LHsType RdrName
                 -> ([Name] -> RnM (a, FreeVars))
                 -> RnM (a, FreeVars)
-rnImplicitBndrs no_implicit_if_forall hs_ty@(L loc _) thing_inside
-  = do { rdr_env <- getLocalRdrEnv
-       ; free_vars <- filterInScope rdr_env <$>
-                      extractHsTyRdrTyVars hs_ty
-       ; let real_tv_rdrs  -- Implicit quantification only if
-                        -- there is no explicit forall
+rnImplicitBndrs no_implicit_if_forall free_vars hs_ty@(L loc _) thing_inside
+  = do { let real_tv_rdrs  -- Implicit quantification only if
+                           -- there is no explicit forall
                | no_implicit_if_forall
                , L _ (HsForAllTy {}) <- hs_ty = []
                | otherwise                    = freeKiTyVarsTypeVars free_vars
@@ -297,6 +350,28 @@ and
 as our lists. We can then do normal fixity resolution on these. The fixities
 must come along for the ride just so that the list stays in sync with the
 operators.
+
+Note [Renaming named wild cards]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Identifiers starting with an underscore are always parsed as type variables.
+(Parser.y) When the NamedWildCards extension is enabled, the renamer replaces
+those variables with named wild cards.
+
+The NameSet lre_nwcs in LocalRdrEnv is used to keep the names of the type
+variables that should be replaced with named wild cards. The set is filled only
+in functions that return a LHsWcType and thus expect to find wild cards.
+In other functions, the set remains empty and the wild cards are not created.
+Because of this, the replacement does not occur in contexts where the wild
+cards are not expected, like data type declarations or type synonyms.
+(See the comments in Trac #10982)
+
+While renaming HsForAllTy (rnWcSigTy, rnHsTyKi), the explicitly bound names are
+removed from the lre_nwcs NameSet. As a result, they are not replaced in the
+quantifier body even if they start with an underscore. (Trac #11098) Eg
+
+    qux :: _a -> (forall _a . _a -> _a) -> _a
+
+The _a bound by forall is a tyvar, the _a outside the parens are wild cards.
 -}
 
 rnLHsTyKi  :: RnTyKiWhat
@@ -350,10 +425,14 @@ rnHsTyKi :: RnTyKiWhat -> HsDocContext -> HsType RdrName -> RnM (HsType Name, Fr
 rnHsTyKi what doc ty@(HsForAllTy { hst_bndrs = tyvars, hst_body  = tau })
   = do { checkTypeInType what ty
        ; bindLHsTyVarBndrs doc Nothing [] tyvars $ \ _ tyvars' ->
+    do { lcl_env <- getLocalRdrEnv
+       ; let explicitly_bound = fmap hsLTyVarName tyvars'
+       ; setLocalRdrEnv (delLocalRdrEnvNwcs lcl_env explicitly_bound) $
+           -- See Note [Renaming named wild cards]
     do { (tau',  fvs) <- rnLHsTyKi what doc tau
        ; warnUnusedForAlls (inTypeDoc ty) tyvars' fvs
        ; return ( HsForAllTy { hst_bndrs = tyvars', hst_body =  tau' }
-                , fvs) }}
+                , fvs) } } }
 
 rnHsTyKi what doc ty@(HsQualTy { hst_ctxt = lctxt
                                , hst_body = tau })
@@ -363,9 +442,13 @@ rnHsTyKi what doc ty@(HsQualTy { hst_ctxt = lctxt
        ; return (HsQualTy { hst_ctxt = ctxt', hst_body =  tau' }
                 , fvs1 `plusFV` fvs2) }
 
-rnHsTyKi what _ (HsTyVar (L loc rdr_name))
-  = do { name <- rnTyVar what rdr_name
-       ; return (HsTyVar (L loc name), unitFV name) }
+rnHsTyKi what doc (HsTyVar lname@(L loc rdr_name))
+  = do { lcl_env <- getLocalRdrEnv
+           -- See Note [Renaming named wild cards]
+       ; if rdr_name `inLocalRdrEnvNwcsRdrName` lcl_env
+         then rnHsTyKi what doc (HsWildCardTy (NamedWildCard lname))
+         else do { name <- rnTyVar what rdr_name
+                 ; return (HsTyVar (L loc name), unitFV name) } }
 
 rnHsTyKi what doc ty@(HsOpTy ty1 l_op ty2)
   = setSrcSpan (getLoc l_op) $
@@ -1418,6 +1501,8 @@ extractHsTyRdrTyVars :: LHsType RdrName -> RnM FreeKiTyVars
 --                        or the free (sort, kind) variables of a HsKind
 -- It's used when making the for-alls explicit.
 -- Does not return any wildcards
+-- When the same name occurs multiple times in the types, only the first
+-- occurence is returned.
 -- See Note [Kind and type-variable binders]
 extractHsTyRdrTyVars ty
   = do { FKTV kis k_set tys t_set all <- extract_lty TypeLevel ty emptyFKTV
@@ -1425,13 +1510,25 @@ extractHsTyRdrTyVars ty
                       (nubL tys) t_set
                       (nubL all)) }
 
-extractHsTysRdrTyVars :: [LHsType RdrName] -> RnM FreeKiTyVars
+-- | Extracts free type and kind variables from types in a list.
+-- When the same name occurs multiple times in the types, only the first
+-- occurence is returned and the rest is filtered out.
 -- See Note [Kind and type-variable binders]
+extractHsTysRdrTyVars :: [LHsType RdrName] -> RnM FreeKiTyVars
 extractHsTysRdrTyVars tys
-  = do { FKTV kis k_set tys t_set all <- extract_ltys TypeLevel tys emptyFKTV
-       ; return (FKTV (nubL kis) k_set
-                      (nubL tys) t_set
-                      (nubL all)) }
+  = rmDupsInRdrTyVars <$> extractHsTysRdrTyVarsDups tys
+
+-- | Extracts free type and kind variables from types in a list.
+-- When the same name occurs multiple times in the types, all occurences
+-- are returned.
+extractHsTysRdrTyVarsDups :: [LHsType RdrName] -> RnM FreeKiTyVars
+extractHsTysRdrTyVarsDups tys
+  = extract_ltys TypeLevel tys emptyFKTV
+
+-- | Removes multiple occurences of the same name from FreeKiTyVars.
+rmDupsInRdrTyVars :: FreeKiTyVars -> FreeKiTyVars
+rmDupsInRdrTyVars (FKTV kis k_set tys t_set all)
+  = FKTV (nubL kis) k_set (nubL tys) t_set (nubL all)
 
 extractRdrKindSigVars :: LFamilyResultSig RdrName -> RnM [Located RdrName]
 extractRdrKindSigVars (L _ resultSig)
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 026c0db2f7..8a8f1122d5 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -1315,10 +1315,20 @@ freshly generated names. These names are collected after renaming
 partial type signatures. The latter generate fresh meta-variables whereas the
 former generate fresh skolems.
 
-Named and extra-constraints wild cards are not supported in type/data family
+When the flag -fwarn-unused-matches is on, the compiler reports warnings
+about unused type variables. (rnFamInstDecl) A type variable is considered
+used when it is either occurs on the RHS of the family instance, or it occurs
+multiple times in the patterns on the LHS. In the first case, the variable
+is in the set of free variables returned by rnPayload. In the second case, there
+are multiple occurences of it in FreeKiTyVars returned by the rmDupsInRdrTyVars.
+
+The warnings are not reported for anonymous wild cards and for type variables
+with names beginning with an underscore.
+
+Extra-constraints wild cards are not supported in type/data family
 instance declarations.
 
-Relevant tickets: #3699 and #10586.
+Relevant tickets: #3699, #10586 and #10982.
 
 ************************************************************************
 *                                                                      *
diff --git a/docs/users_guide/7.12.1-notes.rst b/docs/users_guide/7.12.1-notes.rst
index a1a9d0eef3..87f92f472d 100644
--- a/docs/users_guide/7.12.1-notes.rst
+++ b/docs/users_guide/7.12.1-notes.rst
@@ -231,6 +231,11 @@ Compiler
    a warning when a pattern synonym definition doesn't have a type signature.
    It is turned off by default but enabled by ``-Wall``.
 
+-  Changed the ``-fwarn-unused-matches`` flag to report unused type variables
+   in data and type families in addition to its previous behaviour.
+   To avoid warnings, unused type variables should be prefixed or replaced with
+   underscores.
+
 GHCi
 ~~~~
 
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index da08c7b514..9b0ad3ef1e 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -6184,12 +6184,17 @@ declaration doesn't matter, it can be replaced with an underscore
     -- Equivalent to
     data instance F Int b = Int
 
+When the flag ``-fwarn-unused-matches`` is enabled, type variables that are
+mentioned in the patterns on the left hand side, but not used on the right
+hand side are reported. Variables that occur multiple times on the left hand side
+are also considered used. To suppress the warnings, unused variables should
+be either replaced or prefixed with underscores. Type variables starting with
+an underscore (``_x``) are otherwise treated as ordinary type variables.
+
 This resembles the wildcards that can be used in
 :ref:`partial-type-signatures`. However, there are some differences.
-Only anonymous wildcards are allowed in these instance declarations,
-named and extra-constraints wildcards are not. No error messages
-reporting the inferred types are generated, nor does the flag
-``-XPartialTypeSignatures`` have any effect.
+No error messages reporting the inferred types are generated, nor does
+the flag ``-XPartialTypeSignatures`` have any effect.
 
 Data and newtype instance declarations are only permitted when an
 appropriate family declaration is in scope - just as a class instance
@@ -6357,8 +6362,9 @@ for data instances. For example, the ``[e]`` instance for ``Elem`` is
 
 Type arguments can be replaced with underscores (``_``) if the names of
 the arguments don't matter. This is the same as writing type variables
-with unique names. The same rules apply as for
-:ref:`data-instance-declarations`.
+with unique names. Unused type arguments should be replaced or prefixed
+with underscores to avoid warnings when the `-fwarn-unused-matches` flag
+is enabled. The same rules apply as for :ref:`data-instance-declarations`.
 
 Type family instance declarations are only legitimate when an
 appropriate family declaration is in scope - just like class instances
@@ -9493,9 +9499,9 @@ wildcards are not supported in pattern or expression signatures.
     foo (x :: _) = (x :: _)
     -- Inferred: forall w_. w_ -> w_
 
-Anonymous wildcards *can* occur in type or data instance declarations.
-However, these declarations are not partial type signatures and
-different rules apply. See :ref:`data-instance-declarations` for more
+Anonymous and named wildcards *can* occur in type or data instance
+declarations. However, these declarations are not partial type signatures
+and different rules apply. See :ref:`data-instance-declarations` for more
 details.
 
 Partial type signatures can also be used in :ref:`template-haskell`
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 9748e47fe5..f95ffc9869 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -862,7 +862,8 @@ of ``-W(no-)*``.
        single: matches, unused
 
     Report all unused variables which arise from pattern matches,
-    including patterns consisting of a single variable. For instance
+    including patterns consisting of a single variable. This includes
+    unused type variables in type family instances. For instance
     ``f x y = []`` would report ``x`` and ``y`` as unused. The warning
     is suppressed if the variable name begins with an underscore, thus:
 
diff --git a/libraries/base/Data/Either.hs b/libraries/base/Data/Either.hs
index 50e95824c8..26cd7aa7fd 100644
--- a/libraries/base/Data/Either.hs
+++ b/libraries/base/Data/Either.hs
@@ -281,7 +281,7 @@ isRight (Right _) = True
 type family EqEither a b where
   EqEither ('Left x)  ('Left y)  = x == y
   EqEither ('Right x) ('Right y) = x == y
-  EqEither a         b           = 'False
+  EqEither _a         _b         = 'False
 type instance a == b = EqEither a b
 
 {-
diff --git a/libraries/base/Data/Type/Bool.hs b/libraries/base/Data/Type/Bool.hs
index 137e266501..acac3eb592 100644
--- a/libraries/base/Data/Type/Bool.hs
+++ b/libraries/base/Data/Type/Bool.hs
@@ -28,14 +28,14 @@ import Data.Bool
 
 -- | Type-level "If". @If True a b@ ==> @a@; @If False a b@ ==> @b@
 type family If cond tru fls where
-  If 'True  tru fls = tru
-  If 'False tru fls = fls
+  If 'True   tru _fls = tru
+  If 'False _tru  fls = fls
 
 -- | Type-level "and"
 type family a && b where
-  'False && a      = 'False
+  'False && _a     = 'False
   'True  && a      = a
-  a      && 'False = 'False
+  _a     && 'False = 'False
   a      && 'True  = a
   a      && a      = a
 infixr 3 &&
@@ -43,9 +43,9 @@ infixr 3 &&
 -- | Type-level "or"
 type family a || b where
   'False || a      = a
-  'True  || a      = 'True
+  'True  || _a     = 'True
   a      || 'False = a
-  a      || 'True  = 'True
+  _a     || 'True  = 'True
   a      || a      = a
 infixr 2 ||
 
diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs
index 28a66f2c9d..027a80092b 100644
--- a/libraries/base/Data/Type/Equality.hs
+++ b/libraries/base/Data/Type/Equality.hs
@@ -205,37 +205,37 @@ families.
 
 -- all of the following closed type families are local to this module
 type family EqStar (a :: *) (b :: *) where
-  EqStar a a = 'True
-  EqStar a b = 'False
+  EqStar _a _a = 'True
+  EqStar _a _b = 'False
 
 -- This looks dangerous, but it isn't. This allows == to be defined
 -- over arbitrary type constructors.
 type family EqArrow (a :: k1 -> k2) (b :: k1 -> k2) where
-  EqArrow a a = 'True
-  EqArrow a b = 'False
+  EqArrow _a _a = 'True
+  EqArrow _a _b = 'False
 
 type family EqBool a b where
   EqBool 'True  'True  = 'True
   EqBool 'False 'False = 'True
-  EqBool a     b       = 'False
+  EqBool _a     _b     = 'False
 
 type family EqOrdering a b where
   EqOrdering 'LT 'LT = 'True
   EqOrdering 'EQ 'EQ = 'True
   EqOrdering 'GT 'GT = 'True
-  EqOrdering a  b    = 'False
+  EqOrdering _a  _b  = 'False
 
 type EqUnit (a :: ()) (b :: ()) = 'True
 
 type family EqList a b where
   EqList '[]        '[]        = 'True
   EqList (h1 ': t1) (h2 ': t2) = (h1 == h2) && (t1 == t2)
-  EqList a          b          = 'False
+  EqList _a         _b         = 'False
 
 type family EqMaybe a b where
   EqMaybe 'Nothing   'Nothing  = 'True
   EqMaybe ('Just x) ('Just y)  = x == y
-  EqMaybe a        b           = 'False
+  EqMaybe _a        _b         = 'False
 
 type family Eq2 a b where
   Eq2 '(a1, b1) '(a2, b2) = a1 == a2 && b1 == b2
diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index 43b210da6f..67b98be5ee 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -699,27 +699,27 @@ newtype (:.:) f (g :: * -> *) (p :: *) = Comp1 { unComp1 :: f (g p) }
 data family URec (a :: *) (p :: *)
 
 -- | Used for marking occurrences of 'Addr#'
-data instance URec (Ptr ()) p = UAddr { uAddr# :: Addr# }
+data instance URec (Ptr ()) _p = UAddr { uAddr# :: Addr# }
   deriving (Eq, Ord, Generic)
 
 -- | Used for marking occurrences of 'Char#'
-data instance URec Char p = UChar { uChar# :: Char# }
+data instance URec Char _p = UChar { uChar# :: Char# }
   deriving (Eq, Ord, Show, Generic)
 
 -- | Used for marking occurrences of 'Double#'
-data instance URec Double p = UDouble { uDouble# :: Double# }
+data instance URec Double _p = UDouble { uDouble# :: Double# }
   deriving (Eq, Ord, Show, Generic)
 
 -- | Used for marking occurrences of 'Float#'
-data instance URec Float p = UFloat { uFloat# :: Float# }
+data instance URec Float _p = UFloat { uFloat# :: Float# }
   deriving (Eq, Ord, Show, Generic)
 
 -- | Used for marking occurrences of 'Int#'
-data instance URec Int p = UInt { uInt# :: Int# }
+data instance URec Int _p = UInt { uInt# :: Int# }
   deriving (Eq, Ord, Show, Generic)
 
 -- | Used for marking occurrences of 'Word#'
-data instance URec Word p = UWord { uWord# :: Word# }
+data instance URec Word _p = UWord { uWord# :: Word# }
   deriving (Eq, Ord, Show, Generic)
 
 -- | Type synonym for 'URec': 'Addr#'
@@ -931,7 +931,7 @@ class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where
   fromSing :: Sing (a :: k) -> DemoteRep kparam
 
 -- Singleton booleans
-data instance Sing (a :: Bool) where
+data instance Sing (_a :: Bool) where
   STrue  :: Sing 'True
   SFalse :: Sing 'False
 
@@ -944,7 +944,7 @@ instance SingKind ('KProxy :: KProxy Bool) where
   fromSing SFalse = False
 
 -- Singleton Fixity
-data instance Sing (a :: FixityI) where
+data instance Sing (_a :: FixityI) where
   SPrefix :: Sing 'PrefixI
   SInfix  :: Sing a -> Integer -> Sing ('InfixI a n)
 
@@ -958,7 +958,7 @@ instance SingKind ('KProxy :: KProxy FixityI) where
   fromSing (SInfix a n) = Infix (fromSing a) (I# (integerToInt n))
 
 -- Singleton Associativity
-data instance Sing (a :: Associativity) where
+data instance Sing (_a :: Associativity) where
   SLeftAssociative  :: Sing 'LeftAssociative
   SRightAssociative :: Sing 'RightAssociative
   SNotAssociative   :: Sing 'NotAssociative
diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs
index a51ba910e0..b32721d63c 100644
--- a/libraries/base/GHC/TypeLits.hs
+++ b/libraries/base/GHC/TypeLits.hs
@@ -146,13 +146,13 @@ instance Read SomeSymbol where
   readsPrec p xs = [ (someSymbolVal a, ys) | (a,ys) <- readsPrec p xs ]
 
 type family EqNat (a :: Nat) (b :: Nat) where
-  EqNat a a = 'True
-  EqNat a b = 'False
+  EqNat _a _a = 'True
+  EqNat _a _b = 'False
 type instance a == b = EqNat a b
 
 type family EqSymbol (a :: Symbol) (b :: Symbol) where
-  EqSymbol a a = 'True
-  EqSymbol a b = 'False
+  EqSymbol _a _a = 'True
+  EqSymbol _a _b = 'False
 type instance a == b = EqSymbol a b
 
 --------------------------------------------------------------------------------
diff --git a/testsuite/tests/determinism/should_compile/determ004.hs b/testsuite/tests/determinism/should_compile/determ004.hs
index c74f8d02d8..88fe88a770 100644
--- a/testsuite/tests/determinism/should_compile/determ004.hs
+++ b/testsuite/tests/determinism/should_compile/determ004.hs
@@ -225,7 +225,7 @@ data TyFun (a :: *) (b :: *)
 
 type family Apply (f :: TyFun k1 k2 -> *) (x :: k1) :: k2
 
-data instance Sing (f :: TyFun k1 k2 -> *) =
+data instance Sing (f :: TyFun _k1 _k2 -> *) =
   SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) }
 
 type SingFunction1 f = forall t. Sing t -> Sing (Apply f t)
@@ -273,9 +273,9 @@ type family Foldr1 (a_afe5 :: TyFun a_afdP (TyFun a_afdP a_afdP
                                             -> *)
                               -> *)
                    (a_afe6 :: [a_afdP]) :: a_afdP where
-  Foldr1 z_afe7 '[x_afe8] = x_afe8
+  Foldr1 _z_afe7 '[x_afe8] = x_afe8
   Foldr1 f_afe9 ((:) x_afea ((:) wild_1627448474_afeb wild_1627448476_afec)) = Apply (Apply f_afe9 x_afea) (Apply (Apply Foldr1Sym0 f_afe9) (Let1627448493XsSym4 f_afe9 x_afea wild_1627448474_afeb wild_1627448476_afec))
-  Foldr1 z_afew '[] = Apply ErrorSym0 "Data.Singletons.List.foldr1: empty list"
+  Foldr1 _z_afew '[] = Apply ErrorSym0 "Data.Singletons.List.foldr1: empty list"
 
 sFoldr1 ::
   forall (x :: TyFun a_afdP (TyFun a_afdP a_afdP -> *) -> *)
diff --git a/testsuite/tests/ghci/scripts/T11098.script b/testsuite/tests/ghci/scripts/T11098.script
new file mode 100644
index 0000000000..ad42ba5307
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T11098.script
@@ -0,0 +1,13 @@
+-- See Trac #11098

+

+:set -XTemplateHaskell

+:set -XNamedWildCards

+:set -XScopedTypeVariables

+

+:m +Data.Char

+:m +Language.Haskell.TH

+

+runQ [d|foo :: a -> a;foo x = x|]

+runQ $ fmap (filter (not . isDigit) . show) [d|foo :: _a -> _a; foo x = x|]

+runQ [d|foo :: forall _a . _a -> _a ; foo x = x|]

+

diff --git a/testsuite/tests/ghci/scripts/T11098.stdout b/testsuite/tests/ghci/scripts/T11098.stdout
new file mode 100644
index 0000000000..27ddd486ca
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T11098.stdout
@@ -0,0 +1,3 @@
+[SigD foo_1 (ForallT [PlainTV a_0] [] (AppT (AppT ArrowT (VarT a_0)) (VarT a_0))),FunD foo_1 [Clause [VarP x_2] (NormalB (VarE x_2)) []]]

+"[SigD foo_ (AppT (AppT ArrowT (WildCardT (Just _a_))) (WildCardT (Just _a_))),FunD foo_ [Clause [VarP x_] (NormalB (VarE x_)) []]]"

+[SigD foo_6 (ForallT [PlainTV _a_5] [] (AppT (AppT ArrowT (VarT _a_5)) (VarT _a_5))),FunD foo_6 [Clause [VarP x_7] (NormalB (VarE x_7)) []]]

diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 5c25cf8bb0..5d57f4ea33 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -230,3 +230,4 @@ test('T10989',
       extra_clean(['dummy.hs', 'dummy.lhs', 'dummy.tags'])
     ],
     ghci_script, ['T10989.script'])
+test('T11098', normal, ghci_script, ['T11098.script'])
diff --git a/testsuite/tests/indexed-types/should_compile/T10931.hs b/testsuite/tests/indexed-types/should_compile/T10931.hs
index 2c0ea204d3..44e5865177 100644
--- a/testsuite/tests/indexed-types/should_compile/T10931.hs
+++ b/testsuite/tests/indexed-types/should_compile/T10931.hs
@@ -20,6 +20,6 @@ class ( m ~ Outer m (Inner m) ) => BugC (m :: * -> *) where
 
 instance BugC (IdT m) where
     type Inner (IdT m) = m
-    type Outer (IdT m) = IdT
+    type Outer (IdT _) = IdT
 
     bug f = IdC f
diff --git a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.hs b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.hs
new file mode 100644
index 0000000000..e286f76e3f
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE TypeFamilies, PolyKinds #-}
+
+-- See Trac #10982
+
+module UnusedTyVarWarnings where
+
+type family C a b where
+  C a b = a                 -- should warn
+
+type family C2 a b
+type instance C2 a b = a    -- should warn
+
+type family D a b where
+  D a _b = a                -- should not warn
+
+type family D2 a b
+type instance D2 a _b = a   -- should not warn
+
+type family E a b where
+  E a _ = a                 -- should not warn
+
+type family E2 a b
+type instance E2 a _ = a    -- should not warn
+
+type family X a b where
+  X a a = Int               -- a is considered used, do not warn
+  X a Int = Bool            -- here a is unused
+
+type family Y a b c where
+  Y a b b = a               -- b is used, do no warn
+
+data family I a b c
+data instance I a b c = IDC1 a | IDC2 c  -- should warn
+
+data family J a b
+data instance J a _b = JDC a  -- should not warn
+
+data family K a b
+data instance K a _ = KDC a   -- should not warn
diff --git a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr
new file mode 100644
index 0000000000..1bfced7943
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarnings.stderr
@@ -0,0 +1,15 @@
+UnusedTyVarWarnings.hs:8:5: warning:
+    Defined but not used: type variable ‘b’
+
+UnusedTyVarWarnings.hs:11:18: warning:
+    Defined but not used: type variable ‘b’
+
+UnusedTyVarWarnings.hs:27:5: warning:
+    Defined but not used: type variable ‘a’
+
+UnusedTyVarWarnings.hs:33:17: warning:
+    Defined but not used: type variable ‘b’
+
+
+
+
diff --git a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.hs b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.hs
new file mode 100644
index 0000000000..6d3a48e746
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE TypeFamilies, PolyKinds, NamedWildCards #-}
+
+-- See Trac #10982
+
+module UnusedTyVarWarningsNamedWCs where
+
+type family C a b where
+  C a b = a                 -- should warn
+
+type family C2 a b
+type instance C2 a b = a    -- should warn
+
+type family D a b where
+  D a _b = a                -- should not warn
+
+type family D2 a b
+type instance D2 a _b = a   -- should not warn
+
+type family E a b where
+  E a _ = a                 -- should not warn
+
+type family E2 a b
+type instance E2 a _ = a    -- should not warn
+
+type family X a b where
+  X a a = Int               -- a is considered used, do not warn
+  X a Int = Bool            -- here a is unused
+
+type family Y a b c where
+  Y a b b = a               -- b is used, do no warn
+
+data family I a b c
+data instance I a b c = IDC1 a | IDC2 c  -- should warn
+
+data family J a b
+data instance J a _b = JDC a  -- should not warn
+
+data family K a b
+data instance K a _ = KDC a   -- should not warn
diff --git a/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr
new file mode 100644
index 0000000000..c4895aaab8
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/UnusedTyVarWarningsNamedWCs.stderr
@@ -0,0 +1,12 @@
+UnusedTyVarWarningsNamedWCs.hs:8:5: warning:
+    Defined but not used: type variable ‘b’
+
+UnusedTyVarWarningsNamedWCs.hs:11:18: warning:
+    Defined but not used: type variable ‘b’
+
+UnusedTyVarWarningsNamedWCs.hs:27:5: warning:
+    Defined but not used: type variable ‘a’
+
+UnusedTyVarWarningsNamedWCs.hs:33:17: warning:
+    Defined but not used: type variable ‘b’
+
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index d4ff607b56..15c5b3e027 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -268,3 +268,5 @@ test('T10931', normal, compile, [''])
 test('T11187', normal, compile, [''])
 test('T11067', normal, compile, [''])
 test('T10318', normal, compile, [''])
+test('UnusedTyVarWarnings', normal, compile, ['-W'])
+test('UnusedTyVarWarningsNamedWCs', normal, compile, ['-W'])
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInDataFamilyInstanceLHS.hs b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.hs
index 65bad72c39..65bad72c39 100644
--- a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInDataFamilyInstanceLHS.hs
+++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.hs
diff --git a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr
new file mode 100644
index 0000000000..730c0ed571
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr
@@ -0,0 +1,14 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+  data MyKind = A | B
+    Kind: *
+  data family Sing (a :: k)
+COERCION AXIOMS
+  axiom NamedWildcardInDataFamilyInstanceLHS.TFCo:R:SingMyKind_a ::
+    Sing = NamedWildcardInDataFamilyInstanceLHS.R:SingMyKind_a
+      -- Defined at NamedWildcardInDataFamilyInstanceLHS.hs:8:15
+FAMILY INSTANCES
+  data instance Sing
+Dependent modules: []
+Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0,
+                     integer-gmp-1.0.0.0]
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeFamilyInstanceLHS.hs b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.hs
index dabd781af8..b171221058 100644
--- a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeFamilyInstanceLHS.hs
+++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE NamedWildCards #-}
+{-# LANGUAGE TypeFamilies, NamedWildCards #-}
 module NamedWildcardInTypeFamilyInstanceLHS where
 
 type family F a where
diff --git a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr
new file mode 100644
index 0000000000..84a7b4a55a
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr
@@ -0,0 +1,14 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+  type family F a
+    Kind: * -> *
+    where
+      [_t] F _t = Int
+      axiom NamedWildcardInTypeFamilyInstanceLHS.TFCo:R:F
+COERCION AXIOMS
+  axiom NamedWildcardInTypeFamilyInstanceLHS.TFCo:R:F ::
+    F _t = Int
+      -- Defined at NamedWildcardInTypeFamilyInstanceLHS.hs:5:3
+Dependent modules: []
+Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0,
+                     integer-gmp-1.0.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/NamedWildcardsAsTyVars.hs b/testsuite/tests/partial-sigs/should_compile/NamedWildcardsAsTyVars.hs
new file mode 100644
index 0000000000..8d824f5fec
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardsAsTyVars.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE TypeFamilies, NamedWildCards, PolyKinds #-}
+
+-- All declarations below are accepted when the NamedWildCards extension is not
+-- enabled and the identifiers starting with _ are parsed as type variables.
+-- They should remain valid when the extension is on.
+--
+-- See Trac #11098 and comments in #10982
+
+module NamedWildcardsAsTyVars where
+
+type Synonym _a = _a -> _a
+
+data A a _b = ACon a a Int
+
+data B _a b = BCon _a (_a, Bool)
+
+type family C a b where
+  C _a _b = _a -> _a
+
+type family D a b where
+  D _a b = _a -> (_a, Int)
+
+data family E a b
+data instance E a _b = ECon a (a, Int)
+
+data family F a b
+data instance F _a b = FCon _a _a Bool
+
+class G _a where
+    gfoo :: _a -> _a
+
+instance G Int where
+    gfoo = (*2)
+
+type family H a b where
+  H _a _a = Int
+  H _a _b = Bool
+
+hfoo :: H String String
+hfoo = 10
+
+hbar :: H String Int
+hbar = False
+
+type family I (_a :: k) where
+    I _t = Int
diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T
index caa8934419..2d600a6f5e 100644
--- a/testsuite/tests/partial-sigs/should_compile/all.T
+++ b/testsuite/tests/partial-sigs/should_compile/all.T
@@ -32,6 +32,9 @@ test('Meltdown', normal, compile, ['-ddump-types -fno-warn-partial-type-signatur
 # Bug
 test('MonoLocalBinds', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
 test('NamedTyVar', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
+test('NamedWildcardInDataFamilyInstanceLHS', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
+test('NamedWildcardInTypeFamilyInstanceLHS', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
+test('NamedWildcardsAsTyVars', normal, compile, [''])
 test('ParensAroundContext', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
 test('PatBind', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
 # Bug
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.hs b/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.hs
new file mode 100644
index 0000000000..d0e6e8a14d
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE RankNTypes, NamedWildCards #-}
+
+-- See Trac #11098
+
+module NamedWildcardExplicitForall where
+
+foo :: forall _a . _a -> _a                -- _a is a type variable
+foo = not
+
+bar :: _a -> _a                            -- _a is a named wildcard
+bar = not
+
+baz :: forall _a . _a -> _b -> (_a, _b)    -- _a is a variable, _b is a wildcard
+baz x y = (not x, not y)
+
+qux :: _a -> (forall _a . _a -> _a) -> _a  -- the _a bound by forall is a tyvar
+qux x f = let _ = f 7 in not x             -- the other _a are wildcards
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr b/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr
new file mode 100644
index 0000000000..bfe68d8718
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr
@@ -0,0 +1,51 @@
+
+NamedWildcardExplicitForall.hs:8:7: error:
+    • Couldn't match type ‘_a’ with ‘Bool’
+      ‘_a’ is a rigid type variable bound by
+        the type signature for:
+          foo :: forall _a. _a -> _a
+        at NamedWildcardExplicitForall.hs:7:15
+      Expected type: _a -> _a
+        Actual type: Bool -> Bool
+    • In the expression: not
+      In an equation for ‘foo’: foo = not
+    • Relevant bindings include
+        foo :: _a -> _a (bound at NamedWildcardExplicitForall.hs:8:1)
+
+NamedWildcardExplicitForall.hs:10:8: error:
+    • Found type wildcard ‘_a’ standing for ‘Bool’
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature:
+        bar :: _a -> _a
+    • Relevant bindings include
+        bar :: Bool -> Bool (bound at NamedWildcardExplicitForall.hs:11:1)
+
+NamedWildcardExplicitForall.hs:13:26: error:
+    • Found type wildcard ‘_b’ standing for ‘Bool’
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature:
+        baz :: forall _a. _a -> _b -> (_a, _b)
+    • Relevant bindings include
+        baz :: _a -> Bool -> (_a, Bool)
+          (bound at NamedWildcardExplicitForall.hs:14:1)
+
+NamedWildcardExplicitForall.hs:14:12: error:
+    • Couldn't match expected type ‘_a’ with actual type ‘Bool’
+      ‘_a’ is a rigid type variable bound by
+        the inferred type of baz :: _a -> Bool -> (_a, Bool)
+        at NamedWildcardExplicitForall.hs:13:15
+    • In the expression: not x
+      In the expression: (not x, not y)
+    • Relevant bindings include
+        x :: _a (bound at NamedWildcardExplicitForall.hs:14:5)
+        baz :: _a -> Bool -> (_a, Bool)
+          (bound at NamedWildcardExplicitForall.hs:14:1)
+
+NamedWildcardExplicitForall.hs:16:8: error:
+    • Found type wildcard ‘_a’ standing for ‘Bool’
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature:
+        qux :: _a -> (forall _a. _a -> _a) -> _a
+    • Relevant bindings include
+        qux :: Bool -> (forall _a. _a -> _a) -> Bool
+          (bound at NamedWildcardExplicitForall.hs:17:1)
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInDataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_fail/NamedWildcardInDataFamilyInstanceLHS.stderr
deleted file mode 100644
index e07751d2f4..0000000000
--- a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInDataFamilyInstanceLHS.stderr
+++ /dev/null
@@ -1,4 +0,0 @@
-

-NamedWildcardInDataFamilyInstanceLHS.hs:8:21: error:

-    Wildcard ‘_a’ not allowed

-      in a type pattern of family instance for ‘Sing’

diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeFamilyInstanceLHS.stderr
deleted file mode 100644
index f56d972172..0000000000
--- a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeFamilyInstanceLHS.stderr
+++ /dev/null
@@ -1,4 +0,0 @@
-

-NamedWildcardInTypeFamilyInstanceLHS.hs:5:5: error:

-    Wildcard ‘_t’ not allowed

-      in a type pattern of family instance for ‘F’

diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.stderr b/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.stderr
index ba860445a3..d3dbc1c2cb 100644
--- a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.stderr
@@ -1,10 +1,8 @@
 

 NamedWildcardInTypeSplice.hs:8:16: error:

-    Wildcard ‘_a’ not allowed

-      in a Template-Haskell quoted type

-    In the Template Haskell quotation [t| _a -> _a |]

+    • Not in scope: type variable ‘_a’

+    • In the Template Haskell quotation [t| _a -> _a |]

 

 NamedWildcardInTypeSplice.hs:8:22: error:

-    Wildcard ‘_a’ not allowed

-      in a Template-Haskell quoted type

-    In the Template Haskell quotation [t| _a -> _a |]

+    • Not in scope: type variable ‘_a’

+    • In the Template Haskell quotation [t| _a -> _a |]

diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInADTContext2.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInADTContext2.stderr
index ea145785e6..efa5707692 100644
--- a/testsuite/tests/partial-sigs/should_fail/WildcardInADTContext2.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/WildcardInADTContext2.stderr
@@ -3,5 +3,5 @@ WildcardInADTContext2.hs:1:53: warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.

 

 WildcardInADTContext2.hs:4:10: error:

-    Wildcard ‘_a’ not allowed

-      in the data type declaration for ‘Foo’

+    Not in scope: type variable ‘_a’

+    Perhaps you meant ‘a’ (line 4)

diff --git a/testsuite/tests/partial-sigs/should_fail/all.T b/testsuite/tests/partial-sigs/should_fail/all.T
index 2cb65f000b..649079e6c6 100644
--- a/testsuite/tests/partial-sigs/should_fail/all.T
+++ b/testsuite/tests/partial-sigs/should_fail/all.T
@@ -18,10 +18,9 @@ test('ExtraConstraintsWildcardTwice', normal, compile_fail, [''])
 test('Forall1Bad', normal, compile_fail, [''])
 test('InstantiatedNamedWildcardsInConstraints', normal, compile_fail, [''])
 test('NamedExtraConstraintsWildcard', normal, compile_fail, [''])
+test('NamedWildcardExplicitForall', normal, compile_fail, [''])
 test('NamedWildcardInTypeSplice', normal, compile_fail, [''])
 test('NamedWildcardsEnabled', normal, compile_fail, [''])
-test('NamedWildcardInDataFamilyInstanceLHS', normal, compile_fail, [''])
-test('NamedWildcardInTypeFamilyInstanceLHS', normal, compile_fail, [''])
 test('NamedWildcardsNotEnabled', normal, compile_fail, [''])
 test('NamedWildcardsNotInMonotype', normal, compile_fail, [''])
 test('NestedExtraConstraintsWildcard', normal, compile_fail, [''])
diff --git a/testsuite/tests/simplCore/should_compile/T10689a.hs b/testsuite/tests/simplCore/should_compile/T10689a.hs
index 5b21b42db7..477d80cb14 100644
--- a/testsuite/tests/simplCore/should_compile/T10689a.hs
+++ b/testsuite/tests/simplCore/should_compile/T10689a.hs
@@ -76,9 +76,9 @@ type family Foldr1 (a_afe5 :: TyFun a_afdP (TyFun a_afdP a_afdP
                                             -> *)
                               -> *)
                    (a_afe6 :: [a_afdP]) :: a_afdP where
-  Foldr1 z_afe7 '[x_afe8] = x_afe8
+  Foldr1 _z_afe7 '[x_afe8] = x_afe8
   Foldr1 f_afe9 ((:) x_afea ((:) wild_1627448474_afeb wild_1627448476_afec)) = Apply (Apply f_afe9 x_afea) (Apply (Apply Foldr1Sym0 f_afe9) (Let1627448493XsSym4 f_afe9 x_afea wild_1627448474_afeb wild_1627448476_afec))
-  Foldr1 z_afew '[] = Apply ErrorSym0 "Data.Singletons.List.foldr1: empty list"
+  Foldr1 _z_afew '[] = Apply ErrorSym0 "Data.Singletons.List.foldr1: empty list"
 
 sFoldr1 ::
   forall (x :: TyFun a_afdP (TyFun a_afdP a_afdP -> *) -> *)