Commit 8649535c authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Don't do the RhsCtxt thing for join points

This minor change fixes Trac #14137.

It is described in Note [Join point RHSs] in OccurAnal
parent 33452dfc
......@@ -1554,19 +1554,24 @@ occAnalNonRecRhs :: OccEnv
occAnalNonRecRhs env bndr bndrs body
= occAnalLamOrRhs rhs_env bndrs body
where
-- See Note [Cascading inlines]
env1 | certainly_inline = env
env1 | is_join_point = env -- See Note [Join point RHSs]
| certainly_inline = env -- See Note [Cascading inlines]
| otherwise = rhsCtxt env
-- See Note [Sources of one-shot information]
rhs_env = env1 { occ_one_shots = argOneShots dmd }
certainly_inline -- See Note [Cascading inlines]
= case idOccInfo bndr of
= case occ of
OneOcc { occ_in_lam = in_lam, occ_one_br = one_br }
-> not in_lam && one_br && active && not_stable
_ -> False
is_join_point = isAlwaysTailCalled occ
-- Like (isJoinId bndr) but happens one step earlier
-- c.f. willBeJoinId_maybe
occ = idOccInfo bndr
dmd = idDemandInfo bndr
active = isAlwaysActive (idInlineActivation bndr)
not_stable = not (isStableUnfolding (idUnfolding bndr))
......@@ -1627,7 +1632,18 @@ occAnalRules env mb_expected_join_arity rec_flag id
= case mb_expected_join_arity of
Just ar | args `lengthIs` ar -> uds
_ -> markAllNonTailCalled uds
{-
{- Note [Join point RHSs]
~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
x = e
join j = Just x
We want to inline x into j right away, so we don't want to give
the join point a RhsCtxt (Trac #14137). It's not a huge deal, because
the FloatIn pass knows to float into join point RHSs; and the simplifier
does not float things out of join point RHSs. But it's a simple, cheap
thing to do. See Trac #14137.
Note [Cascading inlines]
~~~~~~~~~~~~~~~~~~~~~~~~
By default we use an rhsCtxt for the RHS of a binding. This tells the
......
module T14137 where
-- The point of this test is that we should inline 'thunk'
-- into j's RHS, and we can do so quite agressively, even
-- when we aren't optimising. See the ticket.
--
-- It's not a big deal, because in the end FloatIn
-- does the same job, only later
f xs = let thunk = length xs
j = Just thunk
g 0 = j
g n = g (n-1)
in
g 7
==================== Tidy Core ====================
Result size of Tidy Core
= {terms: 45, types: 41, coercions: 0, joins: 2/2}
-- RHS size: {terms: 30, types: 24, coercions: 0, joins: 2/2}
f :: forall (t :: * -> *) a. Foldable t => t a -> Maybe Int
[GblId, Arity=2]
f = \ (@ (t :: * -> *))
(@ a)
($dFoldable :: Foldable t)
(xs :: t a) ->
join {
j :: Maybe Int
[LclId[JoinId(0)], Unf=OtherCon []]
j = GHC.Base.Just @ Int (length @ t $dFoldable @ a xs) } in
joinrec {
g [Occ=LoopBreaker] :: Integer -> Maybe Int
[LclId[JoinId(1)], Arity=1, Unf=OtherCon []]
g (ds :: Integer)
= case ==
@ Integer
integer-gmp-1.0.1.0:GHC.Integer.Type.$fEqInteger
ds
(fromInteger @ Integer GHC.Num.$fNumInteger 0)
of {
False ->
jump g
(- @ Integer
GHC.Num.$fNumInteger
ds
(fromInteger @ Integer GHC.Num.$fNumInteger 1));
True -> jump j
}; } in
jump g 7
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule1 :: GHC.Prim.Addr#
[GblId, Caf=NoCafRefs]
$trModule1 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$trModule2 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs]
$trModule2 = GHC.Types.TrNameS $trModule1
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule3 :: GHC.Prim.Addr#
[GblId, Caf=NoCafRefs]
$trModule3 = "T14137"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$trModule4 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs]
$trModule4 = GHC.Types.TrNameS $trModule3
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
T14137.$trModule :: GHC.Types.Module
[GblId, Caf=NoCafRefs]
T14137.$trModule = GHC.Types.Module $trModule2 $trModule4
......@@ -269,3 +269,4 @@ test('T12600',
['$MAKE -s --no-print-directory T12600'])
test('T13658', normal, compile, ['-dcore-lint'])
test('T13708', normal, compile, [''])
test('T14137', normal, compile, ['-dsuppress-uniques -ddump-simpl'])
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