1 % ------------------------------------------------------------------------------
2 % $Id: IOBase.lhs,v 1.6 2002/02/05 17:32:26 simonmar 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(..) )
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
82 returnIO x = IO (\ s -> (# s, x #))
84 -- ---------------------------------------------------------------------------
85 -- Coercions between IO and ST
87 --stToIO :: (forall s. ST s a) -> IO a
88 stToIO :: ST RealWorld a -> IO a
91 ioToST :: IO a -> ST RealWorld a
92 ioToST (IO m) = (ST m)
94 -- ---------------------------------------------------------------------------
95 -- Unsafe IO operations
97 {-# NOINLINE unsafePerformIO #-}
98 unsafePerformIO :: IO a -> a
99 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
101 {-# NOINLINE unsafeInterleaveIO #-}
102 unsafeInterleaveIO :: IO a -> IO a
103 unsafeInterleaveIO (IO m)
105 r = case m s of (# _, res #) -> res
109 -- ---------------------------------------------------------------------------
112 data MVar a = MVar (MVar# RealWorld a)
114 -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module
115 instance Eq (MVar a) where
116 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
118 -- A Handle is represented by (a reference to) a record
119 -- containing the state of the I/O port/device. We record
120 -- the following pieces of info:
122 -- * type (read,write,closed etc.)
123 -- * the underlying file descriptor
125 -- * buffer, and spare buffers
126 -- * user-friendly name (usually the
127 -- FilePath used when IO.openFile was called)
129 -- Note: when a Handle is garbage collected, we want to flush its buffer
130 -- and close the OS file handle, so as to free up a (precious) resource.
133 = FileHandle -- A normal handle to a file
136 | DuplexHandle -- A handle to a read/write stream
137 !(MVar Handle__) -- The read side
138 !(MVar Handle__) -- The write side
141 -- * A 'FileHandle' is seekable. A 'DuplexHandle' may or may not be
144 instance Eq Handle where
145 (FileHandle h1) == (FileHandle h2) = h1 == h2
146 (DuplexHandle h1 _) == (DuplexHandle h2 _) = h1 == h2
149 type FD = Int -- XXX ToDo: should be CInt
153 haFD :: !FD, -- file descriptor
154 haType :: HandleType, -- type (read/write/append etc.)
155 haIsBin :: Bool, -- binary mode?
156 haIsStream :: Bool, -- is this a stream handle?
157 haBufferMode :: BufferMode, -- buffer contains read/write data?
158 haFilePath :: FilePath, -- file name, possibly
159 haBuffer :: !(IORef Buffer), -- the current buffer
160 haBuffers :: !(IORef BufferList), -- spare buffers
161 haOtherSide :: Maybe (MVar Handle__) -- ptr to the write side of a
165 -- ---------------------------------------------------------------------------
168 -- The buffer is represented by a mutable variable containing a
169 -- record, where the record contains the raw buffer and the start/end
170 -- points of the filled portion. We use a mutable variable so that
171 -- the common operation of writing (or reading) some data from (to)
172 -- the buffer doesn't need to modify, and hence copy, the handle
173 -- itself, it just updates the buffer.
175 -- There will be some allocation involved in a simple hPutChar in
176 -- order to create the new Buffer structure (below), but this is
177 -- relatively small, and this only has to be done once per write
180 -- The buffer contains its size - we could also get the size by
181 -- calling sizeOfMutableByteArray# on the raw buffer, but that tends
182 -- to be rounded up to the nearest Word.
184 type RawBuffer = MutableByteArray# RealWorld
186 -- INVARIANTS on a Buffer:
188 -- * A handle *always* has a buffer, even if it is only 1 character long
189 -- (an unbuffered handle needs a 1 character buffer in order to support
190 -- hLookAhead and hIsEOF).
192 -- * if r == w, then r == 0 && w == 0
193 -- * if state == WriteBuffer, then r == 0
194 -- * a write buffer is never full. If an operation
195 -- fills up the buffer, it will always flush it before
197 -- * a read buffer may be full as a result of hLookAhead. In normal
198 -- operation, a read buffer always has at least one character of space.
206 bufState :: BufferState
209 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
211 -- we keep a few spare buffers around in a handle to avoid allocating
212 -- a new one for each hPutStr. These buffers are *guaranteed* to be the
213 -- same size as the main buffer.
216 | BufferListCons RawBuffer BufferList
219 bufferIsWritable :: Buffer -> Bool
220 bufferIsWritable Buffer{ bufState=WriteBuffer } = True
221 bufferIsWritable _other = False
223 bufferEmpty :: Buffer -> Bool
224 bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w
226 -- only makes sense for a write buffer
227 bufferFull :: Buffer -> Bool
228 bufferFull b@Buffer{ bufWPtr=w } = w >= bufSize b
230 -- Internally, we classify handles as being one
241 isReadableHandleType ReadHandle = True
242 isReadableHandleType ReadWriteHandle = True
243 isReadableHandleType _ = False
245 isWritableHandleType AppendHandle = True
246 isWritableHandleType WriteHandle = True
247 isWritableHandleType ReadWriteHandle = True
248 isWritableHandleType _ = False
250 -- File names are specified using @FilePath@, a OS-dependent
251 -- string that (hopefully, I guess) maps to an accessible file/object.
253 type FilePath = String
255 -- ---------------------------------------------------------------------------
258 -- Three kinds of buffering are supported: line-buffering,
259 -- block-buffering or no-buffering. These modes have the following
260 -- effects. For output, items are written out from the internal
261 -- buffer according to the buffer mode:
263 -- * line-buffering the entire output buffer is written
264 -- out whenever a newline is output, the output buffer overflows,
265 -- a flush is issued, or the handle is closed.
267 -- * block-buffering the entire output buffer is written out whenever
268 -- it overflows, a flush is issued, or the handle
271 -- * no-buffering output is written immediately, and never stored
272 -- in the output buffer.
274 -- The output buffer is emptied as soon as it has been written out.
276 -- Similarly, input occurs according to the buffer mode for handle {\em hdl}.
278 -- * line-buffering when the input buffer for the handle is not empty,
279 -- the next item is obtained from the buffer;
280 -- otherwise, when the input buffer is empty,
281 -- characters up to and including the next newline
282 -- character are read into the buffer. No characters
283 -- are available until the newline character is
286 -- * block-buffering when the input buffer for the handle becomes empty,
287 -- the next block of data is read into this buffer.
289 -- * no-buffering the next input item is read and returned.
291 -- For most implementations, physical files will normally be block-buffered
292 -- and terminals will normally be line-buffered. (the IO interface provides
293 -- operations for changing the default buffering of a handle tho.)
296 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
297 deriving (Eq, Ord, Read, Show)
299 -- ---------------------------------------------------------------------------
302 newtype IORef a = IORef (STRef RealWorld a) deriving Eq
304 newIORef :: a -> IO (IORef a)
305 newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
307 readIORef :: IORef a -> IO a
308 readIORef (IORef var) = stToIO (readSTRef var)
310 writeIORef :: IORef a -> a -> IO ()
311 writeIORef (IORef var) v = stToIO (writeSTRef var v)
313 -- ---------------------------------------------------------------------------
314 -- Show instance for Handles
316 -- handle types are 'show'n when printing error msgs, so
317 -- we provide a more user-friendly Show instance for it
318 -- than the derived one.
320 instance Show HandleType where
323 ClosedHandle -> showString "closed"
324 SemiClosedHandle -> showString "semi-closed"
325 ReadHandle -> showString "readable"
326 WriteHandle -> showString "writable"
327 AppendHandle -> showString "writable (append)"
328 ReadWriteHandle -> showString "read-writable"
330 instance Show Handle where
331 showsPrec p (FileHandle h) = showHandle p h False
332 showsPrec p (DuplexHandle _ h) = showHandle p h True
334 showHandle p h duplex =
336 -- (Big) SIGH: unfolded defn of takeMVar to avoid
337 -- an (oh-so) unfortunate module loop with GHC.Conc.
338 hdl_ = unsafePerformIO (IO $ \ s# ->
339 case h of { MVar h# ->
340 case takeMVar# h# s# of { (# s2# , r #) ->
341 case putMVar# h# r s2# of { s3# ->
344 showType | duplex = showString "duplex (read-write)"
345 | otherwise = showsPrec p (haType hdl_)
348 showHdl (haType hdl_)
349 (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
350 showString "type=" . showType . showChar ',' .
351 showString "binary=" . showsPrec p (haIsBin hdl_) . showChar ',' .
352 showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
355 showHdl :: HandleType -> ShowS -> ShowS
358 ClosedHandle -> showsPrec p ht . showString "}"
361 showBufMode :: Buffer -> BufferMode -> ShowS
362 showBufMode buf bmo =
364 NoBuffering -> showString "none"
365 LineBuffering -> showString "line"
366 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
367 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
372 -- ------------------------------------------------------------------------
373 -- Exception datatype and operations
376 = IOException IOException -- IO exceptions
377 | ArithException ArithException -- Arithmetic exceptions
378 | ArrayException ArrayException -- Array-related exceptions
379 | ErrorCall String -- Calls to 'error'
380 | ExitException ExitCode -- Call to System.exitWith
381 | NoMethodError String -- A non-existent method was invoked
382 | PatternMatchFail String -- A pattern match / guard failure
383 | RecSelError String -- Selecting a non-existent field
384 | RecConError String -- Field missing in record construction
385 | RecUpdError String -- Record doesn't contain updated field
386 | AssertionFailed String -- Assertions
387 | DynException Dynamic -- Dynamic exceptions
388 | AsyncException AsyncException -- Externally generated errors
389 | BlockedOnDeadMVar -- Blocking on a dead MVar
390 | Deadlock -- no threads can run (raised in main thread)
408 = IndexOutOfBounds String -- out-of-range array access
409 | UndefinedElement String -- evaluating an undefined element
412 stackOverflow, heapOverflow :: Exception -- for the RTS
413 stackOverflow = AsyncException StackOverflow
414 heapOverflow = AsyncException HeapOverflow
416 instance Show ArithException where
417 showsPrec _ Overflow = showString "arithmetic overflow"
418 showsPrec _ Underflow = showString "arithmetic underflow"
419 showsPrec _ LossOfPrecision = showString "loss of precision"
420 showsPrec _ DivideByZero = showString "divide by zero"
421 showsPrec _ Denormal = showString "denormal"
423 instance Show AsyncException where
424 showsPrec _ StackOverflow = showString "stack overflow"
425 showsPrec _ HeapOverflow = showString "heap overflow"
426 showsPrec _ ThreadKilled = showString "thread killed"
428 instance Show ArrayException where
429 showsPrec _ (IndexOutOfBounds s)
430 = showString "array index out of range"
431 . (if not (null s) then showString ": " . showString s
433 showsPrec _ (UndefinedElement s)
434 = showString "undefined array element"
435 . (if not (null s) then showString ": " . showString s
438 instance Show Exception where
439 showsPrec _ (IOException err) = shows err
440 showsPrec _ (ArithException err) = shows err
441 showsPrec _ (ArrayException err) = shows err
442 showsPrec _ (ErrorCall err) = showString err
443 showsPrec _ (ExitException err) = showString "exit: " . shows err
444 showsPrec _ (NoMethodError err) = showString err
445 showsPrec _ (PatternMatchFail err) = showString err
446 showsPrec _ (RecSelError err) = showString err
447 showsPrec _ (RecConError err) = showString err
448 showsPrec _ (RecUpdError err) = showString err
449 showsPrec _ (AssertionFailed err) = showString err
450 showsPrec _ (DynException _err) = showString "unknown exception"
451 showsPrec _ (AsyncException e) = shows e
452 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
453 showsPrec _ (NonTermination) = showString "<<loop>>"
454 showsPrec _ (Deadlock) = showString "<<deadlock>>"
456 instance Eq Exception where
457 IOException e1 == IOException e2 = e1 == e2
458 ArithException e1 == ArithException e2 = e1 == e2
459 ArrayException e1 == ArrayException e2 = e1 == e2
460 ErrorCall e1 == ErrorCall e2 = e1 == e2
461 ExitException e1 == ExitException e2 = e1 == e2
462 NoMethodError e1 == NoMethodError e2 = e1 == e2
463 PatternMatchFail e1 == PatternMatchFail e2 = e1 == e2
464 RecSelError e1 == RecSelError e2 = e1 == e2
465 RecConError e1 == RecConError e2 = e1 == e2
466 RecUpdError e1 == RecUpdError e2 = e1 == e2
467 AssertionFailed e1 == AssertionFailed e2 = e1 == e2
468 DynException _ == DynException _ = False -- incomparable
469 AsyncException e1 == AsyncException e2 = e1 == e2
470 BlockedOnDeadMVar == BlockedOnDeadMVar = True
471 NonTermination == NonTermination = True
472 Deadlock == Deadlock = True
474 -- -----------------------------------------------------------------------------
477 -- The `ExitCode' type defines the exit codes that a program
478 -- can return. `ExitSuccess' indicates successful termination;
479 -- and `ExitFailure code' indicates program failure
480 -- with value `code'. The exact interpretation of `code'
481 -- is operating-system dependent. In particular, some values of
482 -- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
484 -- We need it here because it is used in ExitException in the
485 -- Exception datatype (above).
487 data ExitCode = ExitSuccess | ExitFailure Int
488 deriving (Eq, Ord, Read, Show)
490 -- --------------------------------------------------------------------------
493 throw :: Exception -> a
494 throw exception = raise# exception
496 ioError :: Exception -> IO a
497 ioError err = IO $ \s -> throw err s
499 ioException :: IOException -> IO a
500 ioException err = IO $ \s -> throw (IOException err) s
502 -- ---------------------------------------------------------------------------
505 -- A value @IOError@ encode errors occurred in the @IO@ monad.
506 -- An @IOError@ records a more specific error type, a descriptive
507 -- string and maybe the handle that was used when the error was
510 type IOError = Exception
514 ioe_handle :: Maybe Handle, -- the handle used by the action flagging
516 ioe_type :: IOErrorType, -- what it was.
517 ioe_location :: String, -- location.
518 ioe_descr :: String, -- error type specific information.
519 ioe_filename :: Maybe FilePath -- filename the error is related to.
522 instance Eq IOException where
523 (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
524 e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
537 | UnsatisfiedConstraints
544 | UnsupportedOperation
548 | DynIOError Dynamic -- cheap&cheerful extensible IO error type.
550 instance Eq IOErrorType where
553 DynIOError{} -> False -- from a strictness POV, compatible with a derived Eq inst?
554 _ -> getTag# x ==# getTag# y
556 instance Show IOErrorType where
560 AlreadyExists -> "already exists"
561 NoSuchThing -> "does not exist"
562 ResourceBusy -> "resource busy"
563 ResourceExhausted -> "resource exhausted"
565 IllegalOperation -> "illegal operation"
566 PermissionDenied -> "permission denied"
567 UserError -> "user error"
568 HardwareFault -> "hardware fault"
569 InappropriateType -> "inappropriate type"
570 Interrupted -> "interrupted"
571 InvalidArgument -> "invalid argument"
572 OtherError -> "failed"
573 ProtocolError -> "protocol error"
574 ResourceVanished -> "resource vanished"
575 SystemError -> "system error"
576 TimeExpired -> "timeout"
577 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
578 UnsupportedOperation -> "unsupported operation"
579 DynIOError{} -> "unknown IO error"
581 userError :: String -> IOError
582 userError str = IOException (IOError Nothing UserError "" str Nothing)
584 -- ---------------------------------------------------------------------------
587 instance Show IOException where
588 showsPrec p (IOError hdl iot loc s fn) =
592 _ -> showString "\nAction: " . showString loc) .
595 Just h -> showString "\nHandle: " . showsPrec p h) .
598 _ -> showString "\nReason: " . showString s) .
601 Just name -> showString "\nFile: " . showString name)