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: