X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplEnv.lhs;h=d1fd65f2a2e94f153a2e00e2bc4a191d104c6f71;hb=cc51a698c0938edaa3ccc95db19150bbaec6f795;hp=1d7d2e4420eea9a6e69420eb689aaf42b59e85c4;hpb=9670d6643e55adeb15f998a0efd5799d499ea2a4;p=ghc-hetmet.git diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs index 1d7d2e4..d1fd65f 100644 --- a/compiler/simplCore/SimplEnv.lhs +++ b/compiler/simplCore/SimplEnv.lhs @@ -4,6 +4,13 @@ \section[SimplMonad]{The simplifier Monad} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module SimplEnv ( InId, InBind, InExpr, InAlt, InArg, InType, InBndr, OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr, @@ -58,6 +65,8 @@ import BasicTypes import DynFlags import Util import Outputable + +import Data.List \end{code} %************************************************************************ @@ -598,29 +607,26 @@ simplRecBndrs env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) ids ; seqIds ids1 `seq` return env1 } --------------- -substLetIdBndr :: SimplEnv -> InBndr -- Env and binder to transform +substLetIdBndr :: SimplEnv + -> InBndr -- Env and binder to transform -> (SimplEnv, OutBndr) -- C.f. substIdBndr above -- Clone Id if necessary, substitute its type --- Return an Id with its fragile info zapped --- namely, any info that depends on free variables --- [addLetIdInfo, below, will restore its IdInfo] --- We want to retain robust info, especially arity and demand info, --- so that they are available to occurrences that occur in an --- earlier binding of a letrec --- Augment the subtitution --- if the unique changed, *or* --- if there's interesting occurrence info - -substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old_id +-- Return an Id with its +-- UnfoldingInfo zapped +-- Rules, etc, substitutd with rec_subst +-- Robust info, retained especially arity and demand info, +-- so that they are available to occurrences that occur in an +-- earlier binding of a letrec +-- Augment the subtitution if the unique changed + +substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) + old_id = (env { seInScope = in_scope `extendInScopeSet` new_id, seIdSubst = new_subst }, new_id) where id1 = uniqAway in_scope old_id id2 = substIdType env id1 - - -- We want to get rid of any info that's dependent on free variables, - -- but keep other info (like the arity). new_id = zapFragileIdInfo id2 -- Extend the substitution if the unique has changed, @@ -690,14 +696,13 @@ when substituting in h's RULE. \begin{code} addLetIdInfo :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr) addLetIdInfo env in_id out_id - = (modifyInScope env out_id final_id, final_id) + = case substIdInfo subst (idInfo in_id) of + Nothing -> (env, out_id) + Just new_info -> (modifyInScope env out_id final_id, final_id) + where + final_id = out_id `setIdInfo` new_info where - final_id = out_id `setIdInfo` new_info subst = mkCoreSubst env - old_info = idInfo in_id - new_info = case substIdInfo subst old_info of - Nothing -> old_info - Just new_info -> new_info substIdInfo :: CoreSubst.Subst -> IdInfo -> Maybe IdInfo -- Substitute the