[GHC] #11564: Possible overzealous unfolding

9 Feb 2016

      #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:
 <C(C(C(S(SS)))),1*C1(C1(C1(U(U,1*U))))><L,U><L,U><L,U><S,U>,
      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 <C(C(C(S(SS)))),1*C1(C1(C1(U(U,1*U))))><L,U><L,U><L,U><S,U>,
  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=<C(C(C(S(SS)))),1*C1(C1(C1(U(U,1*U))))>]
     k_aEC
     env_aED
     ref_aEE
     s_aVC [Dmd=<S,U>, OS=OneShot] ->
     case (((ds_dQP `cast` ...) env_aED ref_aEE) `cast` ...) s_aVC
     of _ [Occ=Dead, Dmd=<L,A>]
     { (# ipv_aVF [Dmd=<S,U>], ipv1_aVG [Dmd=<S,1*U>] #) ->
     case ipv1_aVG of _ [Occ=Dead, Dmd=<L,A>] {
       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 <C(C(C(S(SS)))),1*C1(C1(C1(U(U,1*U))))><L,U><L,U><L,U><S,U>,
  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=<C(C(C(S(SS)))),1*C1(C1(C1(U(U,1*U))))>]
     k_aEC
     env_aED
     ref_aEE
     s_aVC [Dmd=<S,U>, OS=OneShot] ->
     case (((ds_dQP `cast` ...) env_aED ref_aEE) `cast` ...) s_aVC
     of _ [Occ=Dead, Dmd=<L,A>]
     { (# ipv_aVF [Dmd=<S,U>], ipv1_aVG [Dmd=<S,1*U>] #) ->
     case ipv1_aVG of _ [Occ=Dead, Dmd=<L,A>] {
       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: <http://ghc.haskell.org/trac/ghc/ticket/11564>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler

GHC

GHC

GHC

GHC

GHC

GHC

GHC

GHC

GHC

GHC

GHC

GHC

GHC

GHC

GHC

GHC

tags

participants (1)