summaryrefslogtreecommitdiff
path: root/compiler/simplCore
diff options
context:
space:
mode:
authorPhilipp Krüger <matheus.dev@gmail.com>2019-11-21 12:33:07 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-11-28 02:54:05 -0500
commit5f84b52a9c439ae2739bf1899a2adbae9c6d4f67 (patch)
tree5976935b88e084e5d1e6f92164c3b160f8c96b12 /compiler/simplCore
parente122ba33e8426a7b7f18216c451f6288e90c966e (diff)
downloadhaskell-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.
Diffstat (limited to 'compiler/simplCore')
-rw-r--r--compiler/simplCore/OccurAnal.hs20
-rw-r--r--compiler/simplCore/SimplUtils.hs21
2 files changed, 22 insertions, 19 deletions
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]