diff options
author | Philipp Krüger <matheus.dev@gmail.com> | 2019-11-21 12:33:07 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-11-28 02:54:05 -0500 |
commit | 5f84b52a9c439ae2739bf1899a2adbae9c6d4f67 (patch) | |
tree | 5976935b88e084e5d1e6f92164c3b160f8c96b12 | |
parent | e122ba33e8426a7b7f18216c451f6288e90c966e (diff) | |
download | haskell-5f84b52a9c439ae2739bf1899a2adbae9c6d4f67.tar.gz |
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.
-rw-r--r-- | compiler/basicTypes/BasicTypes.hs | 79 | ||||
-rw-r--r-- | compiler/basicTypes/IdInfo.hs | 11 | ||||
-rw-r--r-- | compiler/coreSyn/CoreOpt.hs | 11 | ||||
-rw-r--r-- | compiler/simplCore/OccurAnal.hs | 20 | ||||
-rw-r--r-- | compiler/simplCore/SimplUtils.hs | 21 |
5 files changed, 86 insertions, 56 deletions
diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 6e18180d1c..94e2d2daa8 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -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) diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index 8a59b98959..ab6e08974e 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -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 } diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index a2eeb9beb8..4a0322f00c 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -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 diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index ecad4a585f..d10b1eda22 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -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) ) diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index e8829c845c..6074d00aa9 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -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] |