{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module IntSupply
( IntSupply,
new,
next,
reset,
)
where
import Data.Bits (finiteBitSize)
import GHC.Base
( IO (IO),
Int (I#),
MutableByteArray#,
RealWorld,
atomicWriteIntArray#,
fetchAddIntArray#,
newByteArray#,
writeIntArray#,
)
data IntSupply
= IntSupply (MutableByteArray# RealWorld)
new :: IO IntSupply
new :: IO IntSupply
new =
(State# RealWorld -> (# State# RealWorld, IntSupply #))
-> IO IntSupply
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO \State# RealWorld
s0 ->
case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
size State# RealWorld
s0 of
(# State# RealWorld
s1, MutableByteArray# RealWorld
supply #) ->
(# MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeIntArray# MutableByteArray# RealWorld
supply Int#
0# Int#
0# State# RealWorld
s1, MutableByteArray# RealWorld -> IntSupply
IntSupply MutableByteArray# RealWorld
supply #)
where
!(I# Int#
size) =
Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
forall a. HasCallStack => a
undefined :: Int) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
{-# INLINEABLE new #-}
next :: IntSupply -> IO Int
next :: IntSupply -> IO Int
next (IntSupply MutableByteArray# RealWorld
supply) =
(State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO \State# RealWorld
s0 ->
case MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchAddIntArray# MutableByteArray# RealWorld
supply Int#
0# Int#
1# State# RealWorld
s0 of
(# State# RealWorld
s1, Int#
n #) -> (# State# RealWorld
s1, Int# -> Int
I# Int#
n #)
{-# INLINEABLE next #-}
reset :: IntSupply -> IO ()
reset :: IntSupply -> IO ()
reset (IntSupply MutableByteArray# RealWorld
arr#) =
(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO \State# RealWorld
s0 ->
(# MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
atomicWriteIntArray# MutableByteArray# RealWorld
arr# Int#
0# Int#
0# State# RealWorld
s0, () #)
{-# INLINEABLE reset #-}