X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSetLevels.lhs;h=c684e7d4113726b4a13c669f4b70be5f3d97752a;hb=94bf0d3604ff0d2ecab246924af712bdd1c29a40;hp=ebfc27ea6ebad0ad5d5b47ab3f00adaa810f7778;hpb=a66541af84d102f32b73fb7f89f48008c01092a6;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index ebfc27e..c684e7d 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -671,26 +671,15 @@ lvlLamBndrs lvl []
   = (lvl, [])
 
 lvlLamBndrs lvl bndrs
-  = go  (incMinorLvl lvl)
-	False 	-- Havn't bumped major level in this group
-	[] bndrs
+  = (new_lvl, [TB bndr new_lvl | bndr <- bndrs])
+  -- All the new binders get the same level, because
+  -- any floating binding is either going to float past 
+  -- all or none.  We never separate binders
   where
-    go old_lvl bumped_major rev_lvld_bndrs (bndr:bndrs)
-	| isId bndr &&	    		-- Go to the next major level if this is a value binder,
-	  not bumped_major && 		-- and we havn't already gone to the next level (one jump per group)
-	  not (isOneShotLambda bndr)	-- and it isn't a one-shot lambda
-	= go new_lvl True (TB bndr new_lvl : rev_lvld_bndrs) bndrs
+    new_lvl | any is_major bndrs = incMajorLvl lvl
+            | otherwise          = incMinorLvl lvl
 
-	| otherwise
-	= go old_lvl bumped_major (TB bndr old_lvl : rev_lvld_bndrs) bndrs
-
-	where
-	  new_lvl = incMajorLvl old_lvl
-
-    go old_lvl _ rev_lvld_bndrs []
-	= (old_lvl, reverse rev_lvld_bndrs)
-	-- a lambda like this (\x -> coerce t (\s -> ...))
-	-- This happens quite a bit in state-transformer programs
+    is_major bndr = isId bndr && not (isOneShotLambda bndr)
 \end{code}
 
 \begin{code}