X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSetLevels.lhs;h=23874bfafc261817cede1b024172d6c258d5b89c;hb=2b8358cfe8b6399874090c099e3b96e932c6ccbb;hp=d0914c948bfd68c97e57096f04e43729dd5e793c;hpb=b84ba676034763b3082bbd9405794a4fde499d14;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index d0914c9..23874bf 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -54,8 +54,7 @@ module SetLevels (
 #include "HsVersions.h"
 
 import CoreSyn
-
-import DynFlags		( FloatOutSwitches(..) )
+import CoreMonad	( FloatOutSwitches(..) )
 import CoreUtils	( exprType, mkPiTypes )
 import CoreArity	( exprBotStrictness_maybe )
 import CoreFVs		-- all of it
@@ -450,7 +449,7 @@ notWorthFloating :: CoreExprWithFVs -> [Var] -> Bool
 --   abs_vars = tvars only:  return True if e is trivial, 
 --                           but False for anything bigger
 --   abs_vars = [x] (an Id): return True for trivial, or an application (f x)
---   	      	    	     but False for (f x x) 
+--   	      	    	     but False for (f x x)
 --
 -- One big goal is that floating should be idempotent.  Eg if
 -- we replace e with (lvl79 x y) and then run FloatOut again, don't want
@@ -459,8 +458,8 @@ notWorthFloating :: CoreExprWithFVs -> [Var] -> Bool
 notWorthFloating e abs_vars
   = go e (count isId abs_vars)
   where
-    go (_, AnnVar {}) n    = n == 0
-    go (_, AnnLit {}) n    = n == 0
+    go (_, AnnVar {}) n    = n >= 0
+    go (_, AnnLit {}) n    = n >= 0
     go (_, AnnCast e _)  n = go e n
     go (_, AnnApp e arg) n 
        | (_, AnnType {}) <- arg = go e n
@@ -536,7 +535,7 @@ lvlBind :: TopLevelFlag		-- Used solely to decide whether to clone
 	-> LvlM (LevelledBind, LevelEnv)
 
 lvlBind top_lvl ctxt_lvl env (AnnNonRec bndr rhs@(rhs_fvs,_))
-  |  isTyVar bndr 		-- Don't do anything for TyVar binders
+  |  isTyCoVar bndr 		-- Don't do anything for TyVar binders
 				--   (simplifier gets rid of them pronto)
   = do rhs' <- lvlExpr ctxt_lvl env rhs
        return (NonRec (TB bndr ctxt_lvl) rhs', env)
@@ -616,7 +615,7 @@ lvlBind top_lvl ctxt_lvl env (AnnRec pairs)
     abs_vars = abstractVars dest_lvl env bind_fvs
 
 ----------------------------------------------------
--- Three help functons for the type-abstraction case
+-- Three help functions for the type-abstraction case
 
 lvlFloatRhs :: [CoreBndr] -> Level -> LevelEnv -> CoreExprWithFVs
             -> UniqSM (Expr (TaggedBndr Level))
@@ -846,7 +845,7 @@ abstractVars dest_lvl (_, lvl_env, _, id_env) fvs
 		   (False, True) -> False
 		   _    	 -> v1 <= v2	-- Same family
 
-    is_tv v = isTyVar v && not (isCoVar v)
+    is_tv v = isTyCoVar v && not (isCoVar v)
 
     uniq :: [Var] -> [Var]
 	-- Remove adjacent duplicates; the sort will have brought them together
@@ -860,7 +859,7 @@ abstractVars dest_lvl (_, lvl_env, _, id_env) fvs
 
 	-- We are going to lambda-abstract, so nuke any IdInfo,
 	-- and add the tyvars of the Id (if necessary)
-    zap v | isId v = WARN( isInlineRule (idUnfolding v) ||
+    zap v | isId v = WARN( isStableUnfolding (idUnfolding v) ||
 		           not (isEmptySpecInfo (idSpecialisation v)),
 		           text "absVarsOf: discarding info on" <+> ppr v )
 		     setIdInfo v vanillaIdInfo