1 % ------------------------------------------------------------------------------
2 % $Id: IOBase.lhs,v 1.8 2002/04/11 12:03:44 simonpj Exp $
4 % (c) The University of Glasgow, 1994-2001
7 % Definitions for the @IO@ monad and its friends. Everything is exported
8 % concretely; the @IO@ module itself exports abstractly.
11 {-# OPTIONS -fno-implicit-prelude #-}
13 module GHC.IOBase where
18 import GHC.Num -- To get fromInteger etc, needed because of -fno-implicit-prelude
19 import Data.Maybe ( Maybe(..) )
23 import {-# SOURCE #-} Data.Dynamic
25 -- ---------------------------------------------------------------------------
29 The IO Monad is just an instance of the ST monad, where the state is
30 the real world. We use the exception mechanism (in GHC.Exception) to
31 implement IO exceptions.
33 NOTE: The IO representation is deeply wired in to various parts of the
34 system. The following list may or may not be exhaustive:
36 Compiler - types of various primitives in PrimOp.lhs
38 RTS - forceIO (StgMiscClosures.hc)
39 - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
41 - raiseAsync (Schedule.c)
43 Prelude - GHC.IOBase.lhs, and several other places including
46 Libraries - parts of hslibs/lang.
51 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
53 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
56 instance Functor IO where
57 fmap f x = x >>= (return . f)
59 instance Monad IO where
63 m >> k = m >>= \ _ -> k
69 failIO :: String -> IO a
70 failIO s = ioError (userError s)
72 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
73 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
75 bindIO :: IO a -> (a -> IO b) -> IO b
76 bindIO (IO m) k = IO ( \ s ->
78 (# new_s, a #) -> unIO (k a) new_s
81 thenIO :: IO a -> IO b -> IO b
82 thenIO (IO m) k = IO ( \ s ->
84 (# new_s, a #) -> unIO k new_s
88 returnIO x = IO (\ s -> (# s, x #))
90 -- ---------------------------------------------------------------------------
91 -- Coercions between IO and ST
93 --stToIO :: (forall s. ST s a) -> IO a
94 stToIO :: ST RealWorld a -> IO a
97 ioToST :: IO a -> ST RealWorld a
98 ioToST (IO m) = (ST m)
100 -- ---------------------------------------------------------------------------
101 -- Unsafe IO operations
103 {-# NOINLINE unsafePerformIO #-}
104 unsafePerformIO :: IO a -> a
105 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
107 {-# NOINLINE unsafeInterleaveIO #-}
108 unsafeInterleaveIO :: IO a -> IO a
109 unsafeInterleaveIO (IO m)
111 r = case m s of (# _, res #) -> res
115 -- ---------------------------------------------------------------------------
118 data MVar a = MVar (MVar# RealWorld a)
120 -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module
121 instance Eq (MVar a) where
122 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
124 -- A Handle is represented by (a reference to) a record
125 -- containing the state of the I/O port/device. We record
126 -- the following pieces of info:
128 -- * type (read,write,closed etc.)
129 -- * the underlying file descriptor
131 -- * buffer, and spare buffers
132 -- * user-friendly name (usually the
133 -- FilePath used when IO.openFile was called)
135 -- Note: when a Handle is garbage collected, we want to flush its buffer
136 -- and close the OS file handle, so as to free up a (precious) resource.
139 = FileHandle -- A normal handle to a file
142 | DuplexHandle -- A handle to a read/write stream
143 !(MVar Handle__) -- The read side
144 !(MVar Handle__) -- The write side
147 -- * A 'FileHandle' is seekable. A 'DuplexHandle' may or may not be
150 instance Eq Handle where
151 (FileHandle h1) == (FileHandle h2) = h1 == h2
152 (DuplexHandle h1 _) == (DuplexHandle h2 _) = h1 == h2
155 type FD = Int -- XXX ToDo: should be CInt
159 haFD :: !FD, -- file descriptor
160 haType :: HandleType, -- type (read/write/append etc.)
161 haIsBin :: Bool, -- binary mode?
162 haIsStream :: Bool, -- is this a stream handle?
163 haBufferMode :: BufferMode, -- buffer contains read/write data?
164 haFilePath :: FilePath, -- file name, possibly
165 haBuffer :: !(IORef Buffer), -- the current buffer
166 haBuffers :: !(IORef BufferList), -- spare buffers
167 haOtherSide :: Maybe (MVar Handle__) -- ptr to the write side of a
171 -- ---------------------------------------------------------------------------
174 -- The buffer is represented by a mutable variable containing a
175 -- record, where the record contains the raw buffer and the start/end
176 -- points of the filled portion. We use a mutable variable so that
177 -- the common operation of writing (or reading) some data from (to)
178 -- the buffer doesn't need to modify, and hence copy, the handle
179 -- itself, it just updates the buffer.
181 -- There will be some allocation involved in a simple hPutChar in
182 -- order to create the new Buffer structure (below), but this is
183 -- relatively small, and this only has to be done once per write
186 -- The buffer contains its size - we could also get the size by
187 -- calling sizeOfMutableByteArray# on the raw buffer, but that tends
188 -- to be rounded up to the nearest Word.
190 type RawBuffer = MutableByteArray# RealWorld
192 -- INVARIANTS on a Buffer:
194 -- * A handle *always* has a buffer, even if it is only 1 character long
195 -- (an unbuffered handle needs a 1 character buffer in order to support
196 -- hLookAhead and hIsEOF).
198 -- * if r == w, then r == 0 && w == 0
199 -- * if state == WriteBuffer, then r == 0
200 -- * a write buffer is never full. If an operation
201 -- fills up the buffer, it will always flush it before
203 -- * a read buffer may be full as a result of hLookAhead. In normal
204 -- operation, a read buffer always has at least one character of space.
212 bufState :: BufferState
215 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
217 -- we keep a few spare buffers around in a handle to avoid allocating
218 -- a new one for each hPutStr. These buffers are *guaranteed* to be the
219 -- same size as the main buffer.
222 | BufferListCons RawBuffer BufferList
225 bufferIsWritable :: Buffer -> Bool
226 bufferIsWritable Buffer{ bufState=WriteBuffer } = True
227 bufferIsWritable _other = False
229 bufferEmpty :: Buffer -> Bool
230 bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w
232 -- only makes sense for a write buffer
233 bufferFull :: Buffer -> Bool
234 bufferFull b@Buffer{ bufWPtr=w } = w >= bufSize b
236 -- Internally, we classify handles as being one
247 isReadableHandleType ReadHandle = True
248 isReadableHandleType ReadWriteHandle = True
249 isReadableHandleType _ = False
251 isWritableHandleType AppendHandle = True
252 isWritableHandleType WriteHandle = True
253 isWritableHandleType ReadWriteHandle = True
254 isWritableHandleType _ = False
256 -- File names are specified using @FilePath@, a OS-dependent
257 -- string that (hopefully, I guess) maps to an accessible file/object.
259 type FilePath = String
261 -- ---------------------------------------------------------------------------
264 -- Three kinds of buffering are supported: line-buffering,
265 -- block-buffering or no-buffering. These modes have the following
266 -- effects. For output, items are written out from the internal
267 -- buffer according to the buffer mode:
269 -- * line-buffering the entire output buffer is written
270 -- out whenever a newline is output, the output buffer overflows,
271 -- a flush is issued, or the handle is closed.
273 -- * block-buffering the entire output buffer is written out whenever
274 -- it overflows, a flush is issued, or the handle
277 -- * no-buffering output is written immediately, and never stored
278 -- in the output buffer.
280 -- The output buffer is emptied as soon as it has been written out.
282 -- Similarly, input occurs according to the buffer mode for handle {\em hdl}.
284 -- * line-buffering when the input buffer for the handle is not empty,
285 -- the next item is obtained from the buffer;
286 -- otherwise, when the input buffer is empty,
287 -- characters up to and including the next newline
288 -- character are read into the buffer. No characters
289 -- are available until the newline character is
292 -- * block-buffering when the input buffer for the handle becomes empty,
293 -- the next block of data is read into this buffer.
295 -- * no-buffering the next input item is read and returned.
297 -- For most implementations, physical files will normally be block-buffered
298 -- and terminals will normally be line-buffered. (the IO interface provides
299 -- operations for changing the default buffering of a handle tho.)
302 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
303 deriving (Eq, Ord, Read, Show)
305 -- ---------------------------------------------------------------------------
308 newtype IORef a = IORef (STRef RealWorld a) deriving Eq
310 newIORef :: a -> IO (IORef a)
311 newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
313 readIORef :: IORef a -> IO a
314 readIORef (IORef var) = stToIO (readSTRef var)
316 writeIORef :: IORef a -> a -> IO ()
317 writeIORef (IORef var) v = stToIO (writeSTRef var v)
319 -- ---------------------------------------------------------------------------
320 -- Show instance for Handles
322 -- handle types are 'show'n when printing error msgs, so
323 -- we provide a more user-friendly Show instance for it
324 -- than the derived one.
326 instance Show HandleType where
329 ClosedHandle -> showString "closed"
330 SemiClosedHandle -> showString "semi-closed"
331 ReadHandle -> showString "readable"
332 WriteHandle -> showString "writable"
333 AppendHandle -> showString "writable (append)"
334 ReadWriteHandle -> showString "read-writable"
336 instance Show Handle where
337 showsPrec p (FileHandle h) = showHandle p h False
338 showsPrec p (DuplexHandle _ h) = showHandle p h True
340 showHandle p h duplex =
342 -- (Big) SIGH: unfolded defn of takeMVar to avoid
343 -- an (oh-so) unfortunate module loop with GHC.Conc.
344 hdl_ = unsafePerformIO (IO $ \ s# ->
345 case h of { MVar h# ->
346 case takeMVar# h# s# of { (# s2# , r #) ->
347 case putMVar# h# r s2# of { s3# ->
350 showType | duplex = showString "duplex (read-write)"
351 | otherwise = showsPrec p (haType hdl_)
354 showHdl (haType hdl_)
355 (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
356 showString "type=" . showType . showChar ',' .
357 showString "binary=" . showsPrec p (haIsBin hdl_) . showChar ',' .
358 showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
361 showHdl :: HandleType -> ShowS -> ShowS
364 ClosedHandle -> showsPrec p ht . showString "}"
367 showBufMode :: Buffer -> BufferMode -> ShowS
368 showBufMode buf bmo =
370 NoBuffering -> showString "none"
371 LineBuffering -> showString "line"
372 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
373 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
378 -- ------------------------------------------------------------------------
379 -- Exception datatype and operations
382 = IOException IOException -- IO exceptions
383 | ArithException ArithException -- Arithmetic exceptions
384 | ArrayException ArrayException -- Array-related exceptions
385 | ErrorCall String -- Calls to 'error'
386 | ExitException ExitCode -- Call to System.exitWith
387 | NoMethodError String -- A non-existent method was invoked
388 | PatternMatchFail String -- A pattern match / guard failure
389 | RecSelError String -- Selecting a non-existent field
390 | RecConError String -- Field missing in record construction
391 | RecUpdError String -- Record doesn't contain updated field
392 | AssertionFailed String -- Assertions
393 | DynException Dynamic -- Dynamic exceptions
394 | AsyncException AsyncException -- Externally generated errors
395 | BlockedOnDeadMVar -- Blocking on a dead MVar
396 | Deadlock -- no threads can run (raised in main thread)
414 = IndexOutOfBounds String -- out-of-range array access
415 | UndefinedElement String -- evaluating an undefined element
418 stackOverflow, heapOverflow :: Exception -- for the RTS
419 stackOverflow = AsyncException StackOverflow
420 heapOverflow = AsyncException HeapOverflow
422 instance Show ArithException where
423 showsPrec _ Overflow = showString "arithmetic overflow"
424 showsPrec _ Underflow = showString "arithmetic underflow"
425 showsPrec _ LossOfPrecision = showString "loss of precision"
426 showsPrec _ DivideByZero = showString "divide by zero"
427 showsPrec _ Denormal = showString "denormal"
429 instance Show AsyncException where
430 showsPrec _ StackOverflow = showString "stack overflow"
431 showsPrec _ HeapOverflow = showString "heap overflow"
432 showsPrec _ ThreadKilled = showString "thread killed"
434 instance Show ArrayException where
435 showsPrec _ (IndexOutOfBounds s)
436 = showString "array index out of range"
437 . (if not (null s) then showString ": " . showString s
439 showsPrec _ (UndefinedElement s)
440 = showString "undefined array element"
441 . (if not (null s) then showString ": " . showString s
444 instance Show Exception where
445 showsPrec _ (IOException err) = shows err
446 showsPrec _ (ArithException err) = shows err
447 showsPrec _ (ArrayException err) = shows err
448 showsPrec _ (ErrorCall err) = showString err
449 showsPrec _ (ExitException err) = showString "exit: " . shows err
450 showsPrec _ (NoMethodError err) = showString err
451 showsPrec _ (PatternMatchFail err) = showString err
452 showsPrec _ (RecSelError err) = showString err
453 showsPrec _ (RecConError err) = showString err
454 showsPrec _ (RecUpdError err) = showString err
455 showsPrec _ (AssertionFailed err) = showString err
456 showsPrec _ (DynException _err) = showString "unknown exception"
457 showsPrec _ (AsyncException e) = shows e
458 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
459 showsPrec _ (NonTermination) = showString "<<loop>>"
460 showsPrec _ (Deadlock) = showString "<<deadlock>>"
462 instance Eq Exception where
463 IOException e1 == IOException e2 = e1 == e2
464 ArithException e1 == ArithException e2 = e1 == e2
465 ArrayException e1 == ArrayException e2 = e1 == e2
466 ErrorCall e1 == ErrorCall e2 = e1 == e2
467 ExitException e1 == ExitException e2 = e1 == e2
468 NoMethodError e1 == NoMethodError e2 = e1 == e2
469 PatternMatchFail e1 == PatternMatchFail e2 = e1 == e2
470 RecSelError e1 == RecSelError e2 = e1 == e2
471 RecConError e1 == RecConError e2 = e1 == e2
472 RecUpdError e1 == RecUpdError e2 = e1 == e2
473 AssertionFailed e1 == AssertionFailed e2 = e1 == e2
474 DynException _ == DynException _ = False -- incomparable
475 AsyncException e1 == AsyncException e2 = e1 == e2
476 BlockedOnDeadMVar == BlockedOnDeadMVar = True
477 NonTermination == NonTermination = True
478 Deadlock == Deadlock = True
480 -- -----------------------------------------------------------------------------
483 -- The `ExitCode' type defines the exit codes that a program
484 -- can return. `ExitSuccess' indicates successful termination;
485 -- and `ExitFailure code' indicates program failure
486 -- with value `code'. The exact interpretation of `code'
487 -- is operating-system dependent. In particular, some values of
488 -- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
490 -- We need it here because it is used in ExitException in the
491 -- Exception datatype (above).
493 data ExitCode = ExitSuccess | ExitFailure Int
494 deriving (Eq, Ord, Read, Show)
496 -- --------------------------------------------------------------------------
499 throw :: Exception -> a
500 throw exception = raise# exception
502 ioError :: Exception -> IO a
503 ioError err = IO $ \s -> throw err s
505 ioException :: IOException -> IO a
506 ioException err = IO $ \s -> throw (IOException err) s
508 -- ---------------------------------------------------------------------------
511 -- A value @IOError@ encode errors occurred in the @IO@ monad.
512 -- An @IOError@ records a more specific error type, a descriptive
513 -- string and maybe the handle that was used when the error was
516 type IOError = Exception
520 ioe_handle :: Maybe Handle, -- the handle used by the action flagging
522 ioe_type :: IOErrorType, -- what it was.
523 ioe_location :: String, -- location.
524 ioe_descr :: String, -- error type specific information.
525 ioe_filename :: Maybe FilePath -- filename the error is related to.
528 instance Eq IOException where
529 (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
530 e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
543 | UnsatisfiedConstraints
550 | UnsupportedOperation
554 | DynIOError Dynamic -- cheap&cheerful extensible IO error type.
556 instance Eq IOErrorType where
559 DynIOError{} -> False -- from a strictness POV, compatible with a derived Eq inst?
560 _ -> getTag# x ==# getTag# y
562 instance Show IOErrorType where
566 AlreadyExists -> "already exists"
567 NoSuchThing -> "does not exist"
568 ResourceBusy -> "resource busy"
569 ResourceExhausted -> "resource exhausted"
571 IllegalOperation -> "illegal operation"
572 PermissionDenied -> "permission denied"
573 UserError -> "user error"
574 HardwareFault -> "hardware fault"
575 InappropriateType -> "inappropriate type"
576 Interrupted -> "interrupted"
577 InvalidArgument -> "invalid argument"
578 OtherError -> "failed"
579 ProtocolError -> "protocol error"
580 ResourceVanished -> "resource vanished"
581 SystemError -> "system error"
582 TimeExpired -> "timeout"
583 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
584 UnsupportedOperation -> "unsupported operation"
585 DynIOError{} -> "unknown IO error"
587 userError :: String -> IOError
588 userError str = IOException (IOError Nothing UserError "" str Nothing)
590 -- ---------------------------------------------------------------------------
593 instance Show IOException where
594 showsPrec p (IOError hdl iot loc s fn) =
598 _ -> showString "\nAction: " . showString loc) .
601 Just h -> showString "\nHandle: " . showsPrec p h) .
604 _ -> showString "\nReason: " . showString s) .
607 Just name -> showString "\nFile: " . showString name)