\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,
import DynFlags
import Util
import Outputable
+
+import Data.List
\end{code}
%************************************************************************
seChkr :: SwitchChecker,
seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
- -- Rules from other modules
- seExtRules :: RuleBase,
-
-- The current set of in-scope variables
-- They are all OutVars, and all bound in this module
seInScope :: InScopeSet, -- OutVars only
\begin{code}
-mkSimplEnv :: SimplifierMode -> SwitchChecker -> RuleBase -> SimplEnv
-mkSimplEnv mode switches rules
+mkSimplEnv :: SimplifierMode -> SwitchChecker -> SimplEnv
+mkSimplEnv mode switches
= SimplEnv { seChkr = switches, seCC = subsumedCCS,
seMode = mode, seInScope = emptyInScopeSet,
- seExtRules = rules, seFloats = emptyFloats,
+ seFloats = emptyFloats,
seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
-- The top level "enclosing CC" is "SUBSUMED".
isEmptySimplSubst :: SimplEnv -> Bool
isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
= isEmptyVarEnv tvs && isEmptyVarEnv ids
-
----------------------
-getRules :: SimplEnv -> RuleBase
-getRules = seExtRules
\end{code}
; 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,
= delVarEnv id_subst old_id
\end{code}
-Add IdInfo back onto a let-bound Id
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Add IdInfo back onto a let-bound Id]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We must transfer the IdInfo of the original binder to the new binder.
This is crucial, to preserve
strictness
\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