-tryWW fn_id rhs
- | idWantsToBeINLINEd fn_id
- -- No point in worker/wrappering something that is going to be
- -- INLINEd wholesale anyway. If the strictness analyser is run
- -- twice, this test also prevents wrappers (which are INLINEd)
- -- from being re-done.
- = do_nothing
-
- | otherwise
- = case (getIdStrictness fn_id) of
-
- NoStrictnessInfo -> do_nothing
- BottomGuaranteed -> do_nothing
- StrictnessInfo [] _ -> do_nothing -- V weird (but possible?)
-
- StrictnessInfo args_info _ ->
- if not (indicatesWorker args_info) then
- do_nothing
- else
-
- -- OK, it looks as if a worker is worth a try
- let
- (uvars, tyvars, args, body) = collectBinders rhs
- body_ty = coreExprType body
- in
- mkWwBodies body_ty tyvars args args_info `thenUs` \ result ->
- case result of
-
- Nothing -> -- Very peculiar. This can only happen if we hit an
- -- abstract type, which we shouldn't have since we've
- -- constructed the args_info in this module!
-
- -- False. We might hit the all-args-absent-and-the-
- -- body-is-unboxed case. A Nothing is legit. (WDP 94/10)
- do_nothing
-
- Just (wrapper_w_hole, worker_w_hole, worker_strictness, worker_ty_w_hole) ->
-
- -- Terrific! It worked!
- getUnique `thenUs` \ worker_uniq ->
- let
- worker_ty = worker_ty_w_hole body_ty
-
- worker_id = mkWorkerId worker_uniq fn_id worker_ty
- (noIdInfo `addInfo` worker_strictness)
-
- wrapper_rhs = wrapper_w_hole worker_id
- worker_rhs = worker_w_hole body
-
- revised_strictness_info
- = -- We know the basic strictness info already, but
- -- we need to slam in the exact identity of the
- -- worker Id:
- mkStrictnessInfo args_info (Just worker_id)
-
- wrapper_id = fn_id `replaceIdInfo`
- (getIdInfo fn_id `addInfo`
- revised_strictness_info `addInfo_UF`
- iWantToBeINLINEd UnfoldAlways)
- -- NB! the "iWantToBeINLINEd" part adds an INLINE pragma to
- -- the wrapper, which is of course what we want.
- in
- returnUs [ (worker_id, worker_rhs), -- worker comes first
- (wrapper_id, wrapper_rhs) ] -- because wrapper mentions it
+tryWW non_rec fn_id rhs
+ | isNeverInlinePrag inline_prag || arity == 0
+ = -- Don't split things that will never be inlined
+ returnUs [ (fn_id, rhs) ]
+
+ | non_rec && not do_coerce_ww && certainlyWillInline fn_id
+ -- No point in worker/wrappering a function that is going to be
+ -- INLINEd wholesale anyway. If the strictness analyser is run
+ -- twice, this test also prevents wrappers (which are INLINEd)
+ -- from being re-done.
+ --
+ -- The do_coerce_ww test is so that
+ -- a function with a coerce should w/w to get rid
+ -- of the coerces, which can significantly improve its arity.
+ -- Example: f [] = return [] :: IO [Int]
+ -- f (x:xs) = return (x:xs)
+ -- If we aren't careful we end up with
+ -- f = \ x -> case x of {
+ -- x:xs -> __coerce (IO [Int]) (\ s -> (# s, x:xs #)
+ -- [] -> lvl_sJ8
+ --
+ --
+ -- OUT OF DATE NOTE, kept for info:
+ -- It's out of date because now wrappers look very cheap
+ -- even when they are inlined.
+ -- In this case we add an INLINE pragma to the RHS. Why?
+ -- Because consider
+ -- f = \x -> g x x
+ -- g = \yz -> ... -- And g is strict
+ -- Then f is small, so we don't w/w it. But g is big, and we do, so
+ -- g's wrapper will get inlined in f's RHS, which makes f look big now.
+ -- So f doesn't get inlined, but it is strict and we have failed to w/w it.
+ = returnUs [ (fn_id, rhs) ]
+
+ | not (do_strict_ww || do_cpr_ww || do_coerce_ww)
+ = returnUs [ (fn_id, rhs) ]
+
+ | otherwise -- Do w/w split
+ = mkWwBodies fun_ty arity wrap_dmds result_bot one_shots cpr_info `thenUs` \ (work_demands, wrap_fn, work_fn) ->
+ getUniqueUs `thenUs` \ work_uniq ->
+ let
+ work_rhs = work_fn rhs
+ proto_work_id = mkWorkerId work_uniq fn_id (exprType work_rhs)
+ `setInlinePragma` inline_prag
+
+ work_id | has_strictness = proto_work_id `setIdStrictness` mkStrictnessInfo (work_demands, result_bot)
+ | otherwise = proto_work_id
+
+ wrap_rhs = wrap_fn work_id
+ wrap_id = fn_id `setIdStrictness` wrapper_strictness
+ `setIdWorkerInfo` HasWorker work_id arity
+ `setInlinePragma` NoInlinePragInfo -- Put it on the worker instead
+ -- Add info to the wrapper:
+ -- (a) we want to set its arity
+ -- (b) we want to pin on its revised strictness info
+ -- (c) we pin on its worker id
+ in
+ returnUs ([(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 it
+ where
+ fun_ty = idType fn_id
+ arity = idArity fn_id -- The arity is set by the simplifier using exprEtaExpandArity
+ -- So it may be more than the number of top-level-visible lambdas
+
+ inline_prag = idInlinePragma fn_id
+
+ strictness_info = idStrictness fn_id
+ has_strictness = case strictness_info of
+ StrictnessInfo _ _ -> True
+ NoStrictnessInfo -> False
+ (arg_demands, result_bot) = case strictness_info of
+ StrictnessInfo d r -> (d, r)
+ NoStrictnessInfo -> ([], False)
+
+ wrap_dmds = setUnpackStrategy arg_demands
+ do_strict_ww = WARN( has_strictness && not result_bot && arity < length arg_demands && worthSplitting wrap_dmds result_bot,
+ text "Insufficient arity" <+> ppr fn_id <+> ppr arity <+> ppr arg_demands )
+ (result_bot || arity >= length arg_demands) -- Only if there's enough visible arity
+ && -- (else strictness info isn't valid)
+ --
+ worthSplitting wrap_dmds result_bot -- And it's useful
+ -- worthSplitting returns False for an empty list of demands,
+ -- and hence do_strict_ww is False if arity is zero
+ -- Also it's false if there is no strictness (arg_demands is [])
+
+ wrapper_strictness | has_strictness = mkStrictnessInfo (wrap_dmds, result_bot)
+ | otherwise = noStrictnessInfo
+
+ -------------------------------------------------------------
+ cpr_info = idCprInfo fn_id
+ do_cpr_ww = arity > 0 &&
+ case cpr_info of
+ ReturnsCPR -> True
+ other -> False
+
+ -------------------------------------------------------------
+ do_coerce_ww = check_for_coerce arity fun_ty
+ -- We are willing to do a w/w even if the arity is zero.
+ -- x = coerce t E
+ -- ==>
+ -- x' = E
+ -- x = coerce t x'
+
+ -------------------------------------------------------------
+ one_shots = get_one_shots rhs
+
+-- See if there's a Coerce before we run out of arity;
+-- if so, it's worth trying a w/w split. Reason: we find
+-- functions like f = coerce (\s -> e)
+-- and g = \x -> coerce (\s -> e)
+-- and they may have no useful strictness or cpr info, but if we
+-- do the w/w thing we get rid of the coerces.
+
+check_for_coerce arity ty
+ = length arg_tys <= arity && isNewType res_ty
+ -- Don't look further than arity args,
+ -- but if there are arity or fewer, see if there's
+ -- a newtype in the corner