Commit 39dd1943 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

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.
parent 5a8a219c
......@@ -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)
......
......@@ -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
......
......@@ -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}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment