{-# OPTIONS -fno-warn-tabs #-}-- The above warning supression flag is a temporary kludge.-- While working on this module you are encouraged to remove it and-- detab the module (please do the detabbing in a separate patch). See-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces-- for detailsmoduleWorkWrap(wwTopBinds,mkWrapper)whereimportCoreSynimportCoreUnfold(certainlyWillInline,mkInlineUnfolding,mkWwInlineRule)importCoreUtils(exprType,exprIsHNF)importCoreArity(exprArity)importVarimportIdimportType(Type)importIdInfoimportDemandimportUniqSupplyimportBasicTypesimportDynFlagsimportVarEnv(isEmptyVarEnv)importMaybes(orElse)importWwLibimportUtilimportOutputableimportMonadUtils#include "HsVersions.h"

\end{code}
We take Core bindings whose binders have:
\begin{enumerate}
\item Strictness attached (by the front-end of the strictness
analyser), and / or
\item Constructed Product Result information attached by the CPR
analysis pass.
\end{enumerate}
and we return some ``plain'' bindings which have been
worker/wrapper-ified, meaning:
\begin{enumerate}
\item Functions have been split into workers and wrappers where
appropriate. If a function has both strictness and CPR properties
then only one worker/wrapper doing both transformations is produced;
\item Binders' @IdInfos@ have been updated to reflect the existence of
these workers/wrappers (this is where we get STRICTNESS and CPR pragma
info for exported values).
\end{enumerate}
\begin{code}

wwBind::DynFlags->CoreBind->UniqSM[CoreBind]-- returns a WwBinding intermediate form;-- the caller will convert to Expr/Binding,-- as appropriate.wwBinddflags(NonRecbinderrhs)=donew_rhs<-wwExprdflagsrhsnew_pairs<-tryWWdflagsNonRecursivebindernew_rhsreturn[NonRecbe|(b,e)<-new_pairs]-- Generated bindings must be non-recursive-- because the original binding was.wwBinddflags(Recpairs)=return.Rec<$>concatMapMdo_onepairswheredo_one(binder,rhs)=donew_rhs<-wwExprdflagsrhstryWWdflagsRecursivebindernew_rhs

\end{code}
@wwExpr@ basically just walks the tree, looking for appropriate
annotations that can be used. Remember it is @wwBind@ that does the
matching by looking for strict arguments of the correct type.
@wwExpr@ is a version that just returns the ``Plain'' Tree.
\begin{code}

\end{code}
%************************************************************************
%* *
\subsection[tryWW]{@tryWW@: attempt a worker/wrapper pair}
%* *
%************************************************************************
@tryWW@ just accumulates arguments, converts strictness info from the
front-end into the proper form, then calls @mkWwBodies@ to do
the business.
The only reason this is monadised is for the unique supply.
Note [Don't w/w INLINE things]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's very important to refrain from w/w-ing an INLINE function (ie one
with an InlineRule) because the wrapper will then overwrite the
InlineRule unfolding.
Furthermore, if the programmer has marked something as INLINE,
we may lose by w/w'ing it.
If the strictness analyser is run twice, this test also prevents
wrappers (which are INLINEd) from being re-done. (You can end up with
several liked-named Ids bouncing around at the same time---absolute
mischief.)
Notice that we refrain from w/w'ing an INLINE function even if it is
in a recursive group. It might not be the loop breaker. (We could
test for loop-breaker-hood, but I'm not sure that ever matters.)
Note [Don't w/w INLINABLE things]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have
{-# INLINABLE f #-}
f x y = ....
then in principle we might get a more efficient loop by w/w'ing f.
But that would make a new unfolding which would overwrite the old
one. So we leave INLINABLE things alone too.
This is a slight infelicity really, because it means that adding
an INLINABLE pragma could make a program a bit less efficient,
because you lose the worker/wrapper stuff. But I don't see a way
to avoid that.
Note [Don't w/w inline small non-loop-breaker things]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In general, we refrain from w/w-ing *small* functions, which are not
loop breakers, because they'll inline anyway. But we must take care:
it may look small now, but get to be big later after other inlining
has happened. So we take the precaution of adding an INLINE pragma to
any such functions.
I made this change when I observed a big function at the end of
compilation with a useful strictness signature but no w-w. (It was
small during demand analysis, we refrained from w/w, and then got big
when something was inlined in its rhs.) When I measured it on nofib,
it didn't make much difference; just a few percent improved allocation
on one benchmark (bspt/Euclid.space). But nothing got worse.
There is an infelicity though. We may get something like
f = g val
==>
g x = case gw x of r -> I# r
f {- InlineStable, Template = g val -}
f = case gw x of r -> I# r
The code for f duplicates that for g, without any real benefit. It
won't really be executed, because calls to f will go via the inlining.
Note [Wrapper activation]
~~~~~~~~~~~~~~~~~~~~~~~~~
When should the wrapper inlining be active? It must not be active
earlier than the current Activation of the Id (eg it might have a
NOINLINE pragma). But in fact strictness analysis happens fairly
late in the pipeline, and we want to prioritise specialisations over
strictness. Eg if we have
module Foo where
f :: Num a => a -> Int -> a
f n 0 = n -- Strict in the Int, hence wrapper
f n x = f (n+n) (x-1)
g :: Int -> Int
g x = f x x -- Provokes a specialisation for f
module Bsr where
import Foo
h :: Int -> Int
h x = f 3 x
Then we want the specialisation for 'f' to kick in before the wrapper does.
Now in fact the 'gentle' simplification pass encourages this, by
having rules on, but inlinings off. But that's kind of lucky. It seems
more robust to give the wrapper an Activation of (ActiveAfter 0),
so that it becomes active in an importing module at the same time that
it appears in the first place in the defining module.
\begin{code}

tryWW::DynFlags->RecFlag->Id-- The fn binder->CoreExpr-- The bound rhs; its innards-- are already ww'd->UniqSM[(Id,CoreExpr)]-- either *one* or *two* pairs;-- if one, then no worker (only-- the orig "wrapper" lives on);-- if two, then a worker and a-- wrapper.tryWWdflagsis_recfn_idrhs|isNeverActiveinline_act-- No point in worker/wrappering if the thing is never inlined!-- Because the no-inline prag will prevent the wrapper ever-- being inlined at a call site. -- -- Furthermore, don't even expose strictness info=return[(fn_id,rhs)]|is_thunk&&worthSplittingThunkmaybe_fn_dmdres_info-- See Note [Thunk splitting]=ASSERT2(isNonRecis_rec,pprnew_fn_id)-- The thunk must be non-recursivecheckSizenew_fn_idrhs$splitThunkdflagsnew_fn_idrhs|is_fun&&worthSplittingFunwrap_dmdsres_info=checkSizenew_fn_idrhs$splitFundflagsnew_fn_idfn_infowrap_dmdsres_inforhs|otherwise=return[(new_fn_id,rhs)]wherefn_info=idInfofn_idmaybe_fn_dmd=demandInfofn_infoinline_act=inlinePragmaActivation(inlinePragInfofn_info)-- In practice it always will have a strictness -- signature, even if it's a uninformative onestrict_sig=strictnessInfofn_info`orElse`topSigStrictSig(DmdTypeenvwrap_dmdsres_info)=strict_sig-- new_fn_id has the DmdEnv zapped. -- (a) it is never used again-- (b) it wastes space-- (c) it becomes incorrect as things are cloned, because-- we don't push the substitution into itnew_fn_id|isEmptyVarEnvenv=fn_id|otherwise=fn_id`setIdStrictness`StrictSig(mkTopDmdTypewrap_dmdsres_info)is_fun=notNullwrap_dmdsis_thunk=notis_fun&&not(exprIsHNFrhs)---------------------checkSize::Id->CoreExpr->UniqSM[(Id,CoreExpr)]->UniqSM[(Id,CoreExpr)]checkSizefn_idrhsthing_inside|isStableUnfolding(realIdUnfoldingfn_id)=return[(fn_id,rhs)]-- See Note [Don't w/w INLINE things]-- and Note [Don't w/w INLINABLE things]-- NB: use realIdUnfolding because we want to see the unfolding-- even if it's a loop breaker!|certainlyWillInline(idUnfoldingfn_id)=return[(fn_id`setIdUnfolding`inline_rule,rhs)]-- Note [Don't w/w inline small non-loop-breaker things]-- NB: use idUnfolding because we don't want to apply-- this criterion to a loop breaker!|otherwise=thing_insidewhereinline_rule=mkInlineUnfoldingNothingrhs---------------------splitFun::DynFlags->Id->IdInfo->[Demand]->DmdResult->ExprVar->UniqSM[(Id,CoreExpr)]splitFundflagsfn_idfn_infowrap_dmdsres_inforhs=WARN(not(wrap_dmds`lengthIs`arity),pprfn_id<+>(pprarity$$pprwrap_dmds$$pprres_info))(do{-- The arity should match the signature(work_demands,wrap_fn,work_fn)<-mkWwBodiesdflagsfun_tywrap_dmdsres_infoone_shots;work_uniq<-getUniqueM;letwork_rhs=work_fnrhswork_id=mkWorkerIdwork_uniqfn_id(exprTypework_rhs)`setIdOccInfo`occInfofn_info-- Copy over occurrence info from parent-- Notably whether it's a loop breaker-- Doesn't matter much, since we will simplify next, but-- seems right-er to do so`setInlineActivation`(inlinePragmaActivationinl_prag)-- Any inline activation (which sets when inlining is active) -- on the original function is duplicated on the worker-- It *matters* that the pragma stays on the wrapper-- It seems sensible to have it on the worker too, although we-- can't think of a compelling reason. (In ptic, INLINE things are -- not w/wd). However, the RuleMatchInfo is not transferred since-- it does not make sense for workers to be constructorlike.`setIdStrictness`StrictSig(mkTopDmdTypework_demandswork_res_info)-- Even though we may not be at top level, -- it's ok to give it an empty DmdEnv`setIdArity`(exprAritywork_rhs)-- Set the arity so that the Core Lint check that the -- arity is consistent with the demand type goes throughwrap_rhs=wrap_fnwork_idwrap_prag=InlinePragma{inl_inline=Inline,inl_sat=Nothing,inl_act=ActiveAfter0,inl_rule=rule_match_info}-- See Note [Wrapper activation]-- The RuleMatchInfo is (and must be) unaffected-- The inl_inline is bound to be False, else we would not be-- making a wrapperwrap_id=fn_id`setIdUnfolding`mkWwInlineRulework_idwrap_rhsarity`setInlinePragma`wrap_prag`setIdOccInfo`NoOccInfo-- Zap any loop-breaker-ness, to avoid bleating from Lint-- about a loop breaker with an INLINE rule;return([(work_id,work_rhs),(wrap_id,wrap_rhs)])})-- Worker first, because wrapper mentions it-- mkWwBodies has already built a wrap_rhs with an INLINE pragma wrapped around itwherefun_ty=idTypefn_idinl_prag=inlinePragInfofn_inforule_match_info=inlinePragmaRuleMatchInfoinl_pragarity=arityInfofn_info-- The arity is set by the simplifier using exprEtaExpandArity-- So it may be more than the number of top-level-visible lambdaswork_res_info|isBotResres_info=BotRes-- Cpr stuff done by wrapper|otherwise=TopResone_shots=get_one_shotsrhs-- If the original function has one-shot arguments, it is important to-- make the wrapper and worker have corresponding one-shot arguments too.-- Otherwise we spuriously float stuff out of case-expression join points,-- which is very annoying.get_one_shots::ExprVar->[Bool]get_one_shots(Lambe)|isIdb=isOneShotLambdab:get_one_shotse|otherwise=get_one_shotseget_one_shots(Tick_e)=get_one_shotseget_one_shots_=noOneShotInfo

\end{code}
Note [Thunk splitting]
~~~~~~~~~~~~~~~~~~~~~~
Suppose x is used strictly (never mind whether it has the CPR
property).
let
x* = x-rhs
in body
splitThunk transforms like this:
let
x* = case x-rhs of { I# a -> I# a }
in body
Now simplifier will transform to
case x-rhs of
I# a -> let x* = I# a
in body
which is what we want. Now suppose x-rhs is itself a case:
x-rhs = case e of { T -> I# a; F -> I# b }
The join point will abstract over a, rather than over (which is
what would have happened before) which is fine.
Notice that x certainly has the CPR property now!
In fact, splitThunk uses the function argument w/w splitting
function, so that if x's demand is deeper (say U(U(L,L),L))
then the splitting will go deeper too.
\begin{code}

worthSplittingFun::[Demand]->DmdResult->Bool-- True <=> the wrapper would not be an identity functionworthSplittingFundsres=anyworth_itds||returnsCPRres-- worthSplitting returns False for an empty list of demands,-- and hence do_strict_ww is False if arity is zero and there is no CPR-- See Note [Worker-wrapper for bottoming functions]whereworth_itAbs=True-- Absent argworth_it(Eval(Prod_))=True-- Product arg to evaluateworth_it_=FalseworthSplittingThunk::MaybeDemand-- Demand on the thunk->DmdResult-- CPR info for the thunk->BoolworthSplittingThunkmaybe_dmdres=worth_itmaybe_dmd||returnsCPRreswhere-- Split if the thing is unpackedworth_it(Just(Eval(Prodds)))=not(allisAbsentds)worth_it_=False

\end{code}
Note [Worker-wrapper for bottoming functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We used not to split if the result is bottom.
[Justification: there's no efficiency to be gained.]
But it's sometimes bad not to make a wrapper. Consider
fw = \x# -> let x = I# x# in case e of
p1 -> error_fn x
p2 -> error_fn x
p3 -> the real stuff
The re-boxing code won't go away unless error_fn gets a wrapper too.
[We don't do reboxing now, but in general it's better to pass an
unboxed thing to f, and have it reboxed in the error cases....]
%************************************************************************
%* *
\subsection{The worker wrapper core}
%* *
%************************************************************************
@mkWrapper@ is called when importing a function. We have the type of
the function and the name of its worker, and we want to make its body (the wrapper).
\begin{code}