2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[PrelConc]{Module @PrelConc@}
7 Basic concurrency stuff
10 {-# OPTIONS -fno-implicit-prelude #-}
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
23 {-threadDelay, threadWaitRead, threadWaitWrite,-}
27 , newMVar -- :: a -> IO (MVar a)
28 , newEmptyMVar -- :: IO (MVar a)
29 , takeMVar -- :: MVar a -> IO a
30 , putMVar -- :: MVar a -> a -> IO ()
31 , readMVar -- :: MVar a -> IO a
32 , swapMVar -- :: MVar a -> a -> IO a
33 , isEmptyMVar -- :: MVar a -> IO Bool
38 import PrelErr ( parError, seqError )
39 import PrelST ( liftST )
40 import PrelIOBase ( IO(..), MVar(..), unsafePerformIO )
41 import PrelBase ( Int(..) )
42 import PrelException ( Exception(..), AsyncException(..) )
47 %************************************************************************
49 \subsection{@ThreadId@, @par@, and @fork@}
51 %************************************************************************
54 data ThreadId = ThreadId ThreadId#
55 -- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
56 -- But since ThreadId# is unlifted, the Weak type must use open
59 --forkIO has now been hoisted out into the Concurrent library.
61 killThread :: ThreadId -> IO ()
62 killThread (ThreadId id) = IO $ \ s ->
63 case (killThread# id (AsyncException ThreadKilled) s) of s1 -> (# s1, () #)
65 raiseInThread :: ThreadId -> Exception -> IO ()
66 raiseInThread (ThreadId id) ex = IO $ \ s ->
67 case (killThread# id ex s) of s1 -> (# s1, () #)
69 myThreadId :: IO ThreadId
70 myThreadId = IO $ \s ->
71 case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #)
75 case (yield# s) of s1 -> (# s1, () #)
77 -- "seq" is defined a bit wierdly (see below)
79 -- The reason for the strange "0# -> parError" case is that
80 -- it fools the compiler into thinking that seq is non-strict in
81 -- its second argument (even if it inlines seq at the call site).
82 -- If it thinks seq is strict in "y", then it often evaluates
83 -- "y" before "x", which is totally wrong.
85 -- Just before converting from Core to STG there's a bit of magic
86 -- that recognises the seq# and eliminates the duff case.
90 seq x y = case (seq# x) of { 0# -> seqError; _ -> y }
95 #if defined(__PARALLEL_HASKELL__) || defined (__GRANSIM__)
96 par x y = case (par# x) of { 0# -> parError; _ -> y }
102 %************************************************************************
104 \subsection[mvars]{M-Structures}
106 %************************************************************************
108 M-Vars are rendezvous points for concurrent threads. They begin
109 empty, and any attempt to read an empty M-Var blocks. When an M-Var
110 is written, a single blocked thread may be freed. Reading an M-Var
111 toggles its state from full back to empty. Therefore, any value
112 written to an M-Var may only be read once. Multiple reads and writes
113 are allowed, but there must be at least one read between any two
117 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
119 instance Eq (MVar a) where
120 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
122 newEmptyMVar :: IO (MVar a)
124 newEmptyMVar = IO $ \ s# ->
126 (# s2#, svar# #) -> (# s2#, MVar svar# #)
128 takeMVar :: MVar a -> IO a
130 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
132 putMVar :: MVar a -> a -> IO ()
134 putMVar (MVar mvar#) x = IO $ \ s# ->
135 case putMVar# mvar# x s# of
138 newMVar :: a -> IO (MVar a)
141 newEmptyMVar >>= \ mvar ->
142 putMVar mvar value >>
145 readMVar :: MVar a -> IO a
148 takeMVar mvar >>= \ value ->
149 putMVar mvar value >>
152 swapMVar :: MVar a -> a -> IO a
155 takeMVar mvar >>= \ old ->
160 Low-level op. for checking whether an MVar is filled-in or not.
161 Notice that the boolean value returned is just a snapshot of
162 the state of the MVar. By the time you get to react on its result,
163 the MVar may have been filled (or emptied) - so be extremely
164 careful when using this operation.
166 If you can re-work your abstractions to avoid having to
167 depend on isEmptyMVar, then you're encouraged to do so,
168 i.e., consider yourself warned about the imprecision in
169 general of isEmptyMVar :-)
171 isEmptyMVar :: MVar a -> IO Bool
172 isEmptyMVar (MVar mv#) = IO $ \ s# ->
173 case isEmptyMVar# mv# s# of
174 (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
178 %************************************************************************
180 \subsection{Thread waiting}
182 %************************************************************************
184 @threadDelay@ delays rescheduling of a thread until the indicated
185 number of microseconds have elapsed. Generally, the microseconds are
186 counted by the context switch timer, which ticks in virtual time;
187 however, when there are no runnable threads, we don't accumulate any
188 virtual time, so we start ticking in real time. (The granularity is
189 the effective resolution of the context switch timer, so it is
190 affected by the RTS -C option.)
192 @threadWaitRead@ delays rescheduling of a thread until input on the
193 specified file descriptor is available for reading (just like select).
194 @threadWaitWrite@ is similar, but for writing on a file descriptor.
197 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
199 threadDelay (I# ms) = IO $ \s -> case delay# ms s of s -> (# s, () #)
200 threadWaitRead (I# fd) = IO $ \s -> case waitRead# fd s of s -> (# s, () #)
201 threadWaitWrite (I# fd) = IO $ \s -> case waitWrite# fd s of s -> (# s, () #)