X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FFloatIn.lhs;fp=compiler%2FsimplCore%2FFloatIn.lhs;h=0dd318b4209cc856c0250f271d6f46ef54a4438c;hp=8938731df07a6c468390f12b4febb875d7e05d77;hb=081d294c2a4a9e886e96ab50cf43718b54696646;hpb=10f18550c3684368b9d8e5b7adcccc14994cf170

diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs
index 8938731..0dd318b 100644
--- a/compiler/simplCore/FloatIn.lhs
+++ b/compiler/simplCore/FloatIn.lhs
@@ -291,21 +291,21 @@ fiExpr to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body)
 
 	-- Push rhs_binds into the right hand side of the binding
     rhs'     = fiExpr rhs_binds rhs
-    rhs_fvs' = rhs_fvs `unionVarSet` floatedBindsFVs rhs_binds
+    rhs_fvs' = rhs_fvs `unionVarSet` floatedBindsFVs rhs_binds `unionVarSet` rule_fvs
+			-- Don't forget the rule_fvs; the binding mentions them!
 
 fiExpr to_drop (_,AnnLet (AnnRec bindings) body)
   = fiExpr new_to_drop body
   where
-    rhss = map snd bindings
-
+    (ids, rhss) = unzip bindings
     rhss_fvs = map freeVarsOf rhss
     body_fvs = freeVarsOf body
 
 	-- See Note [extra_fvs (1,2)]
-    extra_fvs = foldr (unionVarSet . get_extras) emptyVarSet bindings
-    get_extras (id, (rhs_fvs, rhs)) 
-	| noFloatIntoRhs rhs = idRuleVars id `unionVarSet` rhs_fvs
-	| otherwise	     = idRuleVars id
+    rule_fvs = foldr (unionVarSet . idRuleVars) emptyVarSet ids
+    extra_fvs = rule_fvs `unionVarSet` 
+		unionVarSets [ fvs | (fvs, rhs) <- rhss
+			     , noFloatIntoRhs rhs ]
 
     (shared_binds:extra_binds:body_binds:rhss_binds) 
 	= sepBindsByDropPoint False (extra_fvs:body_fvs:rhss_fvs) to_drop
@@ -316,8 +316,9 @@ fiExpr to_drop (_,AnnLet (AnnRec bindings) body)
 		  extra_binds ++	-- Note [extra_fvs (1,2)]
 		  shared_binds		-- Used in more than one place
 
-    rhs_fvs' = unionVarSet (unionVarSets rhss_fvs)
-			   (unionVarSets (map floatedBindsFVs rhss_binds))
+    rhs_fvs' = unionVarSets rhss_fvs `unionVarSet`
+	       unionVarSets (map floatedBindsFVs rhss_binds) `unionVarSet`
+	       rule_fvs		-- Don't forget the rule variables!
 
     -- Push rhs_binds into the right hand side of the binding
     fi_bind :: [FloatingBinds]	    -- one per "drop pt" conjured w/ fvs_of_rhss