X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnBinds.lhs;h=9efe64e133ee1966c23dd38d1304c726d9b2fdfa;hb=27286cf2ce6733cbbf008972c6bea30ea2e562ee;hp=2cf2bdc4e3d705beb0e13909ea94d39c4bf21e9a;hpb=f1cc3eb980a634e62f2739a7a25387c902fa9d8a;p=ghc-hetmet.git diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 2cf2bdc..9efe64e 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -28,7 +28,7 @@ import RnPat (rnPats, rnBindPat, ) import RnEnv -import DynFlags ( DynFlag(..) ) +import DynFlags import Name import NameEnv import NameSet @@ -158,8 +158,7 @@ rnTopBindsLHS :: MiniFixityEnv -> HsValBinds RdrName -> RnM (HsValBindsLR Name RdrName) rnTopBindsLHS fix_env binds - = do { mod <- getModule - ; rnValBindsLHSFromDoc (topRecNameMaker mod fix_env) binds } + = rnValBindsLHSFromDoc (topRecNameMaker fix_env) binds rnTopBindsRHS :: NameSet -- Names bound by these binds -> HsValBindsLR Name RdrName @@ -314,10 +313,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 +335,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 @@ -350,9 +351,9 @@ rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside ; let -- The variables "used" in the val binds are: - -- (1) the uses of the binds (duUses) + -- (1) the uses of the binds (allUses) -- (2) the FVs of the thing-inside - all_uses = duUses dus `plusFV` result_fvs + all_uses = allUses dus `plusFV` result_fvs -- Note [Unused binding hack] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Note that *in contrast* to the above reporting of @@ -464,21 +465,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 @@ -606,10 +608,11 @@ rnMethodBinds :: Name -- Class name -> RnM (LHsBinds Name, FreeVars) rnMethodBinds cls sig_fn gen_tyvars binds - = foldM do_one (emptyBag,emptyFVs) (bagToList binds) - where do_one (binds,fvs) bind = do - (bind', fvs_bind) <- rnMethodBind cls sig_fn gen_tyvars bind - return (bind' `unionBags` binds, fvs_bind `plusFV` fvs) + = foldlM do_one (emptyBag,emptyFVs) (bagToList binds) + where + do_one (binds,fvs) bind + = do { (bind', fvs_bind) <- rnMethodBind cls sig_fn gen_tyvars bind + ; return (binds `unionBags` bind', fvs_bind `plusFV` fvs) } rnMethodBind :: Name -> (Name -> [Name])