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