From 54e73a90c275713c3804239fe61fbd5208cee60f Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Mon, 12 Apr 2010 15:16:30 +0000 Subject: [PATCH] Fix Trac #3943: incorrect unused-variable warning In fixing this I did the usual little bit of refactoring --- compiler/rename/RnBinds.lhs | 29 ++++++++++++++++------------- compiler/rename/RnEnv.lhs | 27 +++++++++++---------------- compiler/rename/RnExpr.lhs | 3 ++- compiler/rename/RnPat.lhs | 14 ++++++++++++-- 4 files changed, 41 insertions(+), 32 deletions(-) diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 2cf2bdc..bf4257d 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -314,10 +314,11 @@ rnValBindsRHSGen _ _ b = pprPanic "rnValBindsRHSGen" (ppr b) rnValBindsRHS :: NameSet -- names bound by the LHSes -> HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses) -rnValBindsRHS bound_names binds = - rnValBindsRHSGen (\ fvs -> -- only keep the names the names from this group - intersectNameSet bound_names fvs) bound_names binds - +rnValBindsRHS bound_names binds + = rnValBindsRHSGen trim bound_names binds + where + trim fvs = intersectNameSet bound_names fvs + -- Only keep the names the names from this group -- for local binds -- wrapper that does both the left- and right-hand sides @@ -335,7 +336,8 @@ rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside ; (bound_names, new_lhs) <- rnValBindsLHS new_fixities binds -- ...and bring them (and their fixities) into scope - ; bindLocalNamesFV_WithFixities bound_names new_fixities $ do + ; bindLocalNamesFV bound_names $ + addLocalFixities new_fixities bound_names $ do { -- (C) Do the RHS and thing inside (binds', dus) <- rnValBindsRHS (mkNameSet bound_names) new_lhs @@ -464,21 +466,22 @@ rnBind :: (Name -> [Name]) -- Signature tyvar function rnBind _ trim (L loc (PatBind { pat_lhs = pat, pat_rhs = grhss, -- pat fvs were stored here while - -- processing the LHS - bind_fvs=pat_fvs })) + -- after processing the LHS + bind_fvs = pat_fvs })) = setSrcSpan loc $ do {let bndrs = collectPatBinders pat ; (grhss', fvs) <- rnGRHSs PatBindRhs grhss -- No scoped type variables for pattern bindings - ; let fvs' = trim fvs + ; let all_fvs = pat_fvs `plusFV` fvs + fvs' = trim all_fvs ; fvs' `seq` -- See Note [Free-variable space leak] - return (L loc (PatBind { pat_lhs = pat, - pat_rhs = grhss', - pat_rhs_ty = placeHolderType, - bind_fvs = fvs' }), - bndrs, pat_fvs `plusFV` fvs) } + return (L loc (PatBind { pat_lhs = pat, + pat_rhs = grhss', + pat_rhs_ty = placeHolderType, + bind_fvs = fvs' }), + bndrs, all_fvs) } rnBind sig_fn trim diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index a4e6ab8..6927280 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -20,7 +20,7 @@ module RnEnv ( newLocalBndrRn, newLocalBndrsRn, newIPNameRn, bindLocalName, bindLocalNames, bindLocalNamesFV, MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv, - bindLocalNamesFV_WithFixities, + addLocalFixities, bindLocatedLocalsFV, bindLocatedLocalsRn, bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV, bindTyVarsRn, extendTyVarEnvFVRn, @@ -651,22 +651,17 @@ type MiniFixityEnv = FastStringEnv (Located Fixity) -------------------------------- -- Used for nested fixity decls to bind names along with their fixities. -- the fixities are given as a UFM from an OccName's FastString to a fixity decl -bindLocalNamesFV_WithFixities :: [Name] - -> MiniFixityEnv - -> RnM (a, FreeVars) -> RnM (a, FreeVars) -bindLocalNamesFV_WithFixities names fixities thing_inside - = bindLocalNamesFV names $ - extendFixityEnv boundFixities $ - thing_inside + +addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a +addLocalFixities mini_fix_env names thing_inside + = extendFixityEnv (mapCatMaybes find_fixity names) thing_inside where - -- find the names that have fixity decls - boundFixities = foldr - (\ name -> \ acc -> - -- check whether this name has a fixity decl - case lookupFsEnv fixities (occNameFS (nameOccName name)) of - Just (L _ fix) -> (name, FixItem (nameOccName name) fix) : acc - Nothing -> acc) [] names - -- bind the names; extend the fixity env; do the thing inside + find_fixity name + = case lookupFsEnv mini_fix_env (occNameFS occ) of + Just (L _ fix) -> Just (name, FixItem occ fix) + Nothing -> Nothing + where + occ = nameOccName name \end{code} -------------------------------- diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index d1984f8..48f1e6f 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -886,7 +886,8 @@ rn_rec_stmts_and_then s cont -- ...bring them and their fixities into scope ; let bound_names = collectLStmtsBinders (map fst new_lhs_and_fv) - ; bindLocalNamesFV_WithFixities bound_names fix_env $ do + ; bindLocalNamesFV bound_names $ + addLocalFixities fix_env bound_names $ do -- (C) do the right-hand-sides and thing-inside { segs <- rn_rec_stmts bound_names new_lhs_and_fv diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index 813f39b..58c2c34 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -167,10 +167,12 @@ newName (LetMk mb_top fix_env) rdr_name do { name <- case mb_top of Nothing -> newLocalBndrRn rdr_name Just mod -> newTopSrcBinder mod rdr_name - ; bindLocalNamesFV_WithFixities [name] fix_env $ + ; bindLocalName name $ -- Do *not* use bindLocalNameFV here + -- See Note [View pattern usage] + addLocalFixities fix_env [name] $ thing_inside name }) - -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious + -- Note: the bindLocalName is somewhat suspicious -- because it binds a top-level name as a local name. -- however, this binding seems to work, and it only exists for -- the duration of the patterns and the continuation; @@ -178,6 +180,14 @@ newName (LetMk mb_top fix_env) rdr_name -- before going on to the RHSes (see RnSource.lhs). \end{code} +Note [View pattern usage] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + let (r, (r -> x)) = x in ... +Here the pattern binds 'r', and then uses it *only* in the view pattern. +We want to "see" this use, and in let-bindings we collect all uses and +report unused variables at the binding level. So we must use bindLocalName +here, *not* bindLocalNameFV. Trac #3943. %********************************************************* %* * -- 1.7.10.4