X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=18a04455fb376099c25a8f39fd7904cb11133ee0;hb=8d6feaef4dce4c9256817be8e7e6da25c21d23d7;hp=fc31d5a22a9b88cd6954037ab4d268968fc9eef1;hpb=b8ee6f14ca6e9e49015ee9b404cf8b8191fede05;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index fc31d5a..18a0445 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -19,8 +19,9 @@ module CoreUnfold ( Unfolding, UnfoldingGuidance, -- Abstract types noUnfolding, mkImplicitUnfolding, - mkTopUnfolding, mkUnfolding, mkCoreUnfolding, - mkInlineRule, mkWwInlineRule, + mkUnfolding, mkCoreUnfolding, + mkTopUnfolding, mkSimpleUnfolding, + mkInlineUnfolding, mkInlinableUnfolding, mkWwInlineRule, mkCompulsoryUnfolding, mkDFunUnfolding, interestingArg, ArgSummary(..), @@ -40,9 +41,11 @@ import StaticFlags import DynFlags import CoreSyn import PprCore () -- Instances +import TcType ( tcSplitSigmaTy, tcSplitDFunHead ) import OccurAnal import CoreSubst hiding( substTy ) import CoreFVs ( exprFreeVars ) +import CoreArity ( manifestArity, exprBotStrictness_maybe ) import CoreUtils import Id import DataCon @@ -61,7 +64,7 @@ import Util import FastTypes import FastString import Outputable - +import Data.Maybe \end{code} @@ -73,8 +76,7 @@ import Outputable \begin{code} mkTopUnfolding :: Bool -> CoreExpr -> Unfolding -mkTopUnfolding is_bottoming expr - = mkUnfolding True {- Top level -} is_bottoming expr +mkTopUnfolding = mkUnfolding InlineRhs True {- Top level -} mkImplicitUnfolding :: CoreExpr -> Unfolding -- For implicit Ids, do a tiny bit of optimising first @@ -86,47 +88,19 @@ mkImplicitUnfolding expr = mkTopUnfolding False (simpleOptExpr expr) -- top-level flag to True. It gets set more accurately by the simplifier -- Simplify.simplUnfolding. -mkUnfolding :: Bool -> Bool -> CoreExpr -> Unfolding -mkUnfolding top_lvl is_bottoming expr - = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr, - uf_src = InlineRhs, - uf_arity = arity, - uf_is_top = top_lvl, - uf_is_value = exprIsHNF expr, - uf_is_conlike = exprIsConLike expr, - uf_expandable = exprIsExpandable expr, - uf_is_cheap = is_cheap, - uf_guidance = guidance } - where - is_cheap = exprIsCheap expr - (arity, guidance) = calcUnfoldingGuidance is_cheap (top_lvl && is_bottoming) - opt_UF_CreationThreshold expr - -- Sometimes during simplification, there's a large let-bound thing - -- which has been substituted, and so is now dead; so 'expr' contains - -- two copies of the thing while the occurrence-analysed expression doesn't - -- Nevertheless, we *don't* occ-analyse before computing the size because the - -- size computation bales out after a while, whereas occurrence analysis does not. - -- - -- This can occasionally mean that the guidance is very pessimistic; - -- it gets fixed up next round. And it should be rare, because large - -- let-bound things that are dead are usually caught by preInlineUnconditionally - -mkCoreUnfolding :: Bool -> UnfoldingSource -> CoreExpr - -> Arity -> UnfoldingGuidance -> Unfolding --- Occurrence-analyses the expression before capturing it -mkCoreUnfolding top_lvl src expr arity guidance - = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr, - uf_src = src, - uf_arity = arity, - uf_is_top = top_lvl, - uf_is_value = exprIsHNF expr, - uf_is_conlike = exprIsConLike expr, - uf_is_cheap = exprIsCheap expr, - uf_expandable = exprIsExpandable expr, - uf_guidance = guidance } +mkSimpleUnfolding :: CoreExpr -> Unfolding +mkSimpleUnfolding = mkUnfolding InlineRhs False False -mkDFunUnfolding :: DataCon -> [Id] -> Unfolding -mkDFunUnfolding con ops = DFunUnfolding con (map Var ops) +mkDFunUnfolding :: Type -> [CoreExpr] -> Unfolding +mkDFunUnfolding dfun_ty ops + = DFunUnfolding dfun_nargs data_con ops + where + (tvs, theta, head_ty) = tcSplitSigmaTy dfun_ty + -- NB: tcSplitSigmaTy: do not look through a newtype + -- when the dictionary type is a newtype + (cls, _) = tcSplitDFunHead head_ty + dfun_nargs = length tvs + length theta + data_con = classDataCon cls mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding mkWwInlineRule id expr arity @@ -140,21 +114,76 @@ mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolde expr 0 -- Arity of unfolding doesn't matter (UnfWhen unSaturatedOk boringCxtOk) -mkInlineRule :: Bool -> CoreExpr -> Arity -> Unfolding -mkInlineRule unsat_ok expr arity - = mkCoreUnfolding True InlineRule -- Note [Top-level flag on inline rules] - expr' arity +mkInlineUnfolding :: Maybe Arity -> CoreExpr -> Unfolding +mkInlineUnfolding mb_arity expr + = mkCoreUnfolding True -- Note [Top-level flag on inline rules] + InlineStable + expr' arity (UnfWhen unsat_ok boring_ok) where expr' = simpleOptExpr expr + (unsat_ok, arity) = case mb_arity of + Nothing -> (unSaturatedOk, manifestArity expr') + Just ar -> (needSaturated, ar) + boring_ok = case calcUnfoldingGuidance True -- Treat as cheap False -- But not bottoming (arity+1) expr' of (_, UnfWhen _ boring_ok) -> boring_ok _other -> boringCxtNotOk -- See Note [INLINE for small functions] + +mkInlinableUnfolding :: CoreExpr -> Unfolding +mkInlinableUnfolding expr + = mkUnfolding InlineStable True is_bot expr + where + is_bot = isJust (exprBotStrictness_maybe expr) \end{code} +Internal functions + +\begin{code} +mkCoreUnfolding :: Bool -> UnfoldingSource -> CoreExpr + -> Arity -> UnfoldingGuidance -> Unfolding +-- Occurrence-analyses the expression before capturing it +mkCoreUnfolding top_lvl src expr arity guidance + = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr, + uf_src = src, + uf_arity = arity, + uf_is_top = top_lvl, + uf_is_value = exprIsHNF expr, + uf_is_conlike = exprIsConLike expr, + uf_is_cheap = exprIsCheap expr, + uf_expandable = exprIsExpandable expr, + uf_guidance = guidance } + +mkUnfolding :: UnfoldingSource -> Bool -> Bool -> CoreExpr -> Unfolding +-- Calculates unfolding guidance +-- Occurrence-analyses the expression before capturing it +mkUnfolding src top_lvl is_bottoming expr + = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr, + uf_src = src, + uf_arity = arity, + uf_is_top = top_lvl, + uf_is_value = exprIsHNF expr, + uf_is_conlike = exprIsConLike expr, + uf_expandable = exprIsExpandable expr, + uf_is_cheap = is_cheap, + uf_guidance = guidance } + where + is_cheap = exprIsCheap expr + (arity, guidance) = calcUnfoldingGuidance is_cheap (top_lvl && is_bottoming) + opt_UF_CreationThreshold expr + -- Sometimes during simplification, there's a large let-bound thing + -- which has been substituted, and so is now dead; so 'expr' contains + -- two copies of the thing while the occurrence-analysed expression doesn't + -- Nevertheless, we *don't* occ-analyse before computing the size because the + -- size computation bales out after a while, whereas occurrence analysis does not. + -- + -- This can occasionally mean that the guidance is very pessimistic; + -- it gets fixed up next round. And it should be rare, because large + -- let-bound things that are dead are usually caught by preInlineUnconditionally +\end{code} %************************************************************************ %* * @@ -184,7 +213,6 @@ calcUnfoldingGuidance expr_is_cheap top_bot bOMB_OUT_SIZE expr | uncondInline n_val_bndrs (iBox size) , expr_is_cheap -> UnfWhen unSaturatedOk boringCxtOk -- Note [INLINE for small functions] - | top_bot -- See Note [Do not inline top-level bottoming functions] -> UnfNever @@ -473,21 +501,44 @@ funSize top_args fun n_val_args conSize :: DataCon -> Int -> ExprSize conSize dc n_val_args - | n_val_args == 0 = SizeIs (_ILIT(0)) emptyBag (_ILIT(1)) -- Like variables + | n_val_args == 0 = SizeIs (_ILIT(0)) emptyBag (_ILIT(1)) -- Like variables + +-- See Note [Constructor size] | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (iUnbox n_val_args +# _ILIT(1)) - | otherwise = SizeIs (_ILIT(1)) emptyBag (iUnbox n_val_args +# _ILIT(1)) - -- Treat a constructors application as size 1, regardless of how - -- many arguments it has; we are keen to expose them - -- (and we charge separately for their args). We can't treat - -- them as size zero, else we find that (Just x) has size 0, - -- which is the same as a lone variable; and hence 'v' will - -- always be replaced by (Just x), where v is bound to Just x. - -- - -- However, unboxed tuples count as size zero - -- I found occasions where we had - -- f x y z = case op# x y z of { s -> (# s, () #) } - -- and f wasn't getting inlined +-- See Note [Unboxed tuple result discount] +-- | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (_ILIT(0)) + +-- See Note [Constructor size] + | otherwise = SizeIs (_ILIT(1)) emptyBag (iUnbox n_val_args +# _ILIT(1)) +\end{code} + +Note [Constructor size] +~~~~~~~~~~~~~~~~~~~~~~~ +Treat a constructors application as size 1, regardless of how many +arguments it has; we are keen to expose them (and we charge separately +for their args). We can't treat them as size zero, else we find that +(Just x) has size 0, which is the same as a lone variable; and hence +'v' will always be replaced by (Just x), where v is bound to Just x. + +However, unboxed tuples count as size zero. I found occasions where we had + f x y z = case op# x y z of { s -> (# s, () #) } +and f wasn't getting inlined. + +Note [Unboxed tuple result discount] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +I tried giving unboxed tuples a *result discount* of zero (see the +commented-out line). Why? When returned as a result they do not +allocate, so maybe we don't want to charge so much for them If you +have a non-zero discount here, we find that workers often get inlined +back into wrappers, because it look like + f x = case $wf x of (# a,b #) -> (a,b) +and we are keener because of the case. However while this change +shrank binary sizes by 0.5% it also made spectral/boyer allocate 5% +more. All other changes were very small. So it's not a big deal but I +didn't adopt the idea. + +\begin{code} primOpSize :: PrimOp -> Int -> ExprSize primOpSize op n_val_args | not (primOpIsDupable op) = sizeN opt_UF_DearOp @@ -626,9 +677,11 @@ actual arguments. \begin{code} couldBeSmallEnoughToInline :: Int -> CoreExpr -> Bool couldBeSmallEnoughToInline threshold rhs - = case calcUnfoldingGuidance False False threshold rhs of - (_, UnfNever) -> False - _ -> True + = case sizeExpr (iUnbox threshold) [] body of + TooBig -> False + _ -> True + where + (_, body) = collectBinders rhs ---------------- smallEnoughToInline :: Unfolding -> Bool @@ -716,7 +769,7 @@ callSiteInline dflags id unfolding lone_variable arg_infos cont_info NoUnfolding -> Nothing ; OtherCon _ -> Nothing ; DFunUnfolding {} -> Nothing ; -- Never unfold a DFun - CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top, uf_is_value = is_value, + CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top, uf_is_cheap = is_cheap, uf_arity = uf_arity, uf_guidance = guidance } -> -- uf_arity will typically be equal to (idArity id), -- but may be less for InlineRules @@ -746,10 +799,10 @@ callSiteInline dflags id unfolding lone_variable arg_infos cont_info interesting_saturated_call = case cont_info of - BoringCtxt -> not is_top && uf_arity > 0 -- Note [Nested functions] - CaseCtxt -> not (lone_variable && is_value) -- Note [Lone variables] - ArgCtxt {} -> uf_arity > 0 -- Note [Inlining in ArgCtxt] - ValAppCtxt -> True -- Note [Cast then apply] + BoringCtxt -> not is_top && uf_arity > 0 -- Note [Nested functions] + CaseCtxt -> not (lone_variable && is_cheap) -- Note [Lone variables] + ArgCtxt {} -> uf_arity > 0 -- Note [Inlining in ArgCtxt] + ValAppCtxt -> True -- Note [Cast then apply] (yes_or_no, extra_doc) = case guidance of @@ -776,7 +829,6 @@ callSiteInline dflags id unfolding lone_variable arg_infos cont_info text "uf arity" <+> ppr uf_arity, text "interesting continuation" <+> ppr cont_info, text "some_benefit" <+> ppr some_benefit, - text "is value:" <+> ppr is_value, text "is cheap:" <+> ppr is_cheap, text "guidance" <+> ppr guidance, extra_doc, @@ -890,8 +942,8 @@ call is at least CONLIKE. At least for the cases where we use ArgCtxt for the RHS of a 'let', we only profit from the inlining if we get a CONLIKE thing (modulo lets). -Note [Lone variables] -~~~~~~~~~~~~~~~~~~~~~ +Note [Lone variables] See also Note [Interaction of exprIsCheap and lone variables] +~~~~~~~~~~~~~~~~~~~~~ which appears below The "lone-variable" case is important. I spent ages messing about with unsatisfactory varaints, but this is nice. The idea is that if a variable appears all alone @@ -900,7 +952,7 @@ variable appears all alone as scrutinee of a case CaseCtxt as arg of a fn ArgCtxt AND - it is bound to a value + it is bound to a cheap expression then we should not inline it (unless there is some other reason, e.g. is is the sole occurrence). That is what is happening at @@ -952,6 +1004,27 @@ However, watch out: There's no advantage in inlining f here, and perhaps a significant disadvantage. Hence some_val_args in the Stop case +Note [Interaction of exprIsCheap and lone variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The lone-variable test says "don't inline if a case expression +scrutines a lone variable whose unfolding is cheap". It's very +important that, under these circumstances, exprIsConApp_maybe +can spot a constructor application. So, for example, we don't +consider + let x = e in (x,x) +to be cheap, and that's good because exprIsConApp_maybe doesn't +think that expression is a constructor application. + +I used to test is_value rather than is_cheap, which was utterly +wrong, because the above expression responds True to exprIsHNF. + +This kind of thing can occur if you have + + {-# INLINE foo #-} + foo = let x = e in (x,x) + +which Roman did. + \begin{code} computeDiscount :: Int -> [Int] -> Int -> [ArgSummary] -> CallCtxt -> Int computeDiscount n_vals_wanted arg_discounts res_discount arg_infos cont_info @@ -1054,7 +1127,7 @@ interestingArg e = go e 0 go (Note _ a) n = go a n go (Cast e _) n = go e n go (Lam v e) n - | isTyVar v = go e n + | isTyCoVar v = go e n | n>0 = go e (n-1) | otherwise = ValueArg go (Let _ e) n = case go e n of { ValueArg -> ValueArg; _ -> NonTrivArg } @@ -1174,13 +1247,15 @@ exprIsConApp_maybe id_unf expr analyse (Var fun) args | Just con <- isDataConWorkId_maybe fun - , is_saturated + , count isValArg args == idArity fun , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars con) args = Just (con, stripTypeArgs univ_ty_args, rest_args) -- Look through dictionary functions; see Note [Unfolding DFuns] - | DFunUnfolding con ops <- unfolding - , is_saturated + | DFunUnfolding dfun_nargs con ops <- unfolding + , let sat = length args == dfun_nargs -- See Note [DFun arity check] + in if sat then True else + pprTrace "Unsaturated dfun" (ppr fun <+> int dfun_nargs $$ ppr args) False , let (dfun_tvs, _cls, dfun_res_tys) = tcSplitDFunTy (idType fun) subst = zipOpenTvSubst dfun_tvs (stripTypeArgs (takeList dfun_tvs args)) = Just (con, substTys subst dfun_res_tys, @@ -1192,7 +1267,6 @@ exprIsConApp_maybe id_unf expr = -- pprTrace "expanding" (ppr fun $$ ppr rhs) $ analyse rhs args where - is_saturated = count isValArg args == idArity fun unfolding = id_unf fun analyse _ _ = Nothing @@ -1206,11 +1280,7 @@ exprIsConApp_maybe id_unf expr = Nothing beta fun pairs args - = case analyse (substExpr (text "subst-expr-is-con-app") subst fun) args of - Nothing -> -- pprTrace "Bale out! exprIsConApp_maybe" doc $ - Nothing - Just ans -> -- pprTrace "Woo-hoo! exprIsConApp_maybe" doc $ - Just ans + = analyse (substExpr (text "subst-expr-is-con-app") subst fun) args where subst = mkOpenSubst (mkInScopeSet (exprFreeVars fun)) pairs -- doc = vcat [ppr fun, ppr expr, ppr pairs, ppr args] @@ -1233,3 +1303,8 @@ So to split it up we just need to apply the ops $c1, $c2 etc to the very same args as the dfun. It takes a little more work to compute the type arguments to the dictionary constructor. +Note [DFun arity check] +~~~~~~~~~~~~~~~~~~~~~~~ +Here we check that the total number of supplied arguments (inclding +type args) matches what the dfun is expecting. This may be *less* +than the ordinary arity of the dfun: see Note [DFun unfoldings] in CoreSyn \ No newline at end of file