#11564: Possible overzealous unfolding
-------------------------------------+-------------------------------------
Reporter: simonmar | Owner: simonpj
Type: bug | Status: new
Priority: high | Milestone:
Component: Compiler | Version: 8.1
Keywords: | Operating System: Unknown/Multiple
Architecture: | Type of failure: None/Unknown
Unknown/Multiple |
Test Case: | Blocked By:
Blocking: | Related Tickets:
Differential Rev(s): | Wiki Page:
-------------------------------------+-------------------------------------
I was investigating why (>>=) in the Haxl monad is being inlined more than
I would expect, and I ran into something I don't fully understand, and
looks dubious.
Start from this standalone example:
{{{
{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification #-}
module Haxl where
import Data.IORef
import Control.Exception
newtype GenHaxl u a = GenHaxl
{ unHaxl :: Int -> IORef () -> IO (Result u a) }
data Result u a
= Done a
| Throw SomeException
| Blocked (Cont u a)
data Cont u a
= forall b. Cont u b :>>= (b -> GenHaxl u a)
| forall b. (b -> a) :<$> (Cont u b)
instance Monad (GenHaxl u) where
return a = GenHaxl $ \_env _ref -> return (Done a)
GenHaxl m >>= k = GenHaxl $ \env ref -> do
e <- m env ref
case e of
Done a -> unHaxl (k a) env ref
Throw e -> return (Throw e)
Blocked cont -> return (Blocked (cont :>>= k))
instance Functor (GenHaxl u)
instance Applicative (GenHaxl u)
}}}
(it could be simplified further, but I've intentionally used the exact
definition of `>>=` that is used in Haxl to be sure I'm not investigating
the wrong thing)
Compile like this:
{{{
ghc -O -c Haxl.hs
}}}
and look at the .hi file:
{{{
ghc --show-iface Haxl.hi
}}}
see this:
{{{
ea159c3b107c307a4e76cd310efcc8bc
$fMonadGenHaxl2 ::
GenHaxl u a
-> (a -> GenHaxl u b)
-> Int
-> IORef ()
-> State# RealWorld
-> (# State# RealWorld, Result u b #)
{- Arity: 5, HasNoCafRefs,
Strictness:
,
Unfolding: InlineRule (5, True, False)
(\ @ u
@ a
@ b
(ds :: GenHaxl u a)
(k :: a -> GenHaxl u b)
(env :: Int)
(ref :: IORef ())
(s :: State# RealWorld)[OneShot] ->
case (ds `cast` (N:GenHaxl[0] <u>_P <a>_R) env ref)
`cast`
(N:IO[0] <Result u a>_R)
s of ds1 { (#,#) ipv ipv1 ->
case ipv1 of wild {
Done a1
-> ((k a1) `cast` (N:GenHaxl[0] <u>_P <b>_R) env ref)
`cast`
(N:IO[0] <Result u b>_R)
ipv
Throw e -> (# ipv, Throw @ u @ b e #)
Blocked cont
-> (# ipv, Blocked @ u @ b (:>>= @ u @ b @ a cont k) #)
} }) -}
}}}
That right there is the definition of `>>=`. Note that it has an
`InlineRule`, which means that it will be unconditionally unfolded pretty
much everywhere. I don't think this is right - there's no benefit to be
had in inlining it unconditionally.
I delved in a bit more, and it seems this unfolding arises during worker-
wrapper. Before WW we have
{{{
a_sVM
[LclId,
Arity=5,
Str=DmdType ,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=IF_ARGS [0 60 0 0 0] 94 60}]
a_sVM =
\ @ u_XQR
@ a_aPN
@ b_aPO
ds_dQP [Dmd=]
k_aEC
env_aED
ref_aEE
s_aVC [Dmd=, OS=OneShot] ->
case (((ds_dQP `cast` ...) env_aED ref_aEE) `cast` ...) s_aVC
of _ [Occ=Dead, Dmd=]
{ (# ipv_aVF [Dmd=], ipv1_aVG [Dmd=] #) ->
case ipv1_aVG of _ [Occ=Dead, Dmd=] {
Done a_aEG ->
((((k_aEC a_aEG) `cast` ...) env_aED ref_aEE) `cast` ...) ipv_aVF;
Throw e_aEH -> (# ipv_aVF, Haxl.Throw e_aEH #);
Blocked cont_aEI ->
(# ipv_aVF, Haxl.Blocked (Haxl.:>>= cont_aEI k_aEC) #)
}
}
}}}
and after WW we have
{{{
a_sVM
[LclId,
Arity=5,
Str=DmdType ,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=5,unsat_ok=True,boring_ok=False)
Tmpl= \ @ u_XQR
@ a_aPN
@ b_aPO
ds_dQP [Occ=Once]
k_aEC [Occ=Once*]
env_aED
ref_aEE
s_aVC [Occ=Once, OS=OneShot] ->
case (((ds_dQP `cast` ...) env_aED ref_aEE) `cast` ...)
s_aVC
of _ [Occ=Dead]
{ (# ipv_aVF [Occ=Once*], ipv1_aVG [Occ=Once!] #) ->
case ipv1_aVG of _ [Occ=Dead] {
Done a_aEG [Occ=Once] ->
((((k_aEC a_aEG) `cast` ...) env_aED ref_aEE) `cast`
...) ipv_aVF;
Throw e_aEH [Occ=Once] -> (# ipv_aVF, Haxl.Throw e_aEH
#);
Blocked cont_aEI [Occ=Once] ->
(# ipv_aVF, Haxl.Blocked (Haxl.:>>= cont_aEI k_aEC)
#)
}
}}]
a_sVM =
\ @ u_XQR
@ a_aPN
@ b_aPO
ds_dQP [Dmd=]
k_aEC
env_aED
ref_aEE
s_aVC [Dmd=, OS=OneShot] ->
case (((ds_dQP `cast` ...) env_aED ref_aEE) `cast` ...) s_aVC
of _ [Occ=Dead, Dmd=]
{ (# ipv_aVF [Dmd=], ipv1_aVG [Dmd=] #) ->
case ipv1_aVG of _ [Occ=Dead, Dmd=] {
Done a_aEG ->
((((k_aEC a_aEG) `cast` ...) env_aED ref_aEE) `cast` ...) ipv_aVF;
Throw e_aEH -> (# ipv_aVF, Haxl.Throw e_aEH #);
Blocked cont_aEI ->
(# ipv_aVF, Haxl.Blocked (Haxl.:>>= cont_aEI k_aEC) #)
}
}
}}}
For some unknown reason, this binding has acquired an always-on unfolding.
There's no wrapper, we're just unfolding the whole thing.
Simon, can you shed any light here? I would like to tune unfolding sizes
to reduce code bloat in our codebase, but with this unfolding being
unconditional it doesn't work to use `-funfolding-use-threshold`, I can
only use `NOINLINE` but that's too blunt.
--
Ticket URL:
GHC
The Glasgow Haskell Compiler
