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

Inline in a call argument if the caller has RULES

This is an experimental change suggested by Roman.  Consider
	
	{-# INLINE f #-}
	f x y = ...

	....(g (f a b))...

where g has RULES.  Then we'd like to inline f, even though the context of
the call is otherwise 100% boring -- g is lazy and we know nothing about
x and y. 

This patch just records in the continuation that f has rules.  And does so
somewhat recursively...e.g.

	...(g (h (f a b)))...

where g has rules.  
parent b7d8dffa
......@@ -15,8 +15,9 @@ module SimplUtils (
SimplCont(..), DupFlag(..), LetRhsFlag(..),
contIsDupable, contResultType,
countValArgs, countArgs, pushContArgs,
mkBoringStop, mkRhsStop, contIsRhs, contIsRhsOrArg,
getContArgs, interestingCallContext, interestingArg, isStrictType
mkBoringStop, mkLazyArgStop, mkRhsStop, contIsRhs, contIsRhsOrArg,
getContArgs, interestingCallContext, interestingArgContext,
interestingArg, isStrictType
) where
......@@ -29,16 +30,16 @@ import StaticFlags ( opt_UF_UpdateInPlace, opt_SimplNoPreInlining,
opt_RulesOff )
import CoreSyn
import CoreFVs ( exprFreeVars )
import CoreUtils ( cheapEqExpr, exprType, exprIsTrivial, exprIsCheap,
import CoreUtils ( cheapEqExpr, exprType, exprIsTrivial,
etaExpand, exprEtaExpandArity, bindNonRec, mkCoerce2,
findDefault, exprOkForSpeculation, exprIsHNF, mergeAlts
)
import Literal ( mkStringLit )
import CoreUnfold ( smallEnoughToInline )
import MkId ( eRROR_ID )
import Id ( idType, isDataConWorkId, idOccInfo, isDictId,
import Id ( Id, idType, isDataConWorkId, idOccInfo, isDictId,
isDeadBinder, idNewDemandInfo, isExportedId,
idUnfolding, idNewStrictness, idInlinePragma,
idUnfolding, idNewStrictness, idInlinePragma, idHasRules
)
import NewDemand ( isStrictDmd, isBotRes, splitStrictSig )
import SimplMonad
......@@ -63,11 +64,16 @@ import Outputable
\begin{code}
data SimplCont -- Strict contexts
= Stop OutType -- Type of the result
= Stop OutType -- Type of the result
LetRhsFlag
Bool -- True <=> This is the RHS of a thunk whose type suggests
-- that update-in-place would be possible
-- (This makes the inliner a little keener.)
Bool -- True <=> There is something interesting about
-- the context, and hence the inliner
-- should be a bit keener (see interestingCallContext)
-- Two cases:
-- (a) This is the RHS of a thunk whose type suggests
-- that update-in-place would be possible
-- (b) This is an argument of a function that has RULES
-- Inlining the call might allow the rule to fire
| CoerceIt OutType -- The To-type, simplified
SimplCont
......@@ -86,7 +92,7 @@ data SimplCont -- Strict contexts
| ArgOf LetRhsFlag -- An arbitrary strict context: the argument
-- of a strict function, or a primitive-arg fn
-- or a PrimOp
-- No DupFlag because we never duplicate it
-- No DupFlag, because we never duplicate it
OutType -- arg_ty: type of the argument itself
OutType -- cont_ty: the type of the expression being sought by the context
-- f (error "foo") ==> coerce t (error "foo")
......@@ -120,9 +126,14 @@ instance Outputable DupFlag where
-------------------
mkBoringStop, mkRhsStop :: OutType -> SimplCont
mkBoringStop ty = Stop ty AnArg (canUpdateInPlace ty)
mkRhsStop ty = Stop ty AnRhs (canUpdateInPlace ty)
mkBoringStop :: OutType -> SimplCont
mkBoringStop ty = Stop ty AnArg False
mkLazyArgStop :: OutType -> Bool -> SimplCont
mkLazyArgStop ty has_rules = Stop ty AnArg (canUpdateInPlace ty || has_rules)
mkRhsStop :: OutType -> SimplCont
mkRhsStop ty = Stop ty AnRhs (canUpdateInPlace ty)
contIsRhs :: SimplCont -> Bool
contIsRhs (Stop _ AnRhs _) = True
......@@ -382,7 +393,7 @@ interestingCallContext some_args some_val_args cont
-- seen (coerce f) x, where f has an INLINE prag,
-- So we have to give some motivaiton for inlining it
interesting (ArgOf _ _ _ _) = some_val_args
interesting (Stop ty _ upd_in_place) = some_val_args && upd_in_place
interesting (Stop ty _ interesting) = some_val_args && interesting
interesting (CoerceIt _ cont) = interesting cont
-- If this call is the arg of a strict function, the context
-- is a bit interesting. If we inline here, we may get useful
......@@ -400,6 +411,33 @@ interestingCallContext some_args some_val_args cont
-- the context for (f x) is not totally uninteresting.
-------------------
interestingArgContext :: Id -> SimplCont -> Bool
-- If the argument has form (f x y), where x,y are boring,
-- and f is marked INLINE, then we don't want to inline f.
-- But if the context of the argument is
-- g (f x y)
-- where g has rules, then we *do* want to inline f, in case it
-- exposes a rule that might fire. Similarly, if the context is
-- h (g (f x x))
-- where h has rules, then we do want to inline f.
-- The interesting_arg_ctxt flag makes this happen; if it's
-- set, the inliner gets just enough keener to inline f
-- regardless of how boring f's arguments are, if it's marked INLINE
--
-- The alternative would be to *always* inline an INLINE function,
-- regardless of how boring its context is; but that seems overkill
-- For example, it'd mean that wrapper functions were always inlined
interestingArgContext fn cont
= idHasRules fn || go cont
where
go (InlinePlease c) = go c
go (Select {}) = False
go (ApplyTo {}) = False
go (ArgOf {}) = True
go (CoerceIt _ c) = go c
go (Stop _ _ interesting) = interesting
-------------------
canUpdateInPlace :: Type -> Bool
-- Consider let x = <wurble> in ...
......
......@@ -15,11 +15,11 @@ import SimplMonad
import SimplEnv
import SimplUtils ( mkCase, mkLam,
SimplCont(..), DupFlag(..), LetRhsFlag(..),
mkRhsStop, mkBoringStop, pushContArgs,
mkRhsStop, mkBoringStop, mkLazyArgStop, pushContArgs,
contResultType, countArgs, contIsDupable, contIsRhsOrArg,
getContArgs, interestingCallContext, interestingArg, isStrictType,
preInlineUnconditionally, postInlineUnconditionally,
inlineMode, activeInline, activeRule
interestingArgContext, inlineMode, activeInline, activeRule
)
import Id ( Id, idType, idInfo, idArity, isDataConWorkId,
idUnfolding, setIdUnfolding, isDeadBinder,
......@@ -923,7 +923,8 @@ completeCall env var occ_info cont
(args, call_cont, inline_call) = getContArgs chkr var cont
fn_ty = idType var
in
simplifyArgs env fn_ty args (contResultType call_cont) $ \ env args ->
simplifyArgs env fn_ty (interestingArgContext var call_cont) args
(contResultType call_cont) $ \ env args ->
-- Next, look for rules or specialisations that match
--
......@@ -976,11 +977,9 @@ completeCall env var occ_info cont
-- Next, look for an inlining
let
arg_infos = [ interestingArg arg | arg <- args, isValArg arg]
interesting_cont = interestingCallContext (notNull args)
(notNull arg_infos)
call_cont
active_inline = activeInline env var occ_info
maybe_inline = callSiteInline dflags active_inline inline_call occ_info
var arg_infos interesting_cont
......@@ -1053,6 +1052,7 @@ makeThatCall env var fun args cont
simplifyArgs :: SimplEnv
-> OutType -- Type of the function
-> Bool -- True if the fn has RULES
-> [(InExpr, SimplEnv, Bool)] -- Details of the arguments
-> OutType -- Type of the continuation
-> (SimplEnv -> [OutExpr] -> SimplM FloatsWithExpr)
......@@ -1083,19 +1083,19 @@ simplifyArgs :: SimplEnv
-- discard the entire application and replace it with (error "foo"). Getting
-- all this at once is TOO HARD!
simplifyArgs env fn_ty args cont_ty thing_inside
simplifyArgs env fn_ty has_rules args cont_ty thing_inside
= go env fn_ty args thing_inside
where
go env fn_ty [] thing_inside = thing_inside env []
go env fn_ty (arg:args) thing_inside = simplifyArg env fn_ty arg cont_ty $ \ env arg' ->
go env fn_ty (arg:args) thing_inside = simplifyArg env fn_ty has_rules arg cont_ty $ \ env arg' ->
go env (applyTypeToArg fn_ty arg') args $ \ env args' ->
thing_inside env (arg':args')
simplifyArg env fn_ty (Type ty_arg, se, _) cont_ty thing_inside
simplifyArg env fn_ty has_rules (Type ty_arg, se, _) cont_ty thing_inside
= simplType (setInScope se env) ty_arg `thenSmpl` \ new_ty_arg ->
thing_inside env (Type new_ty_arg)
simplifyArg env fn_ty (val_arg, arg_se, is_strict) cont_ty thing_inside
simplifyArg env fn_ty has_rules (val_arg, arg_se, is_strict) cont_ty thing_inside
| is_strict
= simplStrictArg AnArg env val_arg arg_se arg_ty cont_ty thing_inside
......@@ -1105,8 +1105,8 @@ simplifyArg env fn_ty (val_arg, arg_se, is_strict) cont_ty thing_inside
-- have to be very careful about bogus strictness through
-- floating a demanded let.
= simplExprC (setInScope arg_se env) val_arg
(mkBoringStop arg_ty) `thenSmpl` \ arg1 ->
thing_inside env arg1
(mkLazyArgStop arg_ty has_rules) `thenSmpl` \ arg1 ->
thing_inside env arg1
where
arg_ty = funArgTy fn_ty
......
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