Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.2
http://hackage.haskell.org/trac/ghc/changeset/2bd2670ac1424ca855ea1107316d39658f49e6a1 >--------------------------------------------------------------- commit 2bd2670ac1424ca855ea1107316d39658f49e6a1 Author: Simon Peyton Jones <[email protected]> Date: Thu Jun 30 14:13:27 2011 +0100 Rename to avoid name clashes elsewhere >--------------------------------------------------------------- compiler/coreSyn/CorePrep.lhs | 18 +++++++++--------- 1 files changed, 9 insertions(+), 9 deletions(-) diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs index 0405716..6325a08 100644 --- a/compiler/coreSyn/CorePrep.lhs +++ b/compiler/coreSyn/CorePrep.lhs @@ -318,7 +318,7 @@ cpeBind :: TopLevelFlag -> CorePrepEnv -> CoreBind -> UniqSM (CorePrepEnv, Floats) cpeBind top_lvl env (NonRec bndr rhs) - = do { (_, bndr1) <- cloneBndr env bndr + = do { (_, bndr1) <- cpCloneBndr env bndr ; let is_strict = isStrictDmd (idDemandInfo bndr) is_unlifted = isUnLiftedType (idType bndr) ; (floats, bndr2, rhs2) <- cpePair top_lvl NonRecursive @@ -333,7 +333,7 @@ cpeBind top_lvl env (NonRec bndr rhs) cpeBind top_lvl env (Rec pairs) = do { let (bndrs,rhss) = unzip pairs - ; (env', bndrs1) <- cloneBndrs env (map fst pairs) + ; (env', bndrs1) <- cpCloneBndrs env (map fst pairs) ; stuff <- zipWithM (cpePair top_lvl Recursive False env') bndrs1 rhss ; let (floats_s, bndrs2, rhss2) = unzip3 stuff @@ -472,7 +472,7 @@ cpeRhsE env (Cast expr co) cpeRhsE env expr@(Lam {}) = do { let (bndrs,body) = collectBinders expr - ; (env', bndrs') <- cloneBndrs env bndrs + ; (env', bndrs') <- cpCloneBndrs env bndrs ; body' <- cpeBodyNF env' body ; return (emptyFloats, mkLams bndrs' body') } @@ -485,12 +485,12 @@ cpeRhsE env (Case scrut bndr ty alts) = do { (floats, scrut') <- cpeBody env scrut ; let bndr1 = bndr `setIdUnfolding` evaldUnfolding -- Record that the case binder is evaluated in the alternatives - ; (env', bndr2) <- cloneBndr env bndr1 + ; (env', bndr2) <- cpCloneBndr env bndr1 ; alts' <- mapM (sat_alt env') alts ; return (floats, Case scrut' bndr2 ty alts') } where sat_alt env (con, bs, rhs) - = do { (env2, bs') <- cloneBndrs env bs + = do { (env2, bs') <- cpCloneBndrs env bs ; rhs' <- cpeBodyNF env2 rhs ; return (con, bs', rhs') } @@ -1074,11 +1074,11 @@ lookupCorePrepEnv (CPE env) id -- Cloning binders -- --------------------------------------------------------------------------- -cloneBndrs :: CorePrepEnv -> [Var] -> UniqSM (CorePrepEnv, [Var]) -cloneBndrs env bs = mapAccumLM cloneBndr env bs +cpCloneBndrs :: CorePrepEnv -> [Var] -> UniqSM (CorePrepEnv, [Var]) +cpCloneBndrs env bs = mapAccumLM cpCloneBndr env bs -cloneBndr :: CorePrepEnv -> Var -> UniqSM (CorePrepEnv, Var) -cloneBndr env bndr +cpCloneBndr :: CorePrepEnv -> Var -> UniqSM (CorePrepEnv, Var) +cpCloneBndr env bndr | isLocalId bndr, not (isCoVar bndr) = do bndr' <- setVarUnique bndr <$> getUniqueM _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
