{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

-- |
-- Module      : Data.Primitive.MVar
-- License     : BSD2
-- Portability : non-portable
--
-- Primitive operations on @MVar@. This module provides a similar interface
-- to "Control.Concurrent.MVar". However, the functions are generalized to
-- work in any 'PrimMonad' instead of only working in 'IO'. Note that all
-- of the functions here are completely deterministic. Users of 'MVar' are
-- responsible for designing abstractions that guarantee determinism in
-- the presence of multi-threading.
--
-- @since 0.6.4.0
module Data.Primitive.MVar
  ( MVar(..)
  , newMVar
  , isEmptyMVar
  , newEmptyMVar
  , putMVar
  , readMVar
  , takeMVar
  , tryPutMVar
  , tryReadMVar
  , tryTakeMVar
  ) where

import Control.Monad.Primitive
import Data.Primitive.Internal.Compat (isTrue#)
import GHC.Exts (MVar#,newMVar#,takeMVar#,sameMVar#,putMVar#,tryTakeMVar#,
  isEmptyMVar#,tryPutMVar#,(/=#))

#if __GLASGOW_HASKELL__ >= 708
import GHC.Exts (readMVar#,tryReadMVar#)
#endif

data MVar s a = MVar (MVar# s a)

instance Eq (MVar s a) where
  MVar MVar# s a
mvar1# == :: MVar s a -> MVar s a -> Bool
== MVar MVar# s a
mvar2# = Int# -> Bool
isTrue# (MVar# s a -> MVar# s a -> Int#
forall d a. MVar# d a -> MVar# d a -> Int#
sameMVar# MVar# s a
mvar1# MVar# s a
mvar2#)

-- | Create a new 'MVar' that is initially empty.
newEmptyMVar :: PrimMonad m => m (MVar (PrimState m) a)
newEmptyMVar :: m (MVar (PrimState m) a)
newEmptyMVar = (State# (PrimState m)
 -> (# State# (PrimState m), MVar (PrimState m) a #))
-> m (MVar (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), MVar (PrimState m) a #))
 -> m (MVar (PrimState m) a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), MVar (PrimState m) a #))
-> m (MVar (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \ State# (PrimState m)
s# ->
  case State# (PrimState m)
-> (# State# (PrimState m), MVar# (PrimState m) a #)
forall d a. State# d -> (# State# d, MVar# d a #)
newMVar# State# (PrimState m)
s# of
    (# State# (PrimState m)
s2#, MVar# (PrimState m) a
svar# #) -> (# State# (PrimState m)
s2#, MVar# (PrimState m) a -> MVar (PrimState m) a
forall s a. MVar# s a -> MVar s a
MVar MVar# (PrimState m) a
svar# #)


-- | Create a new 'MVar' that holds the supplied argument.
newMVar :: PrimMonad m => a -> m (MVar (PrimState m) a)
newMVar :: a -> m (MVar (PrimState m) a)
newMVar a
value =
  m (MVar (PrimState m) a)
forall (m :: * -> *) a. PrimMonad m => m (MVar (PrimState m) a)
newEmptyMVar m (MVar (PrimState m) a)
-> (MVar (PrimState m) a -> m (MVar (PrimState m) a))
-> m (MVar (PrimState m) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ MVar (PrimState m) a
mvar ->
  MVar (PrimState m) a -> a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVar (PrimState m) a -> a -> m ()
putMVar MVar (PrimState m) a
mvar a
value m () -> m (MVar (PrimState m) a) -> m (MVar (PrimState m) a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  MVar (PrimState m) a -> m (MVar (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return MVar (PrimState m) a
mvar

-- | Return the contents of the 'MVar'.  If the 'MVar' is currently
-- empty, 'takeMVar' will wait until it is full.  After a 'takeMVar',
-- the 'MVar' is left empty.
takeMVar :: PrimMonad m => MVar (PrimState m) a -> m a
takeMVar :: MVar (PrimState m) a -> m a
takeMVar (MVar MVar# (PrimState m) a
mvar#) = (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)
s# -> MVar# (PrimState m) a
-> State# (PrimState m) -> (# State# (PrimState m), a #)
forall d a. MVar# d a -> State# d -> (# State# d, a #)
takeMVar# MVar# (PrimState m) a
mvar# State# (PrimState m)
s#

-- | Atomically read the contents of an 'MVar'.  If the 'MVar' is
-- currently empty, 'readMVar' will wait until it is full.
-- 'readMVar' is guaranteed to receive the next 'putMVar'.
--
-- /Multiple Wakeup:/ 'readMVar' is multiple-wakeup, so when multiple readers
-- are blocked on an 'MVar', all of them are woken up at the same time.
--
-- /Compatibility note:/ On GHCs prior to 7.8, 'readMVar' is a combination
-- of 'takeMVar' and 'putMVar'. Consequently, its behavior differs in the
-- following ways:
--
-- * It is single-wakeup instead of multiple-wakeup.
-- * It might not receive the value from the next call to 'putMVar' if
--   there is already a pending thread blocked on 'takeMVar'.
-- * If another thread puts a value in the 'MVar' in between the
--   calls to 'takeMVar' and 'putMVar', that value may be overridden.
readMVar :: PrimMonad m => MVar (PrimState m) a -> m a
#if __GLASGOW_HASKELL__ >= 708
readMVar :: MVar (PrimState m) a -> m a
readMVar (MVar MVar# (PrimState m) a
mvar#) = (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)
s# -> MVar# (PrimState m) a
-> State# (PrimState m) -> (# State# (PrimState m), a #)
forall d a. MVar# d a -> State# d -> (# State# d, a #)
readMVar# MVar# (PrimState m) a
mvar# State# (PrimState m)
s#
#else
readMVar mv = do
  a <- takeMVar mv
  putMVar mv a
  return a
#endif

-- |Put a value into an 'MVar'.  If the 'MVar' is currently full,
-- 'putMVar' will wait until it becomes empty.
putMVar :: PrimMonad m => MVar (PrimState m) a -> a -> m ()
putMVar :: MVar (PrimState m) a -> a -> m ()
putMVar (MVar MVar# (PrimState m) a
mvar#) a
x = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MVar# (PrimState m) a
-> a -> State# (PrimState m) -> State# (PrimState m)
forall d a. MVar# d a -> a -> State# d -> State# d
putMVar# MVar# (PrimState m) a
mvar# a
x)

-- |A non-blocking version of 'takeMVar'.  The 'tryTakeMVar' function
-- returns immediately, with 'Nothing' if the 'MVar' was empty, or
-- @'Just' a@ if the 'MVar' was full with contents @a@.  After 'tryTakeMVar',
-- the 'MVar' is left empty.
tryTakeMVar :: PrimMonad m => MVar (PrimState m) a -> m (Maybe a)
tryTakeMVar :: MVar (PrimState m) a -> m (Maybe a)
tryTakeMVar (MVar MVar# (PrimState m) a
m) = (State# (PrimState m) -> (# State# (PrimState m), Maybe a #))
-> m (Maybe a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), Maybe a #))
 -> m (Maybe a))
-> (State# (PrimState m) -> (# State# (PrimState m), Maybe a #))
-> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \ State# (PrimState m)
s ->
  case MVar# (PrimState m) a
-> State# (PrimState m) -> (# State# (PrimState m), Int#, a #)
forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryTakeMVar# MVar# (PrimState m) a
m State# (PrimState m)
s of
    (# State# (PrimState m)
s', Int#
0#, a
_ #) -> (# State# (PrimState m)
s', Maybe a
forall a. Maybe a
Nothing #) -- MVar is empty
    (# State# (PrimState m)
s', Int#
_,  a
a #) -> (# State# (PrimState m)
s', a -> Maybe a
forall a. a -> Maybe a
Just a
a  #) -- MVar is full


-- |A non-blocking version of 'putMVar'.  The 'tryPutMVar' function
-- attempts to put the value @a@ into the 'MVar', returning 'True' if
-- it was successful, or 'False' otherwise.
tryPutMVar :: PrimMonad m => MVar (PrimState m) a -> a -> m Bool
tryPutMVar :: MVar (PrimState m) a -> a -> m Bool
tryPutMVar (MVar MVar# (PrimState m) a
mvar#) a
x = (State# (PrimState m) -> (# State# (PrimState m), Bool #))
-> m Bool
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), Bool #))
 -> m Bool)
-> (State# (PrimState m) -> (# State# (PrimState m), Bool #))
-> m Bool
forall a b. (a -> b) -> a -> b
$ \ State# (PrimState m)
s# ->
    case MVar# (PrimState m) a
-> a -> State# (PrimState m) -> (# State# (PrimState m), Int# #)
forall d a. MVar# d a -> a -> State# d -> (# State# d, Int# #)
tryPutMVar# MVar# (PrimState m) a
mvar# a
x State# (PrimState m)
s# of
        (# State# (PrimState m)
s, Int#
0# #) -> (# State# (PrimState m)
s, Bool
False #)
        (# State# (PrimState m)
s, Int#
_  #) -> (# State# (PrimState m)
s, Bool
True #)

-- | A non-blocking version of 'readMVar'.  The 'tryReadMVar' function
-- returns immediately, with 'Nothing' if the 'MVar' was empty, or
-- @'Just' a@ if the 'MVar' was full with contents @a@.
--
-- /Compatibility note:/ On GHCs prior to 7.8, 'tryReadMVar' is a combination
-- of 'tryTakeMVar' and 'putMVar'. Consequently, its behavior differs in the
-- following ways:
--
-- * It is single-wakeup instead of multiple-wakeup.
-- * In the presence of other threads calling 'putMVar', 'tryReadMVar'
--   may block.
-- * If another thread puts a value in the 'MVar' in between the
--   calls to 'tryTakeMVar' and 'putMVar', that value may be overridden.
tryReadMVar :: PrimMonad m => MVar (PrimState m) a -> m (Maybe a)
#if __GLASGOW_HASKELL__ >= 708
tryReadMVar :: MVar (PrimState m) a -> m (Maybe a)
tryReadMVar (MVar MVar# (PrimState m) a
m) = (State# (PrimState m) -> (# State# (PrimState m), Maybe a #))
-> m (Maybe a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), Maybe a #))
 -> m (Maybe a))
-> (State# (PrimState m) -> (# State# (PrimState m), Maybe a #))
-> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \ State# (PrimState m)
s ->
    case MVar# (PrimState m) a
-> State# (PrimState m) -> (# State# (PrimState m), Int#, a #)
forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryReadMVar# MVar# (PrimState m) a
m State# (PrimState m)
s of
        (# State# (PrimState m)
s', Int#
0#, a
_ #) -> (# State# (PrimState m)
s', Maybe a
forall a. Maybe a
Nothing #)      -- MVar is empty
        (# State# (PrimState m)
s', Int#
_,  a
a #) -> (# State# (PrimState m)
s', a -> Maybe a
forall a. a -> Maybe a
Just a
a  #)      -- MVar is full
#else
tryReadMVar mv = do
  ma <- tryTakeMVar mv
  case ma of
    Just a -> do
      putMVar mv a
      return (Just a)
    Nothing -> return Nothing
#endif

-- | Check whether a given 'MVar' is empty.
--
-- Notice that the boolean value returned  is just a snapshot of
-- the state of the MVar. By the time you get to react on its result,
-- the MVar may have been filled (or emptied) - so be extremely
-- careful when using this operation.   Use 'tryTakeMVar' instead if possible.
isEmptyMVar :: PrimMonad m => MVar (PrimState m) a -> m Bool
isEmptyMVar :: MVar (PrimState m) a -> m Bool
isEmptyMVar (MVar MVar# (PrimState m) a
mv#) = (State# (PrimState m) -> (# State# (PrimState m), Bool #))
-> m Bool
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), Bool #))
 -> m Bool)
-> (State# (PrimState m) -> (# State# (PrimState m), Bool #))
-> m Bool
forall a b. (a -> b) -> a -> b
$ \ State# (PrimState m)
s# ->
  case MVar# (PrimState m) a
-> State# (PrimState m) -> (# State# (PrimState m), Int# #)
forall d a. MVar# d a -> State# d -> (# State# d, Int# #)
isEmptyMVar# MVar# (PrimState m) a
mv# State# (PrimState m)
s# of
    (# State# (PrimState m)
s2#, Int#
flg #) -> (# State# (PrimState m)
s2#, Int# -> Bool
isTrue# (Int#
flg Int# -> Int# -> Int#
/=# Int#
0#) #)