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

module Data.Primitive.PrimArray.Atomic
  ( casPrimArray
  , fetchAddPrimArray
  , fetchSubPrimArray
  , fetchAndPrimArray
  , fetchNandPrimArray
  , fetchOrPrimArray
  , fetchXorPrimArray
  ) where

import Control.Monad.Primitive (PrimMonad,PrimState,primitive)
import Data.Primitive (MutablePrimArray(..))
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.
casPrimArray :: (PrimMonad m, PrimMach a)
  => MutablePrimArray (PrimState m) a -- ^ prim array
  -> Int -- ^ index
  -> a -- ^ expected old value
  -> a -- ^ new value
  -> m a
{-# INLINE casPrimArray #-}
casPrimArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutablePrimArray (PrimState m) a -> Int -> a -> a -> m a
casPrimArray (MutablePrimArray 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.
fetchAddPrimArray :: (PrimMonad m, PrimMach a)
  => MutablePrimArray (PrimState m) a
  -> Int -- ^ index
  -> a -- ^ value to add to the element
  -> m a
{-# INLINE fetchAddPrimArray #-}
fetchAddPrimArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m a
fetchAddPrimArray (MutablePrimArray 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.
fetchSubPrimArray :: (PrimMonad m, PrimMach a)
  => MutablePrimArray (PrimState m) a
  -> Int -- ^ index
  -> a -- ^ value to subtract from the element
  -> m a
{-# INLINE fetchSubPrimArray #-}
fetchSubPrimArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m a
fetchSubPrimArray (MutablePrimArray 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.
fetchAndPrimArray :: (PrimMonad m, PrimMach a)
  => MutablePrimArray (PrimState m) a
  -> Int -- ^ index
  -> a -- ^ value to @AND@ with the element
  -> m a
{-# INLINE fetchAndPrimArray #-}
fetchAndPrimArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m a
fetchAndPrimArray (MutablePrimArray 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.
fetchNandPrimArray :: (PrimMonad m, PrimMach a)
  => MutablePrimArray (PrimState m) a
  -> Int -- ^ index
  -> a -- ^ value to @NAND@ with the element
  -> m a
{-# INLINE fetchNandPrimArray #-}
fetchNandPrimArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m a
fetchNandPrimArray (MutablePrimArray 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.
fetchOrPrimArray :: (PrimMonad m, PrimMach a)
  => MutablePrimArray (PrimState m) a
  -> Int -- ^ index
  -> a -- ^ value to @OR@ with the element
  -> m a
{-# INLINE fetchOrPrimArray #-}
fetchOrPrimArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m a
fetchOrPrimArray (MutablePrimArray 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.
fetchXorPrimArray :: (PrimMonad m, PrimMach a)
  => MutablePrimArray (PrimState m) a
  -> Int -- ^ index
  -> a -- ^ value to @XOR@ with the element
  -> m a
{-# INLINE fetchXorPrimArray #-}
fetchXorPrimArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimMach a) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m a
fetchXorPrimArray (MutablePrimArray 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 #)