1 % ------------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.39 2001/05/22 15:06:47 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 #-}
14 module PrelIOBase where
20 import PrelNum -- To get fromInteger etc, needed because of -fno-implicit-prelude
21 import PrelMaybe ( Maybe(..) )
26 -- ---------------------------------------------------------------------------
30 The IO Monad is just an instance of the ST monad, where the state is
31 the real world. We use the exception mechanism (in PrelException) to
32 implement IO exceptions.
34 NOTE: The IO representation is deeply wired in to various parts of the
35 system. The following list may or may not be exhaustive:
37 Compiler - types of various primitives in PrimOp.lhs
39 RTS - forceIO (StgMiscClosures.hc)
40 - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
42 - raiseAsync (Schedule.c)
44 Prelude - PrelIOBase.lhs, and several other places including
47 Libraries - parts of hslibs/lang.
52 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
54 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
57 instance Functor IO where
58 fmap f x = x >>= (return . f)
60 instance Monad IO where
64 m >> k = m >>= \ _ -> k
70 failIO :: String -> IO a
71 failIO s = ioError (userError s)
73 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
74 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
76 bindIO :: IO a -> (a -> IO b) -> IO b
77 bindIO (IO m) k = IO ( \ s ->
79 (# new_s, a #) -> unIO (k a) new_s
83 returnIO x = IO (\ s -> (# s, x #))
85 -- ---------------------------------------------------------------------------
86 -- Coercions between IO and ST
88 --stToIO :: (forall s. ST s a) -> IO a
89 stToIO :: ST RealWorld a -> IO a
92 ioToST :: IO a -> ST RealWorld a
93 ioToST (IO m) = (ST m)
95 -- ---------------------------------------------------------------------------
96 -- Unsafe IO operations
98 {-# NOINLINE unsafePerformIO #-}
99 unsafePerformIO :: IO a -> a
100 unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
102 {-# NOINLINE unsafeInterleaveIO #-}
103 unsafeInterleaveIO :: IO a -> IO a
104 unsafeInterleaveIO (IO m)
106 r = case m s of (# _, res #) -> res
110 -- ---------------------------------------------------------------------------
113 data MVar a = MVar (MVar# RealWorld a)
115 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
116 instance Eq (MVar a) where
117 (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
119 -- A Handle is represented by (a reference to) a record
120 -- containing the state of the I/O port/device. We record
121 -- the following pieces of info:
123 -- * type (read,write,closed etc.)
124 -- * the underlying file descriptor
126 -- * buffer, and spare buffers
127 -- * user-friendly name (usually the
128 -- FilePath used when IO.openFile was called)
130 -- Note: when a Handle is garbage collected, we want to flush its buffer
131 -- and close the OS file handle, so as to free up a (precious) resource.
134 = FileHandle -- A normal handle to a file
137 | DuplexHandle -- A handle to a read/write stream
138 !(MVar Handle__) -- The read side
139 !(MVar Handle__) -- The write side
142 -- * A 'FileHandle' is seekable. A 'DuplexHandle' may or may not be
145 instance Eq Handle where
146 (FileHandle h1) == (FileHandle h2) = h1 == h2
147 (DuplexHandle h1 _) == (DuplexHandle h2 _) = h1 == h2
150 type FD = Int -- XXX ToDo: should be CInt
155 haType :: HandleType,
156 haBufferMode :: BufferMode,
157 haFilePath :: FilePath,
158 haBuffer :: !(IORef Buffer),
159 haBuffers :: !(IORef BufferList)
162 -- ---------------------------------------------------------------------------
165 -- The buffer is represented by a mutable variable containing a
166 -- record, where the record contains the raw buffer and the start/end
167 -- points of the filled portion. We use a mutable variable so that
168 -- the common operation of writing (or reading) some data from (to)
169 -- the buffer doesn't need to modify, and hence copy, the handle
170 -- itself, it just updates the buffer.
172 -- There will be some allocation involved in a simple hPutChar in
173 -- order to create the new Buffer structure (below), but this is
174 -- relatively small, and this only has to be done once per write
177 -- The buffer contains its size - we could also get the size by
178 -- calling sizeOfMutableByteArray# on the raw buffer, but that tends
179 -- to be rounded up to the nearest Word.
181 type RawBuffer = MutableByteArray# RealWorld
183 -- INVARIANTS on a Buffer:
185 -- * A handle *always* has a buffer, even if it is only 1 character long
186 -- (an unbuffered handle needs a 1 character buffer in order to support
187 -- hLookAhead and hIsEOF).
189 -- * if r == w, then r == 0 && w == 0
190 -- * if state == WriteBuffer, then r == 0
191 -- * a write buffer is never full. If an operation
192 -- fills up the buffer, it will always flush it before
194 -- * a read buffer may be full as a result of hLookAhead. In normal
195 -- operation, a read buffer always has at least one character of space.
203 bufState :: BufferState
206 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
208 -- we keep a few spare buffers around in a handle to avoid allocating
209 -- a new one for each hPutStr. These buffers are *guaranteed* to be the
210 -- same size as the main buffer.
213 | BufferListCons RawBuffer BufferList
216 bufferIsWritable :: Buffer -> Bool
217 bufferIsWritable Buffer{ bufState=WriteBuffer } = True
218 bufferIsWritable _other = False
220 bufferEmpty :: Buffer -> Bool
221 bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w
222 bufferEmpty _other = False
224 -- only makes sense for a write buffer
225 bufferFull :: Buffer -> Bool
226 bufferFull b@Buffer{ bufWPtr=w } = w >= bufSize b
228 -- Internally, we classify handles as being one
238 | ReadSideHandle !(MVar Handle__) -- read side of a duplex handle
240 -- File names are specified using @FilePath@, a OS-dependent
241 -- string that (hopefully, I guess) maps to an accessible file/object.
243 type FilePath = String
245 -- ---------------------------------------------------------------------------
248 -- Three kinds of buffering are supported: line-buffering,
249 -- block-buffering or no-buffering. These modes have the following
250 -- effects. For output, items are written out from the internal
251 -- buffer according to the buffer mode:
253 -- * line-buffering the entire output buffer is written
254 -- out whenever a newline is output, the output buffer overflows,
255 -- a flush is issued, or the handle is closed.
257 -- * block-buffering the entire output buffer is written out whenever
258 -- it overflows, a flush is issued, or the handle
261 -- * no-buffering output is written immediately, and never stored
262 -- in the output buffer.
264 -- The output buffer is emptied as soon as it has been written out.
266 -- Similarly, input occurs according to the buffer mode for handle {\em hdl}.
268 -- * line-buffering when the input buffer for the handle is not empty,
269 -- the next item is obtained from the buffer;
270 -- otherwise, when the input buffer is empty,
271 -- characters up to and including the next newline
272 -- character are read into the buffer. No characters
273 -- are available until the newline character is
276 -- * block-buffering when the input buffer for the handle becomes empty,
277 -- the next block of data is read into this buffer.
279 -- * no-buffering the next input item is read and returned.
281 -- For most implementations, physical files will normally be block-buffered
282 -- and terminals will normally be line-buffered. (the IO interface provides
283 -- operations for changing the default buffering of a handle tho.)
286 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
287 deriving (Eq, Ord, Show, Read)
289 -- ---------------------------------------------------------------------------
292 newtype IORef a = IORef (STRef RealWorld a) deriving Eq
294 newIORef :: a -> IO (IORef a)
295 newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
297 readIORef :: IORef a -> IO a
298 readIORef (IORef var) = stToIO (readSTRef var)
300 writeIORef :: IORef a -> a -> IO ()
301 writeIORef (IORef var) v = stToIO (writeSTRef var v)
303 modifyIORef :: IORef a -> (a -> a) -> IO ()
304 modifyIORef ref f = readIORef ref >>= \x -> writeIORef ref (f x)
306 -- deprecated, use modifyIORef
307 updateIORef :: IORef a -> (a -> a) -> IO ()
308 updateIORef = modifyIORef
310 -- ---------------------------------------------------------------------------
311 -- Show instance for Handles
313 -- handle types are 'show'n when printing error msgs, so
314 -- we provide a more user-friendly Show instance for it
315 -- than the derived one.
317 instance Show HandleType where
320 ClosedHandle -> showString "closed"
321 SemiClosedHandle -> showString "semi-closed"
322 ReadHandle -> showString "readable"
323 WriteHandle -> showString "writable"
324 AppendHandle -> showString "writable (append)"
325 ReadWriteHandle -> showString "read-writable"
326 ReadSideHandle _ -> showString "read-writable (duplex)"
328 instance Show Handle where
329 showsPrec p (FileHandle h) = showHandle p h
330 showsPrec p (DuplexHandle h _) = showHandle p h
334 -- (Big) SIGH: unfolded defn of takeMVar to avoid
335 -- an (oh-so) unfortunate module loop with PrelConc.
336 hdl_ = unsafePerformIO (IO $ \ s# ->
337 case h of { MVar h# ->
338 case takeMVar# h# s# of { (# s2# , r #) ->
339 case putMVar# h# r s2# of { s3# ->
343 showHdl (haType hdl_)
344 (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
345 showString "type=" . showsPrec p (haType hdl_) . showChar ',' .
346 showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
348 showHdl :: HandleType -> ShowS -> ShowS
351 ClosedHandle -> showsPrec p ht . showString "}"
354 showBufMode :: Buffer -> BufferMode -> ShowS
355 showBufMode buf bmo =
357 NoBuffering -> showString "none"
358 LineBuffering -> showString "line"
359 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
360 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
365 -- ------------------------------------------------------------------------
366 -- Exception datatype and operations
369 = IOException IOException -- IO exceptions
370 | ArithException ArithException -- Arithmetic exceptions
371 | ArrayException ArrayException -- Array-related exceptions
372 | ErrorCall String -- Calls to 'error'
373 | ExitException ExitCode -- Call to System.exitWith
374 | NoMethodError String -- A non-existent method was invoked
375 | PatternMatchFail String -- A pattern match / guard failure
376 | RecSelError String -- Selecting a non-existent field
377 | RecConError String -- Field missing in record construction
378 | RecUpdError String -- Record doesn't contain updated field
379 | AssertionFailed String -- Assertions
380 | DynException Dynamic -- Dynamic exceptions
381 | AsyncException AsyncException -- Externally generated errors
382 | BlockedOnDeadMVar -- Blocking on a dead MVar
401 = IndexOutOfBounds String -- out-of-range array access
402 | UndefinedElement String -- evaluating an undefined element
405 stackOverflow, heapOverflow :: Exception -- for the RTS
406 stackOverflow = AsyncException StackOverflow
407 heapOverflow = AsyncException HeapOverflow
409 instance Show ArithException where
410 showsPrec _ Overflow = showString "arithmetic overflow"
411 showsPrec _ Underflow = showString "arithmetic underflow"
412 showsPrec _ LossOfPrecision = showString "loss of precision"
413 showsPrec _ DivideByZero = showString "divide by zero"
414 showsPrec _ Denormal = showString "denormal"
416 instance Show AsyncException where
417 showsPrec _ StackOverflow = showString "stack overflow"
418 showsPrec _ HeapOverflow = showString "heap overflow"
419 showsPrec _ ThreadKilled = showString "thread killed"
421 instance Show ArrayException where
422 showsPrec _ (IndexOutOfBounds s)
423 = showString "array index out of range"
424 . (if not (null s) then showString ": " . showString s
426 showsPrec _ (UndefinedElement s)
427 = showString "undefined array element"
428 . (if not (null s) then showString ": " . showString s
431 instance Show Exception where
432 showsPrec _ (IOException err) = shows err
433 showsPrec _ (ArithException err) = shows err
434 showsPrec _ (ArrayException err) = shows err
435 showsPrec _ (ErrorCall err) = showString err
436 showsPrec _ (ExitException err) = showString "exit: " . shows err
437 showsPrec _ (NoMethodError err) = showString err
438 showsPrec _ (PatternMatchFail err) = showString err
439 showsPrec _ (RecSelError err) = showString err
440 showsPrec _ (RecConError err) = showString err
441 showsPrec _ (RecUpdError err) = showString err
442 showsPrec _ (AssertionFailed err) = showString err
443 showsPrec _ (DynException _err) = showString "unknown exception"
444 showsPrec _ (AsyncException e) = shows e
445 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
446 showsPrec _ (NonTermination) = showString "<<loop>>"
447 showsPrec _ (UserError err) = showString err
449 -- -----------------------------------------------------------------------------
452 -- The `ExitCode' type defines the exit codes that a program
453 -- can return. `ExitSuccess' indicates successful termination;
454 -- and `ExitFailure code' indicates program failure
455 -- with value `code'. The exact interpretation of `code'
456 -- is operating-system dependent. In particular, some values of
457 -- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
459 -- We need it here because it is used in ExitException in the
460 -- Exception datatype (above).
462 data ExitCode = ExitSuccess | ExitFailure Int
463 deriving (Eq, Ord, Read, Show)
465 -- --------------------------------------------------------------------------
468 throw :: Exception -> a
469 throw exception = raise# exception
471 ioError :: Exception -> IO a
472 ioError err = IO $ \s -> throw err s
474 ioException :: IOException -> IO a
475 ioException err = IO $ \s -> throw (IOException err) s
477 -- ---------------------------------------------------------------------------
480 -- A value @IOError@ encode errors occurred in the @IO@ monad.
481 -- An @IOError@ records a more specific error type, a descriptive
482 -- string and maybe the handle that was used when the error was
485 type IOError = Exception
489 (Maybe Handle) -- the handle used by the action flagging the
491 IOErrorType -- what it was.
493 String -- error type specific information.
494 (Maybe FilePath) -- filename the error is related to.
496 instance Eq IOException where
497 (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
498 e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
501 = AlreadyExists | HardwareFault
502 | IllegalOperation | InappropriateType
503 | Interrupted | InvalidArgument
504 | NoSuchThing | OtherError
505 | PermissionDenied | ProtocolError
506 | ResourceBusy | ResourceExhausted
507 | ResourceVanished | SystemError
508 | TimeExpired | UnsatisfiedConstraints
509 | UnsupportedOperation
511 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
512 | ComError Int -- HRESULT
516 instance Show IOErrorType where
520 AlreadyExists -> "already exists"
521 HardwareFault -> "hardware fault"
522 IllegalOperation -> "illegal operation"
523 InappropriateType -> "inappropriate type"
524 Interrupted -> "interrupted"
525 InvalidArgument -> "invalid argument"
526 NoSuchThing -> "does not exist"
527 OtherError -> "failed"
528 PermissionDenied -> "permission denied"
529 ProtocolError -> "protocol error"
530 ResourceBusy -> "resource busy"
531 ResourceExhausted -> "resource exhausted"
532 ResourceVanished -> "resource vanished"
533 SystemError -> "system error"
534 TimeExpired -> "timeout"
535 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
536 UnsupportedOperation -> "unsupported operation"
538 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
539 ComError _ -> "COM error"
544 userError :: String -> IOError
545 userError str = UserError str
547 -- ---------------------------------------------------------------------------
548 -- Predicates on IOError
550 isAlreadyExistsError :: IOError -> Bool
551 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
552 isAlreadyExistsError _ = False
554 isAlreadyInUseError :: IOError -> Bool
555 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
556 isAlreadyInUseError _ = False
558 isFullError :: IOError -> Bool
559 isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
560 isFullError _ = False
562 isEOFError :: IOError -> Bool
563 isEOFError (IOException (IOError _ EOF _ _ _)) = True
566 isIllegalOperation :: IOError -> Bool
567 isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
568 isIllegalOperation _ = False
570 isPermissionError :: IOError -> Bool
571 isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
572 isPermissionError _ = False
574 isDoesNotExistError :: IOError -> Bool
575 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
576 isDoesNotExistError _ = False
578 isUserError :: IOError -> Bool
579 isUserError (UserError _) = True
580 isUserError _ = False
582 -- ---------------------------------------------------------------------------
585 instance Show IOException where
586 showsPrec p (IOError hdl iot loc s fn) =
590 _ -> showString "\nAction: " . showString loc) .
593 Just h -> showString "\nHandle: " . showsPrec p h) .
596 _ -> showString "\nReason: " . showString s) .
599 Just name -> showString "\nFile: " . showString name)