1 % ------------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.41 2001/05/31 10:03:35 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
19 import PrelNum -- To get fromInteger etc, needed because of -fno-implicit-prelude
20 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
223 -- only makes sense for a write buffer
224 bufferFull :: Buffer -> Bool
225 bufferFull b@Buffer{ bufWPtr=w } = w >= bufSize b
227 -- Internally, we classify handles as being one
237 | ReadSideHandle !(MVar Handle__) -- read side of a duplex handle
239 isReadableHandleType ReadHandle = True
240 isReadableHandleType ReadWriteHandle = True
241 isReadableHandleType (ReadSideHandle _) = True
242 isReadableHandleType _ = False
244 isWritableHandleType AppendHandle = True
245 isWritableHandleType WriteHandle = True
246 isWritableHandleType ReadWriteHandle = True
247 isWritableHandleType _ = False
249 -- File names are specified using @FilePath@, a OS-dependent
250 -- string that (hopefully, I guess) maps to an accessible file/object.
252 type FilePath = String
254 -- ---------------------------------------------------------------------------
257 -- Three kinds of buffering are supported: line-buffering,
258 -- block-buffering or no-buffering. These modes have the following
259 -- effects. For output, items are written out from the internal
260 -- buffer according to the buffer mode:
262 -- * line-buffering the entire output buffer is written
263 -- out whenever a newline is output, the output buffer overflows,
264 -- a flush is issued, or the handle is closed.
266 -- * block-buffering the entire output buffer is written out whenever
267 -- it overflows, a flush is issued, or the handle
270 -- * no-buffering output is written immediately, and never stored
271 -- in the output buffer.
273 -- The output buffer is emptied as soon as it has been written out.
275 -- Similarly, input occurs according to the buffer mode for handle {\em hdl}.
277 -- * line-buffering when the input buffer for the handle is not empty,
278 -- the next item is obtained from the buffer;
279 -- otherwise, when the input buffer is empty,
280 -- characters up to and including the next newline
281 -- character are read into the buffer. No characters
282 -- are available until the newline character is
285 -- * block-buffering when the input buffer for the handle becomes empty,
286 -- the next block of data is read into this buffer.
288 -- * no-buffering the next input item is read and returned.
290 -- For most implementations, physical files will normally be block-buffered
291 -- and terminals will normally be line-buffered. (the IO interface provides
292 -- operations for changing the default buffering of a handle tho.)
295 = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
296 deriving (Eq, Ord, Read, Show)
298 -- ---------------------------------------------------------------------------
301 newtype IORef a = IORef (STRef RealWorld a) deriving Eq
303 newIORef :: a -> IO (IORef a)
304 newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
306 readIORef :: IORef a -> IO a
307 readIORef (IORef var) = stToIO (readSTRef var)
309 writeIORef :: IORef a -> a -> IO ()
310 writeIORef (IORef var) v = stToIO (writeSTRef var v)
312 modifyIORef :: IORef a -> (a -> a) -> IO ()
313 modifyIORef ref f = readIORef ref >>= \x -> writeIORef ref (f x)
315 -- deprecated, use modifyIORef
316 updateIORef :: IORef a -> (a -> a) -> IO ()
317 updateIORef = modifyIORef
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"
335 ReadSideHandle _ -> showString "read-writable (duplex)"
337 instance Show Handle where
338 showsPrec p (FileHandle h) = showHandle p h
339 showsPrec p (DuplexHandle h _) = showHandle p h
343 -- (Big) SIGH: unfolded defn of takeMVar to avoid
344 -- an (oh-so) unfortunate module loop with PrelConc.
345 hdl_ = unsafePerformIO (IO $ \ s# ->
346 case h of { MVar h# ->
347 case takeMVar# h# s# of { (# s2# , r #) ->
348 case putMVar# h# r s2# of { s3# ->
352 showHdl (haType hdl_)
353 (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
354 showString "type=" . showsPrec p (haType hdl_) . showChar ',' .
355 showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
357 showHdl :: HandleType -> ShowS -> ShowS
360 ClosedHandle -> showsPrec p ht . showString "}"
363 showBufMode :: Buffer -> BufferMode -> ShowS
364 showBufMode buf bmo =
366 NoBuffering -> showString "none"
367 LineBuffering -> showString "line"
368 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
369 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
374 -- ------------------------------------------------------------------------
375 -- Exception datatype and operations
378 = IOException IOException -- IO exceptions
379 | ArithException ArithException -- Arithmetic exceptions
380 | ArrayException ArrayException -- Array-related exceptions
381 | ErrorCall String -- Calls to 'error'
382 | ExitException ExitCode -- Call to System.exitWith
383 | NoMethodError String -- A non-existent method was invoked
384 | PatternMatchFail String -- A pattern match / guard failure
385 | RecSelError String -- Selecting a non-existent field
386 | RecConError String -- Field missing in record construction
387 | RecUpdError String -- Record doesn't contain updated field
388 | AssertionFailed String -- Assertions
389 | DynException Dynamic -- Dynamic exceptions
390 | AsyncException AsyncException -- Externally generated errors
391 | BlockedOnDeadMVar -- Blocking on a dead MVar
410 = IndexOutOfBounds String -- out-of-range array access
411 | UndefinedElement String -- evaluating an undefined element
414 stackOverflow, heapOverflow :: Exception -- for the RTS
415 stackOverflow = AsyncException StackOverflow
416 heapOverflow = AsyncException HeapOverflow
418 instance Show ArithException where
419 showsPrec _ Overflow = showString "arithmetic overflow"
420 showsPrec _ Underflow = showString "arithmetic underflow"
421 showsPrec _ LossOfPrecision = showString "loss of precision"
422 showsPrec _ DivideByZero = showString "divide by zero"
423 showsPrec _ Denormal = showString "denormal"
425 instance Show AsyncException where
426 showsPrec _ StackOverflow = showString "stack overflow"
427 showsPrec _ HeapOverflow = showString "heap overflow"
428 showsPrec _ ThreadKilled = showString "thread killed"
430 instance Show ArrayException where
431 showsPrec _ (IndexOutOfBounds s)
432 = showString "array index out of range"
433 . (if not (null s) then showString ": " . showString s
435 showsPrec _ (UndefinedElement s)
436 = showString "undefined array element"
437 . (if not (null s) then showString ": " . showString s
440 instance Show Exception where
441 showsPrec _ (IOException err) = shows err
442 showsPrec _ (ArithException err) = shows err
443 showsPrec _ (ArrayException err) = shows err
444 showsPrec _ (ErrorCall err) = showString err
445 showsPrec _ (ExitException err) = showString "exit: " . shows err
446 showsPrec _ (NoMethodError err) = showString err
447 showsPrec _ (PatternMatchFail err) = showString err
448 showsPrec _ (RecSelError err) = showString err
449 showsPrec _ (RecConError err) = showString err
450 showsPrec _ (RecUpdError err) = showString err
451 showsPrec _ (AssertionFailed err) = showString err
452 showsPrec _ (DynException _err) = showString "unknown exception"
453 showsPrec _ (AsyncException e) = shows e
454 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
455 showsPrec _ (NonTermination) = showString "<<loop>>"
456 showsPrec _ (UserError err) = showString err
458 -- -----------------------------------------------------------------------------
461 -- The `ExitCode' type defines the exit codes that a program
462 -- can return. `ExitSuccess' indicates successful termination;
463 -- and `ExitFailure code' indicates program failure
464 -- with value `code'. The exact interpretation of `code'
465 -- is operating-system dependent. In particular, some values of
466 -- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
468 -- We need it here because it is used in ExitException in the
469 -- Exception datatype (above).
471 data ExitCode = ExitSuccess | ExitFailure Int
472 deriving (Eq, Ord, Read, Show)
474 -- --------------------------------------------------------------------------
477 throw :: Exception -> a
478 throw exception = raise# exception
480 ioError :: Exception -> IO a
481 ioError err = IO $ \s -> throw err s
483 ioException :: IOException -> IO a
484 ioException err = IO $ \s -> throw (IOException err) s
486 -- ---------------------------------------------------------------------------
489 -- A value @IOError@ encode errors occurred in the @IO@ monad.
490 -- An @IOError@ records a more specific error type, a descriptive
491 -- string and maybe the handle that was used when the error was
494 type IOError = Exception
498 (Maybe Handle) -- the handle used by the action flagging the
500 IOErrorType -- what it was.
502 String -- error type specific information.
503 (Maybe FilePath) -- filename the error is related to.
505 instance Eq IOException where
506 (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
507 e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
510 = AlreadyExists | HardwareFault
511 | IllegalOperation | InappropriateType
512 | Interrupted | InvalidArgument
513 | NoSuchThing | OtherError
514 | PermissionDenied | ProtocolError
515 | ResourceBusy | ResourceExhausted
516 | ResourceVanished | SystemError
517 | TimeExpired | UnsatisfiedConstraints
518 | UnsupportedOperation
520 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
521 | ComError Int -- HRESULT
525 instance Show IOErrorType where
529 AlreadyExists -> "already exists"
530 HardwareFault -> "hardware fault"
531 IllegalOperation -> "illegal operation"
532 InappropriateType -> "inappropriate type"
533 Interrupted -> "interrupted"
534 InvalidArgument -> "invalid argument"
535 NoSuchThing -> "does not exist"
536 OtherError -> "failed"
537 PermissionDenied -> "permission denied"
538 ProtocolError -> "protocol error"
539 ResourceBusy -> "resource busy"
540 ResourceExhausted -> "resource exhausted"
541 ResourceVanished -> "resource vanished"
542 SystemError -> "system error"
543 TimeExpired -> "timeout"
544 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
545 UnsupportedOperation -> "unsupported operation"
547 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
548 ComError _ -> "COM error"
553 userError :: String -> IOError
554 userError str = UserError str
556 -- ---------------------------------------------------------------------------
557 -- Predicates on IOError
559 isAlreadyExistsError :: IOError -> Bool
560 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
561 isAlreadyExistsError _ = False
563 isAlreadyInUseError :: IOError -> Bool
564 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
565 isAlreadyInUseError _ = False
567 isFullError :: IOError -> Bool
568 isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
569 isFullError _ = False
571 isEOFError :: IOError -> Bool
572 isEOFError (IOException (IOError _ EOF _ _ _)) = True
575 isIllegalOperation :: IOError -> Bool
576 isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
577 isIllegalOperation _ = False
579 isPermissionError :: IOError -> Bool
580 isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
581 isPermissionError _ = False
583 isDoesNotExistError :: IOError -> Bool
584 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
585 isDoesNotExistError _ = False
587 isUserError :: IOError -> Bool
588 isUserError (UserError _) = True
589 isUserError _ = False
591 -- ---------------------------------------------------------------------------
594 instance Show IOException where
595 showsPrec p (IOError hdl iot loc s fn) =
599 _ -> showString "\nAction: " . showString loc) .
602 Just h -> showString "\nHandle: " . showsPrec p h) .
605 _ -> showString "\nReason: " . showString s) .
608 Just name -> showString "\nFile: " . showString name)