*** 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.
put_ bh (HsStrictness ab) = do
putByte bh 1
put_ bh ab
put_ bh (HsStrictness ab) = do
putByte bh 1
put_ bh ab
- put_ bh (HsUnfold ac ad) = do
+ put_ bh (HsUnfold ad) = do
- put_ bh HsNoCafRefs = do
+ put_ bh (HsInline ad) = do
- put_ bh (HsWorker ae af) = do
+ put_ bh ad
+ put_ bh HsNoCafRefs = do
+ put_ bh (HsWorker ae af) = do
+ putByte bh 5
put_ bh ae
put_ bh af
get bh = do
put_ bh ae
put_ bh af
get bh = do
return (HsArity aa)
1 -> do ab <- get bh
return (HsStrictness ab)
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)
_ -> do ae <- get bh
af <- get bh
return (HsWorker ae af)
import TysPrim ( alphaTyVars )
import BasicTypes ( Arity, Activation(..), StrictnessMark,
RecFlag(..), boolToRecFlag, Boxity(..),
import TysPrim ( alphaTyVars )
import BasicTypes ( Arity, Activation(..), StrictnessMark,
RecFlag(..), boolToRecFlag, Boxity(..),
+ isAlwaysActive, tupleParens )
import Outputable
import FastString
import Maybes ( catMaybes )
import Outputable
import FastString
import Maybes ( catMaybes )
data IfaceInfoItem
= HsArity Arity
| HsStrictness StrictSig
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.
| HsNoCafRefs
| HsWorker IfaceExtName Arity -- Worker, if any see IdInfo.WorkerInfo
-- for why we want arity here.
ppr NoInfo = empty
ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr_hs_info is) <+> ptext SLIT("-}")
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")
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")
toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
toIfaceIdInfo ext id_info
= catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
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
where
------------ Arity --------------
arity_info = arityInfo id_info
------------ Unfolding --------------
-- The unfolding is redundant if there is a worker
------------ 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
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
--------------------------
coreRuleToIfaceRule :: (Name -> IfaceExtName) -- For the LHS names
-----------------
eqIfIdInfo NoInfo NoInfo = Equal
eqIfIdInfo (HasInfo is1) (HasInfo is2) = eqListBy eq_item is1 is2
-----------------
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 (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
eq_item HsNoCafRefs HsNoCafRefs = Equal
eq_item (HsWorker wkr1 a1) (HsWorker wkr2 a2) = bool (a1==a2) &&& (wkr1 `eqIfExt` wkr2)
eq_item _ _ = NotEqual
-- The next two are lazy, so they don't transitively suck stuff in
tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity
-- 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
= tcPragExpr name expr `thenM` \ maybe_expr' ->
let
-- maybe_expr' doesn't get looked at if the unfolding
Nothing -> noUnfolding
Just expr' -> mkTopUnfolding expr'
in
Nothing -> noUnfolding
Just expr' -> mkTopUnfolding expr'
in
- returnM (info `setUnfoldingInfoLazily` unfold_info
- `setInlinePragInfo` inline_prag)
+ returnM (info `setUnfoldingInfoLazily` unfold_info)