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.

9 files changed, 348 insertions, 483 deletions

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 499d7beab4..f07788203a 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -59,8 +59,9 @@ module BasicTypes(
 
 	DefMethSpec(..),
 
-	CompilerPhase, 
-	Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
+        CompilerPhase(..), PhaseNum,
+        Activation(..), isActive, isActiveIn,
+        isNeverActive, isAlwaysActive, isEarlyActive,
         RuleMatchInfo(..), isConLike, isFunLike, 
         InlineSpec(..), 
         InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, 
@@ -637,14 +638,22 @@ failed Failed    = True
 When a rule or inlining is active
 
 \begin{code}
-type CompilerPhase = Int	-- Compilation phase
-				-- Phases decrease towards zero
-				-- Zero is the last phase
+type PhaseNum = Int  -- Compilation phase
+                     -- Phases decrease towards zero
+                     -- Zero is the last phase
+
+data CompilerPhase
+  = Phase PhaseNum
+  | InitialPhase    -- The first phase -- number = infinity!
+
+instance Outputable CompilerPhase where
+   ppr (Phase n)    = int n
+   ppr InitialPhase = ptext (sLit "InitialPhase")
 
 data Activation = NeverActive
 		| AlwaysActive
-		| ActiveBefore CompilerPhase	-- Active only *before* this phase
-		| ActiveAfter CompilerPhase	-- Active in this phase and later
+                | ActiveBefore PhaseNum -- Active only *before* this phase
+                | ActiveAfter PhaseNum  -- Active in this phase and later
 		deriving( Eq, Data, Typeable )	-- Eq used in comparing rules in HsDecls
 
 data RuleMatchInfo = ConLike 			-- See Note [CONLIKE pragma]
@@ -830,10 +839,16 @@ instance Outputable InlinePragma where
               | otherwise      = ppr info
 
 isActive :: CompilerPhase -> Activation -> Bool
-isActive _ NeverActive      = False
-isActive _ AlwaysActive     = True
-isActive p (ActiveAfter n)  = p <= n
-isActive p (ActiveBefore n) = p >  n
+isActive InitialPhase AlwaysActive      = True
+isActive InitialPhase (ActiveBefore {}) = True
+isActive InitialPhase _                 = False
+isActive (Phase p)    act               = isActiveIn p act
+
+isActiveIn :: PhaseNum -> Activation -> Bool
+isActiveIn _ NeverActive      = False
+isActiveIn _ AlwaysActive     = True
+isActiveIn p (ActiveAfter n)  = p <= n
+isActiveIn p (ActiveBefore n) = p >  n
 
 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
 isNeverActive NeverActive = True
diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 4c41d28671..29c1f4c551 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -300,6 +300,7 @@ mkDataConIds wrap_name wkr_name data_con
                     `setArityInfo`         wrap_arity
                         -- It's important to specify the arity, so that partial
                         -- applications are treated as values
+		    `setInlinePragInfo`    alwaysInlinePragma
                     `setUnfoldingInfo`     wrap_unf
                     `setStrictnessInfo` Just wrap_sig
 
diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index 1181931fa7..2dda733a7a 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -49,7 +49,7 @@ module CoreSyn (
 	maybeUnfoldingTemplate, otherCons, unfoldingArity,
 	isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
         isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
-	isStableUnfolding, isStableUnfolding_maybe, 
+        isStableUnfolding, isStableCoreUnfolding_maybe,
         isClosedUnfolding, hasSomeUnfolding, 
 	canUnfold, neverUnfoldGuidance, isStableSource,
 
@@ -70,7 +70,7 @@ module CoreSyn (
 	RuleName, IdUnfoldingFun,
 	
 	-- ** Operations on 'CoreRule's 
-	seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
+	seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
 	setRuleIdName,
 	isBuiltinRule, isLocalRule
     ) where
@@ -384,9 +384,9 @@ ruleArity (Rule {ru_args = args})      = length args
 ruleName :: CoreRule -> RuleName
 ruleName = ru_name
 
-ruleActivation_maybe :: CoreRule -> Maybe Activation
-ruleActivation_maybe (BuiltinRule { })       = Nothing
-ruleActivation_maybe (Rule { ru_act = act }) = Just act
+ruleActivation :: CoreRule -> Activation
+ruleActivation (BuiltinRule { })       = AlwaysActive
+ruleActivation (Rule { ru_act = act }) = act
 
 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
 ruleIdName :: CoreRule -> Name
@@ -669,15 +669,10 @@ expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
 expandUnfolding_maybe _                                                       = Nothing
 
-isStableUnfolding_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
-isStableUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide }) 
-   | isStableSource src
-   = Just (src, unsat_ok)
-   where
-     unsat_ok = case guide of
-     	      	  UnfWhen unsat_ok _ -> unsat_ok
-                  _                  -> needSaturated
-isStableUnfolding_maybe _ = Nothing
+isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource
+isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src })
+   | isStableSource src   = Just src
+isStableCoreUnfolding_maybe _ = Nothing
 
 isCompulsoryUnfolding :: Unfolding -> Bool
 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index e54acc0f10..5a00869ddd 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -730,13 +730,12 @@ StrictAnal.addStrictnessInfoToTopId
 \begin{code}
 callSiteInline :: DynFlags
 	       -> Id			-- The Id
-	       -> Unfolding		-- Its unfolding (if active)
+	       -> Bool			-- True <=> unfolding is active
 	       -> Bool			-- True if there are are no arguments at all (incl type args)
 	       -> [ArgSummary]		-- One for each value arg; True if it is interesting
 	       -> CallCtxt		-- True <=> continuation is interesting
 	       -> Maybe CoreExpr	-- Unfolding, if any
 
-
 instance Outputable ArgSummary where
   ppr TrivArg    = ptext (sLit "TrivArg")
   ppr NonTrivArg = ptext (sLit "NonTrivArg")
@@ -765,67 +764,32 @@ instance Outputable CallCtxt where
   ppr CaseCtxt 	      = ptext (sLit "CaseCtxt")
   ppr ValAppCtxt      = ptext (sLit "ValAppCtxt")
 
-callSiteInline dflags id unfolding lone_variable arg_infos cont_info
-  = case unfolding of {
-	NoUnfolding 	 -> Nothing ;
-	OtherCon _  	 -> Nothing ;
-	DFunUnfolding {} -> Nothing ;	-- Never unfold a DFun
-	CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top, 
-		        uf_is_cheap = is_cheap, uf_arity = uf_arity, uf_guidance = guidance } ->
+callSiteInline dflags id active_unfolding lone_variable arg_infos cont_info
+  = case idUnfolding id of 
+      -- idUnfolding checks for loop-breakers, returning NoUnfolding
+      -- Things with an INLINE pragma may have an unfolding *and* 
+      -- be a loop breaker  (maybe the knot is not yet untied)
+	CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top 
+		      , uf_is_cheap = is_cheap, uf_arity = uf_arity
+                      , uf_guidance = guidance }
+          | active_unfolding -> tryUnfolding dflags id lone_variable 
+                                    arg_infos cont_info unf_template is_top 
+                                    is_cheap uf_arity guidance
+          | otherwise    -> Nothing
+	NoUnfolding 	 -> Nothing 
+	OtherCon {} 	 -> Nothing 
+	DFunUnfolding {} -> Nothing 	-- Never unfold a DFun
+
+tryUnfolding :: DynFlags -> Id -> Bool -> [ArgSummary] -> CallCtxt
+             -> CoreExpr -> Bool -> Bool -> Arity -> UnfoldingGuidance
+	     -> Maybe CoreExpr	
+tryUnfolding dflags id lone_variable 
+             arg_infos cont_info unf_template is_top 
+             is_cheap uf_arity guidance
 			-- uf_arity will typically be equal to (idArity id), 
 			-- but may be less for InlineRules
-    let
-	n_val_args = length arg_infos
-        saturated  = n_val_args >= uf_arity
-
-	result | yes_or_no = Just unf_template
-	       | otherwise = Nothing
-
-	interesting_args = any nonTriv arg_infos 
- 		-- NB: (any nonTriv arg_infos) looks at the
- 		-- over-saturated args too which is "wrong"; 
- 		-- but if over-saturated we inline anyway.
-
-	       -- some_benefit is used when the RHS is small enough
-	       -- and the call has enough (or too many) value
-	       -- arguments (ie n_val_args >= arity). But there must
-	       -- be *something* interesting about some argument, or the
-	       -- result context, to make it worth inlining
-	some_benefit 
-           | not saturated = interesting_args	-- Under-saturated
-		   	      		     	-- Note [Unsaturated applications]
-	   | n_val_args > uf_arity = True	-- Over-saturated
-           | otherwise = interesting_args	-- Saturated
-                      || interesting_saturated_call 
-
-	interesting_saturated_call 
-	  = case cont_info of
-	      BoringCtxt -> not is_top && uf_arity > 0	      -- Note [Nested functions]
-	      CaseCtxt   -> not (lone_variable && is_cheap)   -- Note [Lone variables]
-	      ArgCtxt {} -> uf_arity > 0     		      -- Note [Inlining in ArgCtxt]
-	      ValAppCtxt -> True			      -- Note [Cast then apply]
-
-	(yes_or_no, extra_doc)
-	  = case guidance of
-	      UnfNever -> (False, empty)
-
-	      UnfWhen unsat_ok boring_ok 
-                 -> (enough_args && (boring_ok || some_benefit), empty )
-                 where      -- See Note [INLINE for small functions]
-                   enough_args = saturated || (unsat_ok && n_val_args > 0)
-
-	      UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }
-	  	 -> ( is_cheap && some_benefit && small_enough
-                    , (text "discounted size =" <+> int discounted_size) )
-		 where
-		   discounted_size = size - discount
-		   small_enough = discounted_size <= opt_UF_UseThreshold
-		   discount = computeDiscount uf_arity arg_discounts 
-				              res_discount arg_infos cont_info
-		
-    in    
-    if (dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags) then
-	pprTrace ("Considering inlining: " ++ showSDoc (ppr id))
+ | dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags
+ = pprTrace ("Considering inlining: " ++ showSDoc (ppr id))
 		 (vcat [text "arg infos" <+> ppr arg_infos,
 			text "uf arity" <+> ppr uf_arity,
 			text "interesting continuation" <+> ppr cont_info,
@@ -834,10 +798,57 @@ callSiteInline dflags id unfolding lone_variable arg_infos cont_info
 			text "guidance" <+> ppr guidance,
 			extra_doc,
 			text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
-		  result
-    else
-    result
-    }
+	         result
+  | otherwise  = result
+
+  where
+    n_val_args = length arg_infos
+    saturated  = n_val_args >= uf_arity
+
+    result | yes_or_no = Just unf_template
+           | otherwise = Nothing
+
+    interesting_args = any nonTriv arg_infos 
+    	-- NB: (any nonTriv arg_infos) looks at the
+    	-- over-saturated args too which is "wrong"; 
+    	-- but if over-saturated we inline anyway.
+
+           -- some_benefit is used when the RHS is small enough
+           -- and the call has enough (or too many) value
+           -- arguments (ie n_val_args >= arity). But there must
+           -- be *something* interesting about some argument, or the
+           -- result context, to make it worth inlining
+    some_benefit 
+       | not saturated = interesting_args	-- Under-saturated
+    	   	      		     	-- Note [Unsaturated applications]
+       | n_val_args > uf_arity = True	-- Over-saturated
+       | otherwise = interesting_args	-- Saturated
+                  || interesting_saturated_call 
+
+    interesting_saturated_call 
+      = case cont_info of
+          BoringCtxt -> not is_top && uf_arity > 0	      -- Note [Nested functions]
+          CaseCtxt   -> not (lone_variable && is_cheap)   -- Note [Lone variables]
+          ArgCtxt {} -> uf_arity > 0     		      -- Note [Inlining in ArgCtxt]
+          ValAppCtxt -> True			      -- Note [Cast then apply]
+
+    (yes_or_no, extra_doc)
+      = case guidance of
+          UnfNever -> (False, empty)
+
+          UnfWhen unsat_ok boring_ok 
+             -> (enough_args && (boring_ok || some_benefit), empty )
+             where      -- See Note [INLINE for small functions]
+               enough_args = saturated || (unsat_ok && n_val_args > 0)
+
+          UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }
+      	     -> ( is_cheap && some_benefit && small_enough
+                , (text "discounted size =" <+> int discounted_size) )
+    	     where
+    	       discounted_size = size - discount
+    	       small_enough = discounted_size <= opt_UF_UseThreshold
+    	       discount = computeDiscount uf_arity arg_discounts 
+    	         		          res_discount arg_infos cont_info
 \end{code}
 
 Note [RHS of lets]
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index d821d40736..0b8ea1e4a1 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -10,7 +10,6 @@ module CoreMonad (
     -- * Configuration of the core-to-core passes
     CoreToDo(..),
     SimplifierMode(..),
-    SimplifierSwitch(..),
     FloatOutSwitches(..),
     getCoreToDo, dumpSimplPhase,
 
@@ -63,7 +62,7 @@ import Module           ( PackageId, Module )
 import DynFlags
 import StaticFlags	
 import Rules            ( RuleBase )
-import BasicTypes	( CompilerPhase )
+import BasicTypes       ( CompilerPhase(..) )
 import Annotations
 import Id		( Id )
 
@@ -186,8 +185,8 @@ displayLintResults dflags pass warns errs binds
 showLintWarnings :: CoreToDo -> Bool
 -- Disable Lint warnings on the first simplifier pass, because
 -- there may be some INLINE knots still tied, which is tiresomely noisy
-showLintWarnings (CoreDoSimplify (SimplGently {}) _ _) = False
-showLintWarnings _                                     = True
+showLintWarnings (CoreDoSimplify _ (SimplMode { sm_phase = InitialPhase })) = False
+showLintWarnings _ = True
 \end{code}
 
 
@@ -204,10 +203,9 @@ data CoreToDo           -- These are diff core-to-core passes,
                         -- as many times as you like.
 
   = CoreDoSimplify      -- The core-to-core simplifier.
+        Int                    -- Max iterations
         SimplifierMode
-	Int		       -- Max iterations
-        [SimplifierSwitch]     -- Each run of the simplifier can take a different
-                               -- set of simplifier-specific flags.
+
   | CoreDoFloatInwards
   | CoreDoFloatOutwards FloatOutSwitches
   | CoreLiberateCase
@@ -254,8 +252,8 @@ coreDumpFlag CoreDoGlomBinds         = Nothing
 coreDumpFlag (CoreDoPasses {})       = Nothing
 
 instance Outputable CoreToDo where
-  ppr (CoreDoSimplify md n _)  = ptext (sLit "Simplifier") 
-                                 <+> ppr md
+  ppr (CoreDoSimplify n md)  = ptext (sLit "Simplifier")
+                               <+> ppr md
                                  <+> ptext (sLit "max-iterations=") <> int n
   ppr CoreDoFloatInwards       = ptext (sLit "Float inwards")
   ppr (CoreDoFloatOutwards f)  = ptext (sLit "Float out") <> parens (ppr f)
@@ -279,50 +277,56 @@ instance Outputable CoreToDo where
 
 \begin{code}
 data SimplifierMode             -- See comments in SimplMonad
-  = SimplGently
-	{ sm_rules :: Bool	-- Whether RULES are enabled 
-        , sm_inline :: Bool }	-- Whether inlining is enabled
-
-  | SimplPhase 
-        { sm_num :: Int 	  -- Phase number; counts downward so 0 is last phase
-        , sm_names :: [String] }  -- Name(s) of the phase
+  = SimplMode
+        { sm_names      :: [String] -- Name(s) of the phase
+        , sm_phase      :: CompilerPhase
+        , 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
+        }
 
 instance Outputable SimplifierMode where
-    ppr (SimplPhase { sm_num = n, sm_names = ss })
-       = ptext (sLit "Phase") <+> int n <+> brackets (text (concat $ intersperse "," ss))
-    ppr (SimplGently { sm_rules = r, sm_inline = i }) 
-       = ptext (sLit "gentle") <> 
-           brackets (pp_flag r (sLit "rules") <> comma <>
-                     pp_flag i (sLit "inline"))
+    ppr (SimplMode { sm_phase = p, sm_names = ss
+                   , sm_rules = r, sm_inline = i
+                   , sm_eta_expand = eta, sm_case_case = cc })
+       = ptext (sLit "SimplMode") <+> braces (
+         sep [ ptext (sLit "Phase =") <+> ppr p <+>
+               brackets (text (concat $ intersperse "," ss)) <> comma
+             , pp_flag i   (sLit "inline") <> comma
+             , pp_flag r   (sLit "rules") <> comma
+             , pp_flag eta (sLit "eta-expand") <> comma
+             , pp_flag cc  (sLit "case-of-case") ])
 	 where
            pp_flag f s = ppUnless f (ptext (sLit "no")) <+> ptext s
-
-data SimplifierSwitch
-  = NoCaseOfCase
 \end{code}
 
 
 \begin{code}
 data FloatOutSwitches = FloatOutSwitches {
-        floatOutLambdas :: Bool,     -- ^ True <=> float lambdas to top level
-        floatOutConstants :: Bool,   -- ^ True <=> float constants to top level,
-                                     --            even if they do not escape a lambda
-        floatOutPartialApplications :: Bool -- ^ True <=> float out partial applications
+  floatOutLambdas   :: Maybe Int,  -- ^ Just n <=> float lambdas to top level, if
+                                   -- doing so will abstract over n or fewer 
+                                   -- value variables
+				   -- Nothing <=> float all lambdas to top level,
+                                   --             regardless of how many free variables
+                                   -- Just 0 is the vanilla case: float a lambda
+                                   --    iff it has no free vars
+
+  floatOutConstants :: Bool,       -- ^ True <=> float constants to top level,
+                                   --            even if they do not escape a lambda
+  floatOutPartialApplications :: Bool -- ^ True <=> float out partial applications
                                             --            based on arity information.
-    }
+  }
 instance Outputable FloatOutSwitches where
     ppr = pprFloatOutSwitches
 
 pprFloatOutSwitches :: FloatOutSwitches -> SDoc
-pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma
-                     <+> pp_not (floatOutConstants sw) <+> text "constants"
-  where
-    pp_not True  = empty
-    pp_not False = text "not"
-
--- | Switches that specify the minimum amount of floating out
--- gentleFloatOutSwitches :: FloatOutSwitches
--- gentleFloatOutSwitches = FloatOutSwitches False False
+pprFloatOutSwitches sw 
+  = ptext (sLit "FOS") <+> (braces $
+     sep $ punctuate comma $ 
+     [ ptext (sLit "Lam =")    <+> ppr (floatOutLambdas sw)
+     , ptext (sLit "Consts =") <+> ppr (floatOutConstants sw)
+     , ptext (sLit "PAPs =")   <+> ppr (floatOutPartialApplications sw) ])
 \end{code}
 
 
@@ -337,30 +341,41 @@ getCoreToDo :: DynFlags -> [CoreToDo]
 getCoreToDo dflags
   = core_todo
   where
-    opt_level     = optLevel dflags
-    phases        = simplPhases dflags
+    opt_level     = optLevel           dflags
+    phases        = simplPhases        dflags
     max_iter      = maxSimplIterations dflags
-    strictness    = dopt Opt_Strictness dflags
-    full_laziness = dopt Opt_FullLaziness dflags
-    do_specialise = dopt Opt_Specialise dflags
-    do_float_in   = dopt Opt_FloatIn dflags
-    cse           = dopt Opt_CSE dflags
-    spec_constr   = dopt Opt_SpecConstr dflags
-    liberate_case = dopt Opt_LiberateCase dflags
-    rule_check    = ruleCheck dflags
+    rule_check    = ruleCheck          dflags
+    strictness    = dopt Opt_Strictness   		  dflags
+    full_laziness = dopt Opt_FullLaziness 		  dflags
+    do_specialise = dopt Opt_Specialise   		  dflags
+    do_float_in   = dopt Opt_FloatIn      		  dflags          
+    cse           = dopt Opt_CSE                          dflags
+    spec_constr   = dopt Opt_SpecConstr                   dflags
+    liberate_case = dopt Opt_LiberateCase                 dflags
     static_args   = dopt Opt_StaticArgumentTransformation dflags
+    rules_on      = dopt Opt_EnableRewriteRules           dflags
+    eta_expand_on = dopt Opt_DoLambdaEtaExpansion         dflags
 
     maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
 
     maybe_strictness_before phase
       = runWhen (phase `elem` strictnessBefore dflags) CoreDoStrictness
 
+    base_mode = SimplMode { sm_phase      = panic "base_mode"
+                          , sm_names      = []
+                          , sm_rules      = rules_on
+                          , sm_eta_expand = eta_expand_on
+                          , sm_inline     = True
+                          , sm_case_case  = True }
+
     simpl_phase phase names iter
       = CoreDoPasses
           [ maybe_strictness_before phase
-          , CoreDoSimplify (SimplPhase phase names) 
-                           iter []
-          , maybe_rule_check phase
+          , CoreDoSimplify iter
+                (base_mode { sm_phase = Phase phase
+                           , sm_names = names })
+
+          , maybe_rule_check (Phase phase)
           ]
 
     vectorisation
@@ -380,21 +395,18 @@ getCoreToDo dflags
                 -- strictness in the function sumcode' if augment is not inlined
                 -- before strictness analysis runs
     simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter
-                                  | phase <- [phases, phases-1 .. 1] ]
+                                | phase <- [phases, phases-1 .. 1] ]
 
 
         -- initial simplify: mk specialiser happy: minimum effort please
-    simpl_gently = CoreDoSimplify 
-                       (SimplGently { sm_rules = True, sm_inline = False })
-			  -- See Note [Gentle mode] and
-			  -- Note [RULEs enabled in SimplGently] in SimplUtils
-                       max_iter
-                       [
-
-
-            NoCaseOfCase        -- Don't do case-of-case transformations.
-                                -- This makes full laziness work better
-        ]
+    simpl_gently = CoreDoSimplify max_iter
+                       (base_mode { sm_phase = InitialPhase
+                                  , sm_names = ["Gentle"]
+                                  , sm_rules = True     -- Note [RULEs enabled in SimplGently]
+                                  , sm_inline = False
+                                  , sm_case_case = False })
+                          -- Don't do case-of-case transformations.
+                          -- This makes full laziness work better
 
     core_todo =
      if opt_level == 0 then
@@ -421,7 +433,7 @@ getCoreToDo dflags
 
         runWhen full_laziness $
            CoreDoFloatOutwards FloatOutSwitches {
-                                 floatOutLambdas   = False,
+                                 floatOutLambdas   = Just 0,
                                  floatOutConstants = True,
                                  floatOutPartialApplications = False },
       		-- Was: gentleFloatOutSwitches	
@@ -467,7 +479,7 @@ getCoreToDo dflags
 
         runWhen full_laziness $
            CoreDoFloatOutwards FloatOutSwitches {
-                                 floatOutLambdas   = False,
+                                 floatOutLambdas   = floatLamArgs dflags,
                                  floatOutConstants = True,
                                  floatOutPartialApplications = True },
                 -- nofib/spectral/hartel/wang doubles in speed if you
@@ -484,7 +496,7 @@ getCoreToDo dflags
 
         runWhen do_float_in CoreDoFloatInwards,
 
-        maybe_rule_check 0,
+        maybe_rule_check (Phase 0),
 
                 -- Case-liberation for -O2.  This should be after
                 -- strictness analysis and the simplification which follows it.
@@ -497,7 +509,7 @@ getCoreToDo dflags
 
         runWhen spec_constr CoreDoSpecConstr,
 
-        maybe_rule_check 0,
+        maybe_rule_check (Phase 0),
 
         -- Final clean-up simplification:
         simpl_phase 0 ["final"] max_iter
@@ -532,17 +544,35 @@ dumpSimplPhase dflags mode
                 _        -> phase_name s
 
     phase_num :: Int -> Bool
-    phase_num n = case mode of
-                    SimplPhase k _ -> n == k
-                    _              -> False
+    phase_num n = case sm_phase mode of
+                    Phase k -> n == k
+                    _       -> False
 
     phase_name :: String -> Bool
-    phase_name s = case mode of
-                     SimplGently {}               -> s == "gentle"
-                     SimplPhase { sm_names = ss } -> s `elem` ss
+    phase_name s = s `elem` sm_names mode
 \end{code}
 
 
+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.
+
+
 %************************************************************************
 %*									*
              Counting and logging
diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 865acdc98d..9f424cd09f 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The AQUA Project, Glasgow University, 1993-1998
+o% (c) The AQUA Project, Glasgow University, 1993-1998
 %
 \section[SimplMonad]{The simplifier Monad}
 
@@ -12,18 +12,14 @@ module SimplEnv (
 	-- The simplifier mode
 	setMode, getMode, updMode,
 
-	-- Switch checker
-	SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
-	isAmongSimpl, intSwitchSet, switchIsOn,
-
-	setEnclosingCC, getEnclosingCC,
+        setEnclosingCC, getEnclosingCC,
 
 	-- Environments
 	SimplEnv(..), StaticEnv, pprSimplEnv,	-- Temp not abstract
 	mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst, 
 	zapSubstEnv, setSubstEnv, 
 	getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
-	getSimplRules, inGentleMode,
+        getSimplRules,
 
 	SimplSR(..), mkContEx, substId, lookupRecBndr,
 
@@ -106,8 +102,7 @@ data SimplEnv
      -- wrt the original expression
 
 	seMode 	    :: SimplifierMode,
-	seChkr      :: SwitchChecker,
-	seCC        :: CostCentreStack,	-- The enclosing CCS (when profiling)
+        seCC        :: CostCentreStack, -- The enclosing CCS (when profiling)
 
 	-- The current substitution
 	seTvSubst   :: TvSubstEnv,	-- InTyVar |--> OutType
@@ -223,19 +218,15 @@ seIdSubst:
 
 
 \begin{code}
-mkSimplEnv :: SwitchChecker -> SimplifierMode -> SimplEnv
-mkSimplEnv switches mode
-  = SimplEnv { seChkr = switches, seCC = subsumedCCS, 
+mkSimplEnv :: SimplifierMode -> SimplEnv
+mkSimplEnv mode
+  = SimplEnv { seCC = subsumedCCS,
 	       seMode = mode, seInScope = emptyInScopeSet, 
 	       seFloats = emptyFloats,
 	       seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
 	-- The top level "enclosing CC" is "SUBSUMED".
 
 ---------------------
-getSwitchChecker :: SimplEnv -> SwitchChecker
-getSwitchChecker env = seChkr env
-
----------------------
 getMode :: SimplEnv -> SimplifierMode
 getMode env = seMode env
 
@@ -245,11 +236,6 @@ 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
-		        _other         -> False
-
 ---------------------
 getEnclosingCC :: SimplEnv -> CostCentreStack
 getEnclosingCC env = seCC env
diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs
index 10bc70d4e2..1781d56bfb 100644
--- a/compiler/simplCore/SimplMonad.lhs
+++ b/compiler/simplCore/SimplMonad.lhs
@@ -16,11 +16,7 @@ module SimplMonad (
 	-- Counting
 	SimplCount, tick, freeTick,
 	getSimplCount, zeroSimplCount, pprSimplCount, 
-	plusSimplCount, isZeroSimplCount,
-
-	-- Switch checker
-	SwitchChecker, SwitchResult(..), getSimplIntSwitch,
-	isAmongSimpl, intSwitchSet, switchIsOn, allOffSwitchChecker
+        plusSimplCount, isZeroSimplCount
     ) where
 
 import Id		( Id, mkSysLocal )
@@ -29,14 +25,8 @@ import FamInstEnv	( FamInstEnv )
 import Rules		( RuleBase )
 import UniqSupply
 import DynFlags		( DynFlags )
-import Maybes		( expectJust )
 import CoreMonad
 import FastString
-import Outputable
-import FastTypes
-
-import Data.Array
-import Data.Array.Base (unsafeAt)
 \end{code}
 
 %************************************************************************
@@ -162,99 +152,3 @@ freeTick t
    = SM (\_st_env us sc -> let sc' = doFreeSimplTick t sc
                            in sc' `seq` ((), us, sc'))
 \end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{Command-line switches}
-%*									*
-%************************************************************************
-
-\begin{code}
-type SwitchChecker = SimplifierSwitch -> SwitchResult
-
-data SwitchResult
-  = SwBool	Bool		-- on/off
-  | SwString	FastString	-- nothing or a String
-  | SwInt	Int		-- nothing or an Int
-
-allOffSwitchChecker :: SwitchChecker
-allOffSwitchChecker _ = SwBool False
-
-isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
-isAmongSimpl on_switches		-- Switches mentioned later occur *earlier*
-					-- in the list; defaults right at the end.
-  = let
-	tidied_on_switches = foldl rm_dups [] on_switches
-		-- The fold*l* ensures that we keep the latest switches;
-		-- ie the ones that occur earliest in the list.
-
-	sw_tbl :: Array Int SwitchResult
-	sw_tbl = (array	(0, lAST_SIMPL_SWITCH_TAG) -- bounds...
-			all_undefined)
-		 // defined_elems
-
-	all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
-
-	defined_elems = map mk_assoc_elem tidied_on_switches
-    in
-    -- (avoid some unboxing, bounds checking, and other horrible things:)
-    \ switch -> unsafeAt sw_tbl $ iBox (tagOf_SimplSwitch switch)
-  where
-    mk_assoc_elem k
-	= (iBox (tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
-
-    -- cannot have duplicates if we are going to use the array thing
-    rm_dups switches_so_far switch
-      = if switch `is_elem` switches_so_far
-    	then switches_so_far
-	else switch : switches_so_far
-      where
-	_  `is_elem` []     = False
-	sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s)
-			    || sw `is_elem` ss
-\end{code}
-
-\begin{code}
-getSimplIntSwitch :: SwitchChecker -> (Int-> SimplifierSwitch) -> Int
-getSimplIntSwitch chkr switch
-  = expectJust "getSimplIntSwitch" (intSwitchSet chkr switch)
-
-switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
-
-switchIsOn lookup_fn switch
-  = case (lookup_fn switch) of
-      SwBool False -> False
-      _	    	   -> True
-
-intSwitchSet :: (switch -> SwitchResult)
-	     -> (Int -> switch)
-	     -> Maybe Int
-
-intSwitchSet lookup_fn switch
-  = case (lookup_fn (switch (panic "intSwitchSet"))) of
-      SwInt int -> Just int
-      _	    	-> Nothing
-\end{code}
-
-
-These things behave just like enumeration types.
-
-\begin{code}
-instance Eq SimplifierSwitch where
-    a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b
-
-instance Ord SimplifierSwitch where
-    a <  b  = tagOf_SimplSwitch a <# tagOf_SimplSwitch b
-    a <= b  = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b
-
-
-tagOf_SimplSwitch :: SimplifierSwitch -> FastInt
-tagOf_SimplSwitch NoCaseOfCase			= _ILIT(1)
-
--- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
-
-lAST_SIMPL_SWITCH_TAG :: Int
-lAST_SIMPL_SWITCH_TAG = 2
-\end{code}
-
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}
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 8d314aed93..df80c4a66e 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -24,7 +24,7 @@ import Coercion
 import OptCoercion	( optCoercion )
 import FamInstEnv       ( topNormaliseType )
 import DataCon          ( DataCon, dataConWorkId, dataConRepStrictness )
-import CoreMonad	( SimplifierSwitch(..), Tick(..) )
+import CoreMonad        ( Tick(..), SimplifierMode(..) )
 import CoreSyn
 import Demand           ( isStrictDmd )
 import PprCore          ( pprParendExpr, pprCoreExpr )
@@ -237,7 +237,7 @@ simplTopBinds env0 binds0
     trace_bind False _    = \x -> x
 
     simpl_bind env (Rec pairs)  = simplRecBind      env  TopLevel pairs
-    simpl_bind env (NonRec b r) = simplRecOrTopPair env' TopLevel b b' r
+    simpl_bind env (NonRec b r) = simplRecOrTopPair env' TopLevel NonRecursive b b' r
         where
           (env', b') = addBndrRules env b (lookupRecBndr env b)
 \end{code}
@@ -272,7 +272,7 @@ simplRecBind env0 top_lvl pairs0
     go env [] = return env
 
     go env ((old_bndr, new_bndr, rhs) : pairs)
-        = do { env' <- simplRecOrTopPair env top_lvl old_bndr new_bndr rhs
+        = do { env' <- simplRecOrTopPair env top_lvl Recursive old_bndr new_bndr rhs
              ; go env' pairs }
 \end{code}
 
@@ -284,18 +284,17 @@ It assumes the binder has already been simplified, but not its IdInfo.
 
 \begin{code}
 simplRecOrTopPair :: SimplEnv
-                  -> TopLevelFlag
+                  -> TopLevelFlag -> RecFlag
                   -> InId -> OutBndr -> InExpr  -- Binder and rhs
                   -> SimplM SimplEnv    -- Returns an env that includes the binding
 
-simplRecOrTopPair env top_lvl old_bndr new_bndr rhs
+simplRecOrTopPair env top_lvl is_rec old_bndr new_bndr rhs
   | preInlineUnconditionally env top_lvl old_bndr rhs   -- Check for unconditional inline
   = do  { tick (PreInlineUnconditionally old_bndr)
         ; return (extendIdSubst env old_bndr (mkContEx env rhs)) }
 
   | otherwise
-  = simplLazyBind env top_lvl Recursive old_bndr new_bndr rhs env
-        -- May not actually be recursive, but it doesn't matter
+  = simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env
 \end{code}
 
 
@@ -902,7 +901,7 @@ simplExprF' env (Type ty) cont
         ; rebuild env (Type ty') cont }
 
 simplExprF' env (Case scrut bndr _ alts) cont
-  | not (switchIsOn (getSwitchChecker env) NoCaseOfCase)
+  | sm_case_case (getMode env)
   =     -- Simplify the scrutinee with a Select continuation
     simplExprF env scrut (Select NoDup bndr alts env cont)
 
@@ -1355,7 +1354,7 @@ tryRules env rules fn args call_cont
        ; case activeRule dflags env of {
            Nothing     -> return Nothing  ; -- No rules apply
            Just act_fn -> 
-         case lookupRule act_fn (activeUnfInRule env) (getInScope env) fn args rules of {
+         case lookupRule act_fn (getUnfoldingInRuleMatch env) (getInScope env) fn args rules of {
            Nothing               -> return Nothing ;   -- No rule matches
            Just (rule, rule_rhs) ->
 
@@ -1508,7 +1507,7 @@ rebuildCase env scrut case_bndr alts cont
 	    Nothing           -> missingAlt env case_bndr alts cont
 	    Just (_, bs, rhs) -> simple_rhs bs rhs }
 
-  | Just (con, ty_args, other_args) <- exprIsConApp_maybe (activeUnfInRule env) scrut
+  | Just (con, ty_args, other_args) <- exprIsConApp_maybe (getUnfoldingInRuleMatch env) scrut
         -- Works when the scrutinee is a variable with a known unfolding
         -- as well as when it's an explicit constructor application
   = do  { tick (KnownBranch case_bndr)