Transmit inline pragmas faithfully

*** WARNING: you will need to recompile your libraries
***	     when you pull this patch (make clean; make)

The inline pragma on wrapper-functions was being lost; this patch
makes it be transmitted faithfully.

The reason is that we don't write the full inlining for a wrapper into
an interface file, because it's generated algorithmically from its strictness
info.  But previously the inline pragma as being written out only when we
wrote out an unfolding, and hence it was lost for a wrapper.

This makes a particular difference when a function has a NOINLINE[k] pragma.
Then it may be w/w'd, and we must retain the pragma.  It's the only consistent
thing to do really.

The change does change the binary format of interface files, slightly.
So you need to recompile all your libraries.

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 6d02fe0..a31988a 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -829,14 +829,16 @@ instance Binary IfaceInfoItem where
     put_ bh (HsStrictness ab) = do
            putByte bh 1
            put_ bh ab
-    put_ bh (HsUnfold ac ad) = do
+    put_ bh (HsUnfold ad) = do
            putByte bh 2
-           put_ bh ac
            put_ bh ad
-    put_ bh HsNoCafRefs = do
+    put_ bh (HsInline ad) = do
            putByte bh 3
-    put_ bh (HsWorker ae af) = do
+           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
@@ -846,10 +848,11 @@ instance Binary IfaceInfoItem where
                      return (HsArity aa)
              1 -> do ab <- get bh
                      return (HsStrictness ab)
-             2 -> do ac <- get bh
-                     ad <- get bh
-                     return (HsUnfold ac ad)
-             3 -> do return HsNoCafRefs
+             2 -> do ad <- get bh
+                     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)

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 7957050..d4a6eec 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -66,7 +66,7 @@ import ForeignCall    ( ForeignCall )
 import TysPrim         ( alphaTyVars )
 import BasicTypes      ( Arity, Activation(..), StrictnessMark, 
                          RecFlag(..), boolToRecFlag, Boxity(..), 
-                         tupleParens )
+                         isAlwaysActive, tupleParens )
 import Outputable
 import FastString
 import Maybes          ( catMaybes )
@@ -189,7 +189,8 @@ data IfaceIdInfo
 data IfaceInfoItem
   = HsArity     Arity
   | HsStrictness StrictSig
-  | HsUnfold    Activation IfaceExpr
+  | HsInline     Activation
+  | HsUnfold    IfaceExpr
   | HsNoCafRefs
   | HsWorker    IfaceExtName Arity     -- Worker, if any see IdInfo.WorkerInfo
                                        -- for why we want arity here.
@@ -426,8 +427,9 @@ instance Outputable IfaceIdInfo where
    ppr NoInfo       = empty
    ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr_hs_info is) <+> ptext SLIT("-}")
 
-ppr_hs_info (HsUnfold prag unf) = sep [ptext SLIT("Unfolding: ") <> ppr prag,
-                                      parens (pprIfaceExpr noParens unf)]
+ppr_hs_info (HsUnfold unf)     = ptext SLIT("Unfolding:") <+>
+                                       parens (pprIfaceExpr noParens unf)
+ppr_hs_info (HsInline act)      = ptext SLIT("Inline:") <+> ppr act
 ppr_hs_info (HsArity arity)     = ptext SLIT("Arity:") <+> int arity
 ppr_hs_info (HsStrictness str)  = ptext SLIT("Strictness:") <+> pprIfaceStrictSig str
 ppr_hs_info HsNoCafRefs                = ptext SLIT("HasNoCafRefs")
@@ -567,7 +569,7 @@ instanceToIfaceInst ext_lhs ispec@(Instance { is_dfun = dfun_id, is_flag = oflag
 toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
 toIfaceIdInfo ext id_info
   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, 
-              wrkr_hsinfo,  unfold_hsinfo] 
+              inline_hsinfo, wrkr_hsinfo,  unfold_hsinfo] 
   where
     ------------  Arity  --------------
     arity_info = arityInfo id_info
@@ -596,13 +598,23 @@ toIfaceIdInfo ext id_info
 
     ------------  Unfolding  --------------
     -- The unfolding is redundant if there is a worker
-    unfold_info = unfoldingInfo id_info
+    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 ext rhs))
+                                       
+    ------------  Inline prag  --------------
     inline_prag = inlinePragInfo id_info
-    rhs                = unfoldingTemplate unfold_info
-    unfold_hsinfo |  neverUnfold unfold_info   -- The CoreTidy phase retains unfolding info iff
-                 || has_worker = Nothing       -- we want to expose the unfolding, taking into account
-                                               -- unconditional NOINLINE, etc.  See TidyPgm.addExternal
-                 | otherwise   = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
+    inline_hsinfo | isAlwaysActive inline_prag     = Nothing
+                 | no_unfolding && not has_worker = Nothing
+                       -- If the iface file give no unfolding info, we 
+                       -- don't need to say when inlining is OK!
+                 | otherwise                      = Just (HsInline inline_prag)
 
 --------------------------
 coreRuleToIfaceRule :: (Name -> IfaceExtName)  -- For the LHS names
@@ -840,11 +852,12 @@ eq_cls_sig env (IfaceClassOp n1 dm1 ty1) (IfaceClassOp n2 dm2 ty2)
 -----------------
 eqIfIdInfo NoInfo       NoInfo        = Equal
 eqIfIdInfo (HasInfo is1) (HasInfo is2) = eqListBy eq_item is1 is2
-eqIfIdInfo i1 i2 = NotEqual
+eqIfIdInfo i1           i2 = NotEqual
 
+eq_item (HsInline a1)     (HsInline a2)      = bool (a1 == a2)
 eq_item (HsArity a1)      (HsArity a2)       = bool (a1 == a2)
 eq_item (HsStrictness s1)  (HsStrictness s2)  = bool (s1 == s2)
-eq_item (HsUnfold a1 u1)   (HsUnfold a2 u2)   = bool (a1 == a2) &&& eq_ifaceExpr emptyEqEnv u1 u2
+eq_item (HsUnfold u1)   (HsUnfold u2)         = eq_ifaceExpr emptyEqEnv u1 u2
 eq_item HsNoCafRefs        HsNoCafRefs       = Equal
 eq_item (HsWorker wkr1 a1) (HsWorker wkr2 a2) = bool (a1==a2) &&& (wkr1 `eqIfExt` wkr2)
 eq_item _ _ = NotEqual

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index b902c8c..caff95f 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -751,7 +751,8 @@ tcIdInfo name ty (HasInfo info) = foldlM tcPrag init_info info
 
        -- 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 (HsUnfold inline_prag expr)
+    tcPrag info (HsInline inline_prag) = returnM (info `setInlinePragInfo` inline_prag)
+    tcPrag info (HsUnfold expr)
        = tcPragExpr name expr  `thenM` \ maybe_expr' ->
          let
                -- maybe_expr' doesn't get looked at if the unfolding
@@ -760,8 +761,7 @@ tcIdInfo name ty (HasInfo info) = foldlM tcPrag init_info info
                                Nothing    -> noUnfolding
                                Just expr' -> mkTopUnfolding expr' 
          in
-         returnM (info `setUnfoldingInfoLazily` unfold_info
-                       `setInlinePragInfo`      inline_prag)
+         returnM (info `setUnfoldingInfoLazily` unfold_info)
 \end{code}
 
 \begin{code}