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.

4 files changed, 88 insertions, 77 deletions

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 9926b95d24..2ee8310f9e 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -1124,10 +1124,6 @@ instance Binary IfaceInfoItem where
 	    put_ bh ad
     put_ bh HsNoCafRefs = do
 	    putByte bh 4
-    put_ bh (HsWorker ae af) = do
-	    putByte bh 5
-	    put_ bh ae
-	    put_ bh af
     get bh = do
 	    h <- getByte bh
 	    case h of
@@ -1139,17 +1135,36 @@ instance Binary IfaceInfoItem where
 		      return (HsUnfold ad)
 	      3 -> do ad <- get bh
 		      return (HsInline ad)
-	      4 -> do return HsNoCafRefs
-	      _ -> do ae <- get bh
-		      af <- get bh
-		      return (HsWorker ae af)
+	      _ -> do return HsNoCafRefs
+
+instance Binary IfaceUnfolding where
+    put_ bh (IfCoreUnfold e) = do
+	putByte bh 0
+	put_ bh e
+    put_ bh (IfInlineRule a e) = do
+	putByte bh 1
+	put_ bh a
+	put_ bh e
+    put_ bh (IfWrapper a n) = do
+	putByte bh 2
+	put_ bh a
+	put_ bh n
+    get bh = do
+	h <- getByte bh
+	case h of
+	  0 -> do e <- get bh
+		  return (IfCoreUnfold e)
+	  1 -> do a <- get bh
+		  e <- get bh
+		  return (IfInlineRule a e)
+	  _ -> do a <- get bh
+		  n <- get bh
+		  return (IfWrapper a n)
 
 instance Binary IfaceNote where
     put_ bh (IfaceSCC aa) = do
 	    putByte bh 0
 	    put_ bh aa
-    put_ bh IfaceInlineMe = do
-	    putByte bh 3
     put_ bh (IfaceCoreNote s) = do
             putByte bh 4
             put_ bh s
@@ -1158,7 +1173,6 @@ instance Binary IfaceNote where
 	    case h of
 	      0 -> do aa <- get bh
 		      return (IfaceSCC aa)
-	      3 -> do return IfaceInlineMe
               4 -> do ac <- get bh
                       return (IfaceCoreNote ac)
               _ -> panic ("get IfaceNote " ++ show h)
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 7ef13a37e1..16c78fda0e 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -9,7 +9,7 @@ module IfaceSyn (
 
 	IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
 	IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
-	IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..),
+	IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..), IfaceUnfolding(..),
 	IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
 	IfaceInst(..), IfaceFamInst(..),
 
@@ -192,15 +192,18 @@ data IfaceInfoItem
   = HsArity	 Arity
   | HsStrictness StrictSig
   | HsInline     Activation
-  | HsUnfold	 IfaceExpr
+  | HsUnfold	 IfaceUnfolding
   | HsNoCafRefs
-  | HsWorker	 Name Arity	-- Worker, if any see IdInfo.WorkerInfo
-					-- for why we want arity here.
-	-- NB: we need IfaceExtName (not just OccName) because the worker
-	--     can simplify to a function in another module.
+
 -- NB: Specialisations and rules come in separately and are
 -- only later attached to the Id.  Partial reason: some are orphans.
 
+data IfaceUnfolding 
+  = IfCoreUnfold IfaceExpr
+  | IfInlineRule Arity IfaceExpr
+  | IfWrapper    Arity Name	  -- NB: we need a Name (not just OccName) because the worker
+				  --     can simplify to a function in another module.
+
 --------------------------------
 data IfaceExpr
   = IfaceLcl 	FastString
@@ -218,7 +221,6 @@ data IfaceExpr
   | IfaceTick   Module Int
 
 data IfaceNote = IfaceSCC CostCentre
-	       | IfaceInlineMe
                | IfaceCoreNote String
 
 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
@@ -629,7 +631,6 @@ pprIfaceApp fun	 	       args = sep (pprIfaceExpr parens fun : args)
 ------------------
 instance Outputable IfaceNote where
     ppr (IfaceSCC cc)     = pprCostCentreCore cc
-    ppr IfaceInlineMe     = ptext (sLit "__inline_me")
     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 
 
@@ -646,13 +647,16 @@ instance Outputable IfaceIdInfo where
   ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
 
 instance Outputable IfaceInfoItem where
-  ppr (HsUnfold unf)  	 = ptext (sLit "Unfolding:") <+>
-				  	parens (pprIfaceExpr noParens unf)
+  ppr (HsUnfold unf)  	 = ptext (sLit "Unfolding:") <+> ppr unf
   ppr (HsInline act)     = ptext (sLit "Inline:") <+> ppr act
   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
   ppr HsNoCafRefs	 = ptext (sLit "HasNoCafRefs")
-  ppr (HsWorker w a)	 = ptext (sLit "Worker:") <+> ppr w <+> int a
+
+instance Outputable IfaceUnfolding where
+  ppr (IfCoreUnfold e)   = parens (ppr e)
+  ppr (IfInlineRule a e) = ptext (sLit "INLINE:") <+> parens (ptext (sLit "arity") <+> int a) <+> parens (ppr e)
+  ppr (IfWrapper a wkr)  = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
 
 
 -- -----------------------------------------------------------------------------
@@ -756,10 +760,14 @@ freeNamesIfIdInfo NoInfo = emptyNameSet
 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 
 freeNamesItem :: IfaceInfoItem -> NameSet
-freeNamesItem (HsUnfold u)     = freeNamesIfExpr u
-freeNamesItem (HsWorker wkr _) = unitNameSet wkr
+freeNamesItem (HsUnfold u)     = freeNamesIfUnfold u
 freeNamesItem _                = emptyNameSet
 
+freeNamesIfUnfold :: IfaceUnfolding -> NameSet
+freeNamesIfUnfold (IfCoreUnfold e)   = freeNamesIfExpr e
+freeNamesIfUnfold (IfInlineRule _ e) = freeNamesIfExpr e
+freeNamesIfUnfold (IfWrapper _ v)    = unitNameSet v
+
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)	  = unitNameSet v
 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 4976e1fc8f..c55f54f772 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1397,7 +1397,7 @@ instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
     (tvs, fds) = classTvsFds cls
     arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
     orph | is_local cls_name = Just (nameOccName cls_name)
-	 | all isJust mb_ns  = head mb_ns
+	 | all isJust mb_ns  = ASSERT( not (null mb_ns) ) head mb_ns
 	 | otherwise	     = Nothing
     
     mb_ns :: [Maybe OccName]	-- One for each fundep; a locally-defined name
@@ -1445,7 +1445,7 @@ toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
 toIfaceIdInfo id_info
   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, 
-	       inline_hsinfo, wrkr_hsinfo,  unfold_hsinfo] 
+	       inline_hsinfo,  unfold_hsinfo] 
   where
     ------------  Arity  --------------
     arity_info = arityInfo id_info
@@ -1464,33 +1464,29 @@ toIfaceIdInfo id_info
 			Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
 			_other			      -> Nothing
 
-    ------------  Worker  --------------
-    work_info   = workerInfo id_info
-    has_worker  = workerExists work_info
-    wrkr_hsinfo = case work_info of
-		    HasWorker work_id wrap_arity -> 
-			Just (HsWorker ((idName work_id)) wrap_arity)
-		    NoWorker -> Nothing
-
     ------------  Unfolding  --------------
-    -- The unfolding is redundant if there is a worker
-    unfold_info  = unfoldingInfo id_info
-    rhs		 = unfoldingTemplate unfold_info
-    no_unfolding = neverUnfold unfold_info
-		  	-- The CoreTidy phase retains unfolding info iff
-			-- we want to expose the unfolding, taking into account
-			-- unconditional NOINLINE, etc.  See TidyPgm.addExternal
-    unfold_hsinfo | no_unfolding = Nothing			
-		  | has_worker   = Nothing	-- Unfolding is implicit
-		  | otherwise	 = Just (HsUnfold (toIfaceExpr rhs))
+    unfold_hsinfo = fmap HsUnfold $ toIfUnfolding (unfoldingInfo id_info)
 					
     ------------  Inline prag  --------------
     inline_prag = inlinePragInfo id_info
-    inline_hsinfo | isAlwaysActive inline_prag     = Nothing
-		  | no_unfolding && not has_worker = Nothing
+    inline_hsinfo | isAlwaysActive inline_prag = Nothing
+		  | isNothing unfold_hsinfo    = Nothing
 			-- If the iface file give no unfolding info, we 
 			-- don't need to say when inlining is OK!
-		  | otherwise			   = Just (HsInline inline_prag)
+		  | otherwise		       = Just (HsInline inline_prag)
+
+--------------------------
+toIfUnfolding :: Unfolding -> Maybe IfaceUnfolding
+toIfUnfolding (CoreUnfolding { uf_tmpl = rhs, uf_guidance = guidance })
+  = case guidance of
+	UnfoldNever -> Nothing
+	_	    -> Just (IfCoreUnfold (toIfaceExpr rhs))
+toIfUnfolding (InlineRule { uf_worker = Just wkr, uf_arity = arity })
+  = Just (IfWrapper arity (idName wkr))
+toIfUnfolding (InlineRule { uf_worker = Nothing, uf_tmpl = rhs, uf_arity = arity })
+  = Just (IfInlineRule arity (toIfaceExpr rhs))
+toIfUnfolding _
+  = Nothing
 
 --------------------------
 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
@@ -1547,7 +1543,6 @@ toIfaceExpr (Note n e)    = IfaceNote (toIfaceNote n) (toIfaceExpr e)
 ---------------------
 toIfaceNote :: Note -> IfaceNote
 toIfaceNote (SCC cc)      = IfaceSCC cc
-toIfaceNote InlineMe      = IfaceInlineMe
 toIfaceNote (CoreNote s)  = IfaceCoreNote s
 
 ---------------------
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 7f74cf2cd2..48ca729f66 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -53,7 +53,6 @@ import SrcLoc
 import DynFlags
 import Util
 import FastString
-import BasicTypes (Arity)
 
 import Control.Monad
 import Data.List
@@ -848,7 +847,6 @@ tcIfaceExpr (IfaceCast expr co) = do
 tcIfaceExpr (IfaceNote note expr) = do
     expr' <- tcIfaceExpr expr
     case note of
-        IfaceInlineMe     -> return (Note InlineMe   expr')
         IfaceSCC cc       -> return (Note (SCC cc)   expr')
         IfaceCoreNote n   -> return (Note (CoreNote n) expr')
 
@@ -942,43 +940,39 @@ tcIdInfo ignore_prags name ty info
     tcPrag info HsNoCafRefs         = return (info `setCafInfo`   NoCafRefs)
     tcPrag info (HsArity arity)     = return (info `setArityInfo` arity)
     tcPrag info (HsStrictness str)  = return (info `setAllStrictnessInfo` Just str)
+    tcPrag info (HsInline prag)    = return (info `setInlinePragInfo` prag)
 
 	-- The next two are lazy, so they don't transitively suck stuff in
-    tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity
-    tcPrag info (HsInline inline_prag) = return (info `setInlinePragInfo` inline_prag)
-    tcPrag info (HsUnfold expr) = do
-          maybe_expr' <- tcPragExpr name expr
-	  let
-		-- maybe_expr' doesn't get looked at if the unfolding
-		-- is never inspected; so the typecheck doesn't even happen
-		unfold_info = case maybe_expr' of
-				Nothing    -> noUnfolding
-				Just expr' -> mkTopUnfolding expr' 
-          return (info `setUnfoldingInfoLazily` unfold_info)
+    tcPrag info (HsUnfold if_unf)  = do { unf <- tcUnfolding name ty info if_unf
+				        ; return (info `setUnfoldingInfoLazily` unf) }
 \end{code}
 
 \begin{code}
-tcWorkerInfo :: Type -> IdInfo -> Name -> Arity -> IfL IdInfo
-tcWorkerInfo ty info wkr arity
+tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
+tcUnfolding name _ _ (IfCoreUnfold if_expr)
+  = do 	{ mb_expr <- tcPragExpr name if_expr
+	; return (case mb_expr of
+		    Nothing -> NoUnfolding
+		    Just expr -> mkTopUnfolding expr) }
+
+tcUnfolding name _ _ (IfInlineRule arity if_expr)
+  = do 	{ mb_expr <- tcPragExpr name if_expr
+	; return (case mb_expr of
+		    Nothing -> NoUnfolding
+		    Just expr -> mkInlineRule expr arity) }
+
+tcUnfolding name ty info (IfWrapper arity wkr)
   = do 	{ mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
-
-	-- We return without testing maybe_wkr_id, but as soon as info is
-	-- looked at we will test it.  That's ok, because its outside the
-	-- knot; and there seems no big reason to further defer the
-	-- tcIfaceId lookup.  (Contrast with tcPragExpr, where postponing walking
-	-- over the unfolding until it's actually used does seem worth while.)
 	; us <- newUniqueSupply
-
 	; return (case mb_wkr_id of
-		     Nothing     -> info
-		     Just wkr_id -> add_wkr_info us wkr_id info) }
+		     Nothing     -> noUnfolding
+		     Just wkr_id -> make_inline_rule wkr_id us) }
   where
-    doc = text "Worker for" <+> ppr wkr
-    add_wkr_info us wkr_id info
-	= info `setUnfoldingInfoLazily`  mk_unfolding us wkr_id
-	       `setWorkerInfo`           HasWorker wkr_id arity
+    doc = text "Worker for" <+> ppr name
 
-    mk_unfolding us wkr_id = mkTopUnfolding (initUs_ us (mkWrapper ty strict_sig) wkr_id)
+    make_inline_rule wkr_id us 
+	= mkWwInlineRule (initUs_ us (mkWrapper ty strict_sig) wkr_id) 
+		         arity wkr_id
 
     	-- We are relying here on strictness info always appearing 
 	-- before worker info,  fingers crossed ....