X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FSetLevels.lhs;h=6dfb5f1c051bbdfe622e24fa7a02a38430eed532;hp=5dbaec65f0223ac5845124ffada0b6335bff5a6d;hb=9832b556cc8ea22508926f67c628f12eea3bd38b;hpb=42b37bc4ee622d3a7745d451da26bf5a14f1e7ea

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index 5dbaec6..6dfb5f1 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -842,9 +842,11 @@ cloneRecVars NotTopLevel env@(_,_,subst,_) vs ctxt_lvl dest_lvl
     returnUs (env', vs2)
 
 	-- VERY IMPORTANT: we must zap the demand info 
-	-- if the thing is going to float out past a lambda
+	-- if the thing is going to float out past a lambda,
+	-- or if it's going to top level (where things can't be strict)
 zap_demand dest_lvl ctxt_lvl id
-  | ctxt_lvl == dest_lvl = id			-- Stays put
-  | otherwise		 = zapDemandIdInfo id	-- Floats out
+  | ctxt_lvl == dest_lvl,
+    not (isTopLvl dest_lvl) = id	-- Stays, and not going to top level
+  | otherwise		    = zapDemandIdInfo id	-- Floats out
 \end{code}