From 01b453a5c3608f52707ee55374ca50cb592f567d Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Tue, 10 Nov 2009 17:23:37 +0000
Subject: [PATCH] Wibbles to the inline-in-InlineRule stuff

The main change is using SimplUtils.updModeForInlineRules
doesn't overwrite the current setting, it just augments it.
---
 compiler/simplCore/SimplEnv.lhs   |    5 ++++-
 compiler/simplCore/SimplUtils.lhs |   29 ++++++++++++++++++++---------
 compiler/simplCore/Simplify.lhs   |    2 +-
 3 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 5d8b16c..b6f2fbf 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -10,7 +10,7 @@ module SimplEnv (
         InCoercion, OutCoercion,
 
 	-- The simplifier mode
-	setMode, getMode, 
+	setMode, getMode, updMode,
 
 	-- Switch checker
 	SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
@@ -225,6 +225,9 @@ getMode env = seMode env
 setMode :: SimplifierMode -> SimplEnv -> SimplEnv
 setMode mode env = env { seMode = mode }
 
+updMode :: (SimplifierMode -> SimplifierMode) -> SimplEnv -> SimplEnv
+updMode upd env = env { seMode = upd (seMode env) }
+
 inGentleMode :: SimplEnv -> Bool
 inGentleMode env = case seMode env of
 	                SimplGently {} -> True
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 1511a2f..c87e1fc 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -11,7 +11,7 @@ module SimplUtils (
 	-- Inlining,
 	preInlineUnconditionally, postInlineUnconditionally, 
 	activeInline, activeRule, 
-        simplEnvForGHCi, simplEnvForRules, simplGentlyForInlineRules,
+        simplEnvForGHCi, simplEnvForRules, updModeForInlineRules,
 
 	-- The continuation type
 	SimplCont(..), DupFlag(..), ArgInfo(..),
@@ -422,8 +422,11 @@ simplEnvForRules :: SimplEnv
 simplEnvForRules = mkSimplEnv allOffSwitchChecker $
                    SimplGently { sm_rules = True, sm_inline = False }
 
-simplGentlyForInlineRules :: SimplifierMode
-simplGentlyForInlineRules = SimplGently { sm_rules = True, sm_inline = True }
+updModeForInlineRules :: SimplifierMode -> SimplifierMode
+updModeForInlineRules mode
+  = case mode of      
+      SimplGently {} -> mode	-- Don't modify mode if we already gentle
+      SimplPhase  {} -> SimplGently { sm_rules = True, sm_inline = True }
 	-- Simplify as much as possible, subject to the usual "gentle" rules
 \end{code}
 
@@ -476,6 +479,19 @@ running it, we don't want to use -O2.  Indeed, we don't want to inline
 anything, because the byte-code interpreter might get confused about 
 unboxed tuples and suchlike.
 
+Note [RULEs enabled in SimplGently]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+RULES are enabled when doing "gentle" simplification.  Two reasons:
+
+  * We really want the class-op cancellation to happen:
+        op (df d1 d2) --> $cop3 d1 d2
+    because this breaks the mutual recursion between 'op' and 'df'
+
+  * I wanted the RULE
+        lift String ===> ...
+    to work in Template Haskell when simplifying
+    splices, so we get simpler code for literal strings
+
 Note [Simplifying gently inside InlineRules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We don't do much simplification inside InlineRules (which come from
@@ -805,13 +821,8 @@ activeRule dflags env
   | otherwise
   = case getMode env of
       SimplGently { sm_rules = rules_on } 
-        | rules_on  -> Just isEarlyActive
+        | rules_on  -> Just isEarlyActive	-- Note [RULEs enabled in SimplGently]
         | otherwise -> Nothing
-			-- Used to be Nothing (no rules in gentle mode)
-			-- Main motivation for changing is that I wanted
-			-- 	lift String ===> ...
-			-- to work in Template Haskell when simplifying
-			-- splices, so we get simpler code for literal strings
       SimplPhase n _ -> Just (isActive n)
 \end{code}
 
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 6ae9587..96e9559 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -673,7 +673,7 @@ simplUnfolding env _ _ _ _ (DFunUnfolding con ops)
 simplUnfolding env top_lvl _ _ _ 
     (CoreUnfolding { uf_tmpl = expr, uf_arity = arity
                    , uf_guidance = guide@(InlineRule {}) })
-  = do { expr' <- simplExpr (setMode simplGentlyForInlineRules env) expr
+  = do { expr' <- simplExpr (updMode updModeForInlineRules 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 
-- 
1.7.10.4