{-# language MagicHash #-}
{-# language UnboxedTuples #-}

module Data.Primitive.ByteArray.Atomic
  ( casByteArray
  , fetchAddByteArray
  , fetchSubByteArray
  , fetchAndByteArray
  , fetchNandByteArray
  , fetchOrByteArray
  , fetchXorByteArray
  ) where

import Control.Monad.Primitive (PrimMonad,PrimState,primitive)
import Data.Primitive (MutableByteArray(..))
import Data.Primitive.Class.Atomic (PrimMach,primMachToInt#,primMachFromInt#)
import GHC.Exts

-- | Given an array, an offset in Int units, the expected old value, and the new value,
-- perform an atomic compare and swap i.e. write the new value if the current value matches
-- the provided old value. Returns the value of the element before the operation. Implies
-- a full memory barrier.
casByteArray :: (PrimMonad m, PrimMach a)
  => MutableByteArray (PrimState m) -- ^ array
  -> Int -- ^ index
  -> a -- ^ expected old value
  -> a -- ^ new value
  -> m a
{-# INLINE casByteArray #-}
casByteArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutableByteArray (PrimState m) -> Int -> a -> a -> m a
casByteArray (MutableByteArray MutableByteArray# (PrimState m)
arr#) (I# Int#
i#) a
old a
new =
  (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s0 -> case MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> Int# -> State# d -> (# State# d, Int# #)
casIntArray# MutableByteArray# (PrimState m)
arr# Int#
i# (a -> Int#
forall a. PrimMach a => a -> Int#
primMachToInt# a
old) (a -> Int#
forall a. PrimMach a => a -> Int#
primMachToInt# a
new) State# (PrimState m)
s0 of
    (# State# (PrimState m)
s1, Int#
r #) -> (# State# (PrimState m)
s1, Int# -> a
forall a. PrimMach a => Int# -> a
primMachFromInt# Int#
r #)

-- | Given an array, and offset in Int units, and a value to add, atomically
-- add the value to the element. Returns the value of the element before the
-- operation. Implies a full memory barrier.
fetchAddByteArray :: (PrimMonad m, PrimMach a)
  => MutableByteArray (PrimState m)
  -> Int -- ^ index
  -> a -- ^ value to add to the element
  -> m a
{-# INLINE fetchAddByteArray #-}
fetchAddByteArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutableByteArray (PrimState m) -> Int -> a -> m a
fetchAddByteArray (MutableByteArray MutableByteArray# (PrimState m)
arr#) (I# Int#
i#) a
val =
  (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s0 -> case MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchAddIntArray# MutableByteArray# (PrimState m)
arr# Int#
i# (a -> Int#
forall a. PrimMach a => a -> Int#
primMachToInt# a
val) State# (PrimState m)
s0 of
    (# State# (PrimState m)
s1, Int#
r #) -> (# State# (PrimState m)
s1, Int# -> a
forall a. PrimMach a => Int# -> a
primMachFromInt# Int#
r #)

-- | Given an array, and offset in Int units, and a value to subtract, atomically
-- subtract the value to the element. Returns the value of the element before the
-- operation. Implies a full memory barrier.
fetchSubByteArray :: (PrimMonad m, PrimMach a)
  => MutableByteArray (PrimState m)
  -> Int -- ^ index
  -> a -- ^ value to subtract from the element
  -> m a
{-# INLINE fetchSubByteArray #-}
fetchSubByteArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutableByteArray (PrimState m) -> Int -> a -> m a
fetchSubByteArray (MutableByteArray MutableByteArray# (PrimState m)
arr#) (I# Int#
i#) a
val =
  (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s0 -> case MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchSubIntArray# MutableByteArray# (PrimState m)
arr# Int#
i# (a -> Int#
forall a. PrimMach a => a -> Int#
primMachToInt# a
val) State# (PrimState m)
s0 of
    (# State# (PrimState m)
s1, Int#
r #) -> (# State# (PrimState m)
s1, Int# -> a
forall a. PrimMach a => Int# -> a
primMachFromInt# Int#
r #)

-- | Given an array, and offset in Int units, and a value to @AND@, atomically
-- @AND@ the value to the element. Returns the value of the element before the
-- operation. Implies a full memory barrier.
fetchAndByteArray :: (PrimMonad m, PrimMach a)
  => MutableByteArray (PrimState m)
  -> Int -- ^ index
  -> a -- ^ value to @AND@ with the element
  -> m a
{-# INLINE fetchAndByteArray #-}
fetchAndByteArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutableByteArray (PrimState m) -> Int -> a -> m a
fetchAndByteArray (MutableByteArray MutableByteArray# (PrimState m)
arr#) (I# Int#
i#) a
val =
  (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s0 -> case MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchAndIntArray# MutableByteArray# (PrimState m)
arr# Int#
i# (a -> Int#
forall a. PrimMach a => a -> Int#
primMachToInt# a
val) State# (PrimState m)
s0 of
    (# State# (PrimState m)
s1, Int#
r #) -> (# State# (PrimState m)
s1, Int# -> a
forall a. PrimMach a => Int# -> a
primMachFromInt# Int#
r #)

-- | Given an array, and offset in Int units, and a value to @NAND@, atomically
-- @NAND@ the value to the element. Returns the value of the element before the
-- operation. Implies a full memory barrier.
fetchNandByteArray :: (PrimMonad m, PrimMach a)
  => MutableByteArray (PrimState m)
  -> Int -- ^ index
  -> a -- ^ value to @NAND@ with the element
  -> m a
{-# INLINE fetchNandByteArray #-}
fetchNandByteArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutableByteArray (PrimState m) -> Int -> a -> m a
fetchNandByteArray (MutableByteArray MutableByteArray# (PrimState m)
arr#) (I# Int#
i#) a
val =
  (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s0 -> case MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchNandIntArray# MutableByteArray# (PrimState m)
arr# Int#
i# (a -> Int#
forall a. PrimMach a => a -> Int#
primMachToInt# a
val) State# (PrimState m)
s0 of
    (# State# (PrimState m)
s1, Int#
r #) -> (# State# (PrimState m)
s1, Int# -> a
forall a. PrimMach a => Int# -> a
primMachFromInt# Int#
r #)

-- | Given an array, and offset in Int units, and a value to @OR@, atomically
-- @OR@ the value to the element. Returns the value of the element before the
-- operation. Implies a full memory barrier.
fetchOrByteArray :: (PrimMonad m, PrimMach a)
  => MutableByteArray (PrimState m)
  -> Int -- ^ index
  -> a -- ^ value to @OR@ with the element
  -> m a
{-# INLINE fetchOrByteArray #-}
fetchOrByteArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutableByteArray (PrimState m) -> Int -> a -> m a
fetchOrByteArray (MutableByteArray MutableByteArray# (PrimState m)
arr#) (I# Int#
i#) a
val =
  (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s0 -> case MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchOrIntArray# MutableByteArray# (PrimState m)
arr# Int#
i# (a -> Int#
forall a. PrimMach a => a -> Int#
primMachToInt# a
val) State# (PrimState m)
s0 of
    (# State# (PrimState m)
s1, Int#
r #) -> (# State# (PrimState m)
s1, Int# -> a
forall a. PrimMach a => Int# -> a
primMachFromInt# Int#
r #)

-- | Given an array, and offset in Int units, and a value to @XOR@, atomically
-- @XOR@ the value to the element. Returns the value of the element before the
-- operation. Implies a full memory barrier.
fetchXorByteArray :: (PrimMonad m, PrimMach a)
  => MutableByteArray (PrimState m)
  -> Int -- ^ index
  -> a -- ^ value to @XOR@ with the element
  -> m a
{-# INLINE fetchXorByteArray #-}
fetchXorByteArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutableByteArray (PrimState m) -> Int -> a -> m a
fetchXorByteArray (MutableByteArray MutableByteArray# (PrimState m)
arr#) (I# Int#
i#) a
val =
  (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s0 -> case MutableByteArray# (PrimState m)
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchXorIntArray# MutableByteArray# (PrimState m)
arr# Int#
i# (a -> Int#
forall a. PrimMach a => a -> Int#
primMachToInt# a
val) State# (PrimState m)
s0 of
    (# State# (PrimState m)
s1, Int#
r #) -> (# State# (PrimState m)
s1, Int# -> a
forall a. PrimMach a => Int# -> a
primMachFromInt# Int#
r #)