Rollback INLINE patches

rolling back:

Fri Dec  5 16:54:00 GMT 2008  simonpj@microsoft.com
  * Completely new treatment of INLINE pragmas (big patch)
  
  This is a major patch, which changes the way INLINE pragmas work.
  Although lots of files are touched, the net is only +21 lines of
  code -- and I bet that most of those are comments!
  
  HEADS UP: interface file format has changed, so you'll need to
  recompile everything.
  
  There is not much effect on overall performance for nofib, 
  probably because those programs don't make heavy use of INLINE pragmas.
  
          Program           Size    Allocs   Runtime   Elapsed
              Min         -11.3%     -6.9%     -9.2%     -8.2%
              Max          -0.1%     +4.6%     +7.5%     +8.9%
   Geometric Mean          -2.2%     -0.2%     -1.0%     -0.8%
  
  (The +4.6% for on allocs is cichelli; see other patch relating to
  -fpass-case-bndr-to-join-points.)
  
  The old INLINE system
  ~~~~~~~~~~~~~~~~~~~~~
  The old system worked like this. A function with an INLINE pragam
  got a right-hand side which looked like
       f = __inline_me__ (\xy. e)
  The __inline_me__ part was an InlineNote, and was treated specially
  in various ways.  Notably, the simplifier didn't inline inside an
  __inline_me__ note.  
  
  As a result, the code for f itself was pretty crappy. That matters
  if you say (map f xs), because then you execute the code for f,
  rather than inlining a copy at the call site.
  
  The new story: InlineRules
  ~~~~~~~~~~~~~~~~~~~~~~~~~~
  The new system removes the InlineMe Note altogether.  Instead there
  is a new constructor InlineRule in CoreSyn.Unfolding.  This is a 
  bit like a RULE, in that it remembers the template to be inlined inside
  the InlineRule.  No simplification or inlining is done on an InlineRule,
  just like RULEs.  
  
  An Id can have an InlineRule *or* a CoreUnfolding (since these are two
  constructors from Unfolding). The simplifier treats them differently:
  
    - An InlineRule is has the substitution applied (like RULES) but 
      is otherwise left undisturbed.
  
    - A CoreUnfolding is updated with the new RHS of the definition,
      on each iteration of the simplifier.
  
  An InlineRule fires regardless of size, but *only* when the function
  is applied to enough arguments.  The "arity" of the rule is specified
  (by the programmer) as the number of args on the LHS of the "=".  So
  it makes a difference whether you say
    	{-# INLINE f #-}
  	f x = \y -> e     or     f x y = e
  This is one of the big new features that InlineRule gives us, and it
  is one that Roman really wanted.
  
  In contrast, a CoreUnfolding can fire when it is applied to fewer
  args than than the function has lambdas, provided the result is small
  enough.
  
  
  Consequential stuff
  ~~~~~~~~~~~~~~~~~~~
  * A 'wrapper' no longer has a WrapperInfo in the IdInfo.  Instead,
    the InlineRule has a field identifying wrappers.
  
  * Of course, IfaceSyn and interface serialisation changes appropriately.
  
  * Making implication constraints inline nicely was a bit fiddly. In
    the end I added a var_inline field to HsBInd.VarBind, which is why
    this patch affects the type checker slightly
  
  * I made some changes to the way in which eta expansion happens in
    CorePrep, mainly to ensure that *arguments* that become let-bound
    are also eta-expanded.  I'm still not too happy with the clarity
    and robustness fo the result.
  
  * We now complain if the programmer gives an INLINE pragma for
    a recursive function (prevsiously we just ignored it).  Reason for
    change: we don't want an InlineRule on a LoopBreaker, because then
    we'd have to check for loop-breaker-hood at occurrence sites (which
    isn't currenlty done).  Some tests need changing as a result.
  
  This patch has been in my tree for quite a while, so there are
  probably some other minor changes.
  

    M ./compiler/basicTypes/Id.lhs -11
    M ./compiler/basicTypes/IdInfo.lhs -82
    M ./compiler/basicTypes/MkId.lhs -2 +2
    M ./compiler/coreSyn/CoreFVs.lhs -2 +25
    M ./compiler/coreSyn/CoreLint.lhs -5 +1
    M ./compiler/coreSyn/CorePrep.lhs -59 +53
    M ./compiler/coreSyn/CoreSubst.lhs -22 +31
    M ./compiler/coreSyn/CoreSyn.lhs -66 +92
    M ./compiler/coreSyn/CoreUnfold.lhs -112 +112
    M ./compiler/coreSyn/CoreUtils.lhs -185 +184
    M ./compiler/coreSyn/MkExternalCore.lhs -1
    M ./compiler/coreSyn/PprCore.lhs -4 +40
    M ./compiler/deSugar/DsBinds.lhs -70 +118
    M ./compiler/deSugar/DsForeign.lhs -2 +4
    M ./compiler/deSugar/DsMeta.hs -4 +3
    M ./compiler/hsSyn/HsBinds.lhs -3 +3
    M ./compiler/hsSyn/HsUtils.lhs -2 +7
    M ./compiler/iface/BinIface.hs -11 +25
    M ./compiler/iface/IfaceSyn.lhs -13 +21
    M ./compiler/iface/MkIface.lhs -24 +19
    M ./compiler/iface/TcIface.lhs -29 +23
    M ./compiler/main/TidyPgm.lhs -55 +49
    M ./compiler/parser/ParserCore.y -5 +6
    M ./compiler/simplCore/CSE.lhs -2 +1
    M ./compiler/simplCore/FloatIn.lhs -6 +1
    M ./compiler/simplCore/FloatOut.lhs -23
    M ./compiler/simplCore/OccurAnal.lhs -36 +5
    M ./compiler/simplCore/SetLevels.lhs -59 +54
    M ./compiler/simplCore/SimplCore.lhs -48 +52
    M ./compiler/simplCore/SimplEnv.lhs -26 +22
    M ./compiler/simplCore/SimplUtils.lhs -28 +4
    M ./compiler/simplCore/Simplify.lhs -91 +109
    M ./compiler/specialise/Specialise.lhs -15 +18
    M ./compiler/stranal/WorkWrap.lhs -14 +11
    M ./compiler/stranal/WwLib.lhs -2 +2
    M ./compiler/typecheck/Inst.lhs -1 +3
    M ./compiler/typecheck/TcBinds.lhs -17 +27
    M ./compiler/typecheck/TcClassDcl.lhs -1 +2
    M ./compiler/typecheck/TcExpr.lhs -4 +6
    M ./compiler/typecheck/TcForeign.lhs -1 +1
    M ./compiler/typecheck/TcGenDeriv.lhs -14 +13
    M ./compiler/typecheck/TcHsSyn.lhs -3 +2
    M ./compiler/typecheck/TcInstDcls.lhs -5 +4
    M ./compiler/typecheck/TcRnDriver.lhs -2 +11
    M ./compiler/typecheck/TcSimplify.lhs -10 +17
    M ./compiler/vectorise/VectType.hs +7

Mon Dec  8 12:43:10 GMT 2008  simonpj@microsoft.com
  * White space only

    M ./compiler/simplCore/Simplify.lhs -2

Mon Dec  8 12:48:40 GMT 2008  simonpj@microsoft.com
  * Move simpleOptExpr from CoreUnfold to CoreSubst

    M ./compiler/coreSyn/CoreSubst.lhs -1 +87
    M ./compiler/coreSyn/CoreUnfold.lhs -72 +1

Mon Dec  8 17:30:18 GMT 2008  simonpj@microsoft.com
  * Use CoreSubst.simpleOptExpr in place of the ad-hoc simpleSubst (reduces code too)

    M ./compiler/deSugar/DsBinds.lhs -50 +16

Tue Dec  9 17:03:02 GMT 2008  simonpj@microsoft.com
  * Fix Trac #2861: bogus eta expansion
  
  Urghlhl!  I "tided up" the treatment of the "state hack" in CoreUtils, but
  missed an unexpected interaction with the way that a bottoming function
  simply swallows excess arguments.  There's a long
       Note [State hack and bottoming functions]
  to explain (which accounts for most of the new lines of code).
  

    M ./compiler/coreSyn/CoreUtils.lhs -16 +53

Mon Dec 15 10:02:21 GMT 2008  Simon Marlow <marlowsd@gmail.com>
  * Revert CorePrep part of "Completely new treatment of INLINE pragmas..."
  
  The original patch said:
  
  * I made some changes to the way in which eta expansion happens in
    CorePrep, mainly to ensure that *arguments* that become let-bound
    are also eta-expanded.  I'm still not too happy with the clarity
    and robustness fo the result.
    
  Unfortunately this change apparently broke some invariants that were
  relied on elsewhere, and in particular lead to panics when compiling
  with profiling on.
  
  Will re-investigate in the new year.

    M ./compiler/coreSyn/CorePrep.lhs -53 +58
    M ./configure.ac -1 +1

Mon Dec 15 12:28:51 GMT 2008  Simon Marlow <marlowsd@gmail.com>
  * revert accidental change to configure.ac

    M ./configure.ac -1 +1

9 files changed, 473 insertions, 611 deletions

diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs
index a15362a585..d2d1383e2b 100644
--- a/compiler/coreSyn/CoreFVs.lhs
+++ b/compiler/coreSyn/CoreFVs.lhs
@@ -16,7 +16,6 @@ Taken quite directly from the Peyton Jones/Lester paper.
 module CoreFVs (
         -- * Free variables of expressions and binding groups
 	exprFreeVars,	-- CoreExpr   -> VarSet	-- Find all locally-defined free Ids or tyvars
-	exprFreeIds,	-- CoreExpr   -> IdSet	-- Find all locally-defined free Ids
 	exprsFreeVars,	-- [CoreExpr] -> VarSet
 	bindFreeVars, 	-- CoreBind   -> VarSet
 
@@ -26,8 +25,7 @@ module CoreFVs (
 	exprFreeNames, exprsFreeNames,
 
         -- * Free variables of Rules, Vars and Ids
-	idRuleVars, idRuleRhsVars, idFreeVars, idInlineFreeVars,
-	varTypeTyVars, 
+	idRuleVars, idFreeVars, varTypeTyVars, 
 	ruleRhsFreeVars, rulesFreeVars,
 	ruleLhsFreeNames, ruleLhsFreeIds, 
 
@@ -73,10 +71,6 @@ but not those that are free in the type of variable occurrence.
 exprFreeVars :: CoreExpr -> VarSet
 exprFreeVars = exprSomeFreeVars isLocalVar
 
--- | Find all locally-defined free Ids in an expression
-exprFreeIds :: CoreExpr -> IdSet	-- Find all locally-defined free Ids
-exprFreeIds = exprSomeFreeVars isLocalId
-
 -- | Find all locally-defined free Ids or type variables in several expressions
 exprsFreeVars :: [CoreExpr] -> VarSet
 exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
@@ -384,24 +378,7 @@ bndrRuleVars v | isTyVar v = emptyVarSet
 	       | otherwise = idRuleVars v
 
 idRuleVars ::Id -> VarSet
-idRuleVars id = ASSERT( isId id) 
-		specInfoFreeVars (idSpecialisation id) `unionVarSet` 
-		idInlineFreeVars id	-- And the variables in an INLINE rule
-
-idRuleRhsVars :: Id -> VarSet
--- Just the variables free on the *rhs* of a rule
--- See Note [Choosing loop breakers] in Simplify.lhs
-idRuleRhsVars id = foldr (unionVarSet . ruleRhsFreeVars) 
-			 (idInlineFreeVars id)
-			 (idCoreRules id)
-
-idInlineFreeVars :: Id -> VarSet
--- Produce free vars for an InlineRule, BUT NOT for an ordinary unfolding
--- An InlineRule behaves *very like* a RULE, and that is what we are after here
-idInlineFreeVars id
-  = case idUnfolding id of
-	InlineRule { uf_tmpl = tmpl } -> exprFreeVars tmpl
-	_				   -> emptyVarSet
+idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id)
 \end{code}
 
 
diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index 8d0304a90c..2d45eb35d2 100644
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -28,6 +28,7 @@ import VarEnv
 import VarSet
 import Name
 import Id
+import IdInfo
 import PprCore
 import ErrUtils
 import SrcLoc
@@ -227,7 +228,10 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
    where
     binder_ty                  = idType binder
     maybeDmdTy                 = idNewStrictness_maybe binder
-    bndr_vars                  = varSetElems (idFreeVars binder)
+    bndr_vars                  = varSetElems (idFreeVars binder `unionVarSet` wkr_vars)
+    wkr_vars | workerExists wkr_info = unitVarSet (workerId wkr_info)
+	     | otherwise	     = emptyVarSet
+    wkr_info = idWorkerInfo binder
     lintBinder var | isId var  = lintIdBndr var $ \_ -> (return ())
 	           | otherwise = return ()
 \end{code}
diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index 4211dca907..5fa5002bfe 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -519,6 +519,7 @@ corePrepExprFloat env expr@(App _ _) = do
 	  ty = exprType fun
 
     ignore_note	(CoreNote _) = True 
+    ignore_note	InlineMe     = True
     ignore_note	_other       = False
 	-- We don't ignore SCCs, since they require some code generation
 
diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs
index 314ba63ab5..e08cdb8faa 100644
--- a/compiler/coreSyn/CoreSubst.lhs
+++ b/compiler/coreSyn/CoreSubst.lhs
@@ -12,7 +12,7 @@ module CoreSubst (
 
         -- ** Substituting into expressions and related types
 	deShadowBinds,
-	substTy, substExpr, substSpec, substUnfolding,
+	substTy, substExpr, substSpec, substWorker,
 	lookupIdSubst, lookupTvSubst, 
 
         -- ** Operations on substitutions
@@ -24,10 +24,7 @@ module CoreSubst (
 
 	-- ** Substituting and cloning binders
 	substBndr, substBndrs, substRecBndrs,
-	cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs,
-
-	-- ** Simple expression optimiser
-	simpleOptExpr
+	cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs
     ) where
 
 #include "HsVersions.h"
@@ -35,7 +32,6 @@ module CoreSubst (
 import CoreSyn
 import CoreFVs
 import CoreUtils
-import OccurAnal( occurAnalyseExpr )
 
 import qualified Type
 import Type     ( Type, TvSubst(..), TvSubstEnv )
@@ -215,7 +211,7 @@ lookupIdSubst (Subst in_scope ids _) v
   | Just e  <- lookupVarEnv ids       v = e
   | Just v' <- lookupInScope in_scope v = Var v'
 	-- Vital! See Note [Extending the Subst]
-  | otherwise = WARN( True, ptext (sLit "CoreSubst.lookupIdSubst") <+> ppr v $$ ppr in_scope ) 
+  | otherwise = WARN( True, ptext (sLit "CoreSubst.lookupIdSubst") <+> ppr v ) 
 		Var v
 
 -- | Find the substitution for a 'TyVar' in the 'Subst'
@@ -478,40 +474,31 @@ substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo
 substIdInfo subst new_id info
   | nothing_to_do = Nothing
   | otherwise     = Just (info `setSpecInfo`   	  substSpec subst new_id old_rules
-			       `setUnfoldingInfo` substUnfolding subst old_unf)
+			       `setWorkerInfo` 	  substWorker subst old_wrkr
+			       `setUnfoldingInfo` noUnfolding)
   where
     old_rules 	  = specInfo info
-    old_unf	  = unfoldingInfo info
-    nothing_to_do = isEmptySpecInfo old_rules && isClosedUnfolding old_unf
+    old_wrkr  	  = workerInfo info
+    nothing_to_do = isEmptySpecInfo old_rules &&
+		    not (workerExists old_wrkr) &&
+		    not (hasUnfolding (unfoldingInfo info))
     
 
 ------------------
--- | Substitutes for the 'Id's within an unfolding
-substUnfolding :: Subst -> Unfolding -> Unfolding
-	-- Seq'ing on the returned Unfolding is enough to cause
-	-- all the substitutions to happen completely
-substUnfolding subst unf@(InlineRule { uf_tmpl = tmpl, uf_worker = mb_wkr })
-	-- Retain an InlineRule!
-  = seqExpr new_tmpl `seq` 
-    new_mb_wkr `seq`
-    unf { uf_tmpl = new_tmpl, uf_worker = new_mb_wkr }
-  where
-    new_tmpl   = substExpr subst tmpl
-    new_mb_wkr = case mb_wkr of
-		  Nothing -> Nothing
-		  Just w  -> subst_wkr w
-
-    subst_wkr w = case lookupIdSubst subst w of
-		    Var w1 -> Just w1
-		    other  -> WARN( not (exprIsTrivial other), text "CoreSubst.substWorker:" <+> ppr w )
-			      Nothing	-- Worker has got substituted away altogether
-					-- (This can happen if it's trivial, 
-					--  via postInlineUnconditionally, hence warning)
-
-substUnfolding _ (CoreUnfolding {}) = NoUnfolding	-- Discard
-	-- Always zap a CoreUnfolding, to save substitution work
-
-substUnfolding _ unf = unf	-- Otherwise no substitution to do
+-- | Substitutes for the 'Id's within the 'WorkerInfo'
+substWorker :: Subst -> WorkerInfo -> WorkerInfo
+	-- Seq'ing on the returned WorkerInfo is enough to cause all the 
+	-- substitutions to happen completely
+
+substWorker _ NoWorker
+  = NoWorker
+substWorker subst (HasWorker w a)
+  = case lookupIdSubst subst w of
+	Var w1 -> HasWorker w1 a
+	other  -> WARN( not (exprIsTrivial other), text "CoreSubst.substWorker:" <+> ppr w )
+		  NoWorker	-- Worker has got substituted away altogether
+				-- (This can happen if it's trivial, 
+				--  via postInlineUnconditionally, hence warning)
 
 ------------------
 -- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id'
@@ -525,7 +512,7 @@ substSpec subst new_fn (SpecInfo rules rhs_fvs)
     do_subst rule@(BuiltinRule {}) = rule
     do_subst rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })
 	= rule { ru_bndrs = bndrs', 
-		 ru_fn    = new_name, 	-- Important: the function may have changed its name!
+		 ru_fn = new_name, 	-- Important: the function may have changed its name!
 		 ru_args  = map (substExpr subst') args,
 		 ru_rhs   = substExpr subst' rhs }
 	where
@@ -540,85 +527,3 @@ substVarSet subst fvs
 	| isId fv   = exprFreeVars (lookupIdSubst subst fv)
 	| otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
 \end{code}
-
-%************************************************************************
-%*									*
-	The Very Simple Optimiser
-%*									*
-%************************************************************************
-
-\begin{code}
-simpleOptExpr :: CoreExpr -> CoreExpr
--- Return an occur-analysed and slightly optimised expression
--- The optimisation is very straightforward: just
--- inline non-recursive bindings that are used only once, 
--- or where the RHS is trivial
-
-simpleOptExpr expr
-  = go init_subst (occurAnalyseExpr expr)
-  where
-    init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))
-	-- It's potentially to make a proper in-scope set
-	-- Consider  let x = ..y.. in \y. ...x...
-	-- Then we should remember to clone y before substituting
-	-- for x.  It's very unlikely to occur, because we probably
-	-- won't *be* substituting for x if it occurs inside a
-	-- lambda.  
-	--
-	-- It's a bit painful to call exprFreeVars, because it makes
-	-- three passes instead of two (occ-anal, and go)
-
-    go subst (Var v)          = lookupIdSubst subst v
-    go subst (App e1 e2)      = App (go subst e1) (go subst e2)
-    go subst (Type ty)        = Type (substTy subst ty)
-    go _     (Lit lit)        = Lit lit
-    go subst (Note note e)    = Note note (go subst e)
-    go subst (Cast e co)      = Cast (go subst e) (substTy subst co)
-    go subst (Let bind body)  = go_bind subst bind body
-    go subst (Lam bndr body)  = Lam bndr' (go subst' body)
-		              where
-			        (subst', bndr') = substBndr subst bndr
-
-    go subst (Case e b ty as) = Case (go subst e) b' 
-				     (substTy subst ty)
-				     (map (go_alt subst') as)
-			      where
-			  	 (subst', b') = substBndr subst b
-
-
-    ----------------------
-    go_alt subst (con, bndrs, rhs) = (con, bndrs', go subst' rhs)
-				 where
-				   (subst', bndrs') = substBndrs subst bndrs
-
-    ----------------------
-    go_bind subst (Rec prs) body = Let (Rec (bndrs' `zip` rhss'))
-				       (go subst' body)
-			    where
-			      (bndrs, rhss)    = unzip prs
-			      (subst', bndrs') = substRecBndrs subst bndrs
-			      rhss'	       = map (go subst') rhss
-
-    go_bind subst (NonRec b r) body = go_nonrec subst b (go subst r) body
-
-    ----------------------
-    go_nonrec subst b (Type ty') body
-      | isTyVar b = go (extendTvSubst subst b ty') body
-	-- let a::* = TYPE ty in <body>
-    go_nonrec subst b r' body
-      | isId b	-- let x = e in <body>
-      , exprIsTrivial r' || safe_to_inline (idOccInfo b)
-      = go (extendIdSubst subst b r') body
-    go_nonrec subst b r' body
-      = Let (NonRec b' r') (go subst' body)
-      where
-	(subst', b') = substBndr subst b
-
-    ----------------------
-	-- Unconditionally safe to inline
-    safe_to_inline :: OccInfo -> Bool
-    safe_to_inline IAmDead                  = True
-    safe_to_inline (OneOcc in_lam one_br _) = not in_lam && one_br
-    safe_to_inline (IAmALoopBreaker {})     = False
-    safe_to_inline NoOccInfo                = False
-\end{code}
diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index 25d2cdb3ba..79e25a2be0 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -41,10 +41,9 @@ module CoreSyn (
 	noUnfolding, evaldUnfolding, mkOtherCon,
 	
 	-- ** Predicates and deconstruction on 'Unfolding'
-	unfoldingTemplate, setUnfoldingTemplate,
-	maybeUnfoldingTemplate, otherCons, 
+	unfoldingTemplate, maybeUnfoldingTemplate, otherCons, 
 	isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
-	isInlineRule, isClosedUnfolding, hasSomeUnfolding, canUnfold, neverUnfoldGuidance,
+	hasUnfolding, hasSomeUnfolding, neverUnfold,
 
 	-- * Strictness
 	seqExpr, seqExprs, seqUnfolding, 
@@ -272,7 +271,21 @@ See #type_let#
 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
 data Note
   = SCC CostCentre      -- ^ A cost centre annotation for profiling
+
+  | InlineMe		-- ^ Instructs the core simplifer to treat the enclosed expression
+			-- as very small, and inline it at its call sites
+
   | CoreNote String     -- ^ A generic core annotation, propagated but not used by GHC
+
+-- NOTE: we also treat expressions wrapped in InlineMe as
+-- 'cheap' and 'dupable' (in the sense of exprIsCheap, exprIsDupable)
+-- What this means is that we obediently inline even things that don't
+-- look like valuse.  This is sometimes important:
+--	{-# INLINE f #-}
+--	f = g . h
+-- Here, f looks like a redex, and we aren't going to inline (.) because it's
+-- inside an INLINE, so it'll stay looking like a redex.  Nevertheless, we 
+-- should inline f even inside lambdas.  In effect, we should trust the programmer.
 \end{code}
 
 
@@ -391,73 +404,45 @@ data Unfolding
 				--
 				-- Here, @f@ gets an @OtherCon []@ unfolding.
 
-  | CompulsoryUnfolding { 	-- There is /no original definition/, so you'd better unfold.
-	uf_tmpl :: CoreExpr	-- The unfolding is guaranteed to have no free variables
-    }				-- so no need to think about it during dependency analysis
-				
-  | InlineRule { 		-- The function has an INLINE pragma, with the specified (original) RHS
-				-- (The inline phase, if any, is in the InlinePragInfo for this Id.)
-				-- Inline when (a) applied to at least this number of args				
-				--	       (b) if there is something interesting about args or context
-	uf_tmpl  :: CoreExpr,		-- The *original* RHS; occurrence info is correct
-					-- (The actual RHS of the function may be different by now,
-					-- but what we inline is still the original RHS (kept in the InlineRule).)
-	uf_is_top :: Bool,
-
-	uf_arity    :: Arity, 		-- Don't inline unless applied to this number of *value* args
-	uf_is_value :: Bool, 		-- True <=> exprIsHNF is true; save to discard a `seq`			
-	uf_worker   :: Maybe Id		-- Just wrk_id <=> this unfolding is a the wrapper in a worker/wrapper
-					-- 		   split from the strictness analyser
-					--	Used to abbreviate the uf_tmpl in interface files
-					--	  In the Just case, interface files don't actually 
-					-- 	  need to contain the RHS; it can be derived from
-					-- 	  the strictness info
-					--      Also used in CoreUnfold to guide inlining decisions
-    }
+  | CompulsoryUnfolding CoreExpr	-- ^ There is /no original definition/,
+					-- so you'd better unfold.
 
-  | CoreUnfolding {		-- An unfolding for an Id with no pragma, or perhaps a NOINLINE pragma
-				-- (For NOINLINE, the phase, if any, is in the InlinePragInfo for this Id.)
-	uf_tmpl     :: CoreExpr,	-- Template; binder-info is correct
-	uf_is_top   :: Bool,		-- True <=> top level binding
-	uf_is_value :: Bool,		-- exprIsHNF template (cached); it is ok to discard a `seq` on
-					--	this variable
-	uf_is_cheap :: Bool,		-- True <=> doesn't waste (much) work to expand inside an inlining
-					-- 	Basically it's exprIsCheap
-	uf_guidance :: UnfoldingGuidance	-- Tells about the *size* of the template.
-    }
+  | CoreUnfolding
+		CoreExpr
+		Bool
+		Bool
+		Bool
+		UnfoldingGuidance
   -- ^ An unfolding with redundant cached information. Parameters:
   --
-  --  uf_tmpl: Template used to perform unfolding; binder-info is correct
+  --  1) Template used to perform unfolding; binder-info is correct
   --
-  --  uf_is_top: Is this a top level binding?
+  --  2) Is this a top level binding?
   --
-  --  uf_is_valiue: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
+  --  3) 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
   --     this variable
   --
-  --  uf_is_cheap:  Does this waste only a little work if we expand it inside an inlining?
+  --  4) Does this waste only a little work if we expand it inside an inlining?
   --     Basically this is a cached version of 'exprIsCheap'
   --
-  --  uf_guidance:  Tells us about the /size/ of the unfolding template
+  --  5) Tells us about the /size/ of the unfolding template
 
-------------------------------------------------
--- | 'UnfoldingGuidance' says when unfolding should take place
+-- | When unfolding should take place
 data UnfoldingGuidance
   = UnfoldNever
-  | UnfoldIfGoodArgs {
-      ug_arity :: Arity,  -- "n" value args
+  | UnfoldIfGoodArgs	Int	-- and "n" value args
 
-      ug_args ::  [Int],  -- Discount if the argument is evaluated.
-			  -- (i.e., a simplification will definitely
-			  -- be possible).  One elt of the list per *value* arg.
+			[Int]	-- Discount if the argument is evaluated.
+				-- (i.e., a simplification will definitely
+				-- be possible).  One elt of the list per *value* arg.
 
-      ug_size :: Int,	  -- The "size" of the unfolding; to be elaborated
-			  -- later. ToDo
+			Int	-- The "size" of the unfolding; to be elaborated
+				-- later. ToDo
 
-      ug_res :: Int	  -- Scrutinee discount: the discount to substract if the thing is in
-    }			  -- a context (case (thing args) of ...),
-			  -- (where there are the right number of arguments.)
+			Int	-- Scrutinee discount: the discount to substract if the thing is in
+				-- a context (case (thing args) of ...),
+				-- (where there are the right number of arguments.)
 
-------------------------------------------------
 noUnfolding :: Unfolding
 -- ^ There is no known 'Unfolding'
 evaldUnfolding :: Unfolding
@@ -470,8 +455,7 @@ mkOtherCon :: [AltCon] -> Unfolding
 mkOtherCon = OtherCon
 
 seqUnfolding :: Unfolding -> ()
-seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top, 
-		uf_is_value = b1, uf_is_cheap = b2, uf_guidance = g})
+seqUnfolding (CoreUnfolding e top b1 b2 g)
   = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` seqGuidance g
 seqUnfolding _ = ()
 
@@ -483,17 +467,15 @@ seqGuidance _                           = ()
 \begin{code}
 -- | Retrieves the template of an unfolding: panics if none is known
 unfoldingTemplate :: Unfolding -> CoreExpr
-unfoldingTemplate = uf_tmpl
-
-setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
-setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
+unfoldingTemplate (CoreUnfolding expr _ _ _ _) = expr
+unfoldingTemplate (CompulsoryUnfolding expr)   = expr
+unfoldingTemplate _ = panic "getUnfoldingTemplate"
 
 -- | Retrieves the template of an unfolding if possible
 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
-maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })       = Just expr
-maybeUnfoldingTemplate (CompulsoryUnfolding { uf_tmpl = expr }) = Just expr
-maybeUnfoldingTemplate (InlineRule { uf_tmpl = expr })          = Just expr
-maybeUnfoldingTemplate _                            		= Nothing
+maybeUnfoldingTemplate (CoreUnfolding expr _ _ _ _) = Just expr
+maybeUnfoldingTemplate (CompulsoryUnfolding expr)   = Just expr
+maybeUnfoldingTemplate _                            = Nothing
 
 -- | The constructors that the unfolding could never be: 
 -- returns @[]@ if no information is available
@@ -504,53 +486,45 @@ otherCons _               = []
 -- | Determines if it is certainly the case that the unfolding will
 -- yield a value (something in HNF): returns @False@ if unsure
 isValueUnfolding :: Unfolding -> Bool
-	-- Returns False for OtherCon
-isValueUnfolding (CoreUnfolding   { uf_is_value = is_evald }) = is_evald
-isValueUnfolding (InlineRule { uf_is_value = is_evald })      = is_evald
-isValueUnfolding _                                    	      = False
+isValueUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
+isValueUnfolding _                                = False
 
 -- | Determines if it possibly the case that the unfolding will
 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
 -- for 'OtherCon'
 isEvaldUnfolding :: Unfolding -> Bool
-	-- Returns True for OtherCon
-isEvaldUnfolding (OtherCon _)		                      = True
-isEvaldUnfolding (CoreUnfolding   { uf_is_value = is_evald }) = is_evald
-isEvaldUnfolding (InlineRule { uf_is_value = is_evald })      = is_evald
-isEvaldUnfolding _                                            = False
+isEvaldUnfolding (OtherCon _)		          = True
+isEvaldUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
+isEvaldUnfolding _                                = False
 
 -- | Is the thing we will unfold into certainly cheap?
 isCheapUnfolding :: Unfolding -> Bool
-isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
-isCheapUnfolding _                                          = False
-
-isInlineRule :: Unfolding -> Bool
-isInlineRule (InlineRule {}) = True
-isInlineRule _		     = False
+isCheapUnfolding (CoreUnfolding _ _ _ is_cheap _) = is_cheap
+isCheapUnfolding _                                = False
 
 -- | Must this unfolding happen for the code to be executable?
 isCompulsoryUnfolding :: Unfolding -> Bool
-isCompulsoryUnfolding (CompulsoryUnfolding {}) = True
+isCompulsoryUnfolding (CompulsoryUnfolding _) = True
 isCompulsoryUnfolding _                       = False
 
-isClosedUnfolding :: Unfolding -> Bool		-- No free variables
-isClosedUnfolding (CoreUnfolding {})   = False
-isClosedUnfolding (InlineRule {}) = False
-isClosedUnfolding _               = True
+-- | Do we have an available or compulsory unfolding?
+hasUnfolding :: Unfolding -> Bool
+hasUnfolding (CoreUnfolding _ _ _ _ _) = True
+hasUnfolding (CompulsoryUnfolding _)   = True
+hasUnfolding _                         = False
 
 -- | Only returns False if there is no unfolding information available at all
 hasSomeUnfolding :: Unfolding -> Bool
 hasSomeUnfolding NoUnfolding = False
 hasSomeUnfolding _           = True
 
-neverUnfoldGuidance :: UnfoldingGuidance -> Bool
-neverUnfoldGuidance UnfoldNever = True
-neverUnfoldGuidance _           = False
-
-canUnfold :: Unfolding -> Bool
-canUnfold (InlineRule {}) 		      = True
-canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
-canUnfold _  				      = False
+-- | Similar to @not . hasUnfolding@, but also returns @True@
+-- if it has an unfolding that says it should never occur
+neverUnfold :: Unfolding -> Bool
+neverUnfold NoUnfolding				= True
+neverUnfold (OtherCon _)			= True
+neverUnfold (CoreUnfolding _ _ _ _ UnfoldNever) = True
+neverUnfold _                                   = False
 \end{code}
 
 
diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index 4cbe04a271..d7ec4c718e 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -18,10 +18,12 @@ find, unsurprisingly, a Core expression.
 module CoreUnfold (
 	Unfolding, UnfoldingGuidance,	-- Abstract types
 
-	noUnfolding, mkImplicitUnfolding, 
-	mkTopUnfolding, mkUnfolding, 
-	mkInlineRule, mkWwInlineRule,
-	mkCompulsoryUnfolding, 
+	noUnfolding, mkTopUnfolding, mkImplicitUnfolding, mkUnfolding, 
+	mkCompulsoryUnfolding, seqUnfolding,
+	evaldUnfolding, mkOtherCon, otherCons,
+	unfoldingTemplate, maybeUnfoldingTemplate,
+	isEvaldUnfolding, isValueUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
+	hasUnfolding, hasSomeUnfolding, neverUnfold,
 
 	couldBeSmallEnoughToInline, 
 	certainlyWillInline, smallEnoughToInline,
@@ -35,16 +37,15 @@ import DynFlags
 import CoreSyn
 import PprCore		()	-- Instances
 import OccurAnal
-import CoreSubst
+import CoreSubst 	( Subst, emptySubst, substTy, extendIdSubst, extendTvSubst
+			, lookupIdSubst, substBndr, substBndrs, substRecBndrs )
 import CoreUtils
 import Id
 import DataCon
 import Literal
 import PrimOp
 import IdInfo
-import BasicTypes	( Arity )
 import Type hiding( substTy, extendTvSubst )
-import Maybes
 import PrelNames
 import Bag
 import FastTypes
@@ -67,37 +68,24 @@ mkTopUnfolding expr = mkUnfolding True {- Top level -} expr
 mkImplicitUnfolding :: CoreExpr -> Unfolding
 -- For implicit Ids, do a tiny bit of optimising first
 mkImplicitUnfolding expr 
-  = CoreUnfolding (simpleOptExpr expr)
+  = CoreUnfolding (simpleOptExpr emptySubst expr)
 		  True
 		  (exprIsHNF expr)
 		  (exprIsCheap expr)
 		  (calcUnfoldingGuidance opt_UF_CreationThreshold expr)
 
-mkInlineRule :: CoreExpr -> Arity -> Unfolding
-mkInlineRule expr arity 
-  = InlineRule { uf_tmpl = simpleOptExpr expr, 
-    	         uf_is_top = True, 	 -- Conservative; this gets set more
-		 	     		 -- accuately by the simplifier (slight hack)
-					 -- in SimplEnv.substUnfolding
-                 uf_arity = arity, 
-		 uf_is_value = exprIsHNF expr,
-		 uf_worker = Nothing }
-
-mkWwInlineRule :: CoreExpr -> Arity -> Id -> Unfolding
-mkWwInlineRule expr arity wkr 
-  = InlineRule { uf_tmpl = simpleOptExpr expr, 
-    	         uf_is_top = True, 	 -- Conservative; see mkInlineRule
-                 uf_arity = arity, 
-		 uf_is_value = exprIsHNF expr,
-		 uf_worker = Just wkr }
-
 mkUnfolding :: Bool -> CoreExpr -> Unfolding
 mkUnfolding top_lvl expr
-  = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr,
-		    uf_is_top = top_lvl,
-		    uf_is_value = exprIsHNF expr,
-		    uf_is_cheap = exprIsCheap expr,
-		    uf_guidance = calcUnfoldingGuidance opt_UF_CreationThreshold expr }
+  = CoreUnfolding (occurAnalyseExpr expr)
+		  top_lvl
+
+		  (exprIsHNF expr)
+			-- Already evaluated
+
+		  (exprIsCheap expr)
+			-- OK to inline inside a lambda
+
+		  (calcUnfoldingGuidance opt_UF_CreationThreshold expr)
 	-- Sometimes during simplification, there's a large let-bound thing	
 	-- which has been substituted, and so is now dead; so 'expr' contains
 	-- two copies of the thing while the occurrence-analysed expression doesn't
@@ -107,6 +95,14 @@ mkUnfolding top_lvl expr
 	-- This can occasionally mean that the guidance is very pessimistic;
 	-- it gets fixed up next round
 
+instance Outputable Unfolding where
+  ppr NoUnfolding = ptext (sLit "No unfolding")
+  ppr (OtherCon cs) = ptext (sLit "OtherCon") <+> ppr cs
+  ppr (CompulsoryUnfolding e) = ptext (sLit "Compulsory") <+> ppr e
+  ppr (CoreUnfolding e top hnf cheap g) 
+	= ptext (sLit "Unf") <+> sep [ppr top <+> ppr hnf <+> ppr cheap <+> ppr g, 
+				     ppr e]
+
 mkCompulsoryUnfolding :: CoreExpr -> Unfolding
 mkCompulsoryUnfolding expr	-- Used for things that absolutely must be unfolded
   = CompulsoryUnfolding (occurAnalyseExpr expr)
@@ -120,27 +116,75 @@ mkCompulsoryUnfolding expr	-- Used for things that absolutely must be unfolded
 %************************************************************************
 
 \begin{code}
+instance Outputable UnfoldingGuidance where
+    ppr UnfoldNever	= ptext (sLit "NEVER")
+    ppr (UnfoldIfGoodArgs v cs size discount)
+      = hsep [ ptext (sLit "IF_ARGS"), int v,
+	       brackets (hsep (map int cs)),
+	       int size,
+	       int discount ]
+\end{code}
+
+
+\begin{code}
 calcUnfoldingGuidance
 	:: Int		    	-- bomb out if size gets bigger than this
 	-> CoreExpr    		-- expression to look at
 	-> UnfoldingGuidance
 calcUnfoldingGuidance bOMB_OUT_SIZE expr
-  = case collectBinders expr of { (binders, body) ->
+  = case collect_val_bndrs expr of { (inline, val_binders, body) ->
     let
-        val_binders = filter isId binders
 	n_val_binders = length val_binders
+
+	max_inline_size = n_val_binders+2
+	-- The idea is that if there is an INLINE pragma (inline is True)
+	-- and there's a big body, we give a size of n_val_binders+2.  This
+	-- This is just enough to fail the no-size-increase test in callSiteInline,
+	--   so that INLINE things don't get inlined into entirely boring contexts,
+	--   but no more.
+
     in
     case (sizeExpr (iUnbox bOMB_OUT_SIZE) val_binders body) of
-      TooBig -> UnfoldNever
+
+      TooBig 
+	| not inline -> UnfoldNever
+		-- A big function with an INLINE pragma must
+		-- have an UnfoldIfGoodArgs guidance
+	| otherwise  -> UnfoldIfGoodArgs n_val_binders
+					 (map (const 0) val_binders)
+					 max_inline_size 0
+
       SizeIs size cased_args scrut_discount
-	-> UnfoldIfGoodArgs { ug_arity = n_val_binders
-	   		    , ug_args  = map discount_for val_binders
-			    , ug_size  = iBox size
-			    , ug_res   = iBox scrut_discount }
+	-> UnfoldIfGoodArgs
+			n_val_binders
+			(map discount_for val_binders)
+			final_size
+			(iBox scrut_discount)
 	where        
+	    boxed_size    = iBox size
+
+	    final_size | inline     = boxed_size `min` max_inline_size
+		       | otherwise  = boxed_size
+
+		-- Sometimes an INLINE thing is smaller than n_val_binders+2.
+		-- A particular case in point is a constructor, which has size 1.
+		-- We want to inline this regardless, hence the `min`
+
 	    discount_for b = foldlBag (\acc (b',n) -> if b==b' then acc+n else acc) 
 				      0 cased_args
 	}
+  where
+    collect_val_bndrs e = go False [] e
+	-- We need to be a bit careful about how we collect the
+	-- value binders.  In ptic, if we see 
+	--	__inline_me (\x y -> e)
+	-- We want to say "2 value binders".  Why?  So that 
+	-- we take account of information given for the arguments
+
+    go _      rev_vbs (Note InlineMe e)     = go True   rev_vbs     e
+    go inline rev_vbs (Lam b e) | isId b    = go inline (b:rev_vbs) e
+				| otherwise = go inline rev_vbs     e
+    go inline rev_vbs e			    = (inline, reverse rev_vbs, e)
 \end{code}
 
 \begin{code}
@@ -153,10 +197,21 @@ sizeExpr :: FastInt 	    -- Bomb out if it gets bigger than this
 sizeExpr bOMB_OUT_SIZE top_args expr
   = size_up expr
   where
-    size_up (Type _)           = sizeZero      -- Types cost nothing
+    size_up (Type _)           = sizeZero        -- Types cost nothing
     size_up (Var _)            = sizeOne
-    size_up (Note _ body)      = size_up body  -- Notes cost nothing
+
+    size_up (Note InlineMe _)  = sizeOne         -- Inline notes make it look very small
+	-- This can be important.  If you have an instance decl like this:
+	-- 	instance Foo a => Foo [a] where
+	--	   {-# INLINE op1, op2 #-}
+	--	   op1 = ...
+	--	   op2 = ...
+	-- then we'll get a dfun which is a pair of two INLINE lambdas
+
+    size_up (Note _      body) = size_up body  -- Other notes cost nothing
+    
     size_up (Cast e _)         = size_up e
+
     size_up (App fun (Type _)) = size_up fun
     size_up (App fun arg)      = size_up_app fun [arg]
 
@@ -429,17 +484,13 @@ couldBeSmallEnoughToInline threshold rhs = case calcUnfoldingGuidance threshold
 
 certainlyWillInline :: Unfolding -> Bool
   -- Sees if the unfolding is pretty certain to inline	
-certainlyWillInline (CompulsoryUnfolding {}) = True
-certainlyWillInline (InlineRule {})          = True
-certainlyWillInline (CoreUnfolding 
-    { uf_is_cheap = is_cheap
-    , uf_guidance = UnfoldIfGoodArgs {ug_arity = n_vals, ug_size = size}})
+certainlyWillInline (CoreUnfolding _ _ _ is_cheap (UnfoldIfGoodArgs n_vals _ size _))
   = is_cheap && size - (n_vals +1) <= opt_UF_UseThreshold
 certainlyWillInline _
   = False
 
 smallEnoughToInline :: Unfolding -> Bool
-smallEnoughToInline (CoreUnfolding {uf_guidance = UnfoldIfGoodArgs {ug_size = size}})
+smallEnoughToInline (CoreUnfolding _ _ _ _ (UnfoldIfGoodArgs _ _ size _))
   = size <= opt_UF_UseThreshold
 smallEnoughToInline _
   = False
@@ -499,10 +550,7 @@ instance Outputable CallCtxt where
   ppr ValAppCtxt    = ptext (sLit "ValAppCtxt")
 
 callSiteInline dflags active_inline id lone_variable arg_infos cont_info
-  = let
-	n_val_args  = length arg_infos
-    in
-    case idUnfolding id of {
+  = case idUnfolding id of {
 	NoUnfolding -> Nothing ;
 	OtherCon _  -> Nothing ;
 
@@ -513,45 +561,14 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info
 		-- compulsory unfoldings (see MkId.lhs).
 		-- We don't allow them to be inactive
 
-	InlineRule { uf_tmpl = unf_template, uf_arity = arity, uf_is_top = is_top
-		   , uf_is_value = is_value, uf_worker = mb_worker }
-	    -> let yes_or_no | not active_inline   = False
-			     | n_val_args <  arity = yes_unsat	-- Not enough value args
-			     | n_val_args == arity = yes_exact	-- Exactly saturated
-			     | otherwise	   = True	-- Over-saturated
-	           result | yes_or_no = Just unf_template
-	       	 	  | otherwise = Nothing
-		   
-		   -- See Note [Inlining an InlineRule]
-		   is_wrapper = isJust mb_worker 
-		   yes_unsat | is_wrapper  = or arg_infos
-		   	     | otherwise   = False
-
-		   yes_exact = or arg_infos || interesting_saturated_call
-		   interesting_saturated_call 
-			= case cont_info of
-			    BoringCtxt -> not is_top				-- Note [Nested functions]
-			    CaseCtxt   -> not lone_variable || not is_value	-- Note [Lone variables]
-			    ArgCtxt {} -> arity > 0 	    			-- Note [Inlining in ArgCtxt]
-			    ValAppCtxt -> True					-- Note [Cast then apply]
-	       in
-	       if dopt Opt_D_dump_inlinings dflags then
-		pprTrace ("Considering InlineRule for: " ++ showSDoc (ppr id))
-			 (vcat [text "active:" <+> ppr active_inline,
-				text "arg infos" <+> ppr arg_infos,
-				text "interesting call" <+> ppr interesting_saturated_call,
-				text "is value:" <+> ppr is_value,
-				text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
-			  result
-		else result ;
-
-	CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top, uf_is_value = is_value,
-		        uf_is_cheap = is_cheap, uf_guidance = guidance } ->
+	CoreUnfolding unf_template is_top is_value is_cheap guidance ->
 
     let
 	result | yes_or_no = Just unf_template
 	       | otherwise = Nothing
 
+	n_val_args  = length arg_infos
+
  	yes_or_no = active_inline && is_cheap && consider_safe
 		-- We consider even the once-in-one-branch
 		-- occurrences, because they won't all have been
@@ -567,8 +584,7 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info
 		-- work-duplication issue (the caller checks that).
 	  = case guidance of
 	      UnfoldNever  -> False
-	      UnfoldIfGoodArgs { ug_arity = n_vals_wanted, ug_args = arg_discounts
-                               , ug_res = res_discount, ug_size = size }
+	      UnfoldIfGoodArgs n_vals_wanted arg_discounts size res_discount
 		  | enough_args && size <= (n_vals_wanted + 1)
 			-- Inline unconditionally if there no size increase
 			-- Size of call is n_vals_wanted (+1 for the function)
@@ -618,35 +634,20 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info
 		
     in    
     if dopt Opt_D_dump_inlinings dflags then
-	pprTrace ("Considering inlining: " ++ showSDoc (ppr id))
-		 (vcat [text "active:" <+> ppr active_inline,
-			text "arg infos" <+> ppr arg_infos,
-			text "interesting continuation" <+> ppr cont_info,
-			text "is value:" <+> ppr is_value,
-			text "is cheap:" <+> ppr is_cheap,
-			text "guidance" <+> ppr guidance,
-			text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
+	pprTrace "Considering inlining"
+		 (ppr id <+> vcat [text "active:" <+> ppr active_inline,
+			  	   text "arg infos" <+> ppr arg_infos,
+				   text "interesting continuation" <+> ppr cont_info,
+				   text "is value:" <+> ppr is_value,
+				   text "is cheap:" <+> ppr is_cheap,
+				   text "guidance" <+> ppr guidance,
+				   text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
 		  result
     else
     result
     }
 \end{code}
 
-Note [Inlining an InlineRule]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-An InlineRules is used for
-  (a) pogrammer INLINE pragmas
-  (b) inlinings from worker/wrapper
-
-For (a) the RHS may be large, and our contract is that we *only* inline
-when the function is applied to all the arguments on the LHS of the
-source-code defn.  (The uf_arity in the rule.)
-
-However for worker/wrapper it may be worth inlining even if the 
-arity is not satisfied (as we do in the CoreUnfolding case) so we don't
-require saturation.
-
-
 Note [Nested functions]
 ~~~~~~~~~~~~~~~~~~~~~~~
 If a function has a nested defn we also record some-benefit, on the
@@ -763,3 +764,74 @@ computeDiscount n_vals_wanted arg_discounts result_discount arg_infos
 				      | otherwise = 0
 \end{code}
 
+%************************************************************************
+%*									*
+	The Very Simple Optimiser
+%*									*
+%************************************************************************
+
+
+\begin{code}
+simpleOptExpr :: Subst -> CoreExpr -> CoreExpr
+-- Return an occur-analysed and slightly optimised expression
+-- The optimisation is very straightforward: just
+-- inline non-recursive bindings that are used only once, 
+-- or wheere the RHS is trivial
+
+simpleOptExpr subst expr
+  = go subst (occurAnalyseExpr expr)
+  where
+    go subst (Var v)          = lookupIdSubst subst v
+    go subst (App e1 e2)      = App (go subst e1) (go subst e2)
+    go subst (Type ty)        = Type (substTy subst ty)
+    go _     (Lit lit)        = Lit lit
+    go subst (Note note e)    = Note note (go subst e)
+    go subst (Cast e co)      = Cast (go subst e) (substTy subst co)
+    go subst (Let bind body)  = go_bind subst bind body
+    go subst (Lam bndr body)  = Lam bndr' (go subst' body)
+		              where
+			        (subst', bndr') = substBndr subst bndr
+
+    go subst (Case e b ty as) = Case (go subst e) b' 
+				     (substTy subst ty)
+				     (map (go_alt subst') as)
+			      where
+			  	 (subst', b') = substBndr subst b
+
+
+    ----------------------
+    go_alt subst (con, bndrs, rhs) = (con, bndrs', go subst' rhs)
+				 where
+				   (subst', bndrs') = substBndrs subst bndrs
+
+    ----------------------
+    go_bind subst (Rec prs) body = Let (Rec (bndrs' `zip` rhss'))
+				       (go subst' body)
+			    where
+			      (bndrs, rhss)    = unzip prs
+			      (subst', bndrs') = substRecBndrs subst bndrs
+			      rhss'	       = map (go subst') rhss
+
+    go_bind subst (NonRec b r) body = go_nonrec subst b (go subst r) body
+
+    ----------------------
+    go_nonrec subst b (Type ty') body
+      | isTyVar b = go (extendTvSubst subst b ty') body
+	-- let a::* = TYPE ty in <body>
+    go_nonrec subst b r' body
+      | isId b	-- let x = e in <body>
+      , exprIsTrivial r' || safe_to_inline (idOccInfo b)
+      = go (extendIdSubst subst b r') body
+    go_nonrec subst b r' body
+      = Let (NonRec b' r') (go subst' body)
+      where
+	(subst', b') = substBndr subst b
+
+    ----------------------
+	-- Unconditionally safe to inline
+    safe_to_inline :: OccInfo -> Bool
+    safe_to_inline IAmDead                  = True
+    safe_to_inline (OneOcc in_lam one_br _) = not in_lam && one_br
+    safe_to_inline (IAmALoopBreaker {})     = False
+    safe_to_inline NoOccInfo                = False
+\end{code}
\ No newline at end of file
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 8889282527..44ca27a9ab 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -16,7 +16,7 @@ Utility functions on @Core@ syntax
 -- | Commonly useful utilites for manipulating the Core language
 module CoreUtils (
 	-- * Constructing expressions
-	mkSCC, mkCoerce, mkCoerceI,
+	mkInlineMe, mkSCC, mkCoerce, mkCoerceI,
 	bindNonRec, needsCaseBinding,
 	mkAltExpr, mkPiType, mkPiTypes,
 
@@ -27,12 +27,10 @@ module CoreUtils (
 	exprType, coreAltType, coreAltsType,
 	exprIsDupable, exprIsTrivial, exprIsCheap, 
 	exprIsHNF,exprOkForSpeculation, exprIsBig, 
-	exprIsConApp_maybe, 
-	exprBotStrictness_maybe,
+	exprIsConApp_maybe, exprIsBottom,
 	rhsIsStatic,
 
 	-- * Arity and eta expansion
-	-- exprIsBottom, 	Not used
 	manifestArity, exprArity, 
 	exprEtaExpandArity, etaExpand, 
 
@@ -52,7 +50,6 @@ module CoreUtils (
 
 #include "HsVersions.h"
 
-import StaticFlags	( opt_NoStateHack )
 import CoreSyn
 import CoreFVs
 import PprCore
@@ -175,6 +172,46 @@ panic_msg e op_ty = pprCoreExpr e $$ ppr op_ty
 %*									*
 %************************************************************************
 
+mkNote removes redundant coercions, and SCCs where possible
+
+\begin{code}
+#ifdef UNUSED
+mkNote :: Note -> CoreExpr -> CoreExpr
+mkNote (SCC cc)	expr		   = mkSCC cc expr
+mkNote InlineMe expr		   = mkInlineMe expr
+mkNote note     expr		   = Note note expr
+#endif
+\end{code}
+
+Drop trivial InlineMe's.  This is somewhat important, because if we have an unfolding
+that looks like	(Note InlineMe (Var v)), the InlineMe doesn't go away because it may
+not be *applied* to anything.
+
+We don't use exprIsTrivial here, though, because we sometimes generate worker/wrapper
+bindings like
+	fw = ...
+	f  = inline_me (coerce t fw)
+As usual, the inline_me prevents the worker from getting inlined back into the wrapper.
+We want the split, so that the coerces can cancel at the call site.  
+
+However, we can get left with tiresome type applications.  Notably, consider
+	f = /\ a -> let t = e in (t, w)
+Then lifting the let out of the big lambda gives
+	t' = /\a -> e
+	f = /\ a -> let t = inline_me (t' a) in (t, w)
+The inline_me is to stop the simplifier inlining t' right back
+into t's RHS.  In the next phase we'll substitute for t (since
+its rhs is trivial) and *then* we could get rid of the inline_me.
+But it hardly seems worth it, so I don't bother.
+
+\begin{code}
+-- | Wraps the given expression in an inlining hint unless the expression
+-- is trivial in some sense, so that doing so would usually hurt us
+mkInlineMe :: CoreExpr -> CoreExpr
+mkInlineMe (Var v) = Var v
+mkInlineMe e	   = Note InlineMe e
+\end{code}
+
 \begin{code}
 -- | Wrap the given expression in the coercion, dropping identity coercions and coalescing nested coercions
 mkCoerceI :: CoercionI -> CoreExpr -> CoreExpr
@@ -383,11 +420,12 @@ exprIsTrivial _                = False
 
 \begin{code}
 exprIsDupable :: CoreExpr -> Bool
-exprIsDupable (Type _)   = True
-exprIsDupable (Var _)    = True
-exprIsDupable (Lit lit)  = litIsDupable lit
-exprIsDupable (Note _ e) = exprIsDupable e
-exprIsDupable (Cast e _) = exprIsDupable e
+exprIsDupable (Type _)          = True
+exprIsDupable (Var _)           = True
+exprIsDupable (Lit lit)         = litIsDupable lit
+exprIsDupable (Note InlineMe _) = True
+exprIsDupable (Note _ e)        = exprIsDupable e
+exprIsDupable (Cast e _)        = exprIsDupable e
 exprIsDupable expr
   = go expr 0
   where
@@ -434,6 +472,7 @@ exprIsCheap :: CoreExpr -> Bool
 exprIsCheap (Lit _)           = True
 exprIsCheap (Type _)          = True
 exprIsCheap (Var _)           = True
+exprIsCheap (Note InlineMe _) = True
 exprIsCheap (Note _ e)        = exprIsCheap e
 exprIsCheap (Cast e _)        = exprIsCheap e
 exprIsCheap (Lam x e)         = isRuntimeVar x || exprIsCheap e
@@ -580,9 +619,8 @@ isDivOp _                = False
 \end{code}
 
 \begin{code}
-{-	Never used -- omitting
 -- | True of expressions that are guaranteed to diverge upon execution
-exprIsBottom :: CoreExpr -> Bool	-- True => definitely bottom
+exprIsBottom :: CoreExpr -> Bool
 exprIsBottom e = go 0 e
                where
                 -- n is the number of args
@@ -598,7 +636,6 @@ exprIsBottom e = go 0 e
 
 idAppIsBottom :: Id -> Int -> Bool
 idAppIsBottom id n_val_args = appIsBottom (idNewStrictness id) n_val_args
--}
 \end{code}
 
 \begin{code}
@@ -845,7 +882,12 @@ exprIsConApp_maybe (Note (BinaryTickBox {}) expr)
 
 exprIsConApp_maybe (Note _ expr)
   = exprIsConApp_maybe expr
-    -- We ignore all notes.  For example,
+    -- We ignore InlineMe notes in case we have
+    --	x = __inline_me__ (a,b)
+    -- All part of making sure that INLINE pragmas never hurt
+    -- Marcin tripped on this one when making dictionaries more inlinable
+    --
+    -- In fact, we ignore all notes.  For example,
     --  	case _scc_ "foo" (C a b) of
     --			C a b -> e
     -- should be optimised away, but it will be only if we look
@@ -881,55 +923,50 @@ exprIsConApp_maybe expr = analyse (collectArgs expr)
 -- ^ The Arity returned is the number of value args the 
 -- expression can be applied to without doing much work
 exprEtaExpandArity :: DynFlags -> CoreExpr -> Arity
--- exprEtaExpandArity is used when eta expanding
--- 	e  ==>  \xy -> e x y
-exprEtaExpandArity dflags e
-    = applyStateHack e (arityType dicts_cheap e)
-  where
-    dicts_cheap = dopt Opt_DictsCheap dflags
-
-exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, StrictSig)
--- A cheap and cheerful function that identifies bottoming functions
--- and gives them a suitable strictness signatures.  It's used during
--- float-out
-exprBotStrictness_maybe e
-  = case arityType False e of
-	AT _ ATop -> Nothing
-	AT a ABot -> Just (a, mkStrictSig (mkTopDmdType (replicate a topDmd) BotRes))
-\end{code}	
-
-Note [Definition of arity]
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-The "arity" of an expression 'e' is n if
-   applying 'e' to *fewer* than n *value* arguments
-   converges rapidly
+{- 
+exprEtaExpandArity is used when eta expanding
+	e  ==>  \xy -> e x y
 
-Or, to put it another way
+It returns 1 (or more) to:
+	case x of p -> \s -> ...
+because for I/O ish things we really want to get that \s to the top.
+We are prepared to evaluate x each time round the loop in order to get that
 
-   there is no work lost in duplicating the partial
-   application (e x1 .. x(n-1))
+It's all a bit more subtle than it looks:
 
-In the divegent case, no work is lost by duplicating because if the thing
-is evaluated once, that's the end of the program.
+1.  One-shot lambdas
 
-Or, to put it another way, in any context C
+Consider one-shot lambdas
+		let x = expensive in \y z -> E
+We want this to have arity 2 if the \y-abstraction is a 1-shot lambda
+Hence the ArityType returned by arityType
 
-   C[ (\x1 .. xn. e x1 .. xn) ]
-         is as efficient as
-   C[ e ]
+2.  The state-transformer hack
 
+The one-shot lambda special cause is particularly important/useful for
+IO state transformers, where we often get
+	let x = E in \ s -> ...
 
-It's all a bit more subtle than it looks:
+and the \s is a real-world state token abstraction.  Such abstractions
+are almost invariably 1-shot, so we want to pull the \s out, past the
+let x=E, even if E is expensive.  So we treat state-token lambdas as 
+one-shot even if they aren't really.  The hack is in Id.isOneShotBndr.
 
-Note [Arity of case expressions]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We treat the arity of 
-	case x of p -> \s -> ...
-as 1 (or more) because for I/O ish things we really want to get that
-\s to the top.  We are prepared to evaluate x each time round the loop
-in order to get that.
+3.  Dealing with bottom
 
-This isn't really right in the presence of seq.  Consider
+Consider also 
+	f = \x -> error "foo"
+Here, arity 1 is fine.  But if it is
+	f = \x -> case x of 
+			True  -> error "foo"
+			False -> \y -> x+y
+then we want to get arity 2.  Tecnically, this isn't quite right, because
+	(f True) `seq` 1
+should diverge, but it'll converge if we eta-expand f.  Nevertheless, we
+do so; it improves some programs significantly, and increasing convergence
+isn't a bad thing.  Hence the ABot/ATop in ArityType.
+
+Actually, the situation is worse.  Consider
 	f = \x -> case x of
 			True  -> \y -> x+y
 			False -> \y -> x-y
@@ -941,29 +978,8 @@ This should diverge!  But if we eta-expand, it won't.   Again, we ignore this
 many programs.
 
 
-1.  Note [One-shot lambdas]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider one-shot lambdas
-		let x = expensive in \y z -> E
-We want this to have arity 1 if the \y-abstraction is a 1-shot lambda.
+4. Newtypes
 
-3.  Note [Dealing with bottom]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-	f = \x -> error "foo"
-Here, arity 1 is fine.  But if it is
-	f = \x -> case x of 
-			True  -> error "foo"
-			False -> \y -> x+y
-then we want to get arity 2.  Technically, this isn't quite right, because
-	(f True) `seq` 1
-should diverge, but it'll converge if we eta-expand f.  Nevertheless, we
-do so; it improves some programs significantly, and increasing convergence
-isn't a bad thing.  Hence the ABot/ATop in ArityType.
-
-
-4. Note [Newtype arity]
-~~~~~~~~~~~~~~~~~~~~~~~~
 Non-recursive newtypes are transparent, and should not get in the way.
 We do (currently) eta-expand recursive newtypes too.  So if we have, say
 
@@ -981,154 +997,75 @@ HOWEVER, note that if you use coerce bogusly you can ge
 	coerce Int negate
 And since negate has arity 2, you might try to eta expand.  But you can't
 decopose Int to a function type.   Hence the final case in eta_expand.
+-}
 
 
-Note [The state-transformer hack]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Suppose we have 
-	f = e
-where e has arity n.  Then, if we know from the context that f has
-a usage type like
-	t1 -> ... -> tn -1-> t(n+1) -1-> ... -1-> tm -> ...
-then we can expand the arity to m.  This usage type says that
-any application (x e1 .. en) will be applied to uniquely to (m-n) more args
-Consider f = \x. let y = <expensive> 
-		 in case x of
-		      True  -> foo
-		      False -> \(s:RealWorld) -> e
-where foo has arity 1.  Then we want the state hack to
-apply to foo too, so we can eta expand the case.
-
-Then we expect that if f is applied to one arg, it'll be applied to two
-(that's the hack -- we don't really know, and sometimes it's false)
-See also Id.isOneShotBndr.
-
-\begin{code}
-applyStateHack :: CoreExpr -> ArityType -> Arity
-applyStateHack e (AT orig_arity is_bot)
-  | opt_NoStateHack = orig_arity
-  | ABot <- is_bot  = orig_arity   -- Note [State hack and bottoming functions]
-  | otherwise       = go orig_ty orig_arity
-  where			-- Note [The state-transformer hack]
-    orig_ty = exprType e
-    go :: Type -> Arity -> Arity
-    go ty arity		-- This case analysis should match that in eta_expand
-	| Just (_, ty') <- splitForAllTy_maybe ty   = go ty' arity
-
-	| Just (tc,tys) <- splitTyConApp_maybe ty 
-	, Just (ty', _) <- instNewTyCon_maybe tc tys
-	, not (isRecursiveTyCon tc)	            = go ty' arity
-		-- Important to look through non-recursive newtypes, so that, eg 
-		--	(f x)   where f has arity 2, f :: Int -> IO ()
-		-- Here we want to get arity 1 for the result!
-
-	| Just (arg,res) <- splitFunTy_maybe ty
-	, arity > 0 || isStateHackType arg = 1 + go res (arity-1)
-{-
-	= if arity > 0 then 1 + go res (arity-1)
-	  else if isStateHackType arg then
-		pprTrace "applystatehack" (vcat [ppr orig_arity, ppr orig_ty,
-						ppr ty, ppr res, ppr e]) $
-	        1 + go res (arity-1)
-          else WARN( arity > 0, ppr arity ) 0
--}						 
-	| otherwise = WARN( arity > 0, ppr arity ) 0
-\end{code}
-
-Note [State hack and bottoming functions]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-It's a terrible idea to use the state hack on a bottoming function.
-Here's what happens (Trac #2861):
-
-  f :: String -> IO T
-  f = \p. error "..."
-
-Eta-expand, using the state hack:
-
-  f = \p. (\s. ((error "...") |> g1) s) |> g2
-  g1 :: IO T ~ (S -> (S,T))
-  g2 :: (S -> (S,T)) ~ IO T
-
-Extrude the g2
-
-  f' = \p. \s. ((error "...") |> g1) s
-  f = f' |> (String -> g2)
+exprEtaExpandArity dflags e = arityDepth (arityType dflags e)
 
-Discard args for bottomming function
+-- A limited sort of function type
+data ArityType = AFun Bool ArityType	-- True <=> one-shot
+	       | ATop			-- Know nothing
+	       | ABot			-- Diverges
 
-  f' = \p. \s. ((error "...") |> g1 |> g3
-  g3 :: (S -> (S,T)) ~ (S,T)
+arityDepth :: ArityType -> Arity
+arityDepth (AFun _ ty) = 1 + arityDepth ty
+arityDepth _           = 0
 
-Extrude g1.g3
+andArityType :: ArityType -> ArityType -> ArityType
+andArityType ABot           at2           = at2
+andArityType ATop           _             = ATop
+andArityType (AFun t1 at1)  (AFun t2 at2) = AFun (t1 && t2) (andArityType at1 at2)
+andArityType at1            at2           = andArityType at2 at1
 
-  f'' = \p. \s. (error "...")
-  f' = f'' |> (String -> S -> g1.g3)
+arityType :: DynFlags -> CoreExpr -> ArityType
+	-- (go1 e) = [b1,..,bn]
+	-- means expression can be rewritten \x_b1 -> ... \x_bn -> body
+	-- where bi is True <=> the lambda is one-shot
 
-And now we can repeat the whole loop.  Aargh!  The bug is in applying the
-state hack to a function which then swallows the argument.
+arityType dflags (Note _ e) = arityType dflags e
+--	Not needed any more: etaExpand is cleverer
+-- removed: | ok_note n = arityType dflags e
+-- removed: | otherwise = ATop
 
+arityType dflags (Cast e _) = arityType dflags e
 
--------------------- Main arity code ----------------------------
-\begin{code}
--- If e has ArityType (AT n r), then the term 'e'
---  * Must be applied to at least n *value* args 
---	before doing any significant work
---  * It will not diverge before being applied to n
---	value arguments
---  * If 'r' is ABot, then it guarantees to diverge if 
---	applied to n arguments (or more)
-
-data ArityType = AT Arity ArityRes
-data ArityRes  = ATop			-- Know nothing
-	       | ABot			-- Diverges
-
-vanillaArityType :: ArityType
-vanillaArityType = AT 0 ATop	-- Totally uninformative
-
-incArity :: ArityType -> ArityType
-incArity (AT a r) = AT (a+1) r
-
-decArity :: ArityType -> ArityType
-decArity (AT 0 r) = AT 0     r
-decArity (AT a r) = AT (a-1) r
-
-andArityType :: ArityType -> ArityType -> ArityType   -- Used for branches of a 'case'
-andArityType (AT a1 ATop) (AT a2 ATop) = AT (a1 `min` a2) ATop
-andArityType (AT _  ABot) (AT a2 ATop) = AT a2		  ATop
-andArityType (AT a1 ATop) (AT _  ABot) = AT a1		  ATop
-andArityType (AT a1 ABot) (AT a2 ABot) = AT (a1 `max` a2) ABot
-
-trimArity :: Bool -> ArityType -> ArityType
--- We have something like (let x = E in b), where b has the given
--- arity type.  Then
---	* If E is cheap we can push it inside as far as we like
---	* If b eventually diverges, we allow ourselves to push inside
---	  arbitrarily, even though that is not quite right
-trimArity _cheap (AT a ABot) = AT a ABot
-trimArity True   (AT a ATop) = AT a ATop
-trimArity False  (AT _ ATop) = AT 0 ATop	-- Bale out
-
----------------------------
-arityType :: Bool -> CoreExpr -> ArityType
 arityType _ (Var v)
-  | Just strict_sig <- idNewStrictness_maybe v
-  , (ds, res) <- splitStrictSig strict_sig
-  , isBotRes res
-  = AT (length ds) ABot	-- Function diverges
-  | otherwise
-  = AT (idArity v) ATop
+  = mk (idArity v) (arg_tys (idType v))
+  where
+    mk :: Arity -> [Type] -> ArityType
+	-- The argument types are only to steer the "state hack"
+	-- Consider case x of
+	--		True  -> foo
+	--		False -> \(s:RealWorld) -> e
+	-- where foo has arity 1.  Then we want the state hack to
+	-- apply to foo too, so we can eta expand the case.
+    mk 0 tys | isBottomingId v                   = ABot
+             | (ty:_) <- tys, isStateHackType ty = AFun True ATop
+             | otherwise                         = ATop
+    mk n (ty:tys) = AFun (isStateHackType ty) (mk (n-1) tys)
+    mk n []       = AFun False		      (mk (n-1) [])
+
+    arg_tys :: Type -> [Type]	-- Ignore for-alls
+    arg_tys ty 
+	| Just (_, ty')  <- splitForAllTy_maybe ty = arg_tys ty'
+	| Just (arg,res) <- splitFunTy_maybe ty    = arg : arg_tys res
+	| otherwise				   = []
 
 	-- Lambdas; increase arity
-arityType dicts_cheap (Lam x e)
-  | isId x    = incArity (arityType dicts_cheap e)
-  | otherwise = arityType dicts_cheap e
+arityType dflags (Lam x e)
+  | isId x    = AFun (isOneShotBndr x) (arityType dflags e)
+  | otherwise = arityType dflags e
 
 	-- Applications; decrease arity
-arityType dicts_cheap (App fun (Type _))
-   = arityType dicts_cheap fun
-arityType dicts_cheap (App fun arg )
-   = trimArity (exprIsCheap arg) (decArity (arityType dicts_cheap fun))
-
+arityType dflags (App f (Type _)) = arityType dflags f
+arityType dflags (App f a)
+   = case arityType dflags f of
+	ABot -> ABot	-- If function diverges, ignore argument
+	ATop -> ATop	-- No no info about function
+	AFun _ xs
+		| exprIsCheap a -> xs
+		| otherwise	-> ATop
+							   
 	-- Case/Let; keep arity if either the expression is cheap
 	-- or it's a 1-shot lambda
 	-- The former is not really right for Haskell
@@ -1136,16 +1073,22 @@ arityType dicts_cheap (App fun arg )
 	--  ===>
 	--	f x y = case x of { (a,b) -> e }
 	-- The difference is observable using 'seq'
-arityType dicts_cheap (Case scrut _ _ alts)
-  = trimArity (exprIsCheap scrut)
-	      (foldr1 andArityType [arityType dicts_cheap rhs | (_,_,rhs) <- alts])
-
-arityType dicts_cheap (Let b e) 
-  = trimArity (cheap_bind b) (arityType dicts_cheap e)
+arityType dflags (Case scrut _ _ alts)
+  = case foldr1 andArityType [arityType dflags rhs | (_,_,rhs) <- alts] of
+        xs | exprIsCheap scrut     -> xs
+        AFun one_shot _ | one_shot -> AFun True ATop
+        _                          -> ATop
+
+arityType dflags (Let b e) 
+  = case arityType dflags e of
+        xs              | cheap_bind b -> xs
+        AFun one_shot _ | one_shot     -> AFun True ATop
+        _                              -> ATop
   where
     cheap_bind (NonRec b e) = is_cheap (b,e)
     cheap_bind (Rec prs)    = all is_cheap prs
-    is_cheap (b,e) = (dicts_cheap && isDictId b) || exprIsCheap e
+    is_cheap (b,e) = (dopt Opt_DictsCheap dflags && isDictId b)
+		   || exprIsCheap e
 	-- If the experimental -fdicts-cheap flag is on, we eta-expand through
 	-- dictionary bindings.  This improves arities. Thereby, it also
 	-- means that full laziness is less prone to floating out the
@@ -1163,9 +1106,21 @@ arityType dicts_cheap (Let b e)
 	-- One could go further and make exprIsCheap reply True to any
 	-- dictionary-typed expression, but that's more work.
 
-arityType dicts_cheap (Note _ e) = arityType dicts_cheap e
-arityType dicts_cheap (Cast e _) = arityType dicts_cheap e
-arityType _           _          = vanillaArityType
+arityType _ _ = ATop
+
+{- NOT NEEDED ANY MORE: etaExpand is cleverer
+ok_note InlineMe = False
+ok_note other    = True
+    -- Notice that we do not look through __inline_me__
+    -- This may seem surprising, but consider
+    --		f = _inline_me (\x -> e)
+    -- We DO NOT want to eta expand this to
+    --		f = \x -> (_inline_me (\x -> e)) x
+    -- because the _inline_me gets dropped now it is applied, 
+    -- giving just
+    --		f = \x -> e
+    -- A Bad Idea
+-}
 \end{code}
 
 
@@ -1192,7 +1147,8 @@ etaExpand :: Arity	  	-- ^ Result should have this number of value args
 
 etaExpand n us expr ty
   | manifestArity expr >= n = expr		-- The no-op case
-  | otherwise 		    = eta_expand n us expr ty
+  | otherwise 		    
+  = eta_expand n us expr ty
 
 -- manifestArity sees how many leading value lambdas there are
 manifestArity :: CoreExpr -> Arity
@@ -1212,8 +1168,16 @@ manifestArity _                     = 0
 -- so perhaps the extra code isn't worth it
 eta_expand :: Int -> [Unique] -> CoreExpr -> Type -> CoreExpr
 
-eta_expand n _ expr _
-  | n == 0    -- Saturated, so nothing to do
+eta_expand n _ expr ty
+  | n == 0 && 
+    -- The ILX code generator requires eta expansion for type arguments
+    -- too, but alas the 'n' doesn't tell us how many of them there 
+    -- may be.  So we eagerly eta expand any big lambdas, and just
+    -- cross our fingers about possible loss of sharing in the ILX case. 
+    -- The Right Thing is probably to make 'arity' include
+    -- type variables throughout the compiler.  (ToDo.)
+    not (isForAllTy ty)	
+    -- Saturated, so nothing to do
   = expr
 
 	-- Short cut for the case where there already
@@ -1382,7 +1346,6 @@ exprIsBig :: Expr b -> Bool
 exprIsBig (Lit _)      = False
 exprIsBig (Var _)      = False
 exprIsBig (Type _)     = False
-exprIsBig (Lam _ e)    = exprIsBig e
 exprIsBig (App f a)    = exprIsBig f || exprIsBig a
 exprIsBig (Cast e _)   = exprIsBig e	-- Hopefully coercions are not too big!
 exprIsBig _            = True
@@ -1462,6 +1425,7 @@ exprSize (Type t)        = seqType t `seq` 1
 
 noteSize :: Note -> Int
 noteSize (SCC cc)       = cc `seq` 1
+noteSize InlineMe       = 1
 noteSize (CoreNote s)   = s `seq` 1  -- hdaume: core annotations
  
 varSize :: Var -> Int
@@ -1617,7 +1581,7 @@ rhsIsStatic :: PackageId -> CoreExpr -> Bool
 -- This is a bit like CoreUtils.exprIsHNF, with the following differences:
 --    a) scc "foo" (\x -> ...) is updatable (so we catch the right SCC)
 --
---    b) (C x xs), where C is a contructor is updatable if the application is
+--    b) (C x xs), where C is a contructors is updatable if the application is
 --	   dynamic
 -- 
 --    c) don't look through unfolding of f in (f x).
diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs
index d0d9dea468..717d3d8d93 100644
--- a/compiler/coreSyn/MkExternalCore.lhs
+++ b/compiler/coreSyn/MkExternalCore.lhs
@@ -171,6 +171,7 @@ make_exp (Case e v ty alts) = do
   return $ C.Case scrut (make_vbind v) (make_ty ty) newAlts
 make_exp (Note (SCC _) e) = make_exp e >>= (return . C.Note "SCC") -- temporary
 make_exp (Note (CoreNote s) e) = make_exp e >>= (return . C.Note s)  -- hdaume: core annotations
+make_exp (Note InlineMe e) = make_exp e >>= (return . C.Note "InlineMe")
 make_exp _ = error "MkExternalCore died: make_exp"
 
 make_alt :: CoreAlt -> CoreM C.Alt
diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index 595b6d3370..d641a9e833 100644
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -209,6 +209,9 @@ ppr_expr add_par (Let bind expr)
 ppr_expr add_par (Note (SCC cc) expr)
   = add_par (sep [pprCostCentreCore cc, pprCoreExpr expr])
 
+ppr_expr add_par (Note InlineMe expr)
+  = add_par $ ptext (sLit "__inline_me") <+> pprParendExpr expr
+
 ppr_expr add_par (Note (CoreNote s) expr)
   = add_par $ 
     sep [sep [ptext (sLit "__core_note"), pprHsString (mkFastString s)],
@@ -265,9 +268,6 @@ pprCoreBinder LambdaBind bndr
 
 -- Case bound things don't get a signature or a herald, unless we have debug on
 pprCoreBinder CaseBind bndr 
-  | isDeadBinder bndr	 -- False for tyvars
-  = ptext (sLit "_")
-  | otherwise
   = getPprStyle $ \ sty ->
     if debugStyle sty then
 	parens (pprTypedBinder bndr)
@@ -325,10 +325,6 @@ pprIdBndrInfo info
 \end{code}
 
 
------------------------------------------------------
---	IdInfo
------------------------------------------------------
-
 \begin{code}
 pprIdDetails :: Id -> SDoc
 pprIdDetails id | isGlobalId id     = ppr (globalIdDetails id)
@@ -339,13 +335,13 @@ ppIdInfo :: Id -> IdInfo -> SDoc
 ppIdInfo _ info
   = brackets $
     vcat [  ppArityInfo a,
+	    ppWorkerInfo (workerInfo info),
 	    ppCafInfo (cafInfo info),
 #ifdef OLD_STRICTNESS
 	    ppStrictnessInfo s,
             ppCprInfo m,
 #endif
 	    pprNewStrictness (newStrictnessInfo info),
-	    pprInlineInfo (unfoldingInfo info),
 	    if null rules then empty
 	    else ptext (sLit "RULES:") <+> vcat (map pprRule rules)
 	-- Inline pragma, occ, demand, lbvar info
@@ -361,38 +357,6 @@ ppIdInfo _ info
     rules = specInfoRules (specInfo info)
 \end{code}
 
------------------------------------------------------
---	Unfolding and UnfoldingGuidance
------------------------------------------------------
-
-\begin{code}
-instance Outputable UnfoldingGuidance where
-    ppr UnfoldNever	= ptext (sLit "NEVER")
-    ppr (UnfoldIfGoodArgs { ug_arity = v, ug_args = cs
-                          , ug_size = size, ug_res = discount })
-      = hsep [ ptext (sLit "IF_ARGS"), int v,
-	       brackets (hsep (map int cs)),
-	       int size,
-	       int discount ]
-
-instance Outputable Unfolding where
-  ppr NoUnfolding = ptext (sLit "No unfolding")
-  ppr (OtherCon cs) = ptext (sLit "OtherCon") <+> ppr cs
-  ppr (CompulsoryUnfolding e) = ptext (sLit "Compulsory") <+> ppr e
-  ppr (InlineRule { uf_tmpl = e, uf_is_value = hnf, uf_arity = arity, uf_worker = wkr })
-	= ptext (sLit "INLINE") <+> sep [ppr arity <+> ppr hnf <+> ppr wkr, ppr e]
-  ppr (CoreUnfolding e top hnf cheap g) 
-	= ptext (sLit "Unf") <+> sep [ppr top <+> ppr hnf <+> ppr cheap <+> ppr g, 
-				     ppr e]
-
-pprInlineInfo :: Unfolding -> SDoc	-- Print an inline RULE
-pprInlineInfo unf | isInlineRule unf = ppr unf
-		  | otherwise	     = empty
-\end{code}
-
------------------------------------------------------
---	Rules
------------------------------------------------------
 
 \begin{code}
 instance Outputable CoreRule where