X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FOccurAnal.lhs;h=87927ece4821662041495ee0492cbd1d73ee5e6c;hb=cfcebde74cf826af12143a92bcffa8c995eee135;hp=60f846d24def10a0007771fbfcb35dcefd517be5;hpb=7dd11ebc4d4d091edc0f5e3c13f041b99961c136;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs
index 60f846d..87927ec 100644
--- a/ghc/compiler/simplCore/OccurAnal.lhs
+++ b/ghc/compiler/simplCore/OccurAnal.lhs
@@ -285,12 +285,12 @@ occAnalBind env (Rec pairs) body_usage
     pp_item (_, bndr, _)     = ppr bndr
 
     binders = map fst pairs
-    new_env = env `addNewCands` binders
+    rhs_env = env `addNewCands` binders
 
     analysed_pairs :: [Details1]
     analysed_pairs  = [ (bndr, rhs_usage, rhs')
 		      | (bndr, rhs) <- pairs,
-			let (rhs_usage, rhs') = occAnalRhs new_env bndr rhs
+			let (rhs_usage, rhs') = occAnalRhs rhs_env bndr rhs
 		      ]
 
     sccs :: [SCC (Node Details1)]
@@ -497,7 +497,7 @@ occAnalRhs :: OccEnv
 occAnalRhs env id rhs
   = (final_usage, rhs')
   where
-    (rhs_usage, rhs') = occAnal env rhs
+    (rhs_usage, rhs') = occAnal (zapCtxt env) rhs
 
 	-- [March 98] A new wrinkle is that if the binder has specialisations inside
 	-- it then we count the specialised Ids as "extra rhs's".  That way
@@ -639,7 +639,7 @@ occAnal env expr@(Lam _ _)
 
 occAnal env (Case scrut bndr alts)
   = case mapAndUnzip (occAnalAlt alt_env) alts of { (alts_usage_s, alts')   -> 
-    case occAnal env scrut		       of { (scrut_usage, scrut') ->
+    case occAnal (zapCtxt env) scrut	       of { (scrut_usage, scrut') ->
     let
 	alts_usage  = foldr1 combineAltsUsageDetails alts_usage_s
 	(alts_usage1, tagged_bndr) = tagBinder alts_usage bndr
@@ -657,8 +657,10 @@ occAnal env (Let bind body)
     new_env = env `addNewCands` (bindersOf bind)
 
 occAnalArgs env args
-  = case mapAndUnzip (occAnal env) args of	{ (arg_uds_s, args') ->
+  = case mapAndUnzip (occAnal arg_env) args of	{ (arg_uds_s, args') ->
     (foldr combineUsageDetails emptyDetails arg_uds_s, args')}
+  where
+    arg_env = zapCtxt env
 \end{code}
 
 Applications are dealt with specially because we want
@@ -685,8 +687,8 @@ occAnalApp env (Var fun, args)
 		| otherwise		    = occAnalArgs env args
 
 occAnalApp env (fun, args)
-  = case occAnal env fun of		{ (fun_uds, fun') ->
-    case occAnalArgs env args of	{ (args_uds, args') ->
+  = case occAnal (zapCtxt env) fun of		{ (fun_uds, fun') ->
+    case occAnalArgs env args of		{ (args_uds, args') ->
     let
 	final_uds = fun_uds `combineUsageDetails` args_uds
     in
@@ -768,6 +770,9 @@ getCtxt env@(OccEnv ifun cands []) n = (False, env)
 getCtxt (OccEnv ifun cands ctxt)   n = (and (take n ctxt), OccEnv ifun cands (drop n ctxt))
 		-- Only return True if *all* the lambdas are linear
 
+zapCtxt env@(OccEnv ifun cands []) = env
+zapCtxt     (OccEnv ifun cands _ ) = OccEnv ifun cands []
+
 type UsageDetails = IdEnv BinderInfo	-- A finite map from ids to their usage
 
 combineUsageDetails, combineAltsUsageDetails