Commit 685f6314 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Fix Trac #3221: renamer warnings for deriving clauses

This patch arranges to gather the variables used by 'deriving' clauses,
so that unused bindings are correctly reported.
parent 389cca21
......@@ -216,6 +216,8 @@ rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
return decls'
addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
-- This function could be defined lower down in the module hierarchy,
-- but there doesn't seem anywhere very logical to put it.
addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
......@@ -659,10 +661,10 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
else lookupLocatedTopBndrRn tycon
; context' <- rnContext data_doc context
; typats' <- rnTyPats data_doc typatsMaybe
; (derivs', deriv_fvs) <- rn_derivs derivs
; condecls' <- rnConDecls (unLoc tycon') condecls
-- No need to check for duplicate constructor decls
-- since that is done by RnNames.extendGlobalRdrEnvRn
; (derivs', deriv_fvs) <- rn_derivs derivs
; return (TyData {tcdND = new_or_data, tcdCtxt = context',
tcdLName = tycon', tcdTyVars = tyvars',
tcdTyPats = typats', tcdKindSig = Nothing,
......@@ -689,11 +691,11 @@ rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
-- do not scope over the constructor signatures
-- data T a where { T1 :: forall b. b-> b }
; (derivs', deriv_fvs) <- rn_derivs derivs
; condecls' <- rnConDecls (unLoc tycon') condecls
-- No need to check for duplicate constructor decls
-- since that is done by RnNames.extendGlobalRdrEnvRn
; (derivs', deriv_fvs) <- rn_derivs derivs
; return (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
tcdLName = tycon', tcdTyVars = tyvars',
tcdTyPats = typats', tcdKindSig = sig,
......
......@@ -257,7 +257,12 @@ There may be a coercion needed which we get from the tycon for the newtype
when the dict is constructed in TcInstDcls.tcInstDecl2
Note [Unused constructors and deriving clauses]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See Trac #3221. Consider
data T = T1 | T2 deriving( Show )
Are T1 and T2 unused? Well, no: the deriving clause expands to mention
both of them. So we gather defs/uses from deriving just like anything else.
%************************************************************************
%* *
......@@ -270,10 +275,11 @@ tcDeriving :: [LTyClDecl Name] -- All type constructors
-> [LInstDecl Name] -- All instance declarations
-> [LDerivDecl Name] -- All stand-alone deriving declarations
-> TcM ([InstInfo Name], -- The generated "instance decls"
HsValBinds Name) -- Extra generated top-level bindings
HsValBinds Name, -- Extra generated top-level bindings
DefUses)
tcDeriving tycl_decls inst_decls deriv_decls
= recoverM (return ([], emptyValBindsOut)) $
= recoverM (return ([], emptyValBindsOut, emptyDUs)) $
do { -- Fish the "deriving"-related information out of the TcEnv
-- And make the necessary "equations".
is_boot <- tcIsHsBoot
......@@ -291,13 +297,13 @@ tcDeriving tycl_decls inst_decls deriv_decls
-- Generate the generic to/from functions from each type declaration
; gen_binds <- mkGenericBinds is_boot
; (inst_info, rn_binds) <- renameDeriv is_boot gen_binds (insts1 ++ insts2)
; (inst_info, rn_binds, rn_dus) <- renameDeriv is_boot gen_binds (insts1 ++ insts2)
; dflags <- getDOpts
; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances"
(ddump_deriving inst_info rn_binds))
; return (inst_info, rn_binds) }
; return (inst_info, rn_binds, rn_dus) }
where
ddump_deriving :: [InstInfo Name] -> HsValBinds Name -> SDoc
ddump_deriving inst_infos extra_binds
......@@ -305,13 +311,13 @@ tcDeriving tycl_decls inst_decls deriv_decls
renameDeriv :: Bool -> LHsBinds RdrName
-> [(InstInfo RdrName, DerivAuxBinds)]
-> TcM ([InstInfo Name], HsValBinds Name)
-> TcM ([InstInfo Name], HsValBinds Name, DefUses)
renameDeriv is_boot gen_binds insts
| is_boot -- If we are compiling a hs-boot file, don't generate any derived bindings
-- The inst-info bindings will all be empty, but it's easier to
-- just use rn_inst_info to change the type appropriately
= do { rn_inst_infos <- mapM rn_inst_info inst_infos
; return (rn_inst_infos, emptyValBindsOut) }
= do { (rn_inst_infos, fvs) <- mapAndUnzipM rn_inst_info inst_infos
; return (rn_inst_infos, emptyValBindsOut, usesOnly (plusFVs fvs)) }
| otherwise
= discardWarnings $ -- Discard warnings about unused bindings etc
......@@ -330,9 +336,10 @@ renameDeriv is_boot gen_binds insts
; let aux_names = map unLoc (collectHsValBinders rn_aux_lhs)
; bindLocalNames aux_names $
do { (rn_aux, _dus) <- rnTopBindsRHS (mkNameSet aux_names) rn_aux_lhs
; rn_inst_infos <- mapM rn_inst_info inst_infos
; return (rn_inst_infos, rn_aux `plusHsValBinds` rn_gen) } }
do { (rn_aux, dus_aux) <- rnTopBindsRHS (mkNameSet aux_names) rn_aux_lhs
; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
; return (rn_inst_infos, rn_aux `plusHsValBinds` rn_gen,
dus_gen `plusDU` dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }
where
(inst_infos, deriv_aux_binds) = unzip insts
......@@ -344,15 +351,15 @@ renameDeriv is_boot gen_binds insts
rn_inst_info (InstInfo { iSpec = inst, iBinds = NewTypeDerived co })
= return (InstInfo { iSpec = inst, iBinds = NewTypeDerived co })
= return (InstInfo { iSpec = inst, iBinds = NewTypeDerived co }, emptyFVs)
rn_inst_info (InstInfo { iSpec = inst, iBinds = VanillaInst binds sigs })
= -- Bring the right type variables into
-- scope (yuk), and rename the method binds
ASSERT( null sigs )
bindLocalNames (map Var.varName tyvars) $
do { (rn_binds, _fvs) <- rnMethodBinds clas_nm (\_ -> []) [] binds
; return (InstInfo { iSpec = inst, iBinds = VanillaInst rn_binds [] }) }
do { (rn_binds, fvs) <- rnMethodBinds clas_nm (\_ -> []) [] binds
; return (InstInfo { iSpec = inst, iBinds = VanillaInst rn_binds [] }, fvs) }
where
(tyvars,_,clas,_) = instanceHead inst
clas_nm = className clas
......
......@@ -22,6 +22,7 @@ import FamInstEnv
import TcDeriv
import TcEnv
import RnEnv ( lookupGlobalOccRn )
import RnSource ( addTcgDUs )
import TcHsType
import TcUnify
import TcSimplify
......@@ -339,9 +340,9 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
-- a) local instance decls
-- b) generic instances
-- c) local family instance decls
; addInsts local_info $ do {
; addInsts generic_inst_info $ do {
; addFamInsts at_idx_tycons $ do {
; addInsts local_info $
addInsts generic_inst_info $
addFamInsts at_idx_tycons $ do {
-- (4) Compute instances from "deriving" clauses;
-- This stuff computes a context for the derived instance
......@@ -351,13 +352,13 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
failIfErrsM -- If the addInsts stuff gave any errors, don't
-- try the deriving stuff, becuase that may give
-- more errors still
; (deriv_inst_info, deriv_binds) <- tcDeriving tycl_decls inst_decls
deriv_decls
; (deriv_inst_info, deriv_binds, deriv_dus)
<- tcDeriving tycl_decls inst_decls deriv_decls
; gbl_env <- addInsts deriv_inst_info getGblEnv
; return (gbl_env,
; return ( addTcgDUs gbl_env deriv_dus,
generic_inst_info ++ deriv_inst_info ++ local_info,
aux_binds `plusHsValBinds` deriv_binds)
}}}}}
}}}
where
-- Make sure that toplevel type instance are not for associated types.
-- !!!TODO: Need to perform this check for the TyThing of type functions,
......
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