[project @ 1996-05-16 09:42:08 by partain]

[ghc-hetmet.git] / ghc / compiler / simplCore / SimplUtils.lhs

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index 3e9c6aa..ba1cc4e 100644 (file)
--- 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