{-# LANGUAGE Unsafe, DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK hide #-}
module GHC.MVar (
MVar(..)
, newMVar
, newEmptyMVar
, takeMVar
, readMVar
, putMVar
, tryTakeMVar
, tryPutMVar
, tryReadMVar
, isEmptyMVar
, addMVarFinalizer
) where
import GHC.Base
import Data.Maybe
import Data.Typeable
data MVar a = MVar (MVar# RealWorld a) deriving( Typeable )
instance Eq (MVar a) where
(MVar mvar1#) == (MVar mvar2#) = isTrue# (sameMVar# mvar1# mvar2#)
newEmptyMVar :: IO (MVar a)
newEmptyMVar = IO $ \ s# ->
case newMVar# s# of
(# s2#, svar# #) -> (# s2#, MVar svar# #)
newMVar :: a -> IO (MVar a)
newMVar value =
newEmptyMVar >>= \ mvar ->
putMVar mvar value >>
return mvar
takeMVar :: MVar a -> IO a
takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
readMVar :: MVar a -> IO a
readMVar (MVar mvar#) = IO $ \ s# -> readMVar# mvar# s#
putMVar :: MVar a -> a -> IO ()
putMVar (MVar mvar#) x = IO $ \ s# ->
case putMVar# mvar# x s# of
s2# -> (# s2#, () #)
tryTakeMVar :: MVar a -> IO (Maybe a)
tryTakeMVar (MVar m) = IO $ \ s ->
case tryTakeMVar# m s of
(# s', 0#, _ #) -> (# s', Nothing #)
(# s', _, a #) -> (# s', Just a #)
tryPutMVar :: MVar a -> a -> IO Bool
tryPutMVar (MVar mvar#) x = IO $ \ s# ->
case tryPutMVar# mvar# x s# of
(# s, 0# #) -> (# s, False #)
(# s, _ #) -> (# s, True #)
tryReadMVar :: MVar a -> IO (Maybe a)
tryReadMVar (MVar m) = IO $ \ s ->
case tryReadMVar# m s of
(# s', 0#, _ #) -> (# s', Nothing #)
(# s', _, a #) -> (# s', Just a #)
isEmptyMVar :: MVar a -> IO Bool
isEmptyMVar (MVar mv#) = IO $ \ s# ->
case isEmptyMVar# mv# s# of
(# s2#, flg #) -> (# s2#, isTrue# (flg /=# 0#) #)
addMVarFinalizer :: MVar a -> IO () -> IO ()
addMVarFinalizer (MVar m) finalizer =
IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }