From: simonpj@microsoft.com Date: Mon, 22 May 2006 11:02:56 +0000 (+0000) Subject: Transmit inline pragmas faithfully X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=39dd1943735841b6cc62c91134189371ba571f38 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 --- 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 --- 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 --- 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}