X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=fd76f235bd8ce585c69532ce3db2d41ee283e110;hb=59300a7161f44b3a2afe381a6ccd914043a32c4f;hp=ae46a8baba1769785e166a950ac58986b9d7a752;hpb=794c2f4c8829ba3166c9bdb471856bc00c21f001;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index ae46a8b..fd76f23 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -79,21 +79,6 @@ mkImplicitUnfolding :: CoreExpr -> Unfolding -- For implicit Ids, do a tiny bit of optimising first mkImplicitUnfolding expr = mkTopUnfolding (simpleOptExpr expr) -mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding -mkWwInlineRule id = mkInlineRule (InlWrapper id) - -mkInlineRule :: InlineRuleInfo -> CoreExpr -> Arity -> Unfolding -mkInlineRule inl_info expr arity - = mkCoreUnfolding True -- Note [Top-level flag on inline rules] - expr' arity - (InlineRule { ug_ir_info = inl_info, ug_small = small }) - where - expr' = simpleOptExpr expr - small = case calcUnfoldingGuidance (arity+1) expr' of - (arity_e, UnfoldIfGoodArgs { ug_size = size_e }) - -> uncondInline arity_e size_e - _other {- actually UnfoldNever -} -> False - -- Note [Top-level flag on inline rules] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Slight hack: note that mk_inline_rules conservatively sets the @@ -108,11 +93,12 @@ mkUnfolding top_lvl 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 + -- 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 + -- 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 -> CoreExpr -> Arity -> UnfoldingGuidance -> Unfolding -- Occurrence-analyses the expression before capturing it @@ -120,17 +106,38 @@ mkCoreUnfolding top_lvl expr arity guidance = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr, uf_arity = arity, uf_is_top = top_lvl, - uf_is_value = exprIsHNF expr, - uf_is_cheap = exprIsCheap expr, + uf_is_value = exprIsHNF expr, + uf_is_conlike = exprIsConLike expr, + uf_is_cheap = exprIsCheap expr, uf_expandable = exprIsExpandable expr, uf_guidance = guidance } mkDFunUnfolding :: DataCon -> [Id] -> Unfolding mkDFunUnfolding con ops = DFunUnfolding con (map Var ops) +mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding +mkWwInlineRule id expr arity + = mkCoreUnfolding True (simpleOptExpr expr) arity + (InlineRule { ir_sat = InlUnSat, ir_info = InlWrapper id }) + mkCompulsoryUnfolding :: CoreExpr -> Unfolding -mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded - = mkCoreUnfolding True expr 0 UnfoldAlways -- Arity of unfolding doesn't matter +mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded + = mkCoreUnfolding True expr + 0 -- Arity of unfolding doesn't matter + (InlineRule { ir_info = InlAlways, ir_sat = InlUnSat }) + +mkInlineRule :: InlSatFlag -> CoreExpr -> Arity -> Unfolding +mkInlineRule sat expr arity + = mkCoreUnfolding True -- Note [Top-level flag on inline rules] + expr' arity + (InlineRule { ir_sat = sat, ir_info = info }) + where + expr' = simpleOptExpr expr + info = if small then InlSmall else InlVanilla + small = case calcUnfoldingGuidance (arity+1) expr' of + (arity_e, UnfoldIfGoodArgs { ug_size = size_e }) + -> uncondInline arity_e size_e + _other {- actually UnfoldNever -} -> False \end{code} @@ -185,6 +192,7 @@ Examples -------------- 0 42# 0 x + 0 True 2 f x 1 Just x 4 f (g x) @@ -311,9 +319,13 @@ sizeExpr bOMB_OUT_SIZE top_args expr _ -> funSize top_args fun (length val_args) ------------ - size_up_alt (_con, _bndrs, rhs) = size_up rhs + size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 1 -- Don't charge for args, so that wrappers look cheap -- (See comments about wrappers with Case) + -- + -- IMPORATANT: *do* charge 1 for the alternative, else we + -- find that giant case nests are treated as practically free + -- A good example is Foreign.C.Error.errrnoToIOError ------------ -- These addSize things have to be here because @@ -384,7 +396,7 @@ 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)) + | n_val_args == 0 = SizeIs (_ILIT(0)) emptyBag (_ILIT(1)) -- Like variables | 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 @@ -551,7 +563,6 @@ certainlyWillInline :: Unfolding -> Bool -- Sees if the unfolding is pretty certain to inline certainlyWillInline (CoreUnfolding { uf_is_cheap = is_cheap, uf_arity = n_vals, uf_guidance = guidance }) = case guidance of - UnfoldAlways {} -> True UnfoldNever -> False InlineRule {} -> True UnfoldIfGoodArgs { ug_size = size} @@ -600,11 +611,13 @@ instance Outputable ArgSummary where data CallCtxt = BoringCtxt - | ArgCtxt Bool -- We're somewhere in the RHS of function with rules - -- => be keener to inline - Int -- We *are* the argument of a function with this arg discount - -- => be keener to inline - -- INVARIANT: ArgCtxt False 0 ==> BoringCtxt + | ArgCtxt -- We are somewhere in the argument of a function + Bool -- True <=> we're somewhere in the RHS of function with rules + -- False <=> we *are* the argument of a function with non-zero + -- arg discount + -- OR + -- we *are* the RHS of a let Note [RHS of lets] + -- In both cases, be a little keener to inline | ValAppCtxt -- We're applied to at least one value arg -- This arises when we have ((f x |> co) y) @@ -614,16 +627,13 @@ data CallCtxt = BoringCtxt -- that decomposes its scrutinee instance Outputable CallCtxt where - ppr BoringCtxt = ptext (sLit "BoringCtxt") - ppr (ArgCtxt rules disc) = ptext (sLit "ArgCtxt") <> ppr (rules,disc) - ppr CaseCtxt = ptext (sLit "CaseCtxt") - ppr ValAppCtxt = ptext (sLit "ValAppCtxt") + ppr BoringCtxt = ptext (sLit "BoringCtxt") + ppr (ArgCtxt rules) = ptext (sLit "ArgCtxt") <+> ppr rules + ppr CaseCtxt = ptext (sLit "CaseCtxt") + ppr ValAppCtxt = ptext (sLit "ValAppCtxt") callSiteInline dflags active_inline id lone_variable arg_infos cont_info - = let - n_val_args = length arg_infos - in - case idUnfolding id of { + = case idUnfolding id of { NoUnfolding -> Nothing ; OtherCon _ -> Nothing ; DFunUnfolding {} -> Nothing ; -- Never unfold a DFun @@ -632,6 +642,8 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info -- uf_arity will typically be equal to (idArity id), -- but may be less for InlineRules let + n_val_args = length arg_infos + result | yes_or_no = Just unf_template | otherwise = Nothing @@ -660,23 +672,19 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info = case guidance of UnfoldNever -> False - UnfoldAlways -> True - -- UnfoldAlways => there is no top-level binding for - -- these things, so we must inline it. Only a few - -- primop-like things have compulsory unfoldings (see - -- MkId.lhs). Ignore is_active because we want to - -- inline even if SimplGently is on. - - InlineRule { ug_ir_info = inl_info, ug_small = uncond_inline } + InlineRule { ir_info = inl_info, ir_sat = sat } + | InlAlways <- inl_info -> True -- No top-level binding, so inline! + -- Ignore is_active because we want to + -- inline even if SimplGently is on. | not active_inline -> False | n_val_args < uf_arity -> yes_unsat -- Not enough value args - | uncond_inline -> True -- Note [INLINE for small functions] + | InlSmall <- inl_info -> True -- Note [INLINE for small functions] | otherwise -> some_benefit -- Saturated or over-saturated where -- See Note [Inlining an InlineRule] - yes_unsat = case inl_info of - InlSat -> False - _other -> interesting_args + yes_unsat = case sat of + InlSat -> False + InlUnSat -> interesting_args UnfoldIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size } | not active_inline -> False @@ -707,6 +715,15 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info } \end{code} +Note [RHS of lets] +~~~~~~~~~~~~~~~~~~ +Be a tiny bit keener to inline in the RHS of a let, because that might +lead to good thing later + f y = (y,y,y) + g y = let x = f y in ...(case x of (a,b,c) -> ...) ... +We'd inline 'f' if the call was in a case context, and it kind-of-is, +only we can't see it. So we treat the RHS of a let as not-totally-boring. + Note [Unsaturated applications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When a call is not saturated, we *still* inline if one of the @@ -742,7 +759,7 @@ Consider {-# INLINE f #-} g y = f y Then f's RHS is no larger than its LHS, so we should inline it into even the most boring context. (We do so if there is no INLINE -pragma!) That's the reason for the 'inl_small' flag on an InlineRule. +pragma!) That's the reason for the 'ug_small' flag on an InlineRule. Note [Things to watch] @@ -806,6 +823,11 @@ At one stage I replaced this condition by 'True' (leading to the above slow-down). The motivation was test eyeball/inline1.hs; but that seems to work ok now. +NOTE: arguably, we should inline in ArgCtxt only if the result of the +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] ~~~~~~~~~~~~~~~~~~~~~ The "lone-variable" case is important. I spent ages messing about @@ -898,7 +920,7 @@ computeDiscount n_vals_wanted arg_discounts res_discount arg_infos cont_info CaseCtxt -> res_discount _other -> 4 `min` res_discount -- res_discount can be very large when a function returns - -- construtors; but we only want to invoke that large discount + -- constructors; but we only want to invoke that large discount -- when there's a case continuation. -- Otherwise we, rather arbitrarily, threshold it. Yuk. -- But we want to aovid inlining large functions that return @@ -936,7 +958,7 @@ Note [Conlike is interesting] Consider f d = ...((*) d x y)... ... f (df d')... -where df is con-like. Then we'd really like to inline so that the +where df is con-like. Then we'd really like to inline 'f' so that the rule for (*) (df d) can fire. To do this a) we give a discount for being an argument of a class-op (eg (*) d) b) we say that a con-like argument (eg (df d)) is interesting @@ -958,10 +980,11 @@ interestingArg e = go e 0 -- data constructors here | idArity v > n = ValueArg -- Catches (eg) primops with arity but no unfolding | n > 0 = NonTrivArg -- Saturated or unknown call - | evald_unfolding = ValueArg -- n==0; look for a value + | conlike_unfolding = ValueArg -- n==0; look for an interesting unfolding + -- See Note [Conlike is interesting] | otherwise = TrivArg -- n==0, no useful unfolding where - evald_unfolding = isEvaldUnfolding (idUnfolding v) + conlike_unfolding = isConLikeUnfolding (idUnfolding v) go (Type _) _ = TrivArg go (App fn (Type _)) n = go fn n @@ -1072,7 +1095,8 @@ exprIsConApp_maybe (Cast expr co) let dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tyvars, ppr arg_tys, ppr dc_args, ppr _dc_univ_args, ppr ex_args, ppr val_args] - ASSERT2( coreEqType from_ty (mkTyConApp dc_tc _dc_univ_args), dump_doc ) + in + ASSERT2( coreEqType _from_ty (mkTyConApp dc_tc _dc_univ_args), dump_doc ) ASSERT2( all isTypeArg (ex_args ++ co_args), dump_doc ) ASSERT2( equalLength val_args arg_tys, dump_doc ) #endif @@ -1107,7 +1131,9 @@ exprIsConApp_maybe expr analyse rhs args where is_saturated = count isValArg args == idArity fun - unfolding = idUnfolding fun + unfolding = idUnfolding fun -- Does not look through loop breakers + -- ToDo: we *may* look through variables that are NOINLINE + -- in this phase, and that is really not right analyse _ _ = Nothing