{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.MVar
-- Copyright   :  (c) The University of Glasgow 2008
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- The MVar type
--
-----------------------------------------------------------------------------

module GHC.MVar (
        -- * MVars
          MVar(..)
        , newMVar
        , newEmptyMVar
        , takeMVar
        , readMVar
        , putMVar
        , tryTakeMVar
        , tryPutMVar
        , tryReadMVar
        , isEmptyMVar
        , addMVarFinalizer
    ) where

import GHC.Base

data MVar a = MVar (MVar# RealWorld a)
{- ^
An 'MVar' (pronounced \"em-var\") is a synchronising variable, used
for communication between concurrent threads.  It can be thought of
as a box, which may be empty or full.
-}

-- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module
-- | @since 4.1.0.0
instance Eq (MVar a) where
        (MVar MVar# RealWorld a
mvar1#) == :: MVar a -> MVar a -> Bool
== (MVar MVar# RealWorld a
mvar2#) = Int# -> Bool
isTrue# (forall d a. MVar# d a -> MVar# d a -> Int#
sameMVar# MVar# RealWorld a
mvar1# MVar# RealWorld a
mvar2#)

{-
M-Vars are rendezvous points for concurrent threads.  They begin
empty, and any attempt to read an empty M-Var blocks.  When an M-Var
is written, a single blocked thread may be freed.  Reading an M-Var
toggles its state from full back to empty.  Therefore, any value
written to an M-Var may only be read once.  Multiple reads and writes
are allowed, but there must be at least one read between any two
writes.
-}

--Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)

-- |Create an 'MVar' which is initially empty.
newEmptyMVar  :: IO (MVar a)
newEmptyMVar :: forall a. IO (MVar a)
newEmptyMVar = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s# ->
    case forall d a. State# d -> (# State# d, MVar# d a #)
newMVar# State# RealWorld
s# of
         (# State# RealWorld
s2#, MVar# RealWorld a
svar# #) -> (# State# RealWorld
s2#, forall a. MVar# RealWorld a -> MVar a
MVar MVar# RealWorld a
svar# #)

-- |Create an 'MVar' which contains the supplied value.
newMVar :: a -> IO (MVar a)
newMVar :: forall a. a -> IO (MVar a)
newMVar a
value =
    forall a. IO (MVar a)
newEmptyMVar        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ MVar a
mvar ->
    forall a. MVar a -> a -> IO ()
putMVar MVar a
mvar a
value  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    forall (m :: * -> *) a. Monad m => a -> m a
return MVar 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.
--
-- There are two further important properties of 'takeMVar':
--
--   * 'takeMVar' is single-wakeup.  That is, if there are multiple
--     threads blocked in 'takeMVar', and the 'MVar' becomes full,
--     only one thread will be woken up.  The runtime guarantees that
--     the woken thread completes its 'takeMVar' operation.
--
--   * When multiple threads are blocked on an 'MVar', they are
--     woken up in FIFO order.  This is useful for providing
--     fairness properties of abstractions built using 'MVar's.
--
takeMVar :: MVar a -> IO a
takeMVar :: forall a. MVar a -> IO a
takeMVar (MVar MVar# RealWorld a
mvar#) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s# -> forall d a. MVar# d a -> State# d -> (# State# d, a #)
takeMVar# MVar# RealWorld a
mvar# State# RealWorld
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'.
--
-- '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:/ Prior to base 4.7, 'readMVar' was a combination
-- of 'takeMVar' and 'putMVar'.  This mean that in the presence of
-- other threads attempting to 'putMVar', 'readMVar' could block.
-- Furthermore, 'readMVar' would not receive the next 'putMVar' if there
-- was already a pending thread blocked on 'takeMVar'.  The old behavior
-- can be recovered by implementing 'readMVar as follows:
--
-- @
--  readMVar :: MVar a -> IO a
--  readMVar m =
--    mask_ $ do
--      a <- takeMVar m
--      putMVar m a
--      return a
-- @
readMVar :: MVar a -> IO a
readMVar :: forall a. MVar a -> IO a
readMVar (MVar MVar# RealWorld a
mvar#) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s# -> forall d a. MVar# d a -> State# d -> (# State# d, a #)
readMVar# MVar# RealWorld a
mvar# State# RealWorld
s#

-- |Put a value into an 'MVar'.  If the 'MVar' is currently full,
-- 'putMVar' will wait until it becomes empty.
--
-- There are two further important properties of 'putMVar':
--
--   * 'putMVar' is single-wakeup.  That is, if there are multiple
--     threads blocked in 'putMVar', and the 'MVar' becomes empty,
--     only one thread will be woken up.  The runtime guarantees that
--     the woken thread completes its 'putMVar' operation.
--
--   * When multiple threads are blocked on an 'MVar', they are
--     woken up in FIFO order.  This is useful for providing
--     fairness properties of abstractions built using 'MVar's.
--
putMVar  :: MVar a -> a -> IO ()
putMVar :: forall a. MVar a -> a -> IO ()
putMVar (MVar MVar# RealWorld a
mvar#) a
x = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s# ->
    case forall d a. MVar# d a -> a -> State# d -> State# d
putMVar# MVar# RealWorld a
mvar# a
x State# RealWorld
s# of
        State# RealWorld
s2# -> (# State# RealWorld
s2#, () #)

-- |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 :: MVar a -> IO (Maybe a)
tryTakeMVar :: forall a. MVar a -> IO (Maybe a)
tryTakeMVar (MVar MVar# RealWorld a
m) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s ->
    case forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryTakeMVar# MVar# RealWorld a
m State# RealWorld
s of
        (# State# RealWorld
s', Int#
0#, a
_ #) -> (# State# RealWorld
s', forall a. Maybe a
Nothing #)      -- MVar is empty
        (# State# RealWorld
s', Int#
_,  a
a #) -> (# State# RealWorld
s', 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  :: MVar a -> a -> IO Bool
tryPutMVar :: forall a. MVar a -> a -> IO Bool
tryPutMVar (MVar MVar# RealWorld a
mvar#) a
x = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s# ->
    case forall d a. MVar# d a -> a -> State# d -> (# State# d, Int# #)
tryPutMVar# MVar# RealWorld a
mvar# a
x State# RealWorld
s# of
        (# State# RealWorld
s, Int#
0# #) -> (# State# RealWorld
s, Bool
False #)
        (# State# RealWorld
s, Int#
_  #) -> (# State# RealWorld
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@.
--
-- @since 4.7.0.0
tryReadMVar :: MVar a -> IO (Maybe a)
tryReadMVar :: forall a. MVar a -> IO (Maybe a)
tryReadMVar (MVar MVar# RealWorld a
m) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s ->
    case forall d a. MVar# d a -> State# d -> (# State# d, Int#, a #)
tryReadMVar# MVar# RealWorld a
m State# RealWorld
s of
        (# State# RealWorld
s', Int#
0#, a
_ #) -> (# State# RealWorld
s', forall a. Maybe a
Nothing #)      -- MVar is empty
        (# State# RealWorld
s', Int#
_,  a
a #) -> (# State# RealWorld
s', forall a. a -> Maybe a
Just a
a  #)      -- MVar is full

-- |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 :: MVar a -> IO Bool
isEmptyMVar :: forall a. MVar a -> IO Bool
isEmptyMVar (MVar MVar# RealWorld a
mv#) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s# ->
    case forall d a. MVar# d a -> State# d -> (# State# d, Int# #)
isEmptyMVar# MVar# RealWorld a
mv# State# RealWorld
s# of
        (# State# RealWorld
s2#, Int#
flg #) -> (# State# RealWorld
s2#, Int# -> Bool
isTrue# (Int#
flg Int# -> Int# -> Int#
/=# Int#
0#) #)

-- |Add a finalizer to an 'MVar' (GHC only).  See "Foreign.ForeignPtr" and
-- "System.Mem.Weak" for more about finalizers.
addMVarFinalizer :: MVar a -> IO () -> IO ()
addMVarFinalizer :: forall a. MVar a -> IO () -> IO ()
addMVarFinalizer (MVar MVar# RealWorld a
m) (IO State# RealWorld -> (# State# RealWorld, () #)
finalizer) =
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case mkWeak# :: forall a b c.
a
-> b
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
mkWeak# MVar# RealWorld a
m () State# RealWorld -> (# State# RealWorld, () #)
finalizer State# RealWorld
s of { (# State# RealWorld
s1, Weak# ()
_ #) -> (# State# RealWorld
s1, () #) }