#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