1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE MagicHash #-}
4{-# LANGUAGE UnboxedTuples #-}
5
6-- |
7-- Module      : Data.Primitive.MVar
8-- License     : BSD2
9-- Portability : non-portable
10--
11-- Primitive operations on @MVar@. This module provides a similar interface
12-- to "Control.Concurrent.MVar". However, the functions are generalized to
13-- work in any 'PrimMonad' instead of only working in 'IO'. Note that all
14-- of the functions here are completely deterministic. Users of 'MVar' are
15-- responsible for designing abstractions that guarantee determinism in
16-- the presence of multi-threading.
17--
18-- @since 0.6.4.0
19module Data.Primitive.MVar
20  ( MVar(..)
21  , newMVar
22  , isEmptyMVar
23  , newEmptyMVar
24  , putMVar
25  , readMVar
26  , takeMVar
27  , tryPutMVar
28  , tryReadMVar
29  , tryTakeMVar
30  ) where
31
32import Control.Monad.Primitive
33import Data.Primitive.Internal.Compat (isTrue#)
34import GHC.Exts (MVar#,newMVar#,takeMVar#,sameMVar#,putMVar#,tryTakeMVar#,
35  isEmptyMVar#,tryPutMVar#,(/=#))
36
37#if __GLASGOW_HASKELL__ >= 708
38import GHC.Exts (readMVar#,tryReadMVar#)
39#endif
40
41data MVar s a = MVar (MVar# s a)
42
43instance Eq (MVar s a) where
44  MVar mvar1# == MVar mvar2# = isTrue# (sameMVar# mvar1# mvar2#)
45
46-- | Create a new 'MVar' that is initially empty.
47newEmptyMVar :: PrimMonad m => m (MVar (PrimState m) a)
48newEmptyMVar = primitive $ \ s# ->
49  case newMVar# s# of
50    (# s2#, svar# #) -> (# s2#, MVar svar# #)
51
52
53-- | Create a new 'MVar' that holds the supplied argument.
54newMVar :: PrimMonad m => a -> m (MVar (PrimState m) a)
55newMVar value =
56  newEmptyMVar >>= \ mvar ->
57  putMVar mvar value >>
58  return mvar
59
60-- | Return the contents of the 'MVar'.  If the 'MVar' is currently
61-- empty, 'takeMVar' will wait until it is full.  After a 'takeMVar',
62-- the 'MVar' is left empty.
63takeMVar :: PrimMonad m => MVar (PrimState m) a -> m a
64takeMVar (MVar mvar#) = primitive $ \ s# -> takeMVar# mvar# s#
65
66-- | Atomically read the contents of an 'MVar'.  If the 'MVar' is
67-- currently empty, 'readMVar' will wait until it is full.
68-- 'readMVar' is guaranteed to receive the next 'putMVar'.
69--
70-- /Multiple Wakeup:/ 'readMVar' is multiple-wakeup, so when multiple readers
71-- are blocked on an 'MVar', all of them are woken up at the same time.
72--
73-- /Compatibility note:/ On GHCs prior to 7.8, 'readMVar' is a combination
74-- of 'takeMVar' and 'putMVar'. Consequently, its behavior differs in the
75-- following ways:
76--
77-- * It is single-wakeup instead of multiple-wakeup.
78-- * It might not receive the value from the next call to 'putMVar' if
79--   there is already a pending thread blocked on 'takeMVar'.
80-- * If another thread puts a value in the 'MVar' in between the
81--   calls to 'takeMVar' and 'putMVar', that value may be overridden.
82readMVar :: PrimMonad m => MVar (PrimState m) a -> m a
83#if __GLASGOW_HASKELL__ >= 708
84readMVar (MVar mvar#) = primitive $ \ s# -> readMVar# mvar# s#
85#else
86readMVar mv = do
87  a <- takeMVar mv
88  putMVar mv a
89  return a
90#endif
91
92-- |Put a value into an 'MVar'.  If the 'MVar' is currently full,
93-- 'putMVar' will wait until it becomes empty.
94putMVar :: PrimMonad m => MVar (PrimState m) a -> a -> m ()
95putMVar (MVar mvar#) x = primitive_ (putMVar# mvar# x)
96
97-- |A non-blocking version of 'takeMVar'.  The 'tryTakeMVar' function
98-- returns immediately, with 'Nothing' if the 'MVar' was empty, or
99-- @'Just' a@ if the 'MVar' was full with contents @a@.  After 'tryTakeMVar',
100-- the 'MVar' is left empty.
101tryTakeMVar :: PrimMonad m => MVar (PrimState m) a -> m (Maybe a)
102tryTakeMVar (MVar m) = primitive $ \ s ->
103  case tryTakeMVar# m s of
104    (# s', 0#, _ #) -> (# s', Nothing #) -- MVar is empty
105    (# s', _,  a #) -> (# s', Just a  #) -- MVar is full
106
107
108-- |A non-blocking version of 'putMVar'.  The 'tryPutMVar' function
109-- attempts to put the value @a@ into the 'MVar', returning 'True' if
110-- it was successful, or 'False' otherwise.
111tryPutMVar :: PrimMonad m => MVar (PrimState m) a -> a -> m Bool
112tryPutMVar (MVar mvar#) x = primitive $ \ s# ->
113    case tryPutMVar# mvar# x s# of
114        (# s, 0# #) -> (# s, False #)
115        (# s, _  #) -> (# s, True #)
116
117-- | A non-blocking version of 'readMVar'.  The 'tryReadMVar' function
118-- returns immediately, with 'Nothing' if the 'MVar' was empty, or
119-- @'Just' a@ if the 'MVar' was full with contents @a@.
120--
121-- /Compatibility note:/ On GHCs prior to 7.8, 'tryReadMVar' is a combination
122-- of 'tryTakeMVar' and 'putMVar'. Consequently, its behavior differs in the
123-- following ways:
124--
125-- * It is single-wakeup instead of multiple-wakeup.
126-- * In the presence of other threads calling 'putMVar', 'tryReadMVar'
127--   may block.
128-- * If another thread puts a value in the 'MVar' in between the
129--   calls to 'tryTakeMVar' and 'putMVar', that value may be overridden.
130tryReadMVar :: PrimMonad m => MVar (PrimState m) a -> m (Maybe a)
131#if __GLASGOW_HASKELL__ >= 708
132tryReadMVar (MVar m) = primitive $ \ s ->
133    case tryReadMVar# m s of
134        (# s', 0#, _ #) -> (# s', Nothing #)      -- MVar is empty
135        (# s', _,  a #) -> (# s', Just a  #)      -- MVar is full
136#else
137tryReadMVar mv = do
138  ma <- tryTakeMVar mv
139  case ma of
140    Just a -> do
141      putMVar mv a
142      return (Just a)
143    Nothing -> return Nothing
144#endif
145
146-- | Check whether a given 'MVar' is empty.
147--
148-- Notice that the boolean value returned  is just a snapshot of
149-- the state of the MVar. By the time you get to react on its result,
150-- the MVar may have been filled (or emptied) - so be extremely
151-- careful when using this operation.   Use 'tryTakeMVar' instead if possible.
152isEmptyMVar :: PrimMonad m => MVar (PrimState m) a -> m Bool
153isEmptyMVar (MVar mv#) = primitive $ \ s# ->
154  case isEmptyMVar# mv# s# of
155    (# s2#, flg #) -> (# s2#, isTrue# (flg /=# 0#) #)
156