{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
#endif
-- |
-- Module      : Data.Primitive.PVar
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Primitive.PVar
  ( -- | `PVar` has significantly better performance characteristics over
    -- `Data.IORef.IORef`, `Data.STRef.STRef` and `Data.Primitive.MutVar.MutVar`. This is
    -- because value is mutated directly in memory instead of following an extra
    -- pointer. Besides better performance there is another consequence of direct
    -- mutation, namely the value is always evaluated to normal form when being written
    -- into a `PVar`

    PVar
  , RW
  -- * Creation
  , newPVar
  , withPVarST
  -- * Mutable Operations
  , readPVar
  , writePVar
  , modifyPVar
  , modifyPVar_
  , fetchModifyPVar
  , modifyFetchPVar
  , modifyPVarM
  , modifyPVarM_
  , fetchModifyPVarM
  , modifyFetchPVarM
  , swapPVars_
  , swapPVars
  , copyPVar
  , sizeOfPVar
  , alignmentPVar
  -- * Pinned memory
  --
  -- $pinned
  , newPinnedPVar
  , newAlignedPinnedPVar
  , withPtrPVar
  , withStorablePVar
  , withAlignedStorablePVar
  , copyPVarToPtr
  , toForeignPtrPVar
  , isPinnedPVar
  , peekPrim
  , pokePrim
  -- -- * Numeric infix operations
  -- , (=+)
  -- , (=-)
  -- , (=*)
  -- , (=/)
  -- , (=%)
  -- * Atomic operations
  , atomicModifyIntPVar
  , atomicModifyIntPVar_
  , atomicFetchModifyIntPVar
  , atomicModifyFetchIntPVar
  , atomicReadIntPVar
  , atomicWriteIntPVar
  , casIntPVar
  , atomicAddIntPVar
  , atomicSubIntPVar
  , atomicAndIntPVar
  , atomicNandIntPVar
  , atomicOrIntPVar
  , atomicXorIntPVar
  , atomicNotIntPVar
  -- * Re-exports
  , Prim
  , MonadPrim
  , PrimMonad(PrimState)
  , RealWorld
  , sizeOf
  , alignment
  , ST
  , runST
  , S.Storable(peek, poke)
  ) where

import Control.Monad (void)
import Control.Monad.Primitive (MonadPrim, PrimMonad(primitive), PrimState, primitive_,
                                touch)
import Control.Monad.ST (ST, runST)
import Data.Primitive.PVar.Internal
import Data.Primitive.PVar.Unsafe
import Data.Primitive.Types
import qualified Foreign.Storable as S
import GHC.Exts
import GHC.ForeignPtr

-- $pinned
-- In theory it is unsafe to mix `S.Storable` and `Prim` operations on the same chunk of
-- memory, because some instances can have different memory layouts for the same
-- type. This is highly uncommon in practice and if you are intermixing the two concepts
-- together you probably already know what you are doing.

-- | Synonym for `RealWorld`
type RW = RealWorld

-- | Run an `ST` action on a mutable variable.
--
-- @since 0.1.0
withPVarST ::
     Prim p
  => p -- ^ Initial value assigned to the mutable variable
  -> (forall s. PVar p s -> ST s a) -- ^ Action to run
  -> a -- ^ Result produced by the `ST` action
withPVarST :: forall p a. Prim p => p -> (forall s. PVar p s -> ST s a) -> a
withPVarST p
x forall s. PVar p s -> ST s a
st = (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST (p -> ST s (PVar p s)
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
a -> m (PVar a s)
newPVar p
x ST s (PVar p s) -> (PVar p s -> ST s a) -> ST s a
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PVar p s -> ST s a
forall s. PVar p s -> ST s a
st)
{-# INLINE withPVarST #-}

-- | Apply an action to the `Ptr` that references the mutable variable, but only if it is
-- backed by pinned memory, cause otherwise it would be unsafe.
--
-- @since 0.1.0
withPtrPVar :: (MonadPrim s m, Prim a) => PVar a n -> (Ptr a -> m b) -> m (Maybe b)
withPtrPVar :: forall s (m :: * -> *) a n b.
(MonadPrim s m, Prim a) =>
PVar a n -> (Ptr a -> m b) -> m (Maybe b)
withPtrPVar PVar a n
pvar Ptr a -> m b
f =
  case PVar a n -> Maybe (Ptr a)
forall a s. PVar a s -> Maybe (Ptr a)
toPtrPVar PVar a n
pvar of
    Maybe (Ptr a)
Nothing -> Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
    Just Ptr a
ptr -> do
      b
r <- Ptr a -> m b
f Ptr a
ptr
      PVar a n -> m ()
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch PVar a n
pvar
      Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> m (Maybe b)) -> Maybe b -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ b -> Maybe b
forall a. a -> Maybe a
Just b
r
{-# INLINE withPtrPVar #-}

-- | Convert `PVar` into a `ForeignPtr`, but only if it is backed by pinned memory.
--
-- @since 0.1.0
toForeignPtrPVar :: PVar a s -> Maybe (ForeignPtr a)
toForeignPtrPVar :: forall a s. PVar a s -> Maybe (ForeignPtr a)
toForeignPtrPVar PVar a s
pvar
  | PVar a s -> Bool
forall a s. PVar a s -> Bool
isPinnedPVar PVar a s
pvar = ForeignPtr a -> Maybe (ForeignPtr a)
forall a. a -> Maybe a
Just (ForeignPtr a -> Maybe (ForeignPtr a))
-> ForeignPtr a -> Maybe (ForeignPtr a)
forall a b. (a -> b) -> a -> b
$ PVar a s -> ForeignPtr a
forall a s. PVar a s -> ForeignPtr a
unsafeToForeignPtrPVar PVar a s
pvar
  | Bool
otherwise = Maybe (ForeignPtr a)
forall a. Maybe a
Nothing
{-# INLINE toForeignPtrPVar #-}

-- | Copy contents of one mutable variable `PVar` into another
--
-- @since 0.1.0
copyPVar ::
     (MonadPrim s m, Prim a)
  => PVar a s -- ^ Source variable
  -> PVar a s -- ^ Destination variable
  -> m ()
copyPVar :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> PVar a s -> m ()
copyPVar pvar :: PVar a s
pvar@(PVar MutableByteArray# s
mbas#) (PVar MutableByteArray# s
mbad#) =
  (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# s
mbas# Int#
0# MutableByteArray# s
mbad# Int#
0# (PVar a s -> Int#
forall a s. Prim a => PVar a s -> Int#
sizeOfPVar# PVar a s
pvar))
{-# INLINE copyPVar #-}

-- | Copy contents of a mutable variable `PVar` into a pointer `Ptr`
--
-- @since 0.1.0
copyPVarToPtr :: (MonadPrim s m, Prim a) => PVar a s -> Ptr a -> m ()
copyPVarToPtr :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> Ptr a -> m ()
copyPVarToPtr pvar :: PVar a s
pvar@(PVar MutableByteArray# s
mbas#) (Ptr Addr#
addr#) =
  (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# s
-> Int# -> Addr# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d
-> Int# -> Addr# -> Int# -> State# d -> State# d
copyMutableByteArrayToAddr# MutableByteArray# s
mbas# Int#
0# Addr#
addr# (PVar a s -> Int#
forall a s. Prim a => PVar a s -> Int#
sizeOfPVar# PVar a s
pvar))
{-# INLINE copyPVarToPtr #-}

-- | Apply a pure function to the contents of a mutable variable. Returns the artifact of
-- computation.
--
-- @since 0.2.0
modifyPVar :: (MonadPrim s m, Prim a) => PVar a s -> (a -> (a, b)) -> m b
modifyPVar :: forall s (m :: * -> *) a b.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> (a, b)) -> m b
modifyPVar PVar a s
pvar a -> (a, b)
f = PVar a s -> (a -> m (a, b)) -> m b
forall s (m :: * -> *) a b.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> m (a, b)) -> m b
modifyPVarM PVar a s
pvar ((a, b) -> m (a, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, b) -> m (a, b)) -> (a -> (a, b)) -> a -> m (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (a, b)
f)
{-# INLINE modifyPVar #-}

-- | Apply a pure function to the contents of a mutable variable.
--
-- @since 0.1.0
modifyPVar_ :: (MonadPrim s m, Prim a) => PVar a s -> (a -> a) -> m ()
modifyPVar_ :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> a) -> m ()
modifyPVar_ PVar a s
pvar a -> a
f = PVar a s -> (a -> m a) -> m ()
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> m a) -> m ()
modifyPVarM_ PVar a s
pvar (a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (a -> a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)
{-# INLINE modifyPVar_ #-}


-- | Apply a pure function to the contents of a mutable variable. Returns the old value.
--
-- @since 0.2.0
fetchModifyPVar :: (MonadPrim s m, Prim a) => PVar a s -> (a -> a) -> m a
fetchModifyPVar :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> a) -> m a
fetchModifyPVar PVar a s
pvar a -> a
f = PVar a s -> (a -> m a) -> m a
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> m a) -> m a
fetchModifyPVarM PVar a s
pvar (a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (a -> a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)
{-# INLINE fetchModifyPVar #-}

-- | Apply a pure function to the contents of a mutable variable. Returns the new value.
--
-- @since 0.2.0
modifyFetchPVar :: (MonadPrim s m, Prim a) => PVar a s -> (a -> a) -> m a
modifyFetchPVar :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> a) -> m a
modifyFetchPVar PVar a s
pvar a -> a
f = PVar a s -> (a -> m a) -> m a
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> m a) -> m a
modifyFetchPVarM PVar a s
pvar (a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (a -> a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)
{-# INLINE modifyFetchPVar #-}


-- | Apply a monadic action to the contents of a mutable variable. Returns the artifact of
-- computation.
--
-- @since 0.2.0
modifyPVarM :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m (a, b)) -> m b
modifyPVarM :: forall s (m :: * -> *) a b.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> m (a, b)) -> m b
modifyPVarM PVar a s
pvar a -> m (a, b)
f = do
  a
a <- PVar a s -> m a
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> m a
readPVar PVar a s
pvar
  (a
a', b
b) <- a -> m (a, b)
f a
a
  b
b b -> m () -> m b
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ PVar a s -> a -> m ()
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> a -> m ()
writePVar PVar a s
pvar a
a'
{-# INLINE modifyPVarM #-}

-- | Apply a monadic action to the contents of a mutable variable. Returns the old value.
--
-- @since 0.2.0
fetchModifyPVarM :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m a) -> m a
fetchModifyPVarM :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> m a) -> m a
fetchModifyPVarM PVar a s
pvar a -> m a
f = do
  a
a <- PVar a s -> m a
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> m a
readPVar PVar a s
pvar
  a
a a -> m () -> m a
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (PVar a s -> a -> m ()
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> a -> m ()
writePVar PVar a s
pvar (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m a
f a
a)
{-# INLINE fetchModifyPVarM #-}


-- | Apply a monadic action to the contents of a mutable variable. Returns the new value.
--
-- @since 0.2.0
modifyFetchPVarM :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m a) -> m a
modifyFetchPVarM :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> m a) -> m a
modifyFetchPVarM PVar a s
pvar a -> m a
f = do
  a
a <- PVar a s -> m a
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> m a
readPVar PVar a s
pvar
  a
a' <- a -> m a
f a
a
  a
a' a -> m () -> m a
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ PVar a s -> a -> m ()
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> a -> m ()
writePVar PVar a s
pvar a
a'
{-# INLINE modifyFetchPVarM #-}


-- | Apply a monadic action to the contents of a mutable variable.
--
-- @since 0.1.0
modifyPVarM_ :: (MonadPrim s m, Prim a) => PVar a s -> (a -> m a) -> m ()
modifyPVarM_ :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> m a) -> m ()
modifyPVarM_ PVar a s
pvar a -> m a
f = PVar a s -> m a
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> m a
readPVar PVar a s
pvar m a -> (a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
f m a -> (a -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PVar a s -> a -> m ()
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> a -> m ()
writePVar PVar a s
pvar
{-# INLINE modifyPVarM_ #-}

-- | Swap contents of two mutable variables. Returns their old values.
--
-- @since 0.1.0
swapPVars :: (MonadPrim s m, Prim a) => PVar a s -> PVar a s -> m (a, a)
swapPVars :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> PVar a s -> m (a, a)
swapPVars PVar a s
pvar1 PVar a s
pvar2 = do
  a
a1 <- PVar a s -> m a
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> m a
readPVar PVar a s
pvar1
  a
a2 <- PVar a s -> (a -> a) -> m a
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> (a -> a) -> m a
fetchModifyPVar PVar a s
pvar2 (a -> a -> a
forall a b. a -> b -> a
const a
a1)
  (a
a1, a
a2) (a, a) -> m () -> m (a, a)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ PVar a s -> a -> m ()
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> a -> m ()
writePVar PVar a s
pvar1 a
a2
{-# INLINE swapPVars #-}

-- | Swap contents of two mutable variables.
--
-- @since 0.1.0
swapPVars_ :: (MonadPrim s m, Prim a) => PVar a s -> PVar a s -> m ()
swapPVars_ :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> PVar a s -> m ()
swapPVars_ PVar a s
pvar1 PVar a s
pvar2 = m (a, a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (a, a) -> m ()) -> m (a, a) -> m ()
forall a b. (a -> b) -> a -> b
$ PVar a s -> PVar a s -> m (a, a)
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> PVar a s -> m (a, a)
swapPVars PVar a s
pvar1 PVar a s
pvar2
{-# INLINE swapPVars_ #-}

-- TODO: Come up with a concrete interface for numerics
-- (=+) :: (MonadPrim s m, Prim a, Num a) => PVar (PrimState m) a -> a -> m ()
-- (=+) pvar a = modifyPVar_ pvar (+ a)
-- {-# INLINE (=+) #-}

-- (=-) :: (MonadPrim s m, Prim a, Num a) => PVar (PrimState m) a -> a -> m ()
-- (=-) pvar a = modifyPVar_ pvar (subtract a)
-- {-# INLINE (=-) #-}

-- (=*) :: (MonadPrim s m, Prim a, Num a) => PVar (PrimState m) a -> a -> m ()
-- (=*) pvar a = modifyPVar_ pvar (* a)
-- {-# INLINE (=*) #-}

-- (=/) :: (MonadPrim s m, Prim a, Fractional a) => PVar (PrimState m) a -> a -> m ()
-- (=/) pvar a = modifyPVar_ pvar (/ a)
-- {-# INLINE (=/) #-}

-- -- | C like modulo operator
-- (=%) :: (MonadPrim s m, Prim a, Integral a) => PVar (PrimState m) a -> a -> m ()
-- (=%) pvar a = modifyPVar_ pvar (`mod` a)
-- {-# INLINE (=%) #-}




-- | Apply an action to the newly allocated `PVar` and to the `Ptr` that references
-- it. Memory allocated with number of bytes specified by @`S.sizeOf` a@ is allocated and
-- pinned, therefore it is safe to operate directly with the pointer as well as over
-- FFI. Returning the pointer from the supplied action would be very unsafe, therefore
-- return the `PVar` if you still need it afterwards, garbage collector will cleanup the
-- memory when it is no longer needed.
--
-- @since 0.1.0
withStorablePVar ::
     (MonadPrim s m, S.Storable a)
  => a -- ^ Initial value
  -> (PVar a s -> Ptr a -> m b) -- ^ Action to run
  -> m b
withStorablePVar :: forall s (m :: * -> *) a b.
(MonadPrim s m, Storable a) =>
a -> (PVar a s -> Ptr a -> m b) -> m b
withStorablePVar a
a PVar a s -> Ptr a -> m b
f = do
  PVar a s
pvar <- m (PVar a s)
forall a (m :: * -> *) s.
(MonadPrim s m, Storable a) =>
m (PVar a s)
rawStorablePVar
  PVar a s -> a -> (PVar a s -> Ptr a -> m b) -> m b
forall a s (m :: * -> *) b.
(Storable a, MonadPrim s m) =>
PVar a s -> a -> (PVar a s -> Ptr a -> m b) -> m b
runWithPokedPtr PVar a s
pvar a
a PVar a s -> Ptr a -> m b
f
{-# INLINE withStorablePVar #-}

-- | Same `withStorablePVar`, except memory is aligned according to `S.alignment`.
--
-- @since 0.1.0
withAlignedStorablePVar ::
     (MonadPrim s m, S.Storable a)
  => a -- ^ Initial value
  -> (PVar a s -> Ptr a -> m b) -- ^ Action to run
  -> m b
withAlignedStorablePVar :: forall s (m :: * -> *) a b.
(MonadPrim s m, Storable a) =>
a -> (PVar a s -> Ptr a -> m b) -> m b
withAlignedStorablePVar a
a PVar a s -> Ptr a -> m b
f = do
  PVar a s
pvar <- m (PVar a s)
forall a (m :: * -> *) s.
(MonadPrim s m, Storable a) =>
m (PVar a s)
rawAlignedStorablePVar
  PVar a s -> a -> (PVar a s -> Ptr a -> m b) -> m b
forall a s (m :: * -> *) b.
(Storable a, MonadPrim s m) =>
PVar a s -> a -> (PVar a s -> Ptr a -> m b) -> m b
runWithPokedPtr PVar a s
pvar a
a PVar a s -> Ptr a -> m b
f
{-# INLINE withAlignedStorablePVar #-}


-- | Read a value from `PVar` atomically. Implies a full memory barrier.
--
-- @since 0.1.0
atomicReadIntPVar :: MonadPrim s m => PVar Int s -> m Int
atomicReadIntPVar :: forall s (m :: * -> *). MonadPrim s m => PVar Int s -> m Int
atomicReadIntPVar (PVar MutableByteArray# s
mba#) =
  (State# (PrimState m) -> (# State# (PrimState m), Int #)) -> m Int
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), Int #))
 -> m Int)
-> (State# (PrimState m) -> (# State# (PrimState m), Int #))
-> m Int
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s# ->
    case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
atomicReadIntArray# MutableByteArray# s
mba# Int#
0# State# s
State# (PrimState m)
s# of
      (# State# s
s'#, Int#
i# #) -> (# State# s
State# (PrimState m)
s'#, Int# -> Int
I# Int#
i# #)
{-# INLINE atomicReadIntPVar #-}

-- | Write a value into an `PVar` atomically. Implies a full memory barrier.
--
-- @since 0.1.0
atomicWriteIntPVar :: MonadPrim s m => PVar Int s -> Int -> m ()
atomicWriteIntPVar :: forall s (m :: * -> *). MonadPrim s m => PVar Int s -> Int -> m ()
atomicWriteIntPVar (PVar MutableByteArray# s
mba#) Int
a = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
atomicWriteIntArray# MutableByteArray# s
mba# Int#
0# (Int -> Int#
unI# Int
a))
{-# INLINE atomicWriteIntPVar #-}


-- | Apply a function to an integer element of a `PVar` atomically. Implies a full memory
-- barrier. Returns the new value.
--
-- @since 0.2.0
atomicFetchModifyIntPVar ::
     MonadPrim s m => PVar Int s -> (Int -> Int) -> m Int
atomicFetchModifyIntPVar :: forall s (m :: * -> *).
MonadPrim s m =>
PVar Int s -> (Int -> Int) -> m Int
atomicFetchModifyIntPVar PVar Int s
pvar Int -> Int
f =
  PVar Int s -> (Int -> (Int, Int)) -> m Int
forall s (m :: * -> *) a.
MonadPrim s m =>
PVar Int s -> (Int -> (Int, a)) -> m a
atomicModifyIntPVar PVar Int s
pvar ((Int -> (Int, Int)) -> m Int) -> (Int -> (Int, Int)) -> m Int
forall a b. (a -> b) -> a -> b
$ \Int
a ->
    let a' :: Int
a' = Int -> Int
f Int
a
     in Int
a' Int -> (Int, Int) -> (Int, Int)
forall a b. a -> b -> b
`seq` (Int
a', Int
a)
{-# INLINE atomicFetchModifyIntPVar #-}

-- | Apply a function to an integer element of a `PVar` atomically. Implies a full memory
-- barrier. Returns the new value.
--
-- @since 0.2.0
atomicModifyFetchIntPVar ::
     MonadPrim s m => PVar Int s -> (Int -> Int) -> m Int
atomicModifyFetchIntPVar :: forall s (m :: * -> *).
MonadPrim s m =>
PVar Int s -> (Int -> Int) -> m Int
atomicModifyFetchIntPVar PVar Int s
pvar Int -> Int
f =
  PVar Int s -> (Int -> (Int, Int)) -> m Int
forall s (m :: * -> *) a.
MonadPrim s m =>
PVar Int s -> (Int -> (Int, a)) -> m a
atomicModifyIntPVar PVar Int s
pvar ((Int -> (Int, Int)) -> m Int) -> (Int -> (Int, Int)) -> m Int
forall a b. (a -> b) -> a -> b
$ \Int
a ->
    let a' :: Int
a' = Int -> Int
f Int
a
     in Int
a' Int -> (Int, Int) -> (Int, Int)
forall a b. a -> b -> b
`seq` (Int
a', Int
a')
{-# INLINE atomicModifyFetchIntPVar #-}


-- | Compare and swap. This is also a function that is used to implement
-- `atomicModifyIntPVar`. Implies a full memory barrier.
--
-- @since 0.1.0
casIntPVar ::
     MonadPrim s m
  => PVar Int s -- ^ Variable to mutate
  -> Int -- ^ Old expected value
  -> Int -- ^ New value
  -> m Int -- ^ Old actual value
casIntPVar :: forall s (m :: * -> *).
MonadPrim s m =>
PVar Int s -> Int -> Int -> m Int
casIntPVar (PVar MutableByteArray# s
mba#) Int
old Int
new =
  (State# (PrimState m) -> (# State# (PrimState m), Int #)) -> m Int
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), Int #))
 -> m Int)
-> (State# (PrimState m) -> (# State# (PrimState m), Int #))
-> m Int
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s# ->
    case MutableByteArray# s
-> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> Int# -> State# d -> (# State# d, Int# #)
casIntArray# MutableByteArray# s
mba# Int#
0# (Int -> Int#
unI# Int
old) (Int -> Int#
unI# Int
new) State# s
State# (PrimState m)
s# of
      (# State# s
s'#, Int#
i'# #) -> (# State# s
State# (PrimState m)
s'#, Int# -> Int
I# Int#
i'# #)
{-# INLINE casIntPVar #-}



-- | Add two numbers, corresponds to @(`+`)@ done atomically. Returns the previous value of
-- the mutable variable. Implies a full memory barrier.
--
-- @since 0.1.0
atomicAddIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
atomicAddIntPVar :: forall s (m :: * -> *). MonadPrim s m => PVar Int s -> Int -> m Int
atomicAddIntPVar (PVar MutableByteArray# s
mba#) Int
a =
  (State# (PrimState m) -> (# State# (PrimState m), Int #)) -> m Int
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), Int #))
 -> m Int)
-> (State# (PrimState m) -> (# State# (PrimState m), Int #))
-> m Int
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s# ->
    case MutableByteArray# s
-> Int# -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchAddIntArray# MutableByteArray# s
mba# Int#
0# (Int -> Int#
unI# Int
a) State# s
State# (PrimState m)
s# of
      (# State# s
s'#, Int#
p# #) -> (# State# s
State# (PrimState m)
s'#, Int# -> Int
I# Int#
p# #)
{-# INLINE atomicAddIntPVar #-}

-- | Subtract two numbers, corresponds to @(`-`)@ done atomically. Returns the
-- previous value of the mutable variable. Implies a full memory barrier.
--
-- @since 0.1.0
atomicSubIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
atomicSubIntPVar :: forall s (m :: * -> *). MonadPrim s m => PVar Int s -> Int -> m Int
atomicSubIntPVar (PVar MutableByteArray# s
mba#) Int
a =
  (State# (PrimState m) -> (# State# (PrimState m), Int #)) -> m Int
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), Int #))
 -> m Int)
-> (State# (PrimState m) -> (# State# (PrimState m), Int #))
-> m Int
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s# ->
    case MutableByteArray# s
-> Int# -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchSubIntArray# MutableByteArray# s
mba# Int#
0# (Int -> Int#
unI# Int
a) State# s
State# (PrimState m)
s# of
      (# State# s
s'#, Int#
p# #) -> (# State# s
State# (PrimState m)
s'#, Int# -> Int
I# Int#
p# #)
{-# INLINE atomicSubIntPVar #-}


-- | Binary conjuction (AND), corresponds to @(`Data.Bits..&.`)@ done atomically. Returns the previous
-- value of the mutable variable. Implies a full memory barrier.
--
-- @since 0.1.0
atomicAndIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
atomicAndIntPVar :: forall s (m :: * -> *). MonadPrim s m => PVar Int s -> Int -> m Int
atomicAndIntPVar (PVar MutableByteArray# s
mba#) Int
a =
  (State# (PrimState m) -> (# State# (PrimState m), Int #)) -> m Int
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), Int #))
 -> m Int)
-> (State# (PrimState m) -> (# State# (PrimState m), Int #))
-> m Int
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s# ->
    case MutableByteArray# s
-> Int# -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchAndIntArray# MutableByteArray# s
mba# Int#
0# (Int -> Int#
unI# Int
a) State# s
State# (PrimState m)
s# of
      (# State# s
s'#, Int#
p# #) -> (# State# s
State# (PrimState m)
s'#, Int# -> Int
I# Int#
p# #)
{-# INLINE atomicAndIntPVar #-}


-- | Binary negation of conjuction (NAND), corresponds to @\\x y -> `Data.Bits.complement` (x
-- `Data.Bits..&.` y)@ done atomically. Returns the previous value of the mutable variable. Implies
-- a full memory barrier.
--
-- @since 0.1.0
atomicNandIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
atomicNandIntPVar :: forall s (m :: * -> *). MonadPrim s m => PVar Int s -> Int -> m Int
atomicNandIntPVar (PVar MutableByteArray# s
mba#) Int
a =
  (State# (PrimState m) -> (# State# (PrimState m), Int #)) -> m Int
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), Int #))
 -> m Int)
-> (State# (PrimState m) -> (# State# (PrimState m), Int #))
-> m Int
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s# ->
    case MutableByteArray# s
-> Int# -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchNandIntArray# MutableByteArray# s
mba# Int#
0# (Int -> Int#
unI# Int
a) State# s
State# (PrimState m)
s# of
      (# State# s
s'#, Int#
p# #) -> (# State# s
State# (PrimState m)
s'#, Int# -> Int
I# Int#
p# #)
{-# INLINE atomicNandIntPVar #-}


-- | Binary disjunction (OR), corresponds to @(`Data.Bits..|.`)@ done atomically. Returns the previous
-- value of the mutable variable. Implies a full memory barrier.
--
-- @since 0.1.0
atomicOrIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
atomicOrIntPVar :: forall s (m :: * -> *). MonadPrim s m => PVar Int s -> Int -> m Int
atomicOrIntPVar (PVar MutableByteArray# s
mba#) Int
a =
  (State# (PrimState m) -> (# State# (PrimState m), Int #)) -> m Int
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), Int #))
 -> m Int)
-> (State# (PrimState m) -> (# State# (PrimState m), Int #))
-> m Int
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s# ->
    case MutableByteArray# s
-> Int# -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchOrIntArray# MutableByteArray# s
mba# Int#
0# (Int -> Int#
unI# Int
a) State# s
State# (PrimState m)
s# of
      (# State# s
s'#, Int#
p# #) -> (# State# s
State# (PrimState m)
s'#, Int# -> Int
I# Int#
p# #)
{-# INLINE atomicOrIntPVar #-}


-- | Binary exclusive disjunction (XOR), corresponds to @`Data.Bits.xor`@ done atomically. Returns the
-- previous value of the mutable variable. Implies a full memory barrier.
--
-- @since 0.1.0
atomicXorIntPVar :: MonadPrim s m => PVar Int s -> Int -> m Int
atomicXorIntPVar :: forall s (m :: * -> *). MonadPrim s m => PVar Int s -> Int -> m Int
atomicXorIntPVar (PVar MutableByteArray# s
mba#) Int
a =
  (State# (PrimState m) -> (# State# (PrimState m), Int #)) -> m Int
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), Int #))
 -> m Int)
-> (State# (PrimState m) -> (# State# (PrimState m), Int #))
-> m Int
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s# ->
    case MutableByteArray# s
-> Int# -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchXorIntArray# MutableByteArray# s
mba# Int#
0# (Int -> Int#
unI# Int
a) State# s
State# (PrimState m)
s# of
      (# State# s
s'#, Int#
p# #) -> (# State# s
State# (PrimState m)
s'#, Int# -> Int
I# Int#
p# #)
{-# INLINE atomicXorIntPVar #-}


-- | Binary negation (NOT), corresponds to ones' @`Data.Bits.complement`@ done atomically. Returns the
-- previous value of the mutable variable. Implies a full memory barrier.
--
-- @since 0.1.0
atomicNotIntPVar :: MonadPrim s m => PVar Int s -> m Int
atomicNotIntPVar :: forall s (m :: * -> *). MonadPrim s m => PVar Int s -> m Int
atomicNotIntPVar (PVar MutableByteArray# s
mba#) =
  (State# (PrimState m) -> (# State# (PrimState m), Int #)) -> m Int
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), Int #))
 -> m Int)
-> (State# (PrimState m) -> (# State# (PrimState m), Int #))
-> m Int
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s# ->
    case MutableByteArray# s
-> Int# -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d
-> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchXorIntArray# MutableByteArray# s
mba# Int#
0# Int#
fullInt# State# s
State# (PrimState m)
s# of
      (# State# s
s'#, Int#
p# #) -> (# State# s
State# (PrimState m)
s'#, Int# -> Int
I# Int#
p# #)
  where
    fullInt# :: Int#
fullInt# =
      case Word
forall a. Bounded a => a
maxBound :: Word of
        W# Word#
w# -> Word# -> Int#
word2Int# Word#
w#
{-# INLINE atomicNotIntPVar #-}