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

5 files changed, 28 insertions, 28 deletions

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
 
 --------------------------------------------------------------------------------