X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplEnv.lhs;h=245f313e8f874b4f59f60e26f2dd5ca2a26ba5cc;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hp=765fd004d77ad210cba81ae6324463363130c170;hpb=94b170a053c161d1e0cc4418b37a6a4807872a5f;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 765fd00..245f313 100644
--- 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,6 +129,12 @@ 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
 
@@ -144,10 +150,10 @@ instance Outputable SimplSR where
   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}
 
 
@@ -602,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
@@ -614,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