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
21 {-threadDelay, threadWaitRead, threadWaitWrite,-}
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
36 import PrelErr ( parError, seqError )
37 import PrelST ( liftST )
38 import PrelIOBase ( IO(..), MVar(..), unsafePerformIO )
39 import PrelBase ( Int(..) )
40 import PrelException ( Exception(..), AsyncException(..) )
45 %************************************************************************
47 \subsection{@ThreadId@, @par@, and @fork@}
49 %************************************************************************
52 data ThreadId = ThreadId ThreadId#
53 -- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
54 -- But since ThreadId# is unlifted, the Weak type must use open
57 --forkIO has now been hoisted out into the concurrent library.
59 killThread :: ThreadId -> IO ()
60 killThread (ThreadId id) = IO $ \ s ->
61 case (killThread# id (AsyncException ThreadKilled) s) of s1 -> (# s1, () #)
63 raiseInThread :: ThreadId -> Exception -> IO ()
64 raiseInThread (ThreadId id) ex = IO $ \ s ->
65 case (killThread# id ex s) of s1 -> (# s1, () #)
67 myThreadId :: IO ThreadId
68 myThreadId = IO $ \s ->
69 case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #)
71 -- "seq" is defined a bit wierdly (see below)
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.
79 -- Just before converting from Core to STG there's a bit of magic
80 -- that recognises the seq# and eliminates the duff case.
84 seq x y = case (seq# x) of { 0# -> seqError; _ -> y }
89 #if defined(__PARALLEL_HASKELL__) || defined (__GRANSIM__)
90 par x y = case (par# x) of { 0# -> parError; _ -> y }
97 %************************************************************************
99 \subsection[mvars]{M-Structures}
101 %************************************************************************
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
112 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
114 instance Eq (MVar a) where
115 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
117 newEmptyMVar :: IO (MVar a)
119 newEmptyMVar = IO $ \ s# ->
121 (# s2#, svar# #) -> (# s2#, MVar svar# #)
123 takeMVar :: MVar a -> IO a
125 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
127 putMVar :: MVar a -> a -> IO ()
129 putMVar (MVar mvar#) x = IO $ \ s# ->
130 case putMVar# mvar# x s# of
133 newMVar :: a -> IO (MVar a)
136 newEmptyMVar >>= \ mvar ->
137 putMVar mvar value >>
140 readMVar :: MVar a -> IO a
143 takeMVar mvar >>= \ value ->
144 putMVar mvar value >>
147 swapMVar :: MVar a -> a -> IO a
150 takeMVar mvar >>= \ old ->
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.
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 :-)
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#) #)
173 %************************************************************************
175 \subsection{Thread waiting}
177 %************************************************************************
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.)
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.
193 threadDelay, threadWaitRead, threadWaitWrite :: Int -> IO ()
195 threadDelay (I# x#) = IO $ \ s# ->
199 threadWaitRead (I# x#) = IO $ \ s# ->
200 case waitRead# x# s# of
203 threadWaitWrite (I# x#) = IO $ \ s# ->
204 case waitWrite# x# s# of