From: simonpj <unknown>
Date: Thu, 30 Apr 1998 11:20:50 +0000 (+0000)
Subject: [project @ 1998-04-30 11:20:50 by simonpj]
X-Git-Tag: Approx_2487_patches~760
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=eaa85acf5dafa8d0daa1246d43aeadd7d1e0ef1f;p=ghc-hetmet.git

[project @ 1998-04-30 11:20:50 by simonpj]
FreeVars.lhs fix for idSpecVars
---

diff --git a/ghc/compiler/coreSyn/FreeVars.lhs b/ghc/compiler/coreSyn/FreeVars.lhs
index 48185a9..a475c3f 100644
--- a/ghc/compiler/coreSyn/FreeVars.lhs
+++ b/ghc/compiler/coreSyn/FreeVars.lhs
@@ -260,7 +260,7 @@ fvExpr id_cands tyvar_cands (Let (NonRec binder rhs) body)
 	    (leakinessOf rhs' `orLeak` leakinessOf body2),
      AnnLet (AnnNonRec binder rhs') body2)
   where
-    rhs'	= fvExpr id_cands tyvar_cands rhs
+    rhs'	= fvRhs id_cands tyvar_cands (binder, rhs)
     body2	= fvExpr (aFreeId binder `combine` id_cands) tyvar_cands body
     body_fvs	= freeVarsOf body2 `minusIdSet` aFreeId binder
     binder_ftvs = munge_id_ty binder
@@ -275,7 +275,7 @@ fvExpr id_cands tyvar_cands (Let (Rec binds) body)
     (binders, rhss)   = unzip binds
     new_id_cands      = binders_set `combine` id_cands
     binders_set	      = mkIdSet binders
-    rhss'	      = map (fvExpr new_id_cands tyvar_cands) rhss
+    rhss'	      = map (fvRhs new_id_cands tyvar_cands) binds
 
     FVInfo rhss_fvs rhss_tfvs leakiness_of_rhss
 	= foldr1 combineFVInfo [info | (info,_) <- rhss']
@@ -300,6 +300,14 @@ fvExpr id_cands tyvar_cands (Note other_note expr)
   = (fvinfo, AnnNote other_note expr2)
   where
     expr2@(fvinfo,_) = fvExpr id_cands tyvar_cands expr
+
+-- fvRhs returns the annotated RHS, but it adds to the
+-- free vars of the RHS the idSpecVars of the binder,
+-- since those are, in truth, free in the definition.
+fvRhs id_cands tyvar_cands (bndr,rhs)
+  = (FVInfo (fvs `unionIdSets` idSpecVars bndr) ftvs leak, rhs')
+  where
+    (FVInfo fvs ftvs leak, rhs') = fvExpr id_cands tyvar_cands rhs
 \end{code}
 
 \begin{code}