X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSetLevels.lhs;h=6dfb5f1c051bbdfe622e24fa7a02a38430eed532;hb=2f41dd510a893312dfaa0d652f448cc3a045eb88;hp=f8ab29dcd593189f77eb18929143305d51ae4b5a;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index f8ab29d..6dfb5f1 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -290,6 +290,10 @@ lvlExpr ctxt_lvl env (_, AnnNote note expr)
   = lvlExpr ctxt_lvl env expr 		`thenLvl` \ expr' ->
     returnLvl (Note note expr')
 
+lvlExpr ctxt_lvl env (_, AnnCast expr co)
+  = lvlExpr ctxt_lvl env expr		`thenLvl` \ expr' ->
+    returnLvl (Cast expr' co)
+
 -- We don't split adjacent lambdas.  That is, given
 --	\x y -> (x+1,y)
 -- we don't float to give 
@@ -767,8 +771,7 @@ absVarsOf dest_lvl (_, lvl_env, _, id_env) v
 			Just (abs_vars, _) -> abs_vars
 			Nothing	           -> [v]
 
-    add_tyvars v | isId v    = v : varSetElems (idFreeTyVars v)
-		 | otherwise = [v]
+    add_tyvars v = v : varSetElems (varTypeTyVars v)
 
 	-- We are going to lambda-abstract, so nuke any IdInfo,
 	-- and add the tyvars of the Id (if necessary)
@@ -839,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}