+% -----------------------------------------------------------------------------
+% $Id: PrelConc.lhs,v 1.20 2000/07/07 11:03:58 simonmar Exp $
%
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
%
\section[PrelConc]{Module @PrelConc@}
-- Forking and suchlike
, myThreadId -- :: IO ThreadId
, killThread -- :: ThreadId -> IO ()
- , raiseInThread -- :: ThreadId -> Exception -> IO ()
+ , throwTo -- :: ThreadId -> Exception -> IO ()
, par -- :: a -> b -> b
, seq -- :: a -> b -> b
, yield -- :: IO ()
, putMVar -- :: MVar a -> a -> IO ()
, readMVar -- :: MVar a -> IO a
, swapMVar -- :: MVar a -> a -> IO a
+ , tryTakeMVar -- :: MVar a -> IO (Maybe a)
, isEmptyMVar -- :: MVar a -> IO Bool
) where
import PrelBase
+import PrelMaybe
import PrelErr ( parError, seqError )
-import PrelST ( liftST )
-import PrelIOBase ( IO(..), MVar(..), unsafePerformIO )
+import PrelIOBase ( IO(..), MVar(..) )
import PrelBase ( Int(..) )
import PrelException ( Exception(..), AsyncException(..) )
killThread (ThreadId id) = IO $ \ s ->
case (killThread# id (AsyncException ThreadKilled) s) of s1 -> (# s1, () #)
-raiseInThread :: ThreadId -> Exception -> IO ()
-raiseInThread (ThreadId id) ex = IO $ \ s ->
+throwTo :: ThreadId -> Exception -> IO ()
+throwTo (ThreadId id) ex = IO $ \ s ->
case (killThread# id ex s) of s1 -> (# s1, () #)
myThreadId :: IO ThreadId
seq :: a -> b -> b
seq x y = case (seq# x) of { 0# -> seqError; _ -> y }
-par :: a -> b -> b
-
{-# INLINE par #-}
-#if defined(__PARALLEL_HASKELL__) || defined (__GRANSIM__)
+par :: a -> b -> b
par x y = case (par# x) of { 0# -> parError; _ -> y }
-#else
-par _ y = y
-#endif
\end{code}
%************************************************************************
--Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
newEmptyMVar :: IO (MVar a)
-
newEmptyMVar = IO $ \ s# ->
case newMVar# s# of
(# s2#, svar# #) -> (# s2#, MVar svar# #)
takeMVar :: MVar a -> IO a
-
takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
putMVar :: MVar a -> a -> IO ()
-
putMVar (MVar mvar#) x = IO $ \ s# ->
case putMVar# mvar# x s# of
s2# -> (# s2#, () #)
newMVar :: a -> IO (MVar a)
-
newMVar value =
newEmptyMVar >>= \ mvar ->
putMVar mvar value >>
return mvar
readMVar :: MVar a -> IO a
-
readMVar mvar =
takeMVar mvar >>= \ value ->
putMVar mvar value >>
return value
swapMVar :: MVar a -> a -> IO a
-
swapMVar mvar new =
takeMVar mvar >>= \ old ->
putMVar mvar new >>
return old
+-- tryTakeMVar is a non-blocking takeMVar
+tryTakeMVar :: MVar a -> IO (Maybe a)
+tryTakeMVar (MVar m) = IO $ \ s ->
+ case tryTakeMVar# m s of
+ (# s, 0#, _ #) -> (# s, Nothing #) -- MVar is empty
+ (# s, _, a #) -> (# s, Just a #) -- MVar is full
+
{-
Low-level op. for checking whether an MVar is filled-in or not.
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.
+ careful when using this operation.
+
+ Use tryTakeMVar instead if possible.
If you can re-work your abstractions to avoid having to
depend on isEmptyMVar, then you're encouraged to do so,