Commit c3f63fb7 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Report on unused type variables (fixes #5331)

We were doing this already for explicit types like
   f :: forall a. Int
but not for constructor declarations.  This patch
makes it consistent.
parent 8d1464c0
......@@ -702,18 +702,18 @@ renameSig _ (IdSig x)
= return (IdSig x) -- Actually this never occurs
renameSig mb_names sig@(TypeSig vs ty)
= do { new_vs <- mapM (lookupSigOccRn mb_names sig) vs
; new_ty <- rnHsSigType (quotes (ppr vs)) ty
; new_ty <- rnHsSigType (ppr_sig_bndrs vs) ty
; return (TypeSig new_vs new_ty) }
renameSig mb_names sig@(GenericSig vs ty)
= do { defaultSigs_on <- xoptM Opt_DefaultSignatures
; unless defaultSigs_on (addErr (defaultSigErr sig))
; new_v <- mapM (lookupSigOccRn mb_names sig) vs
; new_ty <- rnHsSigType (quotes (ppr vs)) ty
; new_ty <- rnHsSigType (ppr_sig_bndrs vs) ty
; return (GenericSig new_v new_ty) }
renameSig _ (SpecInstSig ty)
= do { new_ty <- rnLHsType (text "A SPECIALISE instance pragma") ty
= do { new_ty <- rnLHsType (text "In a SPECIALISE instance pragma") ty
; return (SpecInstSig new_ty) }
-- {-# SPECIALISE #-} pragmas can refer to imported Ids
......@@ -734,6 +734,9 @@ renameSig mb_names sig@(InlineSig v s)
renameSig mb_names sig@(FixSig (FixitySig v f))
= do { new_v <- lookupSigOccRn mb_names sig v
; return (FixSig (FixitySig new_v f)) }
ppr_sig_bndrs :: [Located RdrName] -> SDoc
ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)
\end{code}
......
......@@ -19,7 +19,7 @@ import HsSyn
import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv, rdrNameOcc )
import RdrHsSyn ( extractHsRhoRdrTyVars )
import RnHsSyn
import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext, rnConDeclFields )
import RnTypes
import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
makeMiniFixityEnv)
import RnEnv ( lookupLocalDataTcNames, lookupLocatedOccRn,
......@@ -531,7 +531,7 @@ rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
rnSrcDerivDecl (DerivDecl ty)
= do { standalone_deriv_ok <- xoptM Opt_StandaloneDeriving
; unless standalone_deriv_ok (addErr standaloneDerivErr)
; ty' <- rnLHsType (text "a deriving decl") ty
; ty' <- rnLHsType (text "In a deriving declaration") ty
; let fvs = extractHsTyNames ty'
; return (DerivDecl ty', fvs) }
......@@ -919,12 +919,16 @@ rnConDecl decl@(ConDecl { con_name = name, con_qvars = tvs
; rdr_env <- getLocalRdrEnv
; let in_scope = (`elemLocalRdrEnv` rdr_env) . unLoc
arg_tys = hsConDeclArgTys details
implicit_tvs = case res_ty of
mentioned_tvs = case res_ty of
ResTyH98 -> filterOut in_scope (get_rdr_tvs arg_tys)
ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
new_tvs = case expl of
Explicit -> tvs
Implicit -> userHsTyVarBndrs implicit_tvs
-- With an Explicit forall, check for unused binders
-- With Implicit, find the mentioned ones, and use them as binders
; new_tvs <- case expl of
Implicit -> return (userHsTyVarBndrs mentioned_tvs)
Explicit -> do { warnUnusedForAlls doc tvs mentioned_tvs
; return tvs }
; mb_doc' <- rnMbLHsDoc mb_doc
......
......@@ -11,7 +11,7 @@ module RnTypes (
-- Precence related stuff
mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
checkPrecMatch, checkSectionPrec,
checkPrecMatch, checkSectionPrec, warnUnusedForAlls,
-- Splice related stuff
rnSplice, checkTH
......@@ -36,6 +36,7 @@ import Name
import SrcLoc
import NameSet
import Util ( filterOut )
import BasicTypes ( compareFixity, funTyFixity, negateFixity,
Fixity(..), FixityDirection(..) )
import Outputable
......@@ -93,19 +94,16 @@ rnHsType doc (HsForAllTy Implicit _ ctxt ty) = do
rnForAll doc Implicit tyvar_bndrs ctxt ty
rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau) = do
-- Explicit quantification.
-- Check that the forall'd tyvars are actually
-- mentioned in the type, and produce a warning if not
let
mentioned = map unLoc (extractHsRhoRdrTyVars ctxt tau)
forall_tyvar_names = hsLTyVarLocNames forall_tyvars
-- Explicitly quantified but not mentioned in ctxt or tau
warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
rnHsType doc ty@(HsForAllTy Explicit forall_tyvars ctxt tau)
= do { -- Explicit quantification.
-- Check that the forall'd tyvars are actually
-- mentioned in the type, and produce a warning if not
let mentioned = extractHsRhoRdrTyVars ctxt tau
in_type_doc = ptext (sLit "In the type") <+> quotes (ppr ty)
; warnUnusedForAlls (in_type_doc $$ doc) forall_tyvars mentioned
mapM_ (forAllWarn doc tau) warn_guys
rnForAll doc Explicit forall_tyvars ctxt tau
; -- rnForAll does the rest
rnForAll doc Explicit forall_tyvars ctxt tau }
rnHsType _ (HsTyVar tyvar) = do
tyvar' <- lookupOccRn tyvar
......@@ -560,14 +558,19 @@ ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)
%*********************************************************
\begin{code}
forAllWarn :: SDoc -> LHsType RdrName -> Located RdrName
-> TcRnIf TcGblEnv TcLclEnv ()
forAllWarn doc ty (L loc tyvar)
= ifWOptM Opt_WarnUnusedMatches $
addWarnAt loc (sep [ptext (sLit "The universally quantified type variable") <+> quotes (ppr tyvar),
nest 4 (ptext (sLit "does not appear in the type") <+> quotes (ppr ty))]
$$
doc)
warnUnusedForAlls :: SDoc -> [LHsTyVarBndr RdrName] -> [Located RdrName] -> TcM ()
warnUnusedForAlls in_doc bound used
= ifWOptM Opt_WarnUnusedMatches $
mapM_ add_warn bound_but_not_used
where
bound_names = hsLTyVarLocNames bound
bound_but_not_used = filterOut ((`elem` mentioned_rdrs) . unLoc) bound_names
mentioned_rdrs = map unLoc used
add_warn (L loc tv)
= addWarnAt loc $
vcat [ ptext (sLit "Unused quantified type variable") <+> quotes (ppr tv)
, in_doc ]
opTyErr :: RdrName -> HsType RdrName -> SDoc
opTyErr op ty@(HsOpTy ty1 _ _)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment