Fix LiberateCase

[ghc-hetmet.git] / compiler / simplCore / SimplEnv.lhs

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 2fedf87..d1fd65f 100644 (file)
--- 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}
 
 %************************************************************************
@@ -101,9 +110,6 @@ data SimplEnv
        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
@@ -207,11 +213,11 @@ seIdSubst:
 
 
 \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".
 
@@ -289,10 +295,6 @@ mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
 isEmptySimplSubst :: SimplEnv -> Bool
 isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
   = isEmptyVarEnv tvs && isEmptyVarEnv ids
-
----------------------
-getRules :: SimplEnv -> RuleBase
-getRules = seExtRules
 \end{code}
 
 
@@ -605,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,
@@ -639,8 +638,8 @@ substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old
              = 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
@@ -697,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