X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSimplUtils.lhs;h=ba1cc4e7bc3849fa61e16e16b5704173fa7da262;hb=5cf27e8f1731c52fe63a5b9615f927484164c61b;hp=3e9c6aab64f490f57555500430b0ae6ff2f48029;hpb=7b0181919416d8f04324575b7e17031ca692f5b0;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index 3e9c6aa..ba1cc4e 100644
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ b/ghc/compiler/simplCore/SimplUtils.lhs
@@ -36,7 +36,7 @@ import PrelInfo		( augmentId, buildId, realWorldStateTy )
 import PrimOp		( primOpIsCheap )
 import SimplEnv
 import SimplMonad
-import Type		( eqTy, isPrimType, maybeAppDataTyCon, getTyVar_maybe )
+import Type		( eqTy, isPrimType, maybeAppDataTyConExpandingDicts, getTyVar_maybe )
 import TyVar		( GenTyVar{-instance Eq-} )
 import Util		( isIn, panic )
 
@@ -246,12 +246,13 @@ which aren't WHNF but are ``cheap'' are:
 \begin{code}
 manifestlyCheap :: GenCoreExpr bndr Id tv uv -> Bool
 
-manifestlyCheap (Var _)     = True
-manifestlyCheap (Lit _)     = True
-manifestlyCheap (Con _ _)   = True
-manifestlyCheap (SCC _ e)   = manifestlyCheap e
-manifestlyCheap (Lam x e)   = if isValBinder x then True else manifestlyCheap e
-manifestlyCheap (Prim op _) = primOpIsCheap op
+manifestlyCheap (Var _)        = True
+manifestlyCheap (Lit _)        = True
+manifestlyCheap (Con _ _)      = True
+manifestlyCheap (SCC _ e)      = manifestlyCheap e
+manifestlyCheap (Coerce _ _ e) = manifestlyCheap e
+manifestlyCheap (Lam x e)      = if isValBinder x then True else manifestlyCheap e
+manifestlyCheap (Prim op _)    = primOpIsCheap op
 
 manifestlyCheap (Let bind body)
   = manifestlyCheap body && all manifestlyCheap (rhssOfBind bind)
@@ -371,7 +372,7 @@ mkIdentityAlts rhs_ty
     returnSmpl (PrimAlts [] (BindDefault (binder, bad_occ_info) (Var binder)))
 
   | otherwise
-  = case (maybeAppDataTyCon rhs_ty) of
+  = case (maybeAppDataTyConExpandingDicts rhs_ty) of
 	Just (tycon, ty_args, [data_con]) ->  -- algebraic type suitable for unpacking
 	    let
 		inst_con_arg_tys = dataConArgTys data_con ty_args
@@ -404,7 +405,7 @@ simplIdWantsToBeINLINEd id env
 type_ok_for_let_to_case :: Type -> Bool
 
 type_ok_for_let_to_case ty
-  = case (maybeAppDataTyCon ty) of
+  = case (maybeAppDataTyConExpandingDicts ty) of
       Nothing                                   -> False
       Just (tycon, ty_args, [])                 -> False
       Just (tycon, ty_args, non_null_data_cons) -> True