[project @ 1998-06-10 08:31:57 by simonpj]

Fix float-in bug

diff --git a/ghc/compiler/simplCore/FloatIn.lhs b/ghc/compiler/simplCore/FloatIn.lhs
index 353a3b2..77d9982 100644 (file)
--- a/ghc/compiler/simplCore/FloatIn.lhs
+++ b/ghc/compiler/simplCore/FloatIn.lhs
@@ -352,35 +352,31 @@ sepBindsByDropPoint drop_pts []
 
 sepBindsByDropPoint drop_pts floaters
   = let
-       (per_drop_pt, must_stay_here, _)
-           --= sep drop_pts emptyIdSet{-fvs of prev drop_pts-} floaters
-           = split' drop_pts floaters [] empty_boxes
-       empty_boxes = nOfThem (length drop_pts) []
+       (must_stay_here : per_drop_pt)
+           = split' floaters ((emptyIdSet : drop_pts) `zip` repeat [])
     in
-    (map reverse per_drop_pt, reverse must_stay_here)
+    (per_drop_pt, must_stay_here)
   where
-    split' drop_pts_fvs [] mult_branch drop_boxes
-      = (drop_boxes, mult_branch, drop_pts_fvs)
-
-    split' drop_pts_fvs (bind:binds) mult_branch drop_boxes
-      | no_of_branches == 1    -- Exactly one branch
-      = split' drop_pts_fvs' binds mult_branch drop_boxes'
-
-      | otherwise              -- Zero or many branches; drop it here
-      = split' drop_pts_fvs binds (bind:mult_branch) drop_boxes
+    split' [] drop_boxes = map (reverse . snd) drop_boxes
 
+    split' (bind:binds) drop_boxes
+      = split' binds drop_boxes'
       where
+       drop_boxes' = zipWith drop drop_flags drop_boxes
+       drop_flags  | no_of_branches == 1       -- Exactly one branch
+                   = used_in_flags
+                   | otherwise                 -- Zero or many branches; drop it here
+                   = True : repeat False
+
        binders         = bindersOf (fst bind)
-       no_of_branches  = length [() | True <- in_branch_flags]
-       in_branch_flags = [ any (`elementOfIdSet` branch_fvs) binders
-                         | branch_fvs <- drop_pts_fvs ]
+       no_of_branches  = length [() | True <- used_in_flags]
+       used_in_flags   = [ any (`elementOfIdSet` branch_fvs) binders
+                         | (branch_fvs,_) <- drop_boxes ]
 
-       (drop_pts_fvs', drop_boxes') = unzip (zipWith3 drop in_branch_flags drop_pts_fvs drop_boxes)
-       drop True drop_fvs box  = (drop_fvs `unionIdSets` fvsOfBind bind, bind:box)
-       drop False drop_fvs box = (drop_fvs,                              box)
+       drop True  (drop_fvs, box) = (drop_fvs `unionIdSets` fvsOfBind bind, bind:box)
+       drop False (drop_fvs, box) = (drop_fvs,                                   box)
       
 
-    -------------------------
     fvsOfBind (_,fvs)  = fvs
 
 floatedBindsFVs :: FloatingBinds -> FreeVarsSet