INLINE prevents inlining

Summary

A function inlines when it doesn't have an INLINE pragma, but does not inline when it has one.

Steps to reproduce

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

module AtomicModifyGeneric
  ( atomicModifyIORef2General
  , myAtomicModifyIORef2
  ) where

import GHC.IORef (IORef (..), newIORef, readIORef)
import GHC.STRef (STRef (..))
import GHC.Exts (casMutVar#, MutVar#, RealWorld, readMutVar#, lazy, State#, writeMutVar#)
import GHC.IO (IO (..))
import System.IO.Unsafe (unsafeDupablePerformIO)

-- | A generalization of atomicModifyIORef2 that takes a function
-- to extract the new 'IORef' value from the result.
atomicModifyIORef2General
  :: IORef a -> (t -> a) -> (a -> t) -> IO (a, t)
atomicModifyIORef2General (IORef (STRef ref)) extract f = do
  holder@(IORef (STRef holder#)) <- newIORef uninitialized
  let r = unsafeDupablePerformIO (f <$> readIORef holder)
  let new = extract r
  IO (\s -> case atomicModifyIORef2General' ref holder# new r s of
               (# s', old, !res #) -> (# s', (old, res) #))
-- ***** This is the relevant pragma *****
-- {-# INLINE atomicModifyIORef2General #-}

atomicModifyIORef2General'
  :: MutVar# RealWorld a -> MutVar# RealWorld a -> a -> t -> State# RealWorld -> (# State# RealWorld, a, t #)
atomicModifyIORef2General' ref holder new r s1 =
  case readMutVar# ref s1 of { (# s2, old #) ->
  case writeMutVar# holder old s2 of { s3 ->
  case casMutVar# ref old new s3 of { (# s4, flag, _ #) ->
  case flag of
    0# -> (# s4, lazy old, lazy r #)
    _ -> atomicModifyIORef2General' ref holder new r s4 }}}

uninitialized :: a
uninitialized = error "Uninitialized. This is a bug in atomic-modify-generics."
{-# NOINLINE uninitialized #-}

myAtomicModifyIORef2 :: IORef a -> (a -> (a, b)) -> IO (a, (a, b))
myAtomicModifyIORef2 ref = atomicModifyIORef2General ref fst
{-# NOINLINE myAtomicModifyIORef2 #-}

As written above, compiling with -O -ddump-simpl -dsuppress-coercions gives the following (-O2 produces very similar results):

AtomicModifyGeneric.myAtomicModifyIORef1 [InlPrag=NOINLINE]
  :: forall {a} {b}.
     IORef a
     -> (a -> (a, b))
     -> State# RealWorld
     -> (# State# RealWorld, (a, (a, b)) #)
[GblId,
 Arity=3,
 Str=<1!P(L)><MCM(L)><L>,
 Cpr=1(, 1),
 Unf=OtherCon []]
AtomicModifyGeneric.myAtomicModifyIORef1
  = \ (@a_aYe)
      (@b_aYf)
      (ref_azM :: IORef a_aYe)
      (f_s13b :: a_aYe -> (a_aYe, b_aYf))
      (eta_s13c [OS=OneShot] :: State# RealWorld) ->
      case ref_azM `cast` <Co:2> :: IORef a_aYe ~R# STRef RealWorld a_aYe
      of
      { STRef ww_s138 ->
      case GHC.Prim.newMutVar#
             @'GHC.Types.Lifted
             @a_aYe
             @RealWorld
             (uninitialized @a_aYe)
             eta_s13c
      of
      { (# ipv_a10C, ipv1_a10D #) ->
      let {
        r_s12l :: (a_aYe, b_aYf)
        [LclId]
        r_s12l
          = GHC.Magic.runRW#
              @GHC.Types.LiftedRep
              @(a_aYe, b_aYf)
              (\ (s_a10J [OS=OneShot] :: State# RealWorld) ->
                 case readMutVar#
                        @'GHC.Types.Lifted @RealWorld @a_aYe ipv1_a10D s_a10J
                 of
                 { (# ipv2_a118, ipv3_a119 #) ->
                 lazy @(a_aYe, b_aYf) (f_s13b ipv3_a119)
                 }) } in
      case atomicModifyIORef2General'
             @a_aYe
             @(a_aYe, b_aYf)
             ww_s138
             ipv1_a10D
             (case r_s12l of { (x_a13s, ds1_a13t) -> x_a13s })
             r_s12l
             ipv_a10C
      of
      { (# ipv2_s12a, ipv3_s12b, ipv4_s12c #) ->
      case ipv4_s12c of res_X3 { (ipv5_s13v, ipv6_s13w) ->
      (# ipv2_s12a, (ipv3_s12b, res_X3) #)
      }
      }
      }
      }

-- RHS size: {terms: 1, types: 0, coercions: 21, joins: 0/0}
myAtomicModifyIORef2 [InlPrag=[final]]
  :: forall a b. IORef a -> (a -> (a, b)) -> IO (a, (a, b))
[GblId,
 Arity=3,
 Str=<1!P(L)><MCM(L)><L>,
 Cpr=1(, 1),
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
myAtomicModifyIORef2
  = AtomicModifyGeneric.myAtomicModifyIORef1
    `cast` <Co:21> :: (forall {a} {b}.
                       IORef a
                       -> (a -> (a, b))
                       -> State# RealWorld
                       -> (# State# RealWorld, (a, (a, b)) #))
                      ~R# (forall {a} {b}. IORef a -> (a -> (a, b)) -> IO (a, (a, b)))

atomicModifyIORef2General inlines, which in particular means we get

      case atomicModifyIORef2General'
             @a_aYe
             @(a_aYe, b_aYf)
             ww_s138
             ipv1_a10D
             (case r_s12l of { (x_a13s, ds1_a13t) -> x_a13s })
             r_s12l
             ipv_a10C

That is, we will produce a selector thunk to pass to atomicModifyIORef2General', which is what we want.

However, if I try to make sure this happens by uncommenting the {-# INLINE atomicModifyIORef2General #-} pragma, then the exact opposite happens!

-- RHS size: {terms: 6, types: 10, coercions: 0, joins: 0/0}
myAtomicModifyIORef2 [InlPrag=NOINLINE]
  :: forall a b. IORef a -> (a -> (a, b)) -> IO (a, (a, b))
[GblId,
 Arity=3,
 Str=<1!P(L)><MCM(L)><L>,
 Cpr=1(, 1),
 Unf=OtherCon []]
myAtomicModifyIORef2
  = \ (@a_aYh) (@b_aYi) (ref_azP :: IORef a_aYh) ->
      atomicModifyIORef2General
        @a_aYh @(a_aYh, b_aYi) ref_azP (fst @a_aYh @b_aYi)

Here, atomicModifyIORef2General doesn't inline, so we'll produce an application thunk instead of a selector thunk; that's no good!

Environment

• GHC version used: 9.6

Optional:

• Operating System:
• System Architecture: