Commit 5f84b52a authored by Philipp Krüger's avatar Philipp Krüger Committed by Marge Bot

Reduce boolean blindness in OccInfo(OneOcc) #17482

* Transformed the type aliases `InterestingCxt`, `InsideLam` and `OneBranch`
  into data types.
* Added Semigroup and Monoid instances for use in orOccInfo in OccurAnal.hs
* Simplified some usage sites by using pattern matching instead of boolean algebra.

Metric Increase:
    T12150

This increase was on a Mac-build of exactly 1%. This commit does *not* re-intruduce
the asymptotic memory usage described in T12150.
parent e122ba33
Pipeline #13269 passed with stages
in 593 minutes and 6 seconds
......@@ -67,9 +67,9 @@ module BasicTypes(
isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,
strongLoopBreaker, weakLoopBreaker,
InsideLam, insideLam, notInsideLam,
OneBranch, oneBranch, notOneBranch,
InterestingCxt,
InsideLam(..),
OneBranch(..),
InterestingCxt(..),
TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,
isAlwaysTailCalled,
......@@ -119,6 +119,7 @@ import SrcLoc ( Located,unLoc )
import Data.Data hiding (Fixity, Prefix, Infix)
import Data.Function (on)
import Data.Bits
import qualified Data.Semigroup as Semi
{-
************************************************************************
......@@ -897,7 +898,6 @@ data OccInfo
| IAmALoopBreaker { occ_rules_only :: !RulesOnly
, occ_tail :: !TailCallInfo }
-- Note [LoopBreaker OccInfo]
deriving (Eq)
type RulesOnly = Bool
......@@ -926,25 +926,52 @@ seqOccInfo occ = occ `seq` ()
-----------------
-- | Interesting Context
type InterestingCxt = Bool -- True <=> Function: is applied
-- Data value: scrutinised by a case with
-- at least one non-DEFAULT branch
data InterestingCxt
= IsInteresting
-- ^ Function: is applied
-- Data value: scrutinised by a case with at least one non-DEFAULT branch
| NotInteresting
deriving (Eq)
-- | If there is any 'interesting' identifier occurance, then the
-- aggregated occurance info of that identifier is considered interesting.
instance Semi.Semigroup InterestingCxt where
IsInteresting <> _ = IsInteresting
_ <> IsInteresting = IsInteresting
_ <> _ = NotInteresting
instance Monoid InterestingCxt where
mempty = NotInteresting
mappend = (Semi.<>)
-----------------
-- | Inside Lambda
type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
-- Substituting a redex for this occurrence is
-- dangerous because it might duplicate work.
insideLam, notInsideLam :: InsideLam
insideLam = True
notInsideLam = False
data InsideLam
= IsInsideLam
-- ^ Occurs inside a non-linear lambda
-- Substituting a redex for this occurrence is
-- dangerous because it might duplicate work.
| NotInsideLam
deriving (Eq)
-- | If any occurance of an identifier is inside a lambda, then the
-- occurance info of that identifier marks it as occuring inside a lambda
instance Semi.Semigroup InsideLam where
IsInsideLam <> _ = IsInsideLam
_ <> IsInsideLam = IsInsideLam
_ <> _ = NotInsideLam
instance Monoid InsideLam where
mempty = NotInsideLam
mappend = (Semi.<>)
-----------------
type OneBranch = Bool -- True <=> Occurs in only one case branch
-- so no code-duplication issue to worry about
oneBranch, notOneBranch :: OneBranch
oneBranch = True
notOneBranch = False
data OneBranch
= InOneBranch
-- ^ One syntactic occurance: Occurs in only one case branch
-- so no code-duplication issue to worry about
| MultipleBranches
deriving (Eq)
-----------------
data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo]
......@@ -1005,15 +1032,15 @@ instance Outputable OccInfo where
pp_ro | rule_only = char '!'
| otherwise = empty
ppr (OneOcc inside_lam one_branch int_cxt tail_info)
= text "Once" <> pp_lam <> pp_br <> pp_args <> pp_tail
= text "Once" <> pp_lam inside_lam <> pp_br one_branch <> pp_args int_cxt <> pp_tail
where
pp_lam | inside_lam = char 'L'
| otherwise = empty
pp_br | one_branch = empty
| otherwise = char '*'
pp_args | int_cxt = char '!'
| otherwise = empty
pp_tail = pprShortTailCallInfo tail_info
pp_lam IsInsideLam = char 'L'
pp_lam NotInsideLam = empty
pp_br MultipleBranches = char '*'
pp_br InOneBranch = empty
pp_args IsInteresting = char '!'
pp_args NotInteresting = empty
pp_tail = pprShortTailCallInfo tail_info
pprShortTailCallInfo :: TailCallInfo -> SDoc
pprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar)
......
......@@ -54,8 +54,7 @@ module IdInfo (
isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
occInfo, setOccInfo,
InsideLam, OneBranch,
insideLam, notInsideLam, oneBranch, notOneBranch,
InsideLam(..), OneBranch(..),
TailCallInfo(..),
tailCallInfo, isAlwaysTailCalled,
......@@ -508,12 +507,12 @@ zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
where
-- The "unsafe" occ info is the ones that say I'm not in a lambda
-- because that might not be true for an unsaturated lambda
is_safe_occ occ | isAlwaysTailCalled occ = False
is_safe_occ (OneOcc { occ_in_lam = in_lam }) = in_lam
is_safe_occ _other = True
is_safe_occ occ | isAlwaysTailCalled occ = False
is_safe_occ (OneOcc { occ_in_lam = NotInsideLam }) = False
is_safe_occ _other = True
safe_occ = case occ of
OneOcc{} -> occ { occ_in_lam = True
OneOcc{} -> occ { occ_in_lam = IsInsideLam
, occ_tail = NoTailCallInfo }
IAmALoopBreaker{}
-> occ { occ_tail = NoTailCallInfo }
......
......@@ -418,11 +418,12 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst })
-- Unconditionally safe to inline
safe_to_inline :: OccInfo -> Bool
safe_to_inline (IAmALoopBreaker {}) = False
safe_to_inline IAmDead = True
safe_to_inline occ@(OneOcc {}) = not (occ_in_lam occ)
&& occ_one_br occ
safe_to_inline (ManyOccs {}) = False
safe_to_inline IAmALoopBreaker{} = False
safe_to_inline IAmDead = True
safe_to_inline OneOcc{ occ_in_lam = NotInsideLam
, occ_one_br = InOneBranch } = True
safe_to_inline OneOcc{} = False
safe_to_inline ManyOccs{} = False
-------------------
simple_out_bind :: TopLevelFlag
......
......@@ -1534,8 +1534,8 @@ occAnalNonRecRhs env bndr bndrs body
certainly_inline -- See Note [Cascading inlines]
= case occ of
OneOcc { occ_in_lam = in_lam, occ_one_br = one_br }
-> not in_lam && one_br && active && not_stable
OneOcc { occ_in_lam = NotInsideLam, occ_one_br = InOneBranch }
-> active && not_stable
_ -> False
is_join_point = isAlwaysTailCalled occ
......@@ -1783,7 +1783,7 @@ occAnal env (Case scrut bndr ty alts)
occ_anal_scrut (Var v) (alt1 : other_alts)
| not (null other_alts) || not (isDefaultAlt alt1)
= (mkOneOcc env v True 0, Var v)
= (mkOneOcc env v IsInteresting 0, Var v)
-- The 'True' says that the variable occurs in an interesting
-- context; the case has at least one non-default alternative
occ_anal_scrut (Tick t e) alts
......@@ -1861,7 +1861,7 @@ occAnalApp env (Var fun, args, ticks)
n_val_args = valArgCount args
n_args = length args
fun_uds = mkOneOcc env fun (n_val_args > 0) n_args
fun_uds = mkOneOcc env fun (if n_val_args > 0 then IsInteresting else NotInteresting) n_args
is_exp = isExpandableApp fun n_val_args
-- See Note [CONLIKE pragma] in BasicTypes
-- The definition of is_exp should match that in Simplify.prepareRhs
......@@ -2475,8 +2475,8 @@ andUDsList = foldl' andUDs emptyDetails
mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails
mkOneOcc env id int_cxt arity
| isLocalId id
= singleton $ OneOcc { occ_in_lam = False
, occ_one_br = True
= singleton $ OneOcc { occ_in_lam = NotInsideLam
, occ_one_br = InOneBranch
, occ_int_cxt = int_cxt
, occ_tail = AlwaysTailCalled arity }
| id `elemVarSet` occ_gbl_scrut env
......@@ -2855,7 +2855,7 @@ markMany, markInsideLam, markNonTailCalled :: OccInfo -> OccInfo
markMany IAmDead = IAmDead
markMany occ = ManyOccs { occ_tail = occ_tail occ }
markInsideLam occ@(OneOcc {}) = occ { occ_in_lam = True }
markInsideLam occ@(OneOcc {}) = occ { occ_in_lam = IsInsideLam }
markInsideLam occ = occ
markNonTailCalled IAmDead = IAmDead
......@@ -2876,9 +2876,9 @@ orOccInfo (OneOcc { occ_in_lam = in_lam1, occ_int_cxt = int_cxt1
, occ_tail = tail1 })
(OneOcc { occ_in_lam = in_lam2, occ_int_cxt = int_cxt2
, occ_tail = tail2 })
= OneOcc { occ_one_br = False -- False, because it occurs in both branches
, occ_in_lam = in_lam1 || in_lam2
, occ_int_cxt = int_cxt1 && int_cxt2
= OneOcc { occ_one_br = MultipleBranches -- because it occurs in both branches
, occ_in_lam = in_lam1 `mappend` in_lam2
, occ_int_cxt = int_cxt1 `mappend` int_cxt2
, occ_tail = tail1 `andTailCallInfo` tail2 }
orOccInfo a1 a2 = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )
......
......@@ -1158,12 +1158,12 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
extend_subst_with inl_rhs = extendIdSubst env bndr (mkContEx rhs_env inl_rhs)
one_occ IAmDead = True -- Happens in ((\x.1) v)
one_occ (OneOcc { occ_one_br = True -- One textual occurrence
, occ_in_lam = in_lam
, occ_int_cxt = int_cxt })
| not in_lam = isNotTopLevel top_lvl || early_phase
| otherwise = int_cxt && canInlineInLam rhs
one_occ _ = False
one_occ OneOcc{ occ_one_br = InOneBranch
, occ_in_lam = NotInsideLam } = isNotTopLevel top_lvl || early_phase
one_occ OneOcc{ occ_one_br = InOneBranch
, occ_in_lam = IsInsideLam
, occ_int_cxt = IsInteresting } = canInlineInLam rhs
one_occ _ = False
pre_inline_unconditionally = gopt Opt_SimplPreInlining (seDynFlags env)
mode = getMode env
......@@ -1297,7 +1297,7 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs
-- PRINCIPLE: when we've already simplified an expression once,
-- make sure that we only inline it if it's reasonably small.
&& (not in_lam ||
&& (in_lam == NotInsideLam ||
-- Outside a lambda, we want to be reasonably aggressive
-- about inlining into multiple branches of case
-- e.g. let x = <non-value>
......@@ -1306,7 +1306,7 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs
-- the uses in C1, C2 are not 'interesting'
-- An example that gets worse if you add int_cxt here is 'clausify'
(isCheapUnfolding unfolding && int_cxt))
(isCheapUnfolding unfolding && int_cxt == IsInteresting))
-- isCheap => acceptable work duplication; in_lam may be true
-- int_cxt to prevent us inlining inside a lambda without some
-- good reason. See the notes on int_cxt in preInlineUnconditionally
......@@ -2251,7 +2251,10 @@ mkCase3 _dflags scrut bndr alts_ty alts
-- InIds, so it's crucial that isExitJoinId is only called on freshly
-- occ-analysed code. It's not a generic function you can call anywhere.
isExitJoinId :: Var -> Bool
isExitJoinId id = isJoinId id && isOneOcc (idOccInfo id) && occ_in_lam (idOccInfo id)
isExitJoinId id
= isJoinId id
&& isOneOcc (idOccInfo id)
&& occ_in_lam (idOccInfo id) == IsInsideLam
{-
Note [Dead binders]
......
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