Refactoring of the way that inlinings and rules are activated

Principally, the SimplifierMode now carries several (currently
four) flags in *all* phases, not just the "Gentle" phase.
This makes things simpler and more uniform.

As usual I did more refactoring than I had intended.

This stuff should go into 7.0.2 in due course, once
we've checked it solves the DPH performance problems.

1 files changed, 115 insertions, 181 deletions

diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 16185250c8..a2fe28d602 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -10,8 +10,9 @@ module SimplUtils (
 
 	-- Inlining,
 	preInlineUnconditionally, postInlineUnconditionally, 
-	activeUnfolding, activeUnfInRule, activeRule, 
-        simplEnvForGHCi, simplEnvForRules, updModeForInlineRules,
+	activeUnfolding, activeRule, 
+	getUnfoldingInRuleMatch, 
+        simplEnvForGHCi, updModeForInlineRules,
 
 	-- The continuation type
 	SimplCont(..), DupFlag(..), ArgInfo(..),
@@ -29,7 +30,7 @@ module SimplUtils (
 #include "HsVersions.h"
 
 import SimplEnv
-import CoreMonad	( SimplifierMode(..), Tick(..) )
+import CoreMonad        ( SimplifierMode(..), Tick(..) )
 import DynFlags
 import StaticFlags
 import CoreSyn
@@ -454,44 +455,37 @@ interestingArgContext rules call_cont
 
 %************************************************************************
 %*									*
-                  Gentle mode									
+                  SimplifierMode
 %*									*
 %************************************************************************
 
-Inlining is controlled partly by the SimplifierMode switch.  This has two
-settings
-	
-	SimplGently	(a) Simplifying before specialiser/full laziness
-			(b) Simplifiying inside InlineRules
-			(c) Simplifying the LHS of a rule
-			(d) Simplifying a GHCi expression or Template 
-				Haskell splice
-
-	SimplPhase n _	 Used at all other times
-
-Note [Gentle mode]
-~~~~~~~~~~~~~~~~~~
-Gentle mode has a separate boolean flag to control
-	a) inlining (sm_inline flag)
-	b) rules    (sm_rules  flag)
-A key invariant about Gentle mode is that it is treated as the EARLIEST
-phase.  
+The SimplifierMode controls several switches; see its definition in
+CoreMonad
+        sm_rules      :: Bool     -- Whether RULES are enabled
+        sm_inline     :: Bool     -- Whether inlining is enabled
+        sm_case_case  :: Bool     -- Whether case-of-case is enabled
+        sm_eta_expand :: Bool     -- Whether eta-expansion is enabled
 
 \begin{code}
 simplEnvForGHCi :: SimplEnv
-simplEnvForGHCi = mkSimplEnv allOffSwitchChecker $
-                  SimplGently { sm_rules = True, sm_inline = False }
+simplEnvForGHCi = mkSimplEnv $
+                  SimplMode { sm_names = ["GHCi"]
+                            , sm_phase = InitialPhase
+                            , sm_rules = True, sm_inline = False
+                            , sm_eta_expand = False, sm_case_case = True }
    -- Do not do any inlining, in case we expose some unboxed
    -- tuple stuff that confuses the bytecode interpreter
 
-simplEnvForRules :: SimplEnv
-simplEnvForRules = mkSimplEnv allOffSwitchChecker $
-                   SimplGently { sm_rules = True, sm_inline = False }
-
 updModeForInlineRules :: Activation -> SimplifierMode -> SimplifierMode
 -- See Note [Simplifying inside InlineRules]
-updModeForInlineRules _inline_rule_act _current_mode
-  = SimplGently { sm_rules = True, sm_inline = True }
+updModeForInlineRules inline_rule_act current_mode
+  = current_mode { sm_phase = phaseFromActivation inline_rule_act
+                 , sm_rules = True
+                 , sm_inline = True
+                 , sm_eta_expand = False }
+  where
+    phaseFromActivation (ActiveAfter n) = Phase n
+    phaseFromActivation _               = InitialPhase
 \end{code}
 
 Note [Inlining in gentle mode]
@@ -531,25 +525,6 @@ 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
-
-But watch out: list fusion can prevent floating.  So use phase control
-to switch off those rules until after floating.
-
-Currently (Oct10) I think that sm_rules is always True, so we
-could remove it.
-
 Note [Simplifying inside InlineRules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We must take care with simplification inside InlineRules (which come from
@@ -568,8 +543,55 @@ one; see OccurAnal.addRuleUsage.
 
 Second, we do want *do* to some modest rules/inlining stuff in InlineRules,
 partly to eliminate senseless crap, and partly to break the recursive knots
-generated by instance declarations.  To keep things simple, we always set 
-the phase to 'gentle' when processing InlineRules.  
+generated by instance declarations.
+
+However, suppose we have
+	{-# INLINE <act> f #-}
+	f = <rhs>
+meaning "inline f in phases p where activation <act>(p) holds". 
+Then what inlinings/rules can we apply to the copy of <rhs> captured in
+f's InlineRule?  Our model is that literally <rhs> is substituted for
+f when it is inlined.  So our conservative plan (implemented by 
+updModeForInlineRules) is this:
+
+  -------------------------------------------------------------
+  When simplifying the RHS of an InlineRule, set the phase to the
+  phase in which the InlineRule first becomes active
+  -------------------------------------------------------------
+
+That ensures that
+
+  a) Rules/inlinings that *cease* being active before p will 
+     not apply to the InlineRule rhs, consistent with it being
+     inlined in its *original* form in phase p.
+
+  b) Rules/inlinings that only become active *after* p will
+     not apply to the InlineRule rhs, again to be consistent with
+     inlining the *original* rhs in phase p.
+
+For example, 
+       	{-# INLINE f #-}
+      	f x = ...g...
+
+      	{-# NOINLINE [1] g #-}
+      	g y = ...
+
+      	{-# RULE h g = ... #-}
+Here we must not inline g into f's RHS, even when we get to phase 0,
+because when f is later inlined into some other module we want the
+rule for h to fire.
+
+Similarly, consider
+ 	{-# INLINE f #-}
+	f x = ...g...
+
+	g y = ...
+and suppose that there are auto-generated specialisations and a strictness
+wrapper for g.  The specialisations get activation AlwaysActive, and the
+strictness wrapper get activation (ActiveAfter 0).  So the strictness
+wrepper fails the test and won't be inlined into f's InlineRule. That
+means f can inline, expose the specialised call to g, so the specialisation
+rules can fire.
 
 A note about wrappers
 ~~~~~~~~~~~~~~~~~~~~~
@@ -583,31 +605,32 @@ mark it 'demanded', so when the RHS is simplified, it'll get an ArgOf
 continuation. 
 
 \begin{code}
-activeUnfolding :: SimplEnv -> IdUnfoldingFun
+activeUnfolding :: SimplEnv -> Id -> Bool
 activeUnfolding env
-  = case getMode env of
-      SimplGently { sm_inline = False } -> active_unfolding_minimal
-      SimplGently { sm_inline = True  } -> active_unfolding_gentle
-      SimplPhase n _                    -> active_unfolding n
+  | not (sm_inline mode) = active_unfolding_minimal
+  | otherwise            = case sm_phase mode of
+                             InitialPhase -> active_unfolding_gentle
+                             Phase n      -> active_unfolding n
+  where
+    mode = getMode env
 
-activeUnfInRule :: SimplEnv -> IdUnfoldingFun
+getUnfoldingInRuleMatch :: SimplEnv -> IdUnfoldingFun
 -- When matching in RULE, we want to "look through" an unfolding
 -- (to see a constructor) if *rules* are on, even if *inlinings* 
 -- are not.  A notable example is DFuns, which really we want to 
 -- match in rules like (op dfun) in gentle mode. Another example
 -- is 'otherwise' which we want exprIsConApp_maybe to be able to
 -- see very early on
-activeUnfInRule env
-  = case getMode env of
-      SimplGently { sm_rules = False } -> active_unfolding_minimal
-      SimplGently { sm_rules = True  } -> active_unfolding_early
-      SimplPhase n _                   -> active_unfolding n
+getUnfoldingInRuleMatch env id
+  | unf_is_active = idUnfolding id
+  | otherwise     = NoUnfolding
   where
-    active_unfolding_early id
-      | isEarlyActive (idInlineActivation id) = idUnfolding id
-      | otherwise                             = idUnfolding id
+    mode = getMode env
+    unf_is_active
+     | not (sm_rules mode) = active_unfolding_minimal id
+     | otherwise           = isActive (sm_phase mode) (idInlineActivation id)
 
-active_unfolding_minimal :: IdUnfoldingFun
+active_unfolding_minimal :: Id -> Bool
 -- Compuslory unfoldings only
 -- Ignore SimplGently, because we want to inline regardless;
 -- the Id has no top-level binding at all
@@ -618,113 +641,31 @@ active_unfolding_minimal :: IdUnfoldingFun
 -- But that only really applies to the trivial wrappers (like (:)),
 -- and they are now constructed as Compulsory unfoldings (in MkId)
 -- so they'll happen anyway.
-active_unfolding_minimal id
-  | isCompulsoryUnfolding unf = unf
-  | otherwise                 = NoUnfolding
-  where
-    unf = idUnfolding id
+active_unfolding_minimal id = isCompulsoryUnfolding (realIdUnfolding id)
+
+active_unfolding :: PhaseNum -> Id -> Bool
+active_unfolding n id = isActiveIn n (idInlineActivation id)
 
-active_unfolding_gentle :: IdUnfoldingFun
+active_unfolding_gentle :: Id -> Bool
 -- Anything that is early-active
 -- See Note [Gentle mode]
 active_unfolding_gentle id
-  | isStableUnfolding unf
-  , isEarlyActive (idInlineActivation id) = unf
+  =  isInlinePragma prag
+  && isEarlyActive (inlinePragmaActivation prag)
        -- NB: wrappers are not early-active
-  | otherwise                             = NoUnfolding
   where
-    unf = idUnfolding id
-      -- idUnfolding checks for loop-breakers
-      -- Things with an INLINE pragma may have 
-      -- an unfolding *and* be a loop breaker  
-      -- (maybe the knot is not yet untied)
-
-active_unfolding :: CompilerPhase -> IdUnfoldingFun
-active_unfolding n id
-  | isActive n (idInlineActivation id) = idUnfolding id
-  | otherwise                          = NoUnfolding
+    prag = idInlinePragma id
 
+----------------------
 activeRule :: DynFlags -> SimplEnv -> Maybe (Activation -> Bool)
 -- Nothing => No rules at all
-activeRule dflags env
-  | not (dopt Opt_EnableRewriteRules dflags)
-  = Nothing	-- Rewriting is off
-  | otherwise
-  = case getMode env of
-      SimplGently { sm_rules = rules_on } 
-        | rules_on  -> Just isEarlyActive	-- Note [RULEs enabled in SimplGently]
-        | otherwise -> Nothing
-      SimplPhase n _ -> Just (isActive n)
+activeRule _dflags env
+  | not (sm_rules mode) = Nothing     -- Rewriting is off
+  | otherwise           = Just (isActive (sm_phase mode))
+  where
+    mode = getMode env
 \end{code}
 
---------------------------------------------------------------
-                OLD NOTES, now wrong
-           Preserved just for now (Oct 10)
---------------------------------------------------------------
-
-      OK, so suppose we have
-      	{-# INLINE <act> f #-}
-      	f = <rhs>
-      meaning "inline f in phases p where activation <act>(p) holds". 
-      Then what inlinings/rules can we apply to the copy of <rhs> captured in
-      f's InlineRule?  Our model is that literally <rhs> is substituted for
-      f when it is inlined.  So our conservative plan (implemented by 
-      updModeForInlineRules) is this:
-
-        -------------------------------------------------------------
-        When simplifying the RHS of an InlineRule,
-        If the InlineRule becomes active in phase p, then
-          if the current phase is *earlier than* p, 
-             make no inlinings or rules active when simplifying the RHS
-          otherwise 
-             set the phase to p when simplifying the RHS
-
-      --    Treat Gentle as phase "infinity"
-      --    If current_phase `earlier than` inline_rule_start_phase 
-      --      then no_op
-      --    else 
-      --    if current_phase `same phase` inline_rule_start_phase 
-      --      then current_phase   (keep gentle flags)
-      --      else inline_rule_start_phase
-        -------------------------------------------------------------
-
-      That ensures that
-
-        a) Rules/inlinings that *cease* being active before p will 
-           not apply to the InlineRule rhs, consistent with it being
-           inlined in its *original* form in phase p.
-
-        b) Rules/inlinings that only become active *after* p will
-           not apply to the InlineRule rhs, again to be consistent with
-           inlining the *original* rhs in phase p.
-
-      For example, 
-       	{-# INLINE f #-}
-      	f x = ...g...
-
-      	{-# NOINLINE [1] g #-}
-      	g y = ...
-
-      	{-# RULE h g = ... #-}
-      Here we must not inline g into f's RHS, even when we get to phase 0,
-      because when f is later inlined into some other module we want the
-      rule for h to fire.
-
-      Similarly, consider
-       	{-# INLINE f #-}
-      	f x = ...g...
-
-      	g y = ...
-      and suppose that there are auto-generated specialisations and a strictness
-      wrapper for g.  The specialisations get activation AlwaysActive, and the
-      strictness wrapper get activation (ActiveAfter 0).  So the strictness
-      wrepper fails the test and won't be inlined into f's InlineRule. That
-      means f can inline, expose the specialised call to g, so the specialisation
-      rules can fire.
-
---------------------------------------------------------------
-                END OF OLD NOTES
---------------------------------------------------------------
 
 
 %************************************************************************
@@ -848,11 +789,9 @@ preInlineUnconditionally env top_lvl bndr rhs
 	  	  OneOcc in_lam True int_cxt -> try_once in_lam int_cxt
 		  _                          -> False
   where
-    phase = getMode env
-    active = case phase of
-		   SimplGently {} -> isEarlyActive act
-			-- See Note [pre/postInlineUnconditionally in gentle mode]
-		   SimplPhase n _ -> isActive n act
+    mode = getMode env
+    active = isActive (sm_phase mode) act
+             -- See Note [pre/postInlineUnconditionally in gentle mode]
     act = idInlineActivation bndr
     try_once in_lam int_cxt	-- There's one textual occurrence
 	| not in_lam = isNotTopLevel top_lvl || early_phase
@@ -884,9 +823,9 @@ preInlineUnconditionally env top_lvl bndr rhs
     canInlineInLam (Note _ e)		= canInlineInLam e
     canInlineInLam _			= False
 
-    early_phase = case phase of
-			SimplPhase 0 _ -> False
-			_    	       -> True
+    early_phase = case sm_phase mode of
+                    Phase 0 -> False
+                    _       -> True
 -- If we don't have this early_phase test, consider
 --	x = length [1,2,3]
 -- The full laziness pass carefully floats all the cons cells to
@@ -1014,11 +953,8 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs unfolding
 -- Alas!
 
   where
-    active = case getMode env of
-		   SimplGently {} -> isEarlyActive act
-			-- See Note [pre/postInlineUnconditionally in gentle mode]
-		   SimplPhase n _ -> isActive n act
-    act = idInlineActivation bndr
+    active = isActive (sm_phase (getMode env)) (idInlineActivation bndr)
+        -- See Note [pre/postInlineUnconditionally in gentle mode]
 \end{code}
 
 Note [Top level and postInlineUnconditionally]
@@ -1147,18 +1083,16 @@ tryEtaExpand env bndr rhs
          return (new_arity, new_rhs) }
   where
     try_expand dflags
-      | dopt Opt_DoLambdaEtaExpansion dflags 
+      | sm_eta_expand (getMode env)      -- Provided eta-expansion is on
       , not (exprIsTrivial rhs)
-      , not (inGentleMode env)  -- In gentle mode don't eta-expansion
-        	                -- because it can clutter up the code
-        	                -- with casts etc that may not be removed
       , let new_arity = exprEtaExpandArity dflags rhs
-      , new_arity > old_arity
+      , new_arity > rhs_arity
       = do { tick (EtaExpansion bndr)
            ; return (new_arity, etaExpand new_arity rhs) }
       | otherwise
-      = return (exprArity rhs, rhs)
+      = return (rhs_arity, rhs)
 
+    rhs_arity  = exprArity rhs
     old_arity  = idArity bndr
     _dmd_arity = length $ fst $ splitStrictSig $ idStrictness bndr
 \end{code}