Add comments, plus fix zapFragileInfo to zap worker info

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

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index f9e0484..245f313 100644 (file)
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -21,7 +21,7 @@ module SimplEnv (
        setEnclosingCC, getEnclosingCC,
 
        -- Environments
-       SimplEnv(..),   -- Temp not abstract
+       SimplEnv(..), pprSimplEnv,      -- Temp not abstract
        mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst, 
        zapSubstEnv, setSubstEnv, 
        getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
@@ -129,7 +129,14 @@ data SimplEnv
 
     }
 
+pprSimplEnv :: SimplEnv -> SDoc
+-- Used for debugging; selective
+pprSimplEnv env
+  = vcat [ptext SLIT("TvSubst:") <+> ppr (seTvSubst env),
+         ptext SLIT("IdSubst:") <+> ppr (seIdSubst env) ]
+
 type SimplIdSubst = IdEnv SimplSR      -- IdId |--> OutExpr
+       -- See Note [Extending the Subst] in CoreSubst
 
 data SimplSR
   = DoneEx OutExpr             -- Completed term
@@ -137,15 +144,16 @@ data SimplSR
   | ContEx TvSubstEnv          -- A suspended substitution
           SimplIdSubst
           InExpr        
+
 instance Outputable SimplSR where
   ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e
   ppr (DoneId v) = ptext SLIT("DoneId") <+> ppr v
   ppr (ContEx tv id e) = vcat [ptext SLIT("ContEx") <+> ppr e {-,
                                ppr (filter_env tv), ppr (filter_env id) -}]
-       where
-         fvs = exprFreeVars e
-         filter_env env = filterVarEnv_Directly keep env
-         keep uniq _ = uniq `elemUFM_Directly` fvs
+       -- where
+       -- fvs = exprFreeVars e
+       -- filter_env env = filterVarEnv_Directly keep env
+       -- keep uniq _ = uniq `elemUFM_Directly` fvs
 \end{code}
 
 
@@ -531,6 +539,8 @@ substIdBndr :: SimplEnv -> Id       -- Substitition and Id to transform
 --     * The substitution extended with a DoneId if unique changed
 --       In this case, the var in the DoneId is the same as the
 --       var returned
+--
+-- Exactly like CoreSubst.substIdBndr, except that the type of id_subst differs
 
 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst})
            old_id
@@ -549,6 +559,7 @@ substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst})
 
        -- Extend the substitution if the unique has changed
        -- See the notes with substTyVarBndr for the delSubstEnv
+       -- Also see Note [Extending the Subst] in CoreSubst
     new_subst | new_id /= old_id
              = extendVarEnv id_subst old_id (DoneId new_id)
              | otherwise 
@@ -597,8 +608,12 @@ 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 completely zapped IdInfo
+-- 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
@@ -609,7 +624,10 @@ substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old
   where
     id1           = uniqAway in_scope old_id
     id2    = substIdType env id1
-    new_id = setIdInfo id2 vanillaIdInfo
+
+    -- 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,
        -- or there's some useful occurrence information