X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSetLevels.lhs;h=ed420899e8102b6aa6f83daa7419899f895ed3da;hb=1cf8d965aeb55701efa47dace761c4d673c06987;hp=c9b0601be00241d0460ec7378437cf499aac5a23;hpb=72462499b891d5779c19f3bda03f96e24f9554ae;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index c9b0601..ed42089 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -64,7 +64,7 @@ import CoreSubst	( Subst, emptySubst, extendInScope, extendInScopeList,
 import Id		( idType, mkSysLocal, isOneShotLambda,
 			  zapDemandIdInfo, transferPolyIdInfo,
 			  idSpecialisation, idUnfolding, setIdInfo, 
-			  setIdNewStrictness, setIdArity
+			  setIdStrictness, setIdArity
 			)
 import IdInfo
 import Var
@@ -251,15 +251,9 @@ lvlExpr _ env (_, AnnVar v)   = return (lookupVar env v)
 lvlExpr _ _   (_, AnnLit lit) = return (Lit lit)
 
 lvlExpr ctxt_lvl env (_, AnnApp fun arg) = do
-    fun' <- lvl_fun fun
+    fun' <- lvlExpr ctxt_lvl env fun   -- We don't do MFE on partial applications
     arg' <- lvlMFE  False ctxt_lvl env arg
     return (App fun' arg')
-  where
--- gaw 2004
-    lvl_fun (_, AnnCase _ _ _ _) = lvlMFE True ctxt_lvl env fun
-    lvl_fun _                    = lvlExpr ctxt_lvl env fun
-	-- We don't do MFE on partial applications generally,
-	-- but we do if the function is big and hairy, like a case
 
 lvlExpr ctxt_lvl env (_, AnnNote note expr) = do
     expr' <- lvlExpr ctxt_lvl env expr
@@ -398,7 +392,7 @@ lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _)
 		-- Note [Bottoming floats]
        let var_w_str = case exprBotStrictness_maybe expr of
 			  Just (arity,str) -> var `setIdArity` arity
-						  `setIdNewStrictness` str
+						  `setIdStrictness` str
 			  Nothing  -> var
        return (Let (NonRec (TB var_w_str dest_lvl) expr') 
                    (mkVarApps (Var var_w_str) abs_vars))