From 685f631451c4e6d8ebb6e31decb935db675f338e Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Wed, 27 May 2009 18:21:57 +0000 Subject: [PATCH] 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. --- compiler/rename/RnSource.lhs | 6 ++++-- compiler/typecheck/TcDeriv.lhs | 35 +++++++++++++++++++++-------------- compiler/typecheck/TcInstDcls.lhs | 15 ++++++++------- 3 files changed, 33 insertions(+), 23 deletions(-) diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index 442d465..5a071ee 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -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, diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 54ffe6b..545a342 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -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 diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index 74879f3..2435395 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -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, -- 1.7.10.4