2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 \section[WorkWrap]{Worker/wrapper-generating back-end of strictness analyser}
7 module WorkWrap ( wwTopBinds, mkWrapper ) where
10 import CoreUnfold ( certainlyWillInline )
11 import CoreUtils ( exprType, exprIsHNF, mkInlineMe )
12 import CoreArity ( exprArity )
14 import Id ( Id, idType, isOneShotLambda, idUnfolding,
15 setIdNewStrictness, mkWorkerId,
16 setIdWorkerInfo, setInlineActivation,
20 import NewDemand ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..),
21 Demands(..), mkTopDmdType, isBotRes, returnsCPR, topSig, isAbsent
24 import BasicTypes ( RecFlag(..), isNonRec, isNeverActive,
25 Activation, inlinePragmaActivation )
26 import VarEnv ( isEmptyVarEnv )
27 import Maybes ( orElse )
29 import Util ( lengthIs, notNull )
33 #include "HsVersions.h"
36 We take Core bindings whose binders have:
40 \item Strictness attached (by the front-end of the strictness
43 \item Constructed Product Result information attached by the CPR
48 and we return some ``plain'' bindings which have been
49 worker/wrapper-ified, meaning:
53 \item Functions have been split into workers and wrappers where
54 appropriate. If a function has both strictness and CPR properties
55 then only one worker/wrapper doing both transformations is produced;
57 \item Binders' @IdInfos@ have been updated to reflect the existence of
58 these workers/wrappers (this is where we get STRICTNESS and CPR pragma
59 info for exported values).
63 wwTopBinds :: UniqSupply -> [CoreBind] -> [CoreBind]
65 wwTopBinds us top_binds
67 top_binds' <- mapM wwBind top_binds
68 return (concat top_binds')
71 %************************************************************************
73 \subsection[wwBind-wwExpr]{@wwBind@ and @wwExpr@}
75 %************************************************************************
77 @wwBind@ works on a binding, trying each \tr{(binder, expr)} pair in
78 turn. Non-recursive case first, then recursive...
82 -> UniqSM [CoreBind] -- returns a WwBinding intermediate form;
83 -- the caller will convert to Expr/Binding,
86 wwBind (NonRec binder rhs) = do
88 new_pairs <- tryWW NonRecursive binder new_rhs
89 return [NonRec b e | (b,e) <- new_pairs]
90 -- Generated bindings must be non-recursive
91 -- because the original binding was.
94 = return . Rec <$> concatMapM do_one pairs
96 do_one (binder, rhs) = do new_rhs <- wwExpr rhs
97 tryWW Recursive binder new_rhs
100 @wwExpr@ basically just walks the tree, looking for appropriate
101 annotations that can be used. Remember it is @wwBind@ that does the
102 matching by looking for strict arguments of the correct type.
103 @wwExpr@ is a version that just returns the ``Plain'' Tree.
106 wwExpr :: CoreExpr -> UniqSM CoreExpr
108 wwExpr e@(Type {}) = return e
109 wwExpr e@(Lit {}) = return e
110 wwExpr e@(Var {}) = return e
111 wwExpr e@(Note InlineMe _) = return e
112 -- Don't w/w inside InlineMe's
114 wwExpr (Lam binder expr)
115 = Lam binder <$> wwExpr expr
118 = App <$> wwExpr f <*> wwExpr a
120 wwExpr (Note note expr)
121 = Note note <$> wwExpr expr
123 wwExpr (Cast expr co) = do
124 new_expr <- wwExpr expr
125 return (Cast new_expr co)
127 wwExpr (Let bind expr)
128 = mkLets <$> wwBind bind <*> wwExpr expr
130 wwExpr (Case expr binder ty alts) = do
131 new_expr <- wwExpr expr
132 new_alts <- mapM ww_alt alts
133 return (Case new_expr binder ty new_alts)
135 ww_alt (con, binders, rhs) = do
136 new_rhs <- wwExpr rhs
137 return (con, binders, new_rhs)
140 %************************************************************************
142 \subsection[tryWW]{@tryWW@: attempt a worker/wrapper pair}
144 %************************************************************************
146 @tryWW@ just accumulates arguments, converts strictness info from the
147 front-end into the proper form, then calls @mkWwBodies@ to do
150 We have to BE CAREFUL that we don't worker-wrapperize an Id that has
151 already been w-w'd! (You can end up with several liked-named Ids
152 bouncing around at the same time---absolute mischief.) So the
153 criterion we use is: if an Id already has an unfolding (for whatever
154 reason), then we don't w-w it.
156 The only reason this is monadised is for the unique supply.
158 Note [Don't w/w inline things (a)]
159 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
160 It's very important to refrain from w/w-ing an INLINE function
161 If we do so by mistake we transform
162 f = __inline (\x -> E)
164 f = __inline (\x -> case x of (a,b) -> fw E)
165 fw = \ab -> (__inline (\x -> E)) (a,b)
166 and the original __inline now vanishes, so E is no longer
167 inside its __inline wrapper. Death! Disaster!
169 Furthermore, if the programmer has marked something as INLINE,
170 we may lose by w/w'ing it.
172 If the strictness analyser is run twice, this test also prevents
173 wrappers (which are INLINEd) from being re-done.
175 Notice that we refrain from w/w'ing an INLINE function even if it is
176 in a recursive group. It might not be the loop breaker. (We could
177 test for loop-breaker-hood, but I'm not sure that ever matters.)
179 Note [Don't w/w inline things (b)]
180 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
181 In general, therefore, we refrain from w/w-ing *small* functions,
182 because they'll inline anyway. But we must take care: it may look
183 small now, but get to be big later after other inling has happened.
184 So we take the precaution of adding an INLINE pragma to any such
187 I made this change when I observed a big function at the end of
188 compilation with a useful strictness signature but no w-w. When
189 I measured it on nofib, it didn't make much difference; just a few
190 percent improved allocation on one benchmark (bspt/Euclid.space).
191 But nothing got worse.
196 -> Id -- The fn binder
197 -> CoreExpr -- The bound rhs; its innards
199 -> UniqSM [(Id, CoreExpr)] -- either *one* or *two* pairs;
200 -- if one, then no worker (only
201 -- the orig "wrapper" lives on);
202 -- if two, then a worker and a
204 tryWW is_rec fn_id rhs
205 | isNeverActive inline_act
206 -- No point in worker/wrappering if the thing is never inlined!
207 -- Because the no-inline prag will prevent the wrapper ever
208 -- being inlined at a call site.
210 -- Furthermore, don't even expose strictness info
211 = return [ (fn_id, rhs) ]
213 | is_thunk && worthSplittingThunk maybe_fn_dmd res_info
214 = ASSERT2( isNonRec is_rec, ppr new_fn_id ) -- The thunk must be non-recursive
215 checkSize new_fn_id rhs $
216 splitThunk new_fn_id rhs
218 | is_fun && worthSplittingFun wrap_dmds res_info
219 = checkSize new_fn_id rhs $
220 splitFun new_fn_id fn_info wrap_dmds res_info inline_act rhs
223 = return [ (new_fn_id, rhs) ]
226 fn_info = idInfo fn_id
227 maybe_fn_dmd = newDemandInfo fn_info
228 inline_act = inlinePragmaActivation (inlinePragInfo fn_info)
230 -- In practice it always will have a strictness
231 -- signature, even if it's a uninformative one
232 strict_sig = newStrictnessInfo fn_info `orElse` topSig
233 StrictSig (DmdType env wrap_dmds res_info) = strict_sig
235 -- new_fn_id has the DmdEnv zapped.
236 -- (a) it is never used again
237 -- (b) it wastes space
238 -- (c) it becomes incorrect as things are cloned, because
239 -- we don't push the substitution into it
240 new_fn_id | isEmptyVarEnv env = fn_id
241 | otherwise = fn_id `setIdNewStrictness`
242 StrictSig (mkTopDmdType wrap_dmds res_info)
244 is_fun = notNull wrap_dmds
245 is_thunk = not is_fun && not (exprIsHNF rhs)
247 ---------------------
248 checkSize :: Id -> CoreExpr -> UniqSM [(Id,CoreExpr)] -> UniqSM [(Id,CoreExpr)]
249 -- See Note [Don't w/w inline things (a) and (b)]
250 checkSize fn_id rhs thing_inside
251 | certainlyWillInline unfolding = return [ (fn_id, mkInlineMe rhs) ]
252 -- Note [Don't w/w inline things (b)]
253 | otherwise = thing_inside
255 unfolding = idUnfolding fn_id
257 ---------------------
258 splitFun :: Id -> IdInfo -> [Demand] -> DmdResult -> Activation -> Expr Var
259 -> UniqSM [(Id, CoreExpr)]
260 splitFun fn_id fn_info wrap_dmds res_info inline_act rhs
261 = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) )
263 -- The arity should match the signature
264 (work_demands, wrap_fn, work_fn) <- mkWwBodies fun_ty wrap_dmds res_info one_shots
265 ; work_uniq <- getUniqueM
267 work_rhs = work_fn rhs
268 work_id = mkWorkerId work_uniq fn_id (exprType work_rhs)
269 `setInlineActivation` inline_act
270 -- Any inline activation (which sets when inlining is active)
271 -- on the original function is duplicated on the worker and wrapper
272 -- It *matters* that the pragma stays on the wrapper
273 -- It seems sensible to have it on the worker too, although we
274 -- can't think of a compelling reason. (In ptic, INLINE things are
275 -- not w/wd). However, the RuleMatchInfo is not transferred since
276 -- it does not make sense for workers to be constructorlike.
277 `setIdNewStrictness` StrictSig (mkTopDmdType work_demands work_res_info)
278 -- Even though we may not be at top level,
279 -- it's ok to give it an empty DmdEnv
280 `setIdArity` (exprArity work_rhs)
281 -- Set the arity so that the Core Lint check that the
282 -- arity is consistent with the demand type goes through
284 wrap_rhs = wrap_fn work_id
285 wrap_id = fn_id `setIdWorkerInfo` HasWorker work_id arity
287 ; return ([(work_id, work_rhs), (wrap_id, wrap_rhs)]) })
288 -- Worker first, because wrapper mentions it
289 -- mkWwBodies has already built a wrap_rhs with an INLINE pragma wrapped around it
291 fun_ty = idType fn_id
293 arity = arityInfo fn_info -- The arity is set by the simplifier using exprEtaExpandArity
294 -- So it may be more than the number of top-level-visible lambdas
296 work_res_info | isBotRes res_info = BotRes -- Cpr stuff done by wrapper
299 one_shots = get_one_shots rhs
301 -- If the original function has one-shot arguments, it is important to
302 -- make the wrapper and worker have corresponding one-shot arguments too.
303 -- Otherwise we spuriously float stuff out of case-expression join points,
304 -- which is very annoying.
305 get_one_shots :: Expr Var -> [Bool]
306 get_one_shots (Lam b e)
307 | isId b = isOneShotLambda b : get_one_shots e
308 | otherwise = get_one_shots e
309 get_one_shots (Note _ e) = get_one_shots e
310 get_one_shots _ = noOneShotInfo
315 Suppose x is used strictly (never mind whether it has the CPR
322 splitThunk transforms like this:
325 x* = case x-rhs of { I# a -> I# a }
328 Now simplifier will transform to
331 I# a -> let x* = I# a
334 which is what we want. Now suppose x-rhs is itself a case:
336 x-rhs = case e of { T -> I# a; F -> I# b }
338 The join point will abstract over a, rather than over (which is
339 what would have happened before) which is fine.
341 Notice that x certainly has the CPR property now!
343 In fact, splitThunk uses the function argument w/w splitting
344 function, so that if x's demand is deeper (say U(U(L,L),L))
345 then the splitting will go deeper too.
348 -- splitThunk converts the *non-recursive* binding
353 -- I# y -> let x = I# y in x }
354 -- See comments above. Is it not beautifully short?
356 splitThunk :: Var -> Expr Var -> UniqSM [(Var, Expr Var)]
357 splitThunk fn_id rhs = do
358 (_, wrap_fn, work_fn) <- mkWWstr [fn_id]
359 return [ (fn_id, Let (NonRec fn_id rhs) (wrap_fn (work_fn (Var fn_id)))) ]
363 %************************************************************************
365 \subsection{Functions over Demands}
367 %************************************************************************
370 worthSplittingFun :: [Demand] -> DmdResult -> Bool
371 -- True <=> the wrapper would not be an identity function
372 worthSplittingFun ds res
373 = any worth_it ds || returnsCPR res
374 -- worthSplitting returns False for an empty list of demands,
375 -- and hence do_strict_ww is False if arity is zero and there is no CPR
376 -- See Note [Worker-wrapper for bottoming functions]
378 worth_it Abs = True -- Absent arg
379 worth_it (Eval (Prod _)) = True -- Product arg to evaluate
382 worthSplittingThunk :: Maybe Demand -- Demand on the thunk
383 -> DmdResult -- CPR info for the thunk
385 worthSplittingThunk maybe_dmd res
386 = worth_it maybe_dmd || returnsCPR res
388 -- Split if the thing is unpacked
389 worth_it (Just (Eval (Prod ds))) = not (all isAbsent ds)
393 Note [Worker-wrapper for bottoming functions]
394 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
395 We used not to split if the result is bottom.
396 [Justification: there's no efficiency to be gained.]
398 But it's sometimes bad not to make a wrapper. Consider
399 fw = \x# -> let x = I# x# in case e of
403 The re-boxing code won't go away unless error_fn gets a wrapper too.
404 [We don't do reboxing now, but in general it's better to pass an
405 unboxed thing to f, and have it reboxed in the error cases....]
408 %************************************************************************
410 \subsection{The worker wrapper core}
412 %************************************************************************
414 @mkWrapper@ is called when importing a function. We have the type of
415 the function and the name of its worker, and we want to make its body (the wrapper).
418 mkWrapper :: Type -- Wrapper type
419 -> StrictSig -- Wrapper strictness info
420 -> UniqSM (Id -> CoreExpr) -- Wrapper body, missing worker Id
422 mkWrapper fun_ty (StrictSig (DmdType _ demands res_info)) = do
423 (_, wrap_fn, _) <- mkWwBodies fun_ty demands res_info noOneShotInfo
426 noOneShotInfo :: [Bool]
427 noOneShotInfo = repeat False