Skip to content

Inlining regression since GHC 9.6

Summary

liftA2, when left implicit (default implementation), is sometimes not getting inlined, when it used to on older GHC.
Specifically I observed this with transformer's RWST monad. Self-contained example below; inlines with GHC 9.4, does not inline with GHC 9.6 - 9.10 unless INLINE liftA2 is added.

  • Can we tell what changed in the inlining heuristics?
  • Is there a more robust fix than adding INLINE liftA2 (whether in GHC, in transformers, or client-side)?

Reproduction

{-# OPTIONS_GHC -O -ddump-simpl -dsuppress-uniques -dsuppress-idinfo -dsuppress-coercions -dsuppress-coercion-types #-}
{-# LANGUAGE CPP #-}
module RWST where

import Data.Functor.Identity
import Control.Applicative
import Control.Monad

newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (w, s, a) }

instance Functor m => Functor (RWST r w s m) where
  fmap f (RWST m) = RWST (\r s -> fmap (\ ~(w,s',x) -> (w,s',f x)) (m r s))

instance (Monoid w, Monad m) => Applicative (RWST r w s m) where
  pure x = RWST (\_ s -> pure (mempty, s, x))
  RWST mf <*> RWST mx = RWST (\r s -> do
    ~(w, s', f) <- mf r s
    ~(w', s'', x) <- mx r s'
    pure (w <> w', s'', f x))
#ifdef DOINLINE
  liftA2 f (RWST mx) (RWST my) = RWST (\r s -> do
    ~(w, s', x) <- mx r s
    ~(w', s'', y) <- my r s'
    pure (w <> w', s'', f x y))
  {-# INLINE liftA2 #-}
#endif

-- Example

type Pairing m a b = m a -> m b -> m (a, b)

f1 :: Pairing (RWST r [a] s Identity) a b
f1 x y = liftA2 (,) x y

Expected result: liftA2 should be inlined in f1.

ghc-9.4.6 RWST.hs inlines OK:

-- RHS size: {terms: 42, types: 95, coercions: 59, joins: 0/2}
RWST.f2
  :: forall {r} {a} {s} {b}.
     RWST r [a] s Identity a
     -> RWST r [a] s Identity b -> r -> s -> Identity ([a], s, (a, b))
RWST.f2
  = \ (@r)
      (@a)
      (@s)
      (@b)
      (eta1 :: RWST r [a] s Identity a)
      (eta :: RWST r [a] s Identity b)
      (eta2 :: r)
      (eta3 :: s) ->
      let {
        ds :: Identity ([a], s, a)
        ds = (eta1 `cast` <Co:7> :: ...) eta2 eta3 } in
      let {
        ds1 :: Identity ([a], s, b)
        ds1
          = (eta `cast` <Co:7> :: ...)
              eta2 (case ds `cast` <Co:6> :: ... of { (w, s', x) -> s' }) } in
      (case ds `cast` <Co:6> :: ... of { (w, s', x) ->
       ++ @a w (case ds1 `cast` <Co:6> :: ... of { (w', s'', x1) -> w' })
       },
       case ds1 `cast` <Co:6> :: ... of { (w', s'', x) -> s'' },
       (case ds `cast` <Co:6> :: ... of { (w, s', x) -> x },
        case ds1 `cast` <Co:6> :: ... of { (w', s'', x) -> x }))
      `cast` <Co:9> :: ...

-- RHS size: {terms: 1, types: 0, coercions: 36, joins: 0/0}
f1 :: forall r a s b. Pairing (RWST r [a] s Identity) a b
f1 = RWST.f2 `cast` <Co:36> :: ...

ghc-9.6.4 RWST.hs does not inline:

-- RHS size: {terms: 8, types: 17, coercions: 0, joins: 0/0}
RWST.f2
  :: forall {r} {a} {s} {b}.
     RWST r [a] s Identity a
     -> RWST r [a] s Identity b -> r -> s -> Identity ([a], s, (a, b))
RWST.f2
  = \ (@r) (@a) (@s) (@b) ->
      RWST.$fApplicativeRWST2
        @[a]
        @Identity
        @r
        @s
        (GHC.Base.$fMonoidList @a)
        Data.Functor.Identity.$fMonadIdentity
        @a
        @b
        @(a, b)
        (RWST.f3 @a @b)

-- RHS size: {terms: 1, types: 0, coercions: 36, joins: 0/0}
f1 :: forall r a s b. Pairing (RWST r [a] s Identity) a b
f1 = RWST.f2 `cast` <Co:36> :: ...

ghc-9.6.4 -DDOINLINE RWST.hs (with an {-# INLINE liftA2 #-}) inlines (but not as great as ghc-9.4):

-- RHS size: {terms: 41, types: 96, coercions: 50, joins: 0/2}
RWST.$wf1
  :: forall {r} {a} {s} {b}.
     RWST r [a] s Identity a
     -> RWST r [a] s Identity b -> r -> s -> (# [a], s, a, b #)
RWST.$wf1
  = \ (@r)
      (@a)
      (@s)
      (@b)
      (x :: RWST r [a] s Identity a)
      (y :: RWST r [a] s Identity b)
      (eta :: r)
      (eta1 :: s) ->
      let {
        ds :: Identity ([a], s, a)
        ds = (x `cast` <Co:7> :: ...) eta eta1 } in
      let {
        ds1 :: Identity ([a], s, b)
        ds1
          = (y `cast` <Co:7> :: ...)
              eta (case ds `cast` <Co:6> :: ... of { (w, s', x1) -> s' }) } in
      (# case ds `cast` <Co:6> :: ... of { (w, s', x1) ->
         ++ @a w (case ds1 `cast` <Co:6> :: ... of { (w', s'', y1) -> w' })
         },
         case ds1 `cast` <Co:6> :: ... of { (w', s'', y1) -> s'' },
         case ds `cast` <Co:6> :: ... of { (w, s', x1) -> x1 },
         case ds1 `cast` <Co:6> :: ... of { (w', s'', y1) -> y1 } #)

-- RHS size: {terms: 21, types: 47, coercions: 9, joins: 0/0}
RWST.f2
  :: forall {r} {a} {s} {b}.
     RWST r [a] s Identity a
     -> RWST r [a] s Identity b -> r -> s -> Identity ([a], s, (a, b))
RWST.f2
  = \ (@r)
      (@a)
      (@s)
      (@b)
      (x :: RWST r [a] s Identity a)
      (y :: RWST r [a] s Identity b)
      (eta :: r)
      (eta1 :: s) ->
      case RWST.$wf1 @r @a @s @b x y eta eta1 of
      { (# ww, ww1, ww2, ww3 #) ->
      (ww, ww1, (ww2, ww3)) `cast` <Co:9> :: ...
      }

-- RHS size: {terms: 1, types: 0, coercions: 36, joins: 0/0}
f1 :: forall r a s b. Pairing (RWST r [a] s Identity) a b
f1 = RWST.f2 `cast` <Co:36> :: ...
-}
Edited by Ben Gamari
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information