#10844: CallStack should not be inlined
-------------------------------------+-------------------------------------
Reporter: nomeata | Owner: gridaphobe
Type: task | Status: patch
Priority: normal | Milestone:
Component: Compiler | Version: 7.10.2
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s): Phab:D1259
-------------------------------------+-------------------------------------
Comment (by gridaphobe):
Ok, here's a version of Joachim's test case that doesn't involve
CallStacks.
{{{#!haskell
==> T10844a.hs <==
module T10844a where
data Foo = Foo Int String
showFoo (Foo i s) = unwords [ "Foo", show i, show s ]
foo n = showFoo $ Foo 0 "foo"
{-# INLINE foo #-}
==> T10844.hs <==
module T10844 where
import T10844a
main = print (foo 0)
}}}
With optimizations it produces the following core
{{{
% ghc --make -fforce-recomp -ddump-simpl T10844.hs -O
[1 of 2] Compiling T10844a ( T10844a.hs, T10844a.o )
==================== Tidy Core ====================
Result size of Tidy Core = {terms: 61, types: 45, coercions: 0}
T10844a.showFoo3 :: [Char]
[GblId,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 0}]
T10844a.showFoo3 = GHC.CString.unpackCString# "Foo"#
T10844a.showFoo2 :: Char
[GblId,
Caf=NoCafRefs,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
T10844a.showFoo2 = GHC.Types.C# ' '
T10844a.showFoo1 :: [Char]
[GblId,
Caf=NoCafRefs,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
T10844a.showFoo1 =
GHC.Types.: @ Char GHC.Show.shows6 (GHC.Types.[] @ Char)
T10844a.$wshowFoo [InlPrag=[0]] :: Int -> String -> String
[GblId,
Arity=2,
Str=DmdType ,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 0] 220 0}]
T10844a.$wshowFoo =
\ (ww_sRs :: Int) (ww1_sRt :: String) ->
++
@ Char
T10844a.showFoo3
(GHC.Types.:
@ Char
T10844a.showFoo2
(case ww_sRs of _ [Occ=Dead] { GHC.Types.I# ww3_aQt ->
case GHC.Show.$wshowSignedInt 0 ww3_aQt (GHC.Types.[] @ Char)
of _ [Occ=Dead] { (# ww5_aQx, ww6_aQy #) ->
++
@ Char
(GHC.Types.: @ Char ww5_aQx ww6_aQy)
(GHC.Types.:
@ Char
T10844a.showFoo2
(++
@ Char
(GHC.Types.:
@ Char
GHC.Show.shows6
(GHC.Show.showLitString ww1_sRt T10844a.showFoo1))
(GHC.Types.[] @ Char)))
}
}))
showFoo [InlPrag=INLINE[0]] :: Foo -> String
[GblId,
Arity=1,
Str=DmdType ,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (w_sRp [Occ=Once!] :: Foo) ->
case w_sRp
of _ [Occ=Dead] { Foo ww1_sRs [Occ=Once] ww2_sRt
[Occ=Once] ->
T10844a.$wshowFoo ww1_sRs ww2_sRt
}}]
showFoo =
\ (w_sRp :: Foo) ->
case w_sRp of _ [Occ=Dead] { Foo ww1_sRs ww2_sRt ->
T10844a.$wshowFoo ww1_sRs ww2_sRt
}
lvl_rEJ :: Int
[GblId, Caf=NoCafRefs, Str=DmdType]
lvl_rEJ = GHC.Types.I# 0
lvl1_rRU :: [Char]
[GblId, Str=DmdType]
lvl1_rRU = GHC.CString.unpackCString# "foo"#
lvl2_rRV :: String
[GblId, Str=DmdType]
lvl2_rRV = T10844a.$wshowFoo lvl_rEJ lvl1_rRU
foo [InlPrag=INLINE (sat-args=1)] :: forall t_aOn. t_aOn -> String
[GblId,
Arity=1,
Str=DmdType ,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False)
Tmpl= \ (@ t_aOp) _ [Occ=Dead] ->
$ @ Foo
@ String
showFoo
(T10844a.Foo
(GHC.Types.I# 0)
(GHC.Base.build
@ Char
(\ (@ b_aPw) -> GHC.CString.unpackFoldrCString# @
b_aPw "foo"#)))}]
foo = \ (@ t_aOp) _ [Occ=Dead] -> lvl2_rRV
[2 of 2] Compiling T10844 ( T10844.hs, T10844.o )
==================== Tidy Core ====================
Result size of Tidy Core = {terms: 31, types: 22, coercions: 3}
T10844.main7 :: Int
[GblId,
Caf=NoCafRefs,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
T10844.main7 = GHC.Types.I# 0
T10844.main6 :: [Char]
[GblId,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 0}]
T10844.main6 = GHC.CString.unpackCString# "foo"#
T10844.main5 :: String
[GblId,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}]
T10844.main5 = T10844a.$wshowFoo T10844.main7 T10844.main6
...
}}}
The problem is that the unfolding for `foo` contains the string literal
`"foo"` instead of the floated `lvl1_rRU`, so we end up inlining the
string literal in `T10844`, which seems rather pointless.
In fact, I'd argue that since the `Foo 0 "foo"` doesn't contain any free
variables, the whole thing should be floated to the top-level. GHC
actually goes further and floats the entire RHS (to `lvl2_rRV`), but it
doesn't update `foo`s unfolding.
The thing that I'm unsure about is that this example relies on the
`INLINE` pragma. As I understand it, `INLINE` tells GHC to unconditionally
inline the entire definition, which is precisely what it's doing here.
(`INLINEABLE` has a similar effect in this example.) The more general fix,
to make the unfolding reflect the result of the FloatOut pass, would
subtly change the semantics of `INLINE`. It would no longer mean "inline
the entire RHS" but rather "inline the pieces of the RHS that we think are
sensible to inline". Is that a change we want to make? It would certainly
decrease binary sizes, but it seems like that could also cause a
performance loss due to increased cache misses.
--
Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10844#comment:9
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler
