Allow inlining in "SimplGentle" mode

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

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index d169518..d847d3b 100644 (file)
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -335,8 +335,7 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se
                 -- See Note [Floating and type abstraction] in SimplUtils
 
         -- Simplify the RHS
-        ; (body_env1, body1) <- simplExprF body_env body mkBoringStop
-
+        ; (body_env1, body1) <- simplExprF body_env body mkRhsStop
         -- ANF-ise a constructor or PAP rhs
         ; (body_env2, body2) <- prepareRhs body_env1 body1
 
@@ -655,10 +654,11 @@ simplUnfolding env _ _ _ _ (DFunUnfolding con ops)
 simplUnfolding env top_lvl _ _ _ 
     (CoreUnfolding { uf_tmpl = expr, uf_arity = arity
                    , uf_guidance = guide@(InlineRule {}) })
-  = do { expr' <- simplExpr (setMode SimplGently env) expr
-       ; let mb_wkr' = CoreSubst.substInlineRuleGuidance (mkCoreSubst env) (ug_ir_info guide)
+  = do { expr' <- simplExpr (setMode simplGentlyForInlineRules env) expr
+                      -- See Note [Simplifying gently inside InlineRules] in SimplUtils
+       ; let mb_wkr' = CoreSubst.substInlineRuleInfo (mkCoreSubst env) (ir_info guide)
        ; return (mkCoreUnfolding (isTopLevel top_lvl) expr' arity 
-                                 (guide { ug_ir_info = mb_wkr' })) }
+                                 (guide { ir_info = mb_wkr' })) }
                -- See Note [Top-level flag on inline rules] in CoreUnfold
 
 simplUnfolding _ top_lvl _ occ_info new_rhs _
@@ -1189,8 +1189,8 @@ rebuildCall env fun
         ; rebuildCall env (fun `App` arg') arg_info' cont }
   where
     arg_info' = ArgInfo { ai_rules = has_rules, ai_strs = strs, ai_discs = discs }
-    cci | has_rules || disc > 0 = ArgCtxt has_rules disc  -- Be keener here
-        | otherwise             = BoringCtxt              -- Nothing interesting
+    cci | has_rules || disc > 0 = ArgCtxt has_rules  -- Be keener here
+        | otherwise             = BoringCtxt         -- Nothing interesting
 
 rebuildCall env fun _ cont
   = rebuild env fun cont