-- SPDX-License-Identifier: CC0-1.0
{-
Each contributor licenses you to do everything with this work that
would otherwise infringe any patent claims they can license or become
able to license.
-}
{-|
`PrimVar` is internally a `PrimArray` of one element,
but with a convenient `MutVar`-like API.
-}
module Data.Primitive.PrimVar
  ( -- * Types
    PrimVar(..)
    -- * Allocation
  , newPrimVar
  , newPinnedPrimVar
  , newAlignedPinnedPrimVar
    -- * Access
  , readPrimVar
  , writePrimVar
  , modifyPrimVar
    -- * Information
  , samePrimVar
  , primVarContents
  , isPrimVarPinned
  ) where

import Data.Functor ( ($>) )
import Foreign (Ptr)

import Control.Monad.Primitive ( PrimMonad(PrimState) )
import Data.Primitive
  ( MutablePrimArray
  , Prim
  , newPrimArray
  , newPinnedPrimArray
  , newAlignedPinnedPrimArray
  , readPrimArray
  , writePrimArray
  , sameMutablePrimArray
  , mutablePrimArrayContents
  , isMutablePrimArrayPinned
  )

newtype PrimVar s a = PrimVar (MutablePrimArray s a)

newPrimVar
  :: (Prim a, PrimMonad m)
  => a -> m (PrimVar (PrimState m) a)
-- ^ Create a new `PrimVar` with the specified initial value.
newPrimVar :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar a
a =
  forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MutablePrimArray (PrimState m) a
arr ->
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) a
arr Int
0 a
a forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall s a. MutablePrimArray s a -> PrimVar s a
PrimVar MutablePrimArray (PrimState m) a
arr

newPinnedPrimVar
  :: (Prim a, PrimMonad m)
  => a -> m (PrimVar (PrimState m) a)
-- ^ Create a new /pinned/ `PrimVar` with the specified initial value.
-- The garbage collector is guaranteed not to move it.
newPinnedPrimVar :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
a -> m (PrimVar (PrimState m) a)
newPinnedPrimVar a
a =
  forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPinnedPrimArray Int
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MutablePrimArray (PrimState m) a
arr ->
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) a
arr Int
0 a
a forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall s a. MutablePrimArray s a -> PrimVar s a
PrimVar MutablePrimArray (PrimState m) a
arr

newAlignedPinnedPrimVar
  :: (Prim a, PrimMonad m)
  => a -> m (PrimVar (PrimState m) a)
-- ^ Create a new /pinned/ `PrimVar` with the specified initial value
-- and with the alignment given by its Prim instance.
-- The garbage collector is guaranteed not to move it.
newAlignedPinnedPrimVar :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
a -> m (PrimVar (PrimState m) a)
newAlignedPinnedPrimVar a
a =
  forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newAlignedPinnedPrimArray Int
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MutablePrimArray (PrimState m) a
arr ->
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) a
arr Int
0 a
a forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall s a. MutablePrimArray s a -> PrimVar s a
PrimVar MutablePrimArray (PrimState m) a
arr

readPrimVar
  :: (Prim a, PrimMonad m)
  => PrimVar (PrimState m) a -> m a
-- ^ Read the value of a `PrimVar`.
readPrimVar :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimVar (PrimState m) a -> m a
readPrimVar (PrimVar MutablePrimArray (PrimState m) a
v) = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray (PrimState m) a
v Int
0

writePrimVar
  :: (Prim a, PrimMonad m)
  => PrimVar (PrimState m) a -> a -> m ()
-- ^ Write a new value into a `PrimVar`.
writePrimVar :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar (PrimVar MutablePrimArray (PrimState m) a
v) = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray (PrimState m) a
v Int
0

modifyPrimVar
  :: (Prim a, PrimMonad m)
  => PrimVar (PrimState m) a -> (a -> a) -> m ()
-- ^ Mutate the contents of a `PrimVar`.
modifyPrimVar :: forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimVar (PrimState m) a -> (a -> a) -> m ()
modifyPrimVar PrimVar (PrimState m) a
v a -> a
f =
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar (PrimState m) a
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a ->
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar (PrimState m) a
v (a -> a
f a
a)

samePrimVar :: PrimVar s a -> PrimVar s a -> Bool
-- ^ Check if two `PrimVar`s refer to the same memory block.
samePrimVar :: forall s a. PrimVar s a -> PrimVar s a -> Bool
samePrimVar (PrimVar MutablePrimArray s a
v0) (PrimVar MutablePrimArray s a
v1) =
  forall s a. MutablePrimArray s a -> MutablePrimArray s a -> Bool
sameMutablePrimArray MutablePrimArray s a
v0 MutablePrimArray s a
v1

primVarContents :: PrimVar s a -> Ptr a
-- ^ Yield a pointer to a `PrimVar`'s data.
-- This operation is only safe on pinned `PrimVar`s
-- allocated by `newPinnedPrimVar` or `newAlignedPinnedPrimVar`.
primVarContents :: forall s a. PrimVar s a -> Ptr a
primVarContents (PrimVar MutablePrimArray s a
v) =
  forall s a. MutablePrimArray s a -> Ptr a
mutablePrimArrayContents MutablePrimArray s a
v

isPrimVarPinned :: PrimVar s a -> Bool
-- ^ Check whether or not a `PrimVar` is pinned.
isPrimVarPinned :: forall s a. PrimVar s a -> Bool
isPrimVarPinned (PrimVar MutablePrimArray s a
v) =
  forall s a. MutablePrimArray s a -> Bool
isMutablePrimArrayPinned MutablePrimArray s a
v