Adjust Activations for specialise and work/wrap, and better simplify in InlineRules

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

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index f6e8569..b7084c8 100644 (file)
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -671,15 +671,17 @@ simplUnfolding env _ _ _ _ (DFunUnfolding con ops)
   where
     ops' = map (CoreSubst.substExpr (mkCoreSubst env)) ops
 
-simplUnfolding env top_lvl _ _ _ 
+simplUnfolding env top_lvl id _ _ 
     (CoreUnfolding { uf_tmpl = expr, uf_arity = arity
                    , uf_src = src, uf_guidance = guide })
   | isInlineRuleSource src
-  = do { expr' <- simplExpr (updMode updModeForInlineRules env) expr
-                      -- See Note [Simplifying gently inside InlineRules] in SimplUtils
+  = do { expr' <- simplExpr rule_env expr
        ; let src' = CoreSubst.substUnfoldingSource (mkCoreSubst env) src
        ; return (mkCoreUnfolding (isTopLevel top_lvl) src' expr' arity guide) }
                -- See Note [Top-level flag on inline rules] in CoreUnfold
+  where
+    rule_env = updMode (updModeForInlineRules (idInlineActivation id)) env
+                      -- See Note [Simplifying gently inside InlineRules] in SimplUtils
 
 simplUnfolding _ top_lvl id _occ_info new_rhs _
   = return (mkUnfolding (isTopLevel top_lvl) (isBottomingId id) new_rhs)
@@ -874,7 +876,7 @@ simplType :: SimplEnv -> InType -> SimplM OutType
         -- Kept monadic just so we can do the seqType
 simplType env ty
   = -- pprTrace "simplType" (ppr ty $$ ppr (seTvSubst env)) $
-    seqType new_ty   `seq`   return new_ty
+    seqType new_ty `seq` return new_ty
   where
     new_ty = substTy env ty
 
@@ -883,8 +885,9 @@ simplCoercion :: SimplEnv -> InType -> SimplM OutType
 -- The InType isn't *necessarily* a coercion, but it might be
 -- (in a type application, say) and optCoercion is a no-op on types
 simplCoercion env co
-  = do { co' <- simplType env co
-       ; return (optCoercion co') }
+  = seqType new_co `seq` return new_co
+  where 
+    new_co = optCoercion (getTvSubst env) co
 \end{code}