[GHC] #14079: Failure to do CPR in the presence of a local letrec
GHC
ghc-devs at haskell.org
Fri Aug 25 14:08:23 UTC 2017
#14079: Failure to do CPR in the presence of a local letrec
-------------------------------------+-------------------------------------
Reporter: nomeata | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 8.3
Resolution: | Keywords: JoinPoints
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by simonpj):
I don't get this. I tried
{{{
{-# LANGUAGE BangPatterns #-}
module T14079 where
e1 :: (Int, Int) -> Int -> (Int, Int)
e1 !x y | y > 0 = x
| otherwise = e1 x (y + 1)
e2 :: (Int, Int) -> Int -> Int -> (Int, Int)
e2 x y n = je x y
where je !x y | y > 0 = x
| otherwise = je x (y + n)
}}}
As you say I get a w/w split for `e1`. So if `e1` is called applied to two
arguments I'll inline the wrapper and good things will happen.
For for `e1` I get something good too
{{{
e2 :: (Int, Int) -> Int -> Int -> (Int, Int)
[GblId,
Arity=3,
Caf=NoCafRefs,
Str=<S,1*U(U,U)><S(S),1*U(U)><L,U(U)>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
Tmpl= \ (x_a1VH [Occ=Once] :: (Int, Int))
(y_a1VI [Occ=Once] :: Int)
(n_a1VJ [Occ=OnceL!] :: Int) ->
joinrec {
je_s2nz [Occ=LoopBreakerT[2]] :: (Int, Int) -> Int ->
(Int, Int)
[LclId[JoinId(2)], Arity=2, Unf=OtherCon []]
je_s2nz (x1_a1VL [Occ=Once!] :: (Int, Int))
(y1_a1VM [Occ=Once!] :: Int)
= case x1_a1VL of x2_X1VS { (_ [Occ=Dead], _
[Occ=Dead]) ->
case y1_a1VM of { GHC.Types.I# x3_a2mT ->
case GHC.Prim.># x3_a2mT 0# of {
__DEFAULT ->
jump je_s2nz
x2_X1VS
(case n_a1VJ of { GHC.Types.I# y2_a2nf
[Occ=Once] ->
GHC.Types.I# (GHC.Prim.+# x3_a2mT y2_a2nf)
});
1# -> x2_X1VS
}
}
}; } in
jump je_s2nz x_a1VH y_a1VI}]
e2
= \ (x_a1VH :: (Int, Int)) (y_a1VI :: Int) (n_a1VJ :: Int) ->
case x_a1VH of { (ww1_s2ox, ww2_s2oy) ->
case y_a1VI of { GHC.Types.I# ww4_s2oC ->
joinrec {
$wje_s2oE [InlPrag=[0], Occ=LoopBreaker]
:: Int -> Int -> GHC.Prim.Int# -> (Int, Int)
[LclId[JoinId(3)], Arity=3, Str=<L,U><L,U><S,U>m, Unf=OtherCon []]
$wje_s2oE (ww5_X2oV :: Int)
(ww6_X2oX :: Int)
(ww7_X2p2 :: GHC.Prim.Int#)
= case GHC.Prim.># ww7_X2p2 0# of {
__DEFAULT ->
case n_a1VJ of { GHC.Types.I# y1_a2nf ->
jump $wje_s2oE ww5_X2oV ww6_X2oX (GHC.Prim.+# ww7_X2p2
y1_a2nf)
};
1# -> (ww5_X2oV, ww6_X2oX)
}; } in
jump $wje_s2oE ww1_s2ox ww2_s2oy ww4_s2oC
}
}
}}}
`e2`'s strictness signature says that it has the CPR property. It doesn't
have a w/w split, but it'll be inlined wherever it is used.
Just to check, I tried this
{{{
f1 x y = e1 x (y+1)
f2 x y n = e2 x (y+t) n
where
t = length (reverse (reverse (reverse (reverse (reverse (reverse
[1..n]))))))
}}}
The definition `t` is just make `f2` big enough so that the strictness
analyser will do a w/w split for it. Sure enough, good things happen
{{{
T14079.$wf2 [InlPrag=[0]]
:: Int -> Int -> GHC.Prim.Int# -> GHC.Prim.Int# -> (# Int, Int #)
[GblId,
Arity=4,
Caf=NoCafRefs,
Str=<L,U><L,U><S,U><S,U>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0 0 0] 289
0}]
T14079.$wf2
= \ (ww_s30e :: Int)
(ww1_s30f :: Int)
(ww2_s30j :: GHC.Prim.Int#)
(ww3_s30n :: GHC.Prim.Int#) ->
case GHC.List.$wlenAcc
@ Int
(GHC.List.reverse1
@ Int
(GHC.List.reverse1
@ Int
(GHC.List.reverse1
@ Int
(GHC.List.reverse1
@ Int
(GHC.List.reverse1
@ Int
(GHC.List.reverse1
@ Int (GHC.Enum.eftInt 1# ww3_s30n)
(GHC.Types.[] @ Int))
(GHC.Types.[] @ Int))
(GHC.Types.[] @ Int))
(GHC.Types.[] @ Int))
(GHC.Types.[] @ Int))
(GHC.Types.[] @ Int))
0#
of ww4_a2Yy
{ __DEFAULT ->
joinrec {
$wje_s308 [InlPrag=[0], Occ=LoopBreaker]
:: Int -> Int -> GHC.Prim.Int# -> (# Int, Int #)
[LclId[JoinId(3)], Arity=3, Str=<L,U><L,U><S,U>, Unf=OtherCon []]
$wje_s308 (ww5_s301 :: Int)
(ww6_s302 :: Int)
(ww7_s306 :: GHC.Prim.Int#)
= case GHC.Prim.># ww7_s306 0# of {
__DEFAULT ->
jump $wje_s308 ww5_s301 ww6_s302 (GHC.Prim.+# ww7_s306
ww3_s30n);
1# -> (# ww5_s301, ww6_s302 #)
}; } in
jump $wje_s308 ww_s30e ww1_s30f (GHC.Prim.+# ww2_s30j ww4_a2Yy)
}
-- RHS size: {terms: 22, types: 23, coercions: 0, joins: 0/0}
f2 [InlPrag=INLINE[0]] :: (Int, Int) -> Int -> Int -> (Int, Int)
[GblId,
Arity=3,
Caf=NoCafRefs,
Str=<S,1*U(U,U)><S(S),1*U(U)><S(S),1*U(U)>m,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
Tmpl= \ (w_s309 [Occ=Once!] :: (Int, Int))
(w1_s30a [Occ=Once!] :: Int)
(w2_s30b [Occ=Once!] :: Int) ->
case w_s309 of { (ww1_s30e [Occ=Once], ww2_s30f
[Occ=Once]) ->
case w1_s30a of { GHC.Types.I# ww4_s30j [Occ=Once] ->
case w2_s30b of { GHC.Types.I# ww6_s30n [Occ=Once] ->
case T14079.$wf2 ww1_s30e ww2_s30f ww4_s30j ww6_s30n of
{ (# ww8_s30I [Occ=Once], ww9_s30J [Occ=Once] #) ->
(ww8_s30I, ww9_s30J)
}
}
}
}}]
f2
= \ (w_s309 :: (Int, Int)) (w1_s30a :: Int) (w2_s30b :: Int) ->
case w_s309 of { (ww1_s30e, ww2_s30f) ->
case w1_s30a of { GHC.Types.I# ww4_s30j ->
case w2_s30b of { GHC.Types.I# ww6_s30n ->
case T14079.$wf2 ww1_s30e ww2_s30f ww4_s30j ww6_s30n of
{ (# ww8_s30I, ww9_s30J #) ->
(ww8_s30I, ww9_s30J)
}
}
}
}
}}}
This all looks fine to me. Are you sure there is a problem here?
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14079#comment:4>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list