X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FFreeVars.lhs;h=b0b39e371c45ac3c6e8c5ce66815070b7a5989f7;hb=ba013704bfb94aa133fb28f342e0d432698a5d6d;hp=48185a984bcd7c812038d989a8609f3a603648cf;hpb=72a9e0e26358e02dec63453d55fbc24a6f13f789;p=ghc-hetmet.git

diff --git a/ghc/compiler/coreSyn/FreeVars.lhs b/ghc/compiler/coreSyn/FreeVars.lhs
index 48185a9..b0b39e3 100644
--- a/ghc/compiler/coreSyn/FreeVars.lhs
+++ b/ghc/compiler/coreSyn/FreeVars.lhs
@@ -21,8 +21,9 @@ module FreeVars (
 import AnnCoreSyn	-- output
 
 import CoreSyn
+import CoreUtils	( idSpecVars )
 import Id		( idType, getIdArity, isBottomingId,
-			  emptyIdSet, unitIdSet, mkIdSet,
+			  emptyIdSet, unitIdSet, mkIdSet, unionIdSets,
 			  elementOfIdSet, minusIdSet, unionManyIdSets,
 			  IdSet, Id
 			)
@@ -36,6 +37,7 @@ import TyVar		( emptyTyVarSet, unitTyVarSet, minusTyVarSet,
 import BasicTypes	( Unused )
 import UniqSet		( unionUniqSets, addOneToUniqSet )
 import Util		( panic, assertPanic )
+
 \end{code}
 
 %************************************************************************
@@ -111,6 +113,7 @@ Main public interface:
 freeVars :: CoreExpr -> CoreExprWithFVs
 
 freeVars expr = fvExpr noIdCands noTyVarCands expr
+
 \end{code}
 
 %************************************************************************
@@ -132,13 +135,18 @@ fvExpr :: IdCands	    -- In-scope Ids
        -> CoreExprWithFVs
 
 fvExpr id_cands tyvar_cands (Var v)
-  = (FVInfo (if (v `is_among` id_cands)
-	     then aFreeId v
-	     else noFreeIds)
-	    noFreeTyVars
-	    leakiness,
-     AnnVar v)
+  = (FVInfo fvs noFreeTyVars leakiness, AnnVar v)
   where
+    {-
+     ToDo: insert motivating example for why we *need*
+     to include the idSpecVars in the FV list.
+    -}
+    fvs = fvs_v `unionIdSets` mkIdSet (idSpecVars v)
+
+    fvs_v
+     | v `is_among` id_cands = aFreeId v
+     | otherwise	     = noFreeIds
+     
     leakiness
       | isBottomingId v = lEAK_FREE_BIG	-- Hack
       | otherwise       = case getIdArity v of
@@ -254,13 +262,16 @@ fvExpr id_cands tyvar_cands (Case expr alts)
 	binder_ftvs = munge_id_ty binder
 	    -- We need to collect free tyvars from the binder
 
+-- Don't forget to notice that the idSpecVars of the binder
+-- are free in the whole expression; albeit not in the RHS or body
+
 fvExpr id_cands tyvar_cands (Let (NonRec binder rhs) body)
-  = (FVInfo (freeVarsOf rhs'   `combine` body_fvs)
+  = (FVInfo (freeVarsOf rhs'   `combine` body_fvs `combine` mkIdSet (idSpecVars binder))
 	    (freeTyVarsOf rhs' `combine` freeTyVarsOf body2 `combine` binder_ftvs)
 	    (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,12 +286,17 @@ 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']
 
-    binds_fvs	      = rhss_fvs `minusIdSet` binders_set
+	-- Don't forget to notice that the idSpecVars of the binder
+	-- are free in the whole expression; albeit not in the RHS or body
+    binds_fvs	      = (foldr (unionIdSets . mkIdSet . idSpecVars) rhss_fvs binders)
+			`minusIdSet`
+			binders_set
+
     body2	      = fvExpr new_id_cands tyvar_cands body
     body_fvs	      = freeVarsOf body2 `minusIdSet` binders_set
     binders_ftvs      = foldr (combine . munge_id_ty) noFreeTyVars binders
@@ -300,6 +316,9 @@ fvExpr id_cands tyvar_cands (Note other_note expr)
   = (fvinfo, AnnNote other_note expr2)
   where
     expr2@(fvinfo,_) = fvExpr id_cands tyvar_cands expr
+
+fvRhs id_cands tyvar_cands (bndr,rhs)
+  = fvExpr id_cands tyvar_cands rhs
 \end{code}
 
 \begin{code}