SafeHaskell: Added SafeHaskell to base
[ghc.git] / libraries / base / GHC / IO.hs
1 {-# LANGUAGE NoImplicitPrelude
2 , BangPatterns
3 , RankNTypes
4 , MagicHash
5 , UnboxedTuples
6 #-}
7 {-# OPTIONS_GHC -funbox-strict-fields #-}
8 {-# OPTIONS_HADDOCK hide #-}
9 -----------------------------------------------------------------------------
10 -- |
11 -- Module : GHC.IO
12 -- Copyright : (c) The University of Glasgow 1994-2002
13 -- License : see libraries/base/LICENSE
14 --
15 -- Maintainer : cvs-ghc@haskell.org
16 -- Stability : internal
17 -- Portability : non-portable (GHC Extensions)
18 --
19 -- Definitions for the 'IO' monad and its friends.
20 --
21 -----------------------------------------------------------------------------
22
23 -- #hide
24 module GHC.IO (
25 IO(..), unIO, failIO, liftIO,
26 unsafePerformIO, unsafeInterleaveIO,
27 unsafeDupablePerformIO, unsafeDupableInterleaveIO,
28 noDuplicate,
29
30 -- To and from from ST
31 stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
32
33 FilePath,
34
35 catchException, catchAny, throwIO,
36 mask, mask_, uninterruptibleMask, uninterruptibleMask_,
37 MaskingState(..), getMaskingState,
38 block, unblock, blocked, unsafeUnmask,
39 onException, bracket, finally, evaluate
40 ) where
41
42 import GHC.Base
43 import GHC.ST
44 import GHC.Exception
45 import GHC.Show
46 import Data.Maybe
47
48 import {-# SOURCE #-} GHC.IO.Exception ( userError )
49
50 -- ---------------------------------------------------------------------------
51 -- The IO Monad
52
53 {-
54 The IO Monad is just an instance of the ST monad, where the state is
55 the real world. We use the exception mechanism (in GHC.Exception) to
56 implement IO exceptions.
57
58 NOTE: The IO representation is deeply wired in to various parts of the
59 system. The following list may or may not be exhaustive:
60
61 Compiler - types of various primitives in PrimOp.lhs
62
63 RTS - forceIO (StgMiscClosures.hc)
64 - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
65 (Exceptions.hc)
66 - raiseAsync (Schedule.c)
67
68 Prelude - GHC.IO.lhs, and several other places including
69 GHC.Exception.lhs.
70
71 Libraries - parts of hslibs/lang.
72
73 --SDM
74 -}
75
76 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
77 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
78
79 failIO :: String -> IO a
80 failIO s = IO (raiseIO# (toException (userError s)))
81
82 -- ---------------------------------------------------------------------------
83 -- Coercions between IO and ST
84
85 -- | A monad transformer embedding strict state transformers in the 'IO'
86 -- monad. The 'RealWorld' parameter indicates that the internal state
87 -- used by the 'ST' computation is a special one supplied by the 'IO'
88 -- monad, and thus distinct from those used by invocations of 'runST'.
89 stToIO :: ST RealWorld a -> IO a
90 stToIO (ST m) = IO m
91
92 ioToST :: IO a -> ST RealWorld a
93 ioToST (IO m) = (ST m)
94
95 -- This relies on IO and ST having the same representation modulo the
96 -- constraint on the type of the state
97 --
98 unsafeIOToST :: IO a -> ST s a
99 unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s
100
101 unsafeSTToIO :: ST s a -> IO a
102 unsafeSTToIO (ST m) = IO (unsafeCoerce# m)
103
104 -- ---------------------------------------------------------------------------
105 -- Unsafe IO operations
106
107 {-|
108 This is the \"back door\" into the 'IO' monad, allowing
109 'IO' computation to be performed at any time. For
110 this to be safe, the 'IO' computation should be
111 free of side effects and independent of its environment.
112
113 If the I\/O computation wrapped in 'unsafePerformIO' performs side
114 effects, then the relative order in which those side effects take
115 place (relative to the main I\/O trunk, or other calls to
116 'unsafePerformIO') is indeterminate. Furthermore, when using
117 'unsafePerformIO' to cause side-effects, you should take the following
118 precautions to ensure the side effects are performed as many times as
119 you expect them to be. Note that these precautions are necessary for
120 GHC, but may not be sufficient, and other compilers may require
121 different precautions:
122
123 * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@
124 that calls 'unsafePerformIO'. If the call is inlined,
125 the I\/O may be performed more than once.
126
127 * Use the compiler flag @-fno-cse@ to prevent common sub-expression
128 elimination being performed on the module, which might combine
129 two side effects that were meant to be separate. A good example
130 is using multiple global variables (like @test@ in the example below).
131
132 * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the
133 call to 'unsafePerformIO' cannot float outside a lambda. For example,
134 if you say:
135 @
136 f x = unsafePerformIO (newIORef [])
137 @
138 you may get only one reference cell shared between all calls to @f@.
139 Better would be
140 @
141 f x = unsafePerformIO (newIORef [x])
142 @
143 because now it can't float outside the lambda.
144
145 It is less well known that
146 'unsafePerformIO' is not type safe. For example:
147
148 > test :: IORef [a]
149 > test = unsafePerformIO $ newIORef []
150 >
151 > main = do
152 > writeIORef test [42]
153 > bang <- readIORef test
154 > print (bang :: [Char])
155
156 This program will core dump. This problem with polymorphic references
157 is well known in the ML community, and does not arise with normal
158 monadic use of references. There is no easy way to make it impossible
159 once you use 'unsafePerformIO'. Indeed, it is
160 possible to write @coerce :: a -> b@ with the
161 help of 'unsafePerformIO'. So be careful!
162 -}
163 unsafePerformIO :: IO a -> a
164 unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)
165
166 {-|
167 This version of 'unsafePerformIO' is slightly more efficient,
168 because it omits the check that the IO is only being performed by a
169 single thread. Hence, when you write 'unsafeDupablePerformIO',
170 there is a possibility that the IO action may be performed multiple
171 times (on a multiprocessor), and you should therefore ensure that
172 it gives the same results each time.
173 -}
174 {-# NOINLINE unsafeDupablePerformIO #-}
175 unsafeDupablePerformIO :: IO a -> a
176 unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
177
178 -- Why do we NOINLINE unsafeDupablePerformIO? See the comment with
179 -- GHC.ST.runST. Essentially the issue is that the IO computation
180 -- inside unsafePerformIO must be atomic: it must either all run, or
181 -- not at all. If we let the compiler see the application of the IO
182 -- to realWorld#, it might float out part of the IO.
183
184 -- Why is there a call to 'lazy' in unsafeDupablePerformIO?
185 -- If we don't have it, the demand analyser discovers the following strictness
186 -- for unsafeDupablePerformIO: C(U(AV))
187 -- But then consider
188 -- unsafeDupablePerformIO (\s -> let r = f x in
189 -- case writeIORef v r s of (# s1, _ #) ->
190 -- (# s1, r #)
191 -- The strictness analyser will find that the binding for r is strict,
192 -- (becuase of uPIO's strictness sig), and so it'll evaluate it before
193 -- doing the writeIORef. This actually makes tests/lib/should_run/memo002
194 -- get a deadlock!
195 --
196 -- Solution: don't expose the strictness of unsafeDupablePerformIO,
197 -- by hiding it with 'lazy'
198
199 {-|
200 'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
201 When passed a value of type @IO a@, the 'IO' will only be performed
202 when the value of the @a@ is demanded. This is used to implement lazy
203 file reading, see 'System.IO.hGetContents'.
204 -}
205 {-# INLINE unsafeInterleaveIO #-}
206 unsafeInterleaveIO :: IO a -> IO a
207 unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
208
209 -- We believe that INLINE on unsafeInterleaveIO is safe, because the
210 -- state from this IO thread is passed explicitly to the interleaved
211 -- IO, so it cannot be floated out and shared.
212
213 {-# INLINE unsafeDupableInterleaveIO #-}
214 unsafeDupableInterleaveIO :: IO a -> IO a
215 unsafeDupableInterleaveIO (IO m)
216 = IO ( \ s -> let
217 r = case m s of (# _, res #) -> res
218 in
219 (# s, r #))
220
221 {-|
222 Ensures that the suspensions under evaluation by the current thread
223 are unique; that is, the current thread is not evaluating anything
224 that is also under evaluation by another thread that has also executed
225 'noDuplicate'.
226
227 This operation is used in the definition of 'unsafePerformIO' to
228 prevent the IO action from being executed multiple times, which is usually
229 undesirable.
230 -}
231 noDuplicate :: IO ()
232 noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #)
233
234 -- -----------------------------------------------------------------------------
235 -- | File and directory names are values of type 'String', whose precise
236 -- meaning is operating system dependent. Files can be opened, yielding a
237 -- handle which can then be used to operate on the contents of that file.
238
239 type FilePath = String
240
241 -- -----------------------------------------------------------------------------
242 -- Primitive catch and throwIO
243
244 {-
245 catchException used to handle the passing around of the state to the
246 action and the handler. This turned out to be a bad idea - it meant
247 that we had to wrap both arguments in thunks so they could be entered
248 as normal (remember IO returns an unboxed pair...).
249
250 Now catch# has type
251
252 catch# :: IO a -> (b -> IO a) -> IO a
253
254 (well almost; the compiler doesn't know about the IO newtype so we
255 have to work around that in the definition of catchException below).
256 -}
257
258 catchException :: Exception e => IO a -> (e -> IO a) -> IO a
259 catchException (IO io) handler = IO $ catch# io handler'
260 where handler' e = case fromException e of
261 Just e' -> unIO (handler e')
262 Nothing -> raiseIO# e
263
264 catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
265 catchAny (IO io) handler = IO $ catch# io handler'
266 where handler' (SomeException e) = unIO (handler e)
267
268 -- | A variant of 'throw' that can only be used within the 'IO' monad.
269 --
270 -- Although 'throwIO' has a type that is an instance of the type of 'throw', the
271 -- two functions are subtly different:
272 --
273 -- > throw e `seq` x ===> throw e
274 -- > throwIO e `seq` x ===> x
275 --
276 -- The first example will cause the exception @e@ to be raised,
277 -- whereas the second one won\'t. In fact, 'throwIO' will only cause
278 -- an exception to be raised when it is used within the 'IO' monad.
279 -- The 'throwIO' variant should be used in preference to 'throw' to
280 -- raise an exception within the 'IO' monad because it guarantees
281 -- ordering with respect to other 'IO' operations, whereas 'throw'
282 -- does not.
283 throwIO :: Exception e => e -> IO a
284 throwIO e = IO (raiseIO# (toException e))
285
286 -- -----------------------------------------------------------------------------
287 -- Controlling asynchronous exception delivery
288
289 {-# DEPRECATED block "use Control.Exception.mask instead" #-}
290 -- | Note: this function is deprecated, please use 'mask' instead.
291 --
292 -- Applying 'block' to a computation will
293 -- execute that computation with asynchronous exceptions
294 -- /blocked/. That is, any thread which
295 -- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be
296 -- blocked until asynchronous exceptions are unblocked again. There\'s
297 -- no need to worry about re-enabling asynchronous exceptions; that is
298 -- done automatically on exiting the scope of
299 -- 'block'.
300 --
301 -- Threads created by 'Control.Concurrent.forkIO' inherit the blocked
302 -- state from the parent; that is, to start a thread in blocked mode,
303 -- use @block $ forkIO ...@. This is particularly useful if you need to
304 -- establish an exception handler in the forked thread before any
305 -- asynchronous exceptions are received.
306 block :: IO a -> IO a
307 block (IO io) = IO $ maskAsyncExceptions# io
308
309 {-# DEPRECATED unblock "use Control.Exception.mask instead" #-}
310 -- | Note: this function is deprecated, please use 'mask' instead.
311 --
312 -- To re-enable asynchronous exceptions inside the scope of
313 -- 'block', 'unblock' can be
314 -- used. It scopes in exactly the same way, so on exit from
315 -- 'unblock' asynchronous exception delivery will
316 -- be disabled again.
317 unblock :: IO a -> IO a
318 unblock = unsafeUnmask
319
320 unsafeUnmask :: IO a -> IO a
321 unsafeUnmask (IO io) = IO $ unmaskAsyncExceptions# io
322
323 blockUninterruptible :: IO a -> IO a
324 blockUninterruptible (IO io) = IO $ maskUninterruptible# io
325
326 -- | Describes the behaviour of a thread when an asynchronous
327 -- exception is received.
328 data MaskingState
329 = Unmasked -- ^ asynchronous exceptions are unmasked (the normal state)
330 | MaskedInterruptible
331 -- ^ the state during 'mask': asynchronous exceptions are masked, but blocking operations may still be interrupted
332 | MaskedUninterruptible
333 -- ^ the state during 'uninterruptibleMask': asynchronous exceptions are masked, and blocking operations may not be interrupted
334 deriving (Eq,Show)
335
336 -- | Returns the 'MaskingState' for the current thread.
337 getMaskingState :: IO MaskingState
338 getMaskingState = IO $ \s ->
339 case getMaskingState# s of
340 (# s', i #) -> (# s', case i of
341 0# -> Unmasked
342 1# -> MaskedUninterruptible
343 _ -> MaskedInterruptible #)
344
345 {-# DEPRECATED blocked "use Control.Exception.getMaskingState instead" #-}
346 -- | returns True if asynchronous exceptions are blocked in the
347 -- current thread.
348 blocked :: IO Bool
349 blocked = fmap (/= Unmasked) getMaskingState
350
351 onException :: IO a -> IO b -> IO a
352 onException io what = io `catchException` \e -> do _ <- what
353 throwIO (e :: SomeException)
354
355 -- | Executes an IO computation with asynchronous
356 -- exceptions /masked/. That is, any thread which attempts to raise
357 -- an exception in the current thread with 'Control.Exception.throwTo'
358 -- will be blocked until asynchronous exceptions are unmasked again.
359 --
360 -- The argument passed to 'mask' is a function that takes as its
361 -- argument another function, which can be used to restore the
362 -- prevailing masking state within the context of the masked
363 -- computation. For example, a common way to use 'mask' is to protect
364 -- the acquisition of a resource:
365 --
366 -- > mask $ \restore -> do
367 -- > x <- acquire
368 -- > restore (do_something_with x) `onException` release
369 -- > release
370 --
371 -- This code guarantees that @acquire@ is paired with @release@, by masking
372 -- asynchronous exceptions for the critical parts. (Rather than write
373 -- this code yourself, it would be better to use
374 -- 'Control.Exception.bracket' which abstracts the general pattern).
375 --
376 -- Note that the @restore@ action passed to the argument to 'mask'
377 -- does not necessarily unmask asynchronous exceptions, it just
378 -- restores the masking state to that of the enclosing context. Thus
379 -- if asynchronous exceptions are already masked, 'mask' cannot be used
380 -- to unmask exceptions again. This is so that if you call a library function
381 -- with exceptions masked, you can be sure that the library call will not be
382 -- able to unmask exceptions again. If you are writing library code and need
383 -- to use asynchronous exceptions, the only way is to create a new thread;
384 -- see 'Control.Concurrent.forkIOUnmasked'.
385 --
386 -- Asynchronous exceptions may still be received while in the masked
387 -- state if the masked thread /blocks/ in certain ways; see
388 -- "Control.Exception#interruptible".
389 --
390 -- Threads created by 'Control.Concurrent.forkIO' inherit the masked
391 -- state from the parent; that is, to start a thread in blocked mode,
392 -- use @mask_ $ forkIO ...@. This is particularly useful if you need
393 -- to establish an exception handler in the forked thread before any
394 -- asynchronous exceptions are received. To create a a new thread in
395 -- an unmasked state use 'Control.Concurrent.forkIOUnmasked'.
396 --
397 mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
398
399 -- | Like 'mask', but does not pass a @restore@ action to the argument.
400 mask_ :: IO a -> IO a
401
402 -- | Like 'mask', but the masked computation is not interruptible (see
403 -- "Control.Exception#interruptible"). THIS SHOULD BE USED WITH
404 -- GREAT CARE, because if a thread executing in 'uninterruptibleMask'
405 -- blocks for any reason, then the thread (and possibly the program,
406 -- if this is the main thread) will be unresponsive and unkillable.
407 -- This function should only be necessary if you need to mask
408 -- exceptions around an interruptible operation, and you can guarantee
409 -- that the interruptible operation will only block for a short period
410 -- of time.
411 --
412 uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
413
414 -- | Like 'uninterruptibleMask', but does not pass a @restore@ action
415 -- to the argument.
416 uninterruptibleMask_ :: IO a -> IO a
417
418 mask_ io = mask $ \_ -> io
419
420 mask io = do
421 b <- getMaskingState
422 case b of
423 Unmasked -> block $ io unblock
424 _ -> io id
425
426 uninterruptibleMask_ io = uninterruptibleMask $ \_ -> io
427
428 uninterruptibleMask io = do
429 b <- getMaskingState
430 case b of
431 Unmasked -> blockUninterruptible $ io unblock
432 MaskedInterruptible -> blockUninterruptible $ io block
433 MaskedUninterruptible -> io id
434
435 bracket
436 :: IO a -- ^ computation to run first (\"acquire resource\")
437 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
438 -> (a -> IO c) -- ^ computation to run in-between
439 -> IO c -- returns the value from the in-between computation
440 bracket before after thing =
441 mask $ \restore -> do
442 a <- before
443 r <- restore (thing a) `onException` after a
444 _ <- after a
445 return r
446
447 finally :: IO a -- ^ computation to run first
448 -> IO b -- ^ computation to run afterward (even if an exception
449 -- was raised)
450 -> IO a -- returns the value from the first computation
451 a `finally` sequel =
452 mask $ \restore -> do
453 r <- restore a `onException` sequel
454 _ <- sequel
455 return r
456
457 -- | Forces its argument to be evaluated to weak head normal form when
458 -- the resultant 'IO' action is executed. It can be used to order
459 -- evaluation with respect to other 'IO' operations; its semantics are
460 -- given by
461 --
462 -- > evaluate x `seq` y ==> y
463 -- > evaluate x `catch` f ==> (return $! x) `catch` f
464 -- > evaluate x >>= f ==> (return $! x) >>= f
465 --
466 -- /Note:/ the first equation implies that @(evaluate x)@ is /not/ the
467 -- same as @(return $! x)@. A correct definition is
468 --
469 -- > evaluate x = (return $! x) >>= return
470 --
471 evaluate :: a -> IO a
472 evaluate a = IO $ \s -> let !va = a in (# s, va #) -- NB. see #2273