Commit eb7796f1 authored by msosn's avatar msosn Committed by Ben Gamari

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
parent b225b234
......@@ -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]
......
......@@ -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
......
......@@ -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
{-
%************************************************************************
%* *
......
......@@ -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
......
......@@ -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 -> []
......
......@@ -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)
......
......@@ -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.
************************************************************************
* *
......
......@@ -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
~~~~
......
......@@ -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`
......
......@@ -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:
......
......@@ -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
{-
......
......@@ -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"