ghc/lib/std/PrelConc.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[PrelConc]{Module @PrelConc@}
   6
   7 Basic concurrency stuff
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module PrelConc
  13         ( ThreadId(..)
  14
  15         -- Forking and suchlike
  16         , myThreadId    -- :: IO ThreadId
  17         , killThread    -- :: ThreadId -> IO ()
  18         , raiseInThread -- :: ThreadId -> Exception -> IO ()
  19         , par           -- :: a -> b -> b
  20         , seq           -- :: a -> b -> b
  21         {-threadDelay, threadWaitRead, threadWaitWrite,-}
  22
  23         -- MVars
  24         , MVar          -- abstract
  25         , newMVar       -- :: a -> IO (MVar a)
  26         , newEmptyMVar  -- :: IO (MVar a)
  27         , takeMVar      -- :: MVar a -> IO a
  28         , putMVar       -- :: MVar a -> a -> IO ()
  29         , readMVar      -- :: MVar a -> IO a
  30         , swapMVar      -- :: MVar a -> a -> IO a
  31         , isEmptyMVar   -- :: MVar a -> IO Bool
  32
  33     ) where
  34
  35 import PrelBase
  36 import PrelErr ( parError, seqError )
  37 import PrelST           ( liftST )
  38 import PrelIOBase       ( IO(..), MVar(..), unsafePerformIO )
  39 import PrelBase         ( Int(..) )
  40 import PrelException    ( Exception(..), AsyncException(..) )
  41
  42 infixr 0 `par`
  43 \end{code}
  44
  45 %************************************************************************
  46 %*                                                                      *
  47 \subsection{@ThreadId@, @par@, and @fork@}
  48 %*                                                                      *
  49 %************************************************************************
  50
  51 \begin{code}
  52 data ThreadId = ThreadId ThreadId#
  53 -- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
  54 -- But since ThreadId# is unlifted, the Weak type must use open
  55 -- type variables.
  56
  57 --forkIO has now been hoisted out into the concurrent library.
  58
  59 killThread :: ThreadId -> IO ()
  60 killThread (ThreadId id) = IO $ \ s ->
  61    case (killThread# id (AsyncException ThreadKilled) s) of s1 -> (# s1, () #)
  62
  63 raiseInThread :: ThreadId -> Exception -> IO ()
  64 raiseInThread (ThreadId id) ex = IO $ \ s ->
  65    case (killThread# id ex s) of s1 -> (# s1, () #)
  66
  67 myThreadId :: IO ThreadId
  68 myThreadId = IO $ \s ->
  69    case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #)
  70
  71 -- "seq" is defined a bit wierdly (see below)
  72 --
  73 -- The reason for the strange "0# -> parError" case is that
  74 -- it fools the compiler into thinking that seq is non-strict in
  75 -- its second argument (even if it inlines seq at the call site).
  76 -- If it thinks seq is strict in "y", then it often evaluates
  77 -- "y" before "x", which is totally wrong.
  78 --
  79 -- Just before converting from Core to STG there's a bit of magic
  80 -- that recognises the seq# and eliminates the duff case.
  81
  82 {-# INLINE seq  #-}
  83 seq :: a -> b -> b
  84 seq  x y = case (seq#  x) of { 0# -> seqError; _ -> y }
  85
  86 par :: a -> b -> b
  87
  88 {-# INLINE par  #-}
  89 #if defined(__PARALLEL_HASKELL__) || defined (__GRANSIM__)
  90 par  x y = case (par# x) of { 0# -> parError; _ -> y }
  91 #else
  92 par  _ y = y
  93 #endif
  94
  95 \end{code}
  96
  97 %************************************************************************
  98 %*                                                                      *
  99 \subsection[mvars]{M-Structures}
 100 %*                                                                      *
 101 %************************************************************************
 102
 103 M-Vars are rendezvous points for concurrent threads.  They begin
 104 empty, and any attempt to read an empty M-Var blocks.  When an M-Var
 105 is written, a single blocked thread may be freed.  Reading an M-Var
 106 toggles its state from full back to empty.  Therefore, any value
 107 written to an M-Var may only be read once.  Multiple reads and writes
 108 are allowed, but there must be at least one read between any two
 109 writes.
 110
 111 \begin{code}
 112 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
 113
 114 instance Eq (MVar a) where
 115         (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
 116
 117 newEmptyMVar  :: IO (MVar a)
 118
 119 newEmptyMVar = IO $ \ s# ->
 120     case newMVar# s# of
 121          (# s2#, svar# #) -> (# s2#, MVar svar# #)
 122
 123 takeMVar :: MVar a -> IO a
 124
 125 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
 126
 127 putMVar  :: MVar a -> a -> IO ()
 128
 129 putMVar (MVar mvar#) x = IO $ \ s# ->
 130     case putMVar# mvar# x s# of
 131         s2# -> (# s2#, () #)
 132
 133 newMVar :: a -> IO (MVar a)
 134
 135 newMVar value =
 136     newEmptyMVar        >>= \ mvar ->
 137     putMVar mvar value  >>
 138     return mvar
 139
 140 readMVar :: MVar a -> IO a
 141
 142 readMVar mvar =
 143     takeMVar mvar       >>= \ value ->
 144     putMVar mvar value  >>
 145     return value
 146
 147 swapMVar :: MVar a -> a -> IO a
 148
 149 swapMVar mvar new =
 150     takeMVar mvar       >>= \ old ->
 151     putMVar mvar new    >>
 152     return old
 153
 154 {-
 155  Low-level op. for checking whether an MVar is filled-in or not.
 156  Notice that the boolean value returned  is just a snapshot of
 157  the state of the MVar. By the time you get to react on its result,
 158  the MVar may have been filled (or emptied) - so be extremely
 159  careful when using this operation.
 160
 161  If you can re-work your abstractions to avoid having to
 162  depend on isEmptyMVar, then you're encouraged to do so,
 163  i.e., consider yourself warned about the imprecision in
 164  general of isEmptyMVar :-)
 165 -}
 166 isEmptyMVar :: MVar a -> IO Bool
 167 isEmptyMVar (MVar mv#) = IO $ \ s# ->
 168     case isEmptyMVar# mv# s# of
 169         (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
 170 \end{code}
 171
 172
 173 %************************************************************************
 174 %*                                                                      *
 175 \subsection{Thread waiting}
 176 %*                                                                      *
 177 %************************************************************************
 178
 179 @threadDelay@ delays rescheduling of a thread until the indicated
 180 number of microseconds have elapsed.  Generally, the microseconds are
 181 counted by the context switch timer, which ticks in virtual time;
 182 however, when there are no runnable threads, we don't accumulate any
 183 virtual time, so we start ticking in real time.  (The granularity is
 184 the effective resolution of the context switch timer, so it is
 185 affected by the RTS -C option.)
 186
 187 @threadWaitRead@ delays rescheduling of a thread until input on the
 188 specified file descriptor is available for reading (just like select).
 189 @threadWaitWrite@ is similar, but for writing on a file descriptor.
 190
 191 \begin{code}
 192 {- Not yet -- SDM
 193 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
 194
 195 threadDelay (I# x#) = IO $ \ s# ->
 196     case delay# x# s# of
 197       s2# -> (# s2#, () #)
 198
 199 threadWaitRead (I# x#) = IO $ \ s# ->
 200     case waitRead# x# s# of
 201       s2# -> (# s2#, () #)
 202
 203 threadWaitWrite (I# x#) = IO $ \ s# ->
 204     case waitWrite# x# s# of
 205       s2# -> (# s2#, () #)
 206 -}
 207 \end{code}