Implement INLINABLE pragma

Implements Trac #4299.  Documentation to come.

30 files changed, 264 insertions, 195 deletions

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 8cd5c35900..f125714935 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -62,8 +62,10 @@ module BasicTypes(
 	CompilerPhase, 
 	Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
         RuleMatchInfo(..), isConLike, isFunLike, 
-        InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma,
-	isDefaultInlinePragma, isInlinePragma, inlinePragmaSat,
+        InlineSpec(..), 
+        InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, 
+        neverInlinePragma, dfunInlinePragma, 
+	isDefaultInlinePragma, isInlinePragma, inlinePragmaSpec, inlinePragmaSat,
         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
 
@@ -645,12 +647,12 @@ data Activation = NeverActive
 
 data RuleMatchInfo = ConLike 			-- See Note [CONLIKE pragma]
                    | FunLike
-                   deriving( Eq, Data, Typeable )
+                   deriving( Eq, Data, Typeable, Show )
+	-- Show needed for Lexer.x
 
 data InlinePragma  	     -- Note [InlinePragma]
   = InlinePragma
-      { inl_inline :: Bool           -- True <=> INLINE, 
-      		      		     -- False <=> no pragma at all, or NOINLINE
+      { inl_inline :: InlineSpec
 
       , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n 
       		      	    	     --            explicit (non-type, non-dictionary) args
@@ -663,6 +665,14 @@ data InlinePragma  	     -- Note [InlinePragma]
 
       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
     } deriving( Eq, Data, Typeable )
+
+data InlineSpec   -- What the user's INLINE pragama looked like
+  = Inline
+  | Inlinable
+  | NoInline
+  | EmptyInlineSpec
+  deriving( Eq, Data, Typeable, Show )
+	-- Show needed for Lexer.x
 \end{code}
 
 Note [InlinePragma]
@@ -725,16 +735,24 @@ isFunLike :: RuleMatchInfo -> Bool
 isFunLike FunLike = True
 isFunLike _            = False
 
+isInlineSpec :: InlineSpec -> Bool
+isInlineSpec Inline    = True
+isInlineSpec Inlinable = True
+isInlineSpec _         = False
+
 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
   :: InlinePragma
 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
                                    , inl_rule = FunLike
-                                   , inl_inline = False
+                                   , inl_inline = EmptyInlineSpec
                                    , inl_sat = Nothing }
 
-alwaysInlinePragma = defaultInlinePragma { inl_inline = True }
+alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
 neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }
 
+inlinePragmaSpec :: InlinePragma -> InlineSpec
+inlinePragmaSpec = inl_inline
+
 -- A DFun has an always-active inline activation so that 
 -- exprIsConApp_maybe can "see" its unfolding
 -- (However, its actual Unfolding is a DFunUnfolding, which is
@@ -746,10 +764,10 @@ isDefaultInlinePragma :: InlinePragma -> Bool
 isDefaultInlinePragma (InlinePragma { inl_act = activation
                                     , inl_rule = match_info
                                     , inl_inline = inline })
-  = not inline && isAlwaysActive activation && isFunLike match_info
+  = isInlineSpec inline && isAlwaysActive activation && isFunLike match_info
 
 isInlinePragma :: InlinePragma -> Bool
-isInlinePragma prag = inl_inline prag
+isInlinePragma prag = isInlineSpec (inl_inline prag)
 
 inlinePragmaSat :: InlinePragma -> Maybe Arity
 inlinePragmaSat = inl_sat
@@ -776,16 +794,20 @@ instance Outputable RuleMatchInfo where
    ppr ConLike = ptext (sLit "CONLIKE")
    ppr FunLike = ptext (sLit "FUNLIKE")
 
+instance Outputable InlineSpec where
+   ppr Inline          = ptext (sLit "INLINE")
+   ppr NoInline        = ptext (sLit "NOINLINE")
+   ppr Inlinable       = ptext (sLit "INLINABLE")
+   ppr EmptyInlineSpec = empty
+
 instance Outputable InlinePragma where
   ppr (InlinePragma { inl_inline = inline, inl_act = activation
                     , inl_rule = info, inl_sat = mb_arity })
-    = pp_inl_act (inline, activation) <+> pp_sat <+> pp_info 
+    = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info 
     where
-      pp_inl_act (False, AlwaysActive)  = empty	-- defaultInlinePragma
-      pp_inl_act (False, NeverActive)   = ptext (sLit "NOINLINE")
-      pp_inl_act (False, act)           = ptext (sLit "NOINLINE") <> ppr act
-      pp_inl_act (True,  AlwaysActive)  = ptext (sLit "INLINE")
-      pp_inl_act (True,  act)           = ptext (sLit "INLINE") <> ppr act
+      pp_act Inline   AlwaysActive = empty	
+      pp_act NoInline NeverActive  = empty
+      pp_act _        act          = ppr act
 
       pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
              | otherwise           = empty
diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 774c9199e4..4c41d28671 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -317,7 +317,7 @@ mkDataConIds wrap_name wkr_name data_con
         --      ...(let w = C x in ...(w p q)...)...
         -- we want to see that w is strict in its two arguments
 
-    wrap_unf = mkInlineRule wrap_rhs (Just (length dict_args + length id_args))
+    wrap_unf = mkInlineUnfolding (Just (length dict_args + length id_args)) wrap_rhs
     wrap_rhs = mkLams wrap_tvs $ 
                mkLams eq_args $
                mkLams dict_args $ mkLams id_args $
diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs
index e5cbfc4d43..90d7619649 100644
--- a/compiler/coreSyn/CoreFVs.lhs
+++ b/compiler/coreSyn/CoreFVs.lhs
@@ -422,7 +422,7 @@ idUnfoldingVars :: Id -> VarSet
 idUnfoldingVars id
   = case realIdUnfolding id of
       CoreUnfolding { uf_tmpl = rhs, uf_src = src }
-      		             | isInlineRuleSource src
+      		             | isStableSource src
 	                     -> exprFreeVars rhs
       DFunUnfolding _ _ args -> exprsFreeVars args
       _                      -> emptyVarSet
diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs
index 4f92b1a001..7ca5a6787b 100644
--- a/compiler/coreSyn/CoreSubst.lhs
+++ b/compiler/coreSyn/CoreSubst.lhs
@@ -555,9 +555,9 @@ substUnfolding subst (DFunUnfolding ar con args)
 
 substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_src = src })
 	-- Retain an InlineRule!
-  | not (isInlineRuleSource src)  -- Always zap a CoreUnfolding, to save substitution work
+  | not (isStableSource src)  -- Zap an unstable unfolding, to save substitution work
   = NoUnfolding
-  | otherwise                     -- But keep an InlineRule!
+  | otherwise                 -- But keep a stable one!
   = seqExpr new_tmpl `seq` 
     new_src `seq`
     unf { uf_tmpl = new_tmpl, uf_src = new_src }
@@ -576,7 +576,7 @@ substUnfoldingSource (Subst in_scope ids _) (InlineWrapper wkr)
       _other -> -- WARN( True, text "Interesting! CoreSubst.substWorker1:" <+> ppr wkr 
                 --             <+> ifPprDebug (equals <+> ppr wkr_expr) )   
 			      -- Note [Worker inlining]
-                InlineRule    -- It's not a wrapper any more, but still inline it!
+                InlineStable  -- It's not a wrapper any more, but still inline it!
 
   | Just w1  <- lookupInScope in_scope wkr = InlineWrapper w1
   | otherwise = -- WARN( True, text "Interesting! CoreSubst.substWorker2:" <+> ppr wkr )
@@ -584,7 +584,7 @@ substUnfoldingSource (Subst in_scope ids _) (InlineWrapper wkr)
 		-- dropped as dead code, because we don't treat the UnfoldingSource
 		-- as an "occurrence".
                 -- Note [Worker inlining]
-      	        InlineRule
+      	        InlineStable
 
 substUnfoldingSource _ src = src
 
diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index e09e4f29d3..05cc575f97 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -48,8 +48,9 @@ module CoreSyn (
 	maybeUnfoldingTemplate, otherCons, unfoldingArity,
 	isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
         isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
-	isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding, 
-	isStableUnfolding, canUnfold, neverUnfoldGuidance, isInlineRuleSource,
+	isStableUnfolding, isStableUnfolding_maybe, 
+        isClosedUnfolding, hasSomeUnfolding, 
+	canUnfold, neverUnfoldGuidance, isStableSource,
 
 	-- * Strictness
 	seqExpr, seqExprs, seqUnfolding, 
@@ -433,17 +434,20 @@ data Unfolding
 			-- They are usually variables, but can be trivial expressions
 			-- instead (e.g. a type application).  
 
-  | 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.)
+  | 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; occurrence info is correct
 	uf_src        :: UnfoldingSource, -- Where the unfolding came from
 	uf_is_top     :: Bool,		-- True <=> top level binding
 	uf_arity      :: Arity,		-- Number of value arguments expected
-	uf_is_value   :: Bool,		-- exprIsHNF template (cached); it is ok to discard a `seq` on
-		      			--	this variable
-        uf_is_conlike :: Bool,          -- True <=> application of constructor or CONLIKE function
+	uf_is_value   :: Bool,		-- exprIsHNF template (cached); it is ok to discard 
+		      			--	a `seq` on this variable
+        uf_is_conlike :: Bool,          -- True <=> applicn of constructor or CONLIKE function
                                         --      Cached version of exprIsConLike
-	uf_is_cheap   :: Bool,		-- True <=> doesn't waste (much) work to expand inside an inlining
+	uf_is_cheap   :: Bool,		-- True <=> doesn't waste (much) work to expand 
+                                        --          inside an inlining
 					-- 	Cached version of exprIsCheap
 	uf_expandable :: Bool,		-- True <=> can expand in RULE matching
 		      	 		--      Cached version of exprIsExpandable
@@ -467,13 +471,18 @@ data Unfolding
 
 ------------------------------------------------
 data UnfoldingSource 
-  = InlineCompulsory   -- Something that *has* no binding, so you *must* inline it
+  = InlineRhs          -- The current rhs of the function
+    		       -- Replace uf_tmpl each time around
+
+  | InlineStable       -- From an INLINE or INLINABLE pragma 
+    		       -- Do not replace uf_tmpl; instead, keep it unchanged
+    		       -- See Note [InlineRules]
+
+  | InlineCompulsory   -- Something that *has* no binding, so you *must* inline it
     		       -- Only a few primop-like things have this property 
                        -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
                        -- Inline absolutely always, however boring the context.
 
-  | InlineRule	       -- From an {-# INLINE #-} pragma; See Note [InlineRules]
-
   | InlineWrapper Id   -- This unfolding is a the wrapper in a 
 		       --     worker/wrapper split from the strictness analyser
 	               -- The Id is the worker-id
@@ -481,10 +490,6 @@ data UnfoldingSource
 		       --	which don't need to contain the RHS; 
 		       --	it can be derived from the strictness info
 
-  | InlineRhs          -- The current rhs of the function
-
-   -- For InlineRhs, the uf_tmpl is replaced each time around
-   -- For all the others we leave uf_tmpl alone
 
 
 -- | 'UnfoldingGuidance' says when unfolding should take place
@@ -579,11 +584,12 @@ seqGuidance _                      = ()
 \end{code}
 
 \begin{code}
-isInlineRuleSource :: UnfoldingSource -> Bool
-isInlineRuleSource InlineCompulsory   = True
-isInlineRuleSource InlineRule         = True
-isInlineRuleSource (InlineWrapper {}) = True
-isInlineRuleSource InlineRhs          = False
+isStableSource :: UnfoldingSource -> Bool
+-- Keep the unfolding template
+isStableSource InlineCompulsory   = True
+isStableSource InlineStable       = True
+isStableSource (InlineWrapper {}) = True
+isStableSource InlineRhs          = False
  
 -- | Retrieves the template of an unfolding: panics if none is known
 unfoldingTemplate :: Unfolding -> CoreExpr
@@ -642,19 +648,15 @@ expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
 expandUnfolding_maybe _                                                       = Nothing
 
-isInlineRule :: Unfolding -> Bool
-isInlineRule (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
-isInlineRule _		                      = False
-
-isInlineRule_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
-isInlineRule_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide }) 
-   | isInlineRuleSource src
+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
-isInlineRule_maybe _ = Nothing
+isStableUnfolding_maybe _ = Nothing
 
 isCompulsoryUnfolding :: Unfolding -> Bool
 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
@@ -663,7 +665,7 @@ isCompulsoryUnfolding _                                             = False
 isStableUnfolding :: Unfolding -> Bool
 -- True of unfoldings that should not be overwritten 
 -- by a CoreUnfolding for the RHS of a let-binding
-isStableUnfolding (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
+isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
 isStableUnfolding (DFunUnfolding {})		   = True
 isStableUnfolding _                                = False
 
diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index 24d633085b..18a04455fb 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -19,8 +19,9 @@ module CoreUnfold (
 	Unfolding, UnfoldingGuidance,	-- Abstract types
 
 	noUnfolding, mkImplicitUnfolding, 
-	mkTopUnfolding, mkUnfolding, mkCoreUnfolding,
-	mkInlineRule, mkWwInlineRule,
+        mkUnfolding, mkCoreUnfolding,
+	mkTopUnfolding, mkSimpleUnfolding,
+	mkInlineUnfolding, mkInlinableUnfolding, mkWwInlineRule,
 	mkCompulsoryUnfolding, mkDFunUnfolding,
 
 	interestingArg, ArgSummary(..),
@@ -44,7 +45,7 @@ import TcType	 	( tcSplitSigmaTy, tcSplitDFunHead )
 import OccurAnal
 import CoreSubst hiding( substTy )
 import CoreFVs         ( exprFreeVars )
-import CoreArity       ( manifestArity )
+import CoreArity       ( manifestArity, exprBotStrictness_maybe )
 import CoreUtils
 import Id
 import DataCon
@@ -63,7 +64,7 @@ import Util
 import FastTypes
 import FastString
 import Outputable
-
+import Data.Maybe
 \end{code}
 
 
@@ -75,8 +76,7 @@ import Outputable
 
 \begin{code}
 mkTopUnfolding :: Bool -> CoreExpr -> Unfolding
-mkTopUnfolding is_bottoming expr 
-  = mkUnfolding True {- Top level -} is_bottoming expr
+mkTopUnfolding = mkUnfolding InlineRhs True {- Top level -}
 
 mkImplicitUnfolding :: CoreExpr -> Unfolding
 -- For implicit Ids, do a tiny bit of optimising first
@@ -88,44 +88,8 @@ mkImplicitUnfolding expr = mkTopUnfolding False (simpleOptExpr expr)
 -- top-level flag to True.  It gets set more accurately by the simplifier
 -- Simplify.simplUnfolding.
 
-mkUnfolding :: Bool -> Bool -> CoreExpr -> Unfolding
-mkUnfolding top_lvl is_bottoming expr
-  = CoreUnfolding { uf_tmpl   	  = occurAnalyseExpr expr,
-    		    uf_src        = InlineRhs,
-    		    uf_arity      = arity,
-		    uf_is_top 	  = top_lvl,
-		    uf_is_value   = exprIsHNF        expr,
-                    uf_is_conlike = exprIsConLike    expr,
-		    uf_expandable = exprIsExpandable expr,
-		    uf_is_cheap   = is_cheap,
-		    uf_guidance   = guidance }
-  where
-    is_cheap = exprIsCheap expr
-    (arity, guidance) = calcUnfoldingGuidance is_cheap (top_lvl && is_bottoming) 
-                                              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
-	-- Nevertheless, we *don't* occ-analyse before computing the size because the
-	-- size computation bales out after a while, whereas occurrence analysis does not.
-	--
-	-- This can occasionally mean that the guidance is very pessimistic;
-	-- it gets fixed up next round.  And it should be rare, because large
-	-- let-bound things that are dead are usually caught by preInlineUnconditionally
-
-mkCoreUnfolding :: Bool -> UnfoldingSource -> CoreExpr
-                -> Arity -> UnfoldingGuidance -> Unfolding
--- Occurrence-analyses the expression before capturing it
-mkCoreUnfolding top_lvl src expr arity guidance 
-  = CoreUnfolding { uf_tmpl   	  = occurAnalyseExpr expr,
-    		    uf_src        = src,
-    		    uf_arity      = arity,
-		    uf_is_top 	  = top_lvl,
-		    uf_is_value   = exprIsHNF        expr,
-                    uf_is_conlike = exprIsConLike    expr,
-		    uf_is_cheap   = exprIsCheap      expr,
-		    uf_expandable = exprIsExpandable expr,
-		    uf_guidance   = guidance }
+mkSimpleUnfolding :: CoreExpr -> Unfolding
+mkSimpleUnfolding = mkUnfolding InlineRhs False False
 
 mkDFunUnfolding :: Type -> [CoreExpr] -> Unfolding
 mkDFunUnfolding dfun_ty ops 
@@ -150,10 +114,11 @@ mkCompulsoryUnfolding expr	   -- Used for things that absolutely must be unfolde
                     expr 0    -- Arity of unfolding doesn't matter
                     (UnfWhen unSaturatedOk boringCxtOk)
 
-mkInlineRule :: CoreExpr -> Maybe Arity -> Unfolding
-mkInlineRule expr mb_arity 
-  = mkCoreUnfolding True InlineRule 	 -- Note [Top-level flag on inline rules]
-    		    expr' arity 
+mkInlineUnfolding :: Maybe Arity -> CoreExpr -> Unfolding
+mkInlineUnfolding mb_arity expr 
+  = mkCoreUnfolding True 	 -- Note [Top-level flag on inline rules]
+    		    InlineStable
+                    expr' arity 
 		    (UnfWhen unsat_ok boring_ok)
   where
     expr' = simpleOptExpr expr
@@ -167,8 +132,58 @@ mkInlineRule expr mb_arity
               	  (_, UnfWhen _ boring_ok) -> boring_ok
               	  _other                   -> boringCxtNotOk
      -- See Note [INLINE for small functions]
+
+mkInlinableUnfolding :: CoreExpr -> Unfolding
+mkInlinableUnfolding expr
+  = mkUnfolding InlineStable True is_bot expr
+  where
+    is_bot = isJust (exprBotStrictness_maybe expr)
 \end{code}
 
+Internal functions
+
+\begin{code}
+mkCoreUnfolding :: Bool -> UnfoldingSource -> CoreExpr
+                -> Arity -> UnfoldingGuidance -> Unfolding
+-- Occurrence-analyses the expression before capturing it
+mkCoreUnfolding top_lvl src expr arity guidance 
+  = CoreUnfolding { uf_tmpl   	  = occurAnalyseExpr expr,
+    		    uf_src        = src,
+    		    uf_arity      = arity,
+		    uf_is_top 	  = top_lvl,
+		    uf_is_value   = exprIsHNF        expr,
+                    uf_is_conlike = exprIsConLike    expr,
+		    uf_is_cheap   = exprIsCheap      expr,
+		    uf_expandable = exprIsExpandable expr,
+		    uf_guidance   = guidance }
+
+mkUnfolding :: UnfoldingSource -> Bool -> Bool -> CoreExpr -> Unfolding
+-- Calculates unfolding guidance
+-- Occurrence-analyses the expression before capturing it
+mkUnfolding src top_lvl is_bottoming expr
+  = CoreUnfolding { uf_tmpl   	  = occurAnalyseExpr expr,
+    		    uf_src        = src,
+    		    uf_arity      = arity,
+		    uf_is_top 	  = top_lvl,
+		    uf_is_value   = exprIsHNF        expr,
+                    uf_is_conlike = exprIsConLike    expr,
+		    uf_expandable = exprIsExpandable expr,
+		    uf_is_cheap   = is_cheap,
+		    uf_guidance   = guidance }
+  where
+    is_cheap = exprIsCheap expr
+    (arity, guidance) = calcUnfoldingGuidance is_cheap (top_lvl && is_bottoming) 
+                                              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
+	-- Nevertheless, we *don't* occ-analyse before computing the size because the
+	-- size computation bales out after a while, whereas occurrence analysis does not.
+	--
+	-- This can occasionally mean that the guidance is very pessimistic;
+	-- it gets fixed up next round.  And it should be rare, because large
+	-- let-bound things that are dead are usually caught by preInlineUnconditionally
+\end{code}
 
 %************************************************************************
 %*									*
diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index 1908667e14..3752d1d5bd 100644
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -382,7 +382,7 @@ instance Outputable UnfoldingGuidance where
 instance Outputable UnfoldingSource where
   ppr InlineCompulsory  = ptext (sLit "Compulsory")
   ppr (InlineWrapper w) = ptext (sLit "Worker=") <> ppr w
-  ppr InlineRule        = ptext (sLit "InlineRule")
+  ppr InlineStable      = ptext (sLit "InlineStable")
   ppr InlineRhs         = ptext (sLit "<vanilla>")
 
 instance Outputable Unfolding where
@@ -407,8 +407,8 @@ instance Outputable Unfolding where
                 , ptext (sLit "Expandable=") <> ppr exp
                 , ptext (sLit "Guidance=")   <> ppr g ]
       pp_tmpl = ptext (sLit "Tmpl=") <+> ppr rhs
-      pp_rhs | isInlineRuleSource src = pp_tmpl
-             | otherwise              = empty
+      pp_rhs | isStableSource src = pp_tmpl
+             | otherwise          = empty
             -- Don't print the RHS or we get a quadratic 
 	    -- blowup in the size of the printout!
 \end{code}
diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index c886c8ef6b..17333af2d6 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -355,21 +355,29 @@ makeCorePair gbl_id is_default_method dict_arity rhs
   | is_default_method		      -- Default methods are *always* inlined
   = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding rhs, rhs)
 
-  | not (isInlinePragma inline_prag)
-  = (gbl_id, rhs)
+  | otherwise
+  = case inlinePragmaSpec inline_prag of
+      	  EmptyInlineSpec -> (gbl_id, rhs)
+      	  NoInline        -> (gbl_id, rhs)
+      	  Inlinable       -> (gbl_id `setIdUnfolding` inlinable_unf, rhs)
+          Inline          -> inline_pair
 
-  | Just arity <- inlinePragmaSat inline_prag
+  where
+    inline_prag   = idInlinePragma gbl_id
+    inlinable_unf = mkInlinableUnfolding rhs
+    inline_pair
+       | Just arity <- inlinePragmaSat inline_prag
       	-- Add an Unfolding for an INLINE (but not for NOINLINE)
 	-- And eta-expand the RHS; see Note [Eta-expanding INLINE things]
-  , let real_arity = dict_arity + arity
+       , let real_arity = dict_arity + arity
         -- NB: The arity in the InlineRule takes account of the dictionaries
-  = (gbl_id `setIdUnfolding` mkInlineRule rhs (Just real_arity),
-     etaExpand real_arity rhs)
+       = ( gbl_id `setIdUnfolding` mkInlineUnfolding (Just real_arity) rhs
+         , etaExpand real_arity rhs)
+
+       | otherwise
+       = pprTrace "makeCorePair: arity missing" (ppr gbl_id) $
+         (gbl_id `setIdUnfolding` mkInlineUnfolding Nothing rhs, rhs)
 
-  | otherwise
-  = (gbl_id `setIdUnfolding` mkInlineRule rhs Nothing, rhs)
-  where
-    inline_prag = idInlinePragma gbl_id
 
 dictArity :: [Var] -> Arity
 -- Don't count coercion variables in arity
diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index 51f03c2f8f..d73cd53044 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -207,7 +207,7 @@ dsFCall fn_id fcall = do
         work_app     = mkApps (mkVarApps (Var work_id) tvs) val_args
         wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers
         wrap_rhs     = mkLams (tvs ++ args) wrapper_body
-        fn_id_w_inl  = fn_id `setIdUnfolding` mkInlineRule wrap_rhs (Just (length args))
+        fn_id_w_inl  = fn_id `setIdUnfolding` mkInlineUnfolding (Just (length args)) wrap_rhs
     
     return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs)], empty, empty)
 \end{code}
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 3310ffa4c2..b24daea781 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -460,15 +460,17 @@ rep_specialise nm ty ispec loc
 rep_InlinePrag :: InlinePragma	-- Never defaultInlinePragma
                -> DsM (Core TH.InlineSpecQ)
 rep_InlinePrag (InlinePragma { inl_act = activation, inl_rule = match, inl_inline = inline })
-  | Nothing            <- activation1 
-    = repInlineSpecNoPhase inline1 match1
   | Just (flag, phase) <- activation1 
-    = repInlineSpecPhase inline1 match1 flag phase
-  | otherwise = {- unreachable, but shuts up -W -} panic "rep_InlineSpec"
-    where
+  = repInlineSpecPhase inline1 match1 flag phase
+  | otherwise
+  = repInlineSpecNoPhase inline1 match1
+  where
       match1      = coreBool (rep_RuleMatchInfo match)
       activation1 = rep_Activation activation
-      inline1     = coreBool inline
+      inline1     = case inline of 
+                       Inline -> coreBool True
+ 		       _other -> coreBool False
+		       -- We have no representation for Inlinable
 
       rep_RuleMatchInfo FunLike = False
       rep_RuleMatchInfo ConLike = True
diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index d392be24e3..0ab26eede8 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -400,7 +400,7 @@ cvtInlineSpec Nothing
   = defaultInlinePragma
 cvtInlineSpec (Just (TH.InlineSpec inline conlike opt_activation)) 
   = InlinePragma { inl_act = opt_activation', inl_rule = matchinfo
-                 , inl_inline = inline, inl_sat = Nothing }
+                 , inl_inline = inl_spec, inl_sat = Nothing }
   where
     matchinfo       = cvtRuleMatchInfo conlike
     opt_activation' = cvtActivation opt_activation
@@ -408,6 +408,10 @@ cvtInlineSpec (Just (TH.InlineSpec inline conlike opt_activation))
     cvtRuleMatchInfo False = FunLike
     cvtRuleMatchInfo True  = ConLike
 
+    inl_spec | inline    = Inline
+             | otherwise = NoInline
+ 	     -- Currently we have no way to say Inlinable
+
     cvtActivation Nothing | inline      = AlwaysActive
                           | otherwise   = NeverActive
     cvtActivation (Just (False, phase)) = ActiveBefore phase
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 4d3f619b4f..ec85995b45 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -612,6 +612,19 @@ instance Binary InlinePragma where
            d <- get bh
            return (InlinePragma a b c d)
 
+instance Binary InlineSpec where
+    put_ bh EmptyInlineSpec = putByte bh 0
+    put_ bh Inline          = putByte bh 1
+    put_ bh Inlinable       = putByte bh 2
+    put_ bh NoInline        = putByte bh 3
+
+    get bh = do h <- getByte bh
+                case h of
+                  0 -> return EmptyInlineSpec
+                  1 -> return Inline
+                  2 -> return Inlinable
+                  _ -> return NoInline
+
 instance Binary HsBang where
     put_ bh HsNoBang        = putByte bh 0
     put_ bh HsStrict        = putByte bh 1
@@ -1188,8 +1201,9 @@ instance Binary IfaceInfoItem where
 	      _ -> do return HsNoCafRefs
 
 instance Binary IfaceUnfolding where
-    put_ bh (IfCoreUnfold e) = do
+    put_ bh (IfCoreUnfold s e) = do
 	putByte bh 0
+	put_ bh s
 	put_ bh e
     put_ bh (IfInlineRule a b c d) = do
 	putByte bh 1
@@ -1210,8 +1224,9 @@ instance Binary IfaceUnfolding where
     get bh = do
 	h <- getByte bh
 	case h of
-	  0 -> do e <- get bh
-		  return (IfCoreUnfold e)
+	  0 -> do s <- get bh
+		  e <- get bh
+		  return (IfCoreUnfold s e)
 	  1 -> do a <- get bh
 		  b <- get bh
 		  c <- get bh
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 282752b0e4..c8348cb6cd 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -210,7 +210,8 @@ data IfaceInfoItem
 -- only later attached to the Id.  Partial reason: some are orphans.
 
 data IfaceUnfolding 
-  = IfCoreUnfold IfaceExpr
+  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
+
   | IfCompulsory IfaceExpr	-- Only used for default methods, in fact
 
   | IfInlineRule Arity 
@@ -688,11 +689,13 @@ instance Outputable IfaceInfoItem where
 
 instance Outputable IfaceUnfolding where
   ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
-  ppr (IfCoreUnfold e)     = parens (ppr e)
+  ppr (IfCoreUnfold s e)   = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
   ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
       		           	        pprParendIfaceExpr e]
-  ppr (IfWrapper a wkr)    = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
-  ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:") <+> brackets (pprWithCommas pprParendIfaceExpr ns)
+  ppr (IfWrapper a wkr)    = ptext (sLit "Worker:") <+> ppr wkr
+                             <+> parens (ptext (sLit "arity") <+> int a)
+  ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:")
+                             <+> brackets (pprWithCommas pprParendIfaceExpr ns)
 
 
 -- -----------------------------------------------------------------------------
@@ -810,7 +813,7 @@ freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
 freeNamesItem _              = emptyNameSet
 
 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
-freeNamesIfUnfold (IfCoreUnfold e)       = freeNamesIfExpr e
+freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
 freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 freeNamesIfUnfold (IfWrapper _ v)        = unitNameSet v
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 68c6cf16a6..fd8fbdb5ae 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1535,21 +1535,23 @@ toIfaceIdInfo id_info
 
 --------------------------
 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
-toIfUnfolding lb unf@(CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
-                                    , uf_src = src, uf_guidance = guidance })
+toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
+                                , uf_src = src, uf_guidance = guidance })
   = Just $ HsUnfold lb $
     case src of
-	InlineRule {}
+	InlineStable
           -> case guidance of
-               UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok (toIfaceExpr rhs)
-               _other                     -> pprPanic "toIfUnfolding" (ppr unf)
+               UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok if_rhs
+               _other                     -> IfCoreUnfold True if_rhs
 	InlineWrapper w  -> IfWrapper arity (idName w)
-        InlineCompulsory -> IfCompulsory (toIfaceExpr rhs)
-        InlineRhs        -> IfCoreUnfold (toIfaceExpr rhs)
+        InlineCompulsory -> IfCompulsory if_rhs
+        InlineRhs        -> IfCoreUnfold False if_rhs
 	-- Yes, even if guidance is UnfNever, expose the unfolding
 	-- If we didn't want to expose the unfolding, TidyPgm would
 	-- have stuck in NoUnfolding.  For supercompilation we want 
 	-- to see that unfolding!
+  where
+    if_rhs = toIfaceExpr rhs
 
 toIfUnfolding lb (DFunUnfolding _ar _con ops)
   = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index fde31465ab..07b0b72bfa 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -1008,11 +1008,14 @@ tcIdInfo ignore_prags name ty info
 
 \begin{code}
 tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
-tcUnfolding name _ info (IfCoreUnfold if_expr)
+tcUnfolding name _ info (IfCoreUnfold stable if_expr)
   = do 	{ mb_expr <- tcPragExpr name if_expr
+        ; let unf_src = if stable then InlineStable else InlineRhs
 	; return (case mb_expr of
-		    Nothing -> NoUnfolding
-		    Just expr -> mkTopUnfolding is_bottoming expr) }
+		    Nothing   -> NoUnfolding
+		    Just expr -> mkUnfolding unf_src
+                                             True {- Top level -} 
+                                             is_bottoming expr) }
   where
      -- Strictness should occur before unfolding!
     is_bottoming = case strictnessInfo info of
@@ -1029,7 +1032,7 @@ tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
   = do 	{ mb_expr <- tcPragExpr name if_expr
 	; return (case mb_expr of
 		    Nothing   -> NoUnfolding
-		    Just expr -> mkCoreUnfolding True InlineRule expr arity 
+		    Just expr -> mkCoreUnfolding True InlineStable expr arity 
                                                  (UnfWhen unsat_ok boring_ok))
     }
 
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 8ce4dcda5c..7d045632ba 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -725,7 +725,7 @@ addExternal expose_all id = (new_needed_ids, show_unfold)
        =  expose_all 	     -- 'expose_all' says to expose all 
 			     -- unfoldings willy-nilly
 
-       || isInlineRuleSource unf_source	     -- Always expose things whose 
+       || isStableSource unf_source	     -- Always expose things whose 
        	  		     		     -- source is an inline rule
 
        || not (bottoming_fn	 -- No need to inline bottom functions
@@ -1098,7 +1098,7 @@ tidyUnfolding tidy_env _ _ (DFunUnfolding ar con ids)
   = DFunUnfolding ar con (map (tidyExpr tidy_env) ids)
 tidyUnfolding tidy_env tidy_rhs strict_sig
               unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
-  | isInlineRuleSource src
+  | isStableSource src
   = unf { uf_tmpl = tidyExpr tidy_env unf_rhs, 	   -- Preserves OccInfo
 	  uf_src  = tidyInl tidy_env src }
   | otherwise
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index cadd56d17d..0fa3256f69 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -66,6 +66,7 @@ import UniqFM
 import DynFlags
 import Module
 import Ctype
+import BasicTypes	( InlineSpec(..), RuleMatchInfo(..) )
 import Util		( readRational )
 
 import Control.Monad
@@ -462,8 +463,7 @@ data Token
   | ITusing
 
 	-- Pragmas
-  | ITinline_prag Bool		-- True <=> INLINE, False <=> NOINLINE
-  | ITinline_conlike_prag Bool  -- same
+  | ITinline_prag InlineSpec RuleMatchInfo
   | ITspec_prag			-- SPECIALISE	
   | ITspec_inline_prag Bool	-- SPECIALISE INLINE (or NOINLINE)
   | ITsource_prag
@@ -2216,8 +2216,9 @@ ignoredPrags = Map.fromList (map ignored pragmas)
                      pragmas = options_pragmas ++ ["cfiles", "contract"]
 
 oneWordPrags = Map.fromList([("rules", rulePrag),
-                           ("inline", token (ITinline_prag True)),
-                           ("notinline", token (ITinline_prag False)),
+                           ("inline", token (ITinline_prag Inline FunLike)),
+                           ("inlinable", token (ITinline_prag Inlinable FunLike)),
+                           ("notinline", token (ITinline_prag NoInline FunLike)),
                            ("specialize", token ITspec_prag),
                            ("source", token ITsource_prag),
                            ("warning", token ITwarning_prag),
@@ -2228,8 +2229,8 @@ oneWordPrags = Map.fromList([("rules", rulePrag),
                            ("unpack", token ITunpack_prag),
                            ("ann", token ITann_prag)])
 
-twoWordPrags = Map.fromList([("inline conlike", token (ITinline_conlike_prag True)),
-                             ("notinline conlike", token (ITinline_conlike_prag False)),
+twoWordPrags = Map.fromList([("inline conlike", token (ITinline_prag Inline ConLike)),
+                             ("notinline conlike", token (ITinline_prag NoInline ConLike)),
                              ("specialize inline", token (ITspec_inline_prag True)),
                              ("specialize notinline", token (ITspec_inline_prag False))])
 
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index e78b1cab6a..7ab7c447b2 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -56,8 +56,7 @@ import StaticFlags	( opt_SccProfilingOn, opt_Hpc )
 import Type		( Kind, liftedTypeKind, unliftedTypeKind )
 import Coercion		( mkArrowKind )
 import Class		( FunDep )
-import BasicTypes	( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
-			  Activation(..), RuleMatchInfo(..), defaultInlinePragma )
+import BasicTypes
 import DynFlags
 import OrdList
 import HaddockUtils
@@ -261,8 +260,7 @@ incorrect.
  'by'       { L _ ITby }        -- for list transform extension
  'using'    { L _ ITusing }     -- for list transform extension
 
- '{-# INLINE'      	  { L _ (ITinline_prag _) }
- '{-# INLINE_CONLIKE'     { L _ (ITinline_conlike_prag _) }
+ '{-# INLINE'      	  { L _ (ITinline_prag _ _) }
  '{-# SPECIALISE'  	  { L _ ITspec_prag }
  '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _) }
  '{-# SOURCE'	   { L _ ITsource_prag }
@@ -1238,14 +1236,12 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
 	| infix prec ops	{ LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
 					     | n <- unLoc $3 ] }
 	| '{-# INLINE'   activation qvar '#-}'	      
-		{ LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma $2 FunLike (getINLINE $1)))) }
-        | '{-# INLINE_CONLIKE' activation qvar '#-}'
-                { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma $2 ConLike (getINLINE_CONLIKE $1)))) }
+		{ LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma (getINLINE $1) $2))) }
 	| '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
 		{ LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlinePragma) 
 					    | t <- $4] }
 	| '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
-		{ LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlinePragma $2 FunLike (getSPEC_INLINE $1)))
+		{ LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlinePragma (getSPEC_INLINE $1) $2))
 					    | t <- $5] }
 	| '{-# SPECIALISE' 'instance' inst_type '#-}'
 		{ LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
@@ -1988,9 +1984,9 @@ getPRIMWORD	(L _ (ITprimword x)) = x
 getPRIMFLOAT	(L _ (ITprimfloat  x)) = x
 getPRIMDOUBLE	(L _ (ITprimdouble x)) = x
 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
-getINLINE	(L _ (ITinline_prag b)) = b
-getINLINE_CONLIKE (L _ (ITinline_conlike_prag b)) = b
-getSPEC_INLINE	(L _ (ITspec_inline_prag b)) = b
+getINLINE	(L _ (ITinline_prag inl conl)) = (inl,conl)
+getSPEC_INLINE	(L _ (ITspec_inline_prag True))  = (Inline,  FunLike)
+getSPEC_INLINE	(L _ (ITspec_inline_prag False)) = (NoInline,FunLike)
 
 getDOCNEXT (L _ (ITdocCommentNext x)) = x
 getDOCPREV (L _ (ITdocCommentPrev x)) = x
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 7d806ed174..548b111bd4 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -55,7 +55,7 @@ import TypeRep          ( Kind )
 import RdrName		( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc, 
 			  isRdrDataCon, isUnqual, getRdrName, setRdrNameSpace )
 import BasicTypes	( maxPrecedence, Activation(..), RuleMatchInfo,
-                          InlinePragma(..) )
+                          InlinePragma(..), InlineSpec(..) )
 import Lexer
 import TysWiredIn	( unitTyCon ) 
 import ForeignCall
@@ -937,9 +937,9 @@ mk_rec_fields :: [HsRecField id arg] -> Bool -> HsRecFields id arg
 mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
 mk_rec_fields fs True  = HsRecFields { rec_flds = fs, rec_dotdot = Just (length fs) }
 
-mkInlinePragma :: Maybe Activation -> RuleMatchInfo -> Bool -> InlinePragma
+mkInlinePragma :: (InlineSpec, RuleMatchInfo) -> Maybe Activation -> InlinePragma
 -- The Maybe is because the user can omit the activation spec (and usually does)
-mkInlinePragma mb_act match_info inl 
+mkInlinePragma (inl, match_info) mb_act
   = InlinePragma { inl_inline = inl
                  , inl_sat    = Nothing
                  , inl_act    = act
@@ -947,11 +947,10 @@ mkInlinePragma mb_act match_info inl
   where
     act = case mb_act of
             Just act -> act
-            Nothing | inl       -> AlwaysActive
-                    | otherwise -> NeverActive
-        -- If no specific phase is given then:
-	--   NOINLINE => NeverActive
-        --   INLINE   => Active
+            Nothing  -> -- No phase specified
+                        case inl of
+                          NoInline -> NeverActive
+                          _other   -> AlwaysActive
 
 -----------------------------------------------------------------------------
 -- utilities for foreign declarations
diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index a37b5f16bd..3dca9a857d 100644
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -537,7 +537,7 @@ reOrderCycle depth (bind : binds) pairs
         | isDFunId bndr = 9   -- Never choose a DFun as a loop breaker
 	   	     	      -- Note [DFuns should not be loop breakers]
 
-        | Just (inl_source, _) <- isInlineRule_maybe (idUnfolding bndr)
+        | Just (inl_source, _) <- isStableUnfolding_maybe (idUnfolding bndr)
 	= case inl_source of
 	     InlineWrapper {} -> 10  -- Note [INLINE pragmas]
 	     _other	      ->  3  -- Data structures are more important than this
diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index ef0c7f2427..23874bfafc 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -859,7 +859,7 @@ abstractVars dest_lvl (_, lvl_env, _, id_env) fvs
 
 	-- We are going to lambda-abstract, so nuke any IdInfo,
 	-- and add the tyvars of the Id (if necessary)
-    zap v | isId v = WARN( isInlineRule (idUnfolding v) ||
+    zap v | isId v = WARN( isStableUnfolding (idUnfolding v) ||
 		           not (isEmptySpecInfo (idSpecialisation v)),
 		           text "absVarsOf: discarding info on" <+> ppr v )
 		     setIdInfo v vanillaIdInfo
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 0a1fdd2d87..5d8e0a2da0 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -28,8 +28,9 @@ import CoreMonad	( SimplifierSwitch(..), Tick(..) )
 import CoreSyn
 import Demand           ( isStrictDmd, splitStrictSig )
 import PprCore          ( pprParendExpr, pprCoreExpr )
-import CoreUnfold       ( mkUnfolding, mkCoreUnfolding, mkInlineRule, 
-                          exprIsConApp_maybe, callSiteInline, CallCtxt(..) )
+import CoreUnfold       ( mkUnfolding, mkCoreUnfolding
+                        , mkInlineUnfolding, mkSimpleUnfolding
+                        , exprIsConApp_maybe, callSiteInline, CallCtxt(..) )
 import CoreUtils
 import qualified CoreSubst
 import CoreArity	( exprArity )
@@ -713,7 +714,7 @@ simplUnfolding env _ _ _ _ (DFunUnfolding ar con ops)
 simplUnfolding env top_lvl id _ _ 
     (CoreUnfolding { uf_tmpl = expr, uf_arity = arity
                    , uf_src = src, uf_guidance = guide })
-  | isInlineRuleSource src
+  | isStableSource src
   = do { expr' <- simplExpr rule_env expr
        ; let src' = CoreSubst.substUnfoldingSource (mkCoreSubst (text "inline-unf") env) src
        ; return (mkCoreUnfolding (isTopLevel top_lvl) src' expr' arity guide) }
@@ -724,7 +725,7 @@ simplUnfolding env top_lvl id _ _
        	       -- See Note [Simplifying gently inside InlineRules] in SimplUtils
 
 simplUnfolding _ top_lvl id _occ_info new_rhs _
-  = return (mkUnfolding (isTopLevel top_lvl) (isBottomingId id) new_rhs)
+  = return (mkUnfolding InlineRhs (isTopLevel top_lvl) (isBottomingId id) new_rhs)
   -- We make an  unfolding *even for loop-breakers*.
   -- Reason: (a) It might be useful to know that they are WHNF
   -- 	     (b) In TidyPgm we currently assume that, if we want to
@@ -1789,7 +1790,7 @@ simplAlt env _ case_bndr' cont' (DataAlt con, vs, rhs)
 
 addBinderUnfolding :: SimplEnv -> Id -> CoreExpr -> SimplEnv
 addBinderUnfolding env bndr rhs
-  = modifyInScope env (bndr `setIdUnfolding` mkUnfolding False False rhs)
+  = modifyInScope env (bndr `setIdUnfolding` mkSimpleUnfolding rhs)
 
 addBinderOtherCon :: SimplEnv -> Id -> [AltCon] -> SimplEnv
 addBinderOtherCon env bndr cons
@@ -2016,7 +2017,7 @@ mkDupableAlt env case_bndr (con, bndrs', rhs')
 	      	      DataAlt dc -> setIdUnfolding case_bndr unf
 		      	  where
 			     	 -- See Note [Case binders and join points]
-		      	     unf = mkInlineRule rhs Nothing
+		      	     unf = mkInlineUnfolding Nothing rhs
 		      	     rhs = mkConApp dc (map Type (tyConAppArgs scrut_ty)
 			     	   	        ++ varsToCoreExprs bndrs')
 
diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index 2d0b383c1a..47a4f055f5 100644
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -11,7 +11,7 @@ module Specialise ( specProgram ) where
 import Id
 import TcType
 import CoreSubst 
-import CoreUnfold	( mkUnfolding, mkInlineRule )
+import CoreUnfold	( mkSimpleUnfolding, mkInlineUnfolding )
 import VarSet
 import VarEnv
 import CoreSyn
@@ -706,7 +706,7 @@ specCase subst scrut' case_bndr [(con, args, rhs)]
          loc  = getSrcSpan name
 
     add_unf sc_flt sc_rhs  -- Sole purpose: make sc_flt respond True to interestingDictId
-      = setIdUnfolding sc_flt (mkUnfolding False False sc_rhs)
+      = setIdUnfolding sc_flt (mkSimpleUnfolding sc_rhs)
 
     arg_set = mkVarSet args'
     is_flt_sc_arg var =  isId var
@@ -908,7 +908,7 @@ specDefn subst body_uds fn rhs
 	-- Figure out whether the function has an INLINE pragma
 	-- See Note [Inline specialisations]
     fn_has_inline_rule :: Maybe Bool	-- Derive sat-flag from existing thing
-    fn_has_inline_rule = case isInlineRule_maybe fn_unf of
+    fn_has_inline_rule = case isStableUnfolding_maybe fn_unf of
                            Just (_,sat) -> Just sat
 			   Nothing      -> Nothing
 
@@ -1015,7 +1015,7 @@ specDefn subst body_uds fn rhs
 		  = let 
                        mb_spec_arity = if sat then Just spec_arity else Nothing
                     in 
-                    spec_f_w_arity `setIdUnfolding` mkInlineRule spec_rhs mb_spec_arity
+                    spec_f_w_arity `setIdUnfolding` mkInlineUnfolding mb_spec_arity spec_rhs
 		  | otherwise 
 		  = spec_f_w_arity
 
@@ -1048,7 +1048,7 @@ bindAuxiliaryDicts subst triples = go subst [] triples
 
       | otherwise        = go subst_w_unf (NonRec dx_id dx : binds) pairs
       where
-        dx_id1 = dx_id `setIdUnfolding` mkUnfolding False False dx
+        dx_id1 = dx_id `setIdUnfolding` mkSimpleUnfolding dx
 	subst_w_unf = extendIdSubst subst d (Var dx_id1)
        	     -- Important!  We're going to substitute dx_id1 for d
 	     -- and we want it to look "interesting", else we won't gather *any*
diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index 7a56c33289..d329b5a078 100644
--- a/compiler/stranal/WorkWrap.lhs
+++ b/compiler/stranal/WorkWrap.lhs
@@ -7,20 +7,16 @@
 module WorkWrap ( wwTopBinds, mkWrapper ) where
 
 import CoreSyn
-import CoreUnfold	( certainlyWillInline, mkInlineRule, mkWwInlineRule )
+import CoreUnfold	( certainlyWillInline, mkInlineUnfolding, mkWwInlineRule )
 import CoreUtils	( exprType, exprIsHNF )
 import CoreArity	( exprArity )
 import Var
 import Id
 import Type		( Type )
 import IdInfo
-import Demand           ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..), 
-			  Demands(..), mkTopDmdType, isBotRes, returnsCPR, topSig, isAbsent
-			)
+import Demand
 import UniqSupply
-import BasicTypes	( RecFlag(..), isNonRec, isNeverActive,
-                          Activation(..), InlinePragma(..), 
-			  inlinePragmaActivation, inlinePragmaRuleMatchInfo )
+import BasicTypes
 import VarEnv		( isEmptyVarEnv )
 import Maybes		( orElse )
 import WwLib
@@ -276,7 +272,7 @@ checkSize fn_id rhs thing_inside
   | otherwise = thing_inside
   where
     unfolding   = idUnfolding fn_id
-    inline_rule = mkInlineRule rhs Nothing
+    inline_rule = mkInlineUnfolding Nothing rhs
 
 ---------------------
 splitFun :: Id -> IdInfo -> [Demand] -> DmdResult -> Expr Var
@@ -314,7 +310,7 @@ splitFun fn_id fn_info wrap_dmds res_info rhs
                                 -- arity is consistent with the demand type goes through
 
 	wrap_rhs  = wrap_fn work_id
-	wrap_prag = InlinePragma { inl_inline = True
+	wrap_prag = InlinePragma { inl_inline = Inline
                                  , inl_sat    = Nothing
                                  , inl_act    = ActiveAfter 0
                                  , inl_rule   = rule_match_info }
diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index a296e89fe0..8e048333eb 100644
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -15,7 +15,7 @@ import Vectorise.Monad
 import HscTypes hiding      ( MonadThings(..) )
 import Module               ( PackageId )
 import CoreSyn
-import CoreUnfold           ( mkInlineRule )
+import CoreUnfold           ( mkInlineUnfolding )
 import CoreFVs
 import CoreMonad            ( CoreM, getHscEnv )
 import FamInstEnv           ( extendFamInstEnvList )
@@ -177,7 +177,7 @@ vectTopBinder var inline expr
       return var'
   where
     unfolding = case inline of
-                  Inline arity -> mkInlineRule expr (Just arity)
+                  Inline arity -> mkInlineUnfolding (Just arity) expr
                   DontInline   -> noUnfolding
 
 
diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs
index 7831c93e6b..42efe37f96 100644
--- a/compiler/vectorise/Vectorise/Exp.hs
+++ b/compiler/vectorise/Vectorise/Exp.hs
@@ -22,7 +22,7 @@ import Var
 import VarEnv
 import VarSet
 import Id
-import BasicTypes
+import BasicTypes( isLoopBreaker )
 import Literal
 import TysWiredIn
 import TysPrim
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index 8e26ed9788..06bd789027 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -182,7 +182,7 @@ vectDataConWorkers orig_tc vect_tc arr_tc
 
           raw_worker <- cloneId mkVectOcc orig_worker (exprType body)
           let vect_worker = raw_worker `setIdUnfolding`
-                              mkInlineRule body (Just arity)
+                              mkInlineUnfolding (Just arity) body
           defGlobalVar orig_worker vect_worker
           return (vect_worker, body)
       where
diff --git a/compiler/vectorise/Vectorise/Type/PADict.hs b/compiler/vectorise/Vectorise/Type/PADict.hs
index ef5c8d58c9..d3d2213e67 100644
--- a/compiler/vectorise/Vectorise/Type/PADict.hs
+++ b/compiler/vectorise/Vectorise/Type/PADict.hs
@@ -56,7 +56,7 @@ buildPADict vect_tc prepr_tc arr_tc repr
           let body = mkLams (tvs ++ args) expr
           raw_var <- newExportedVar (method_name name) (exprType body)
           let var = raw_var
-                      `setIdUnfolding` mkInlineRule body (Just (length args))
+                      `setIdUnfolding` mkInlineUnfolding (Just (length args)) body
                       `setInlinePragma` alwaysInlinePragma
           hoistBinding var body
           return var
diff --git a/compiler/vectorise/Vectorise/Utils/Closure.hs b/compiler/vectorise/Vectorise/Utils/Closure.hs
index b70ecb4584..6b8688c7d9 100644
--- a/compiler/vectorise/Vectorise/Utils/Closure.hs
+++ b/compiler/vectorise/Vectorise/Utils/Closure.hs
@@ -24,7 +24,7 @@ import TyCon
 import DataCon
 import MkId
 import TysWiredIn
-import BasicTypes
+import BasicTypes( Boxity(..) )
 import FastString
 
 
diff --git a/compiler/vectorise/Vectorise/Utils/Hoisting.hs b/compiler/vectorise/Vectorise/Utils/Hoisting.hs
index 9cce4161d2..12b1b6fe4f 100644
--- a/compiler/vectorise/Vectorise/Utils/Hoisting.hs
+++ b/compiler/vectorise/Vectorise/Utils/Hoisting.hs
@@ -22,7 +22,7 @@ import CoreUnfold
 import Type
 import Var
 import Id
-import BasicTypes
+import BasicTypes( Arity )
 import FastString
 import Control.Monad
 
@@ -58,7 +58,7 @@ hoistExpr fs expr inl
   where
     mk_inline var = case inl of
                       Inline arity -> var `setIdUnfolding`
-                                      mkInlineRule expr (Just arity)
+                                      mkInlineUnfolding (Just arity) expr
                       DontInline   -> var