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