From: simonpj@microsoft.com Date: Thu, 3 Apr 2008 11:02:50 +0000 (+0000) Subject: Fix Trac #2136: reporting of unused variables X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=7502efdcd468b9a77385c5456481cf39f8eec79f Fix Trac #2136: reporting of unused variables There's a bit of a hack RnBinds.rnValBindsAndThen, documented in Note [Unused binding hack]. But the hack was over brutal before, and produced unnecssarily bad (absence of) warnings. This patch does a bit of refactoring; and fixes the bug in rnValBindsAndThen. --- diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index e27be3d..e7a781c 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -343,12 +343,12 @@ rnValBindsRHSGen trim bound_names binds@(ValBindsIn mbinds sigs) = do check_sigs (okBindSig (duDefs anal_dus)) sigs' return (valbind', valbind'_dus) --- wrapper for local binds +-- Wrapper for local binds -- --- the *client* of this function is responsible for checking for unused binders; +-- The *client* of this function is responsible for checking for unused binders; -- it doesn't (and can't: we don't have the thing inside the binds) happen here -- --- the client is also responsible for bringing the fixities into scope +-- The client is also responsible for bringing the fixities into scope rnValBindsRHS :: [Name] -- names bound by the LHSes -> HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses) @@ -365,42 +365,53 @@ rnValBindsRHS bound_names binds = rnValBindsAndThen :: HsValBinds RdrName -> (HsValBinds Name -> RnM (result, FreeVars)) -> RnM (result, FreeVars) -rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside = - let - (original_bndrs, doc) = bindersAndDoc binds +rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside + = do { let (original_bndrs, doc) = bindersAndDoc binds + + -- (A) Create the local fixity environment + ; new_fixities <- makeMiniFixityEnv [L loc sig | L loc (FixSig sig) <- sigs] - in do - -- (A) create the local fixity environment - new_fixities <- makeMiniFixityEnv [L loc sig | L loc (FixSig sig) <- sigs] + -- (B) Rename the LHSes + ; new_lhs <- rnValBindsLHSFromDoc_Local original_bndrs doc new_fixities binds + ; let bound_names = map unLoc $ collectHsValBinders new_lhs - -- (B) rename the LHSes - new_lhs <- rnValBindsLHSFromDoc_Local original_bndrs doc new_fixities binds - let bound_names = map unLoc $ collectHsValBinders new_lhs + -- ...and bring them (and their fixities) into scope + ; bindLocalNamesFV_WithFixities bound_names new_fixities $ do - -- and bring them (and their fixities) into scope - bindLocalNamesFV_WithFixities bound_names new_fixities $ - warnUnusedLocalBinds bound_names $ do + { -- (C) Do the RHS and thing inside + (binds', dus) <- rnValBindsRHS bound_names new_lhs + ; (result, result_fvs) <- thing_inside binds' - -- (C) do the RHS and thing inside - (binds', dus) <- rnValBindsRHS bound_names new_lhs - (result, result_fvs) <- thing_inside binds' + -- Report unused bindings based on the (accurate) + -- findUses. E.g. + -- let x = x in 3 + -- should report 'x' unused + ; let real_uses = findUses dus result_fvs + ; warnUnusedLocalBinds bound_names real_uses - let - -- the variables used in the val binds are: - -- (1) the uses of the binds + ; let + -- The variables "used" in the val binds are: + -- (1) the uses of the binds (duUses) -- (2) the FVs of the thing-inside - all_uses = (duUses dus) `plusFV` result_fvs - -- duUses: It's important to return all the uses. Otherwise consider: + all_uses = duUses dus `plusFV` result_fvs + -- Note [Unused binding hack] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- Note that *in contrast* to the above reporting of + -- unused bindings, (1) above uses duUses to return *all* + -- the uses, even if the binding is unused. Otherwise consider: -- x = 3 -- y = let p = x in 'x' -- NB: p not used -- If we don't "see" the dependency of 'y' on 'x', we may put the -- bindings in the wrong order, and the type checker will complain -- that x isn't in scope - - return (result, - -- the bound names are pruned out of all_uses - -- by the bindLocalNamesFV call above - all_uses) + -- + -- But note that this means we won't report 'x' as unused, + -- whereas we would if we had { x = 3; p = x; y = 'x' } + + ; return (result, all_uses) }} + -- The bound names are pruned out of all_uses + -- by the bindLocalNamesFV call above + -- Process the fixity declarations, making a FastString -> (Located Fixity) map diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index 35d3fcc..6fd707d 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -949,19 +949,13 @@ warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM () warnUnusedImports gres = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres) warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds (warnUnusedGREs gres) -warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars) +warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> FreeVars -> RnM () warnUnusedLocalBinds = check_unused Opt_WarnUnusedBinds warnUnusedMatches = check_unused Opt_WarnUnusedMatches -check_unused :: DynFlag -> [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars) -check_unused flag names thing_inside - = do { (res, res_fvs) <- thing_inside - - -- Warn about unused names - ; ifOptM flag (warnUnusedLocals (filterOut (`elemNameSet` res_fvs) names)) - - -- And return - ; return (res, res_fvs) } +check_unused :: DynFlag -> [Name] -> FreeVars -> RnM () +check_unused flag bound_names used_names + = ifOptM flag (warnUnusedLocals (filterOut (`elemNameSet` used_names) bound_names)) ------------------------- -- Helpers diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 8c96a5f..5968b94 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -886,22 +886,22 @@ rn_rec_stmts_and_then :: [LStmt RdrName] -- the FreeVars of the Segments -> ([Segment (LStmt Name)] -> RnM (a, FreeVars)) -> RnM (a, FreeVars) -rn_rec_stmts_and_then s cont = do - -- (A) make the mini fixity env for all of the stmts - fix_env <- makeMiniFixityEnv (collectRecStmtsFixities s) - - -- (B) do the LHSes - new_lhs_and_fv <- rn_rec_stmts_lhs fix_env s - - -- bring them and their fixities into scope - let bound_names = map unLoc $ collectLStmtsBinders (map fst new_lhs_and_fv) - bindLocalNamesFV_WithFixities bound_names fix_env $ - warnUnusedLocalBinds bound_names $ do - - -- (C) do the right-hand-sides and thing-inside - segs <- rn_rec_stmts bound_names new_lhs_and_fv - cont segs - +rn_rec_stmts_and_then s cont + = do { -- (A) Make the mini fixity env for all of the stmts + fix_env <- makeMiniFixityEnv (collectRecStmtsFixities s) + + -- (B) Do the LHSes + ; new_lhs_and_fv <- rn_rec_stmts_lhs fix_env s + + -- ...bring them and their fixities into scope + ; let bound_names = map unLoc $ collectLStmtsBinders (map fst new_lhs_and_fv) + ; bindLocalNamesFV_WithFixities bound_names fix_env $ do + + -- (C) do the right-hand-sides and thing-inside + { segs <- rn_rec_stmts bound_names new_lhs_and_fv + ; (res, fvs) <- cont segs + ; warnUnusedLocalBinds bound_names fvs + ; return (res, fvs) }} -- get all the fixity decls in any Let stmt collectRecStmtsFixities l = diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index 2edb72d..0c0d683 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -105,9 +105,10 @@ matchNameMaker :: NameMaker matchNameMaker = NM (\ rdr_name thing_inside -> do { names@[name] <- newLocalsRn [rdr_name] - ; bindLocalNamesFV names $ - warnUnusedMatches names $ - thing_inside name }) + ; bindLocalNamesFV names $ do + { (res, fvs) <- thing_inside name + ; warnUnusedMatches names fvs + ; return (res, fvs) }}) topRecNameMaker, localRecNameMaker :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind