1 % ------------------------------------------------------------------------------
2 % $Id: PrelIOBase.lhs,v 1.42 2001/06/01 13:06:01 sewardj 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,
157 haBufferMode :: BufferMode,
158 haFilePath :: FilePath,
159 haBuffer :: !(IORef Buffer),
160 haBuffers :: !(IORef BufferList)
163 -- ---------------------------------------------------------------------------
166 -- The buffer is represented by a mutable variable containing a
167 -- record, where the record contains the raw buffer and the start/end
168 -- points of the filled portion. We use a mutable variable so that
169 -- the common operation of writing (or reading) some data from (to)
170 -- the buffer doesn't need to modify, and hence copy, the handle
171 -- itself, it just updates the buffer.
173 -- There will be some allocation involved in a simple hPutChar in
174 -- order to create the new Buffer structure (below), but this is
175 -- relatively small, and this only has to be done once per write
178 -- The buffer contains its size - we could also get the size by
179 -- calling sizeOfMutableByteArray# on the raw buffer, but that tends
180 -- to be rounded up to the nearest Word.
182 type RawBuffer = MutableByteArray# RealWorld
184 -- INVARIANTS on a Buffer:
186 -- * A handle *always* has a buffer, even if it is only 1 character long
187 -- (an unbuffered handle needs a 1 character buffer in order to support
188 -- hLookAhead and hIsEOF).
190 -- * if r == w, then r == 0 && w == 0
191 -- * if state == WriteBuffer, then r == 0
192 -- * a write buffer is never full. If an operation
193 -- fills up the buffer, it will always flush it before
195 -- * a read buffer may be full as a result of hLookAhead. In normal
196 -- operation, a read buffer always has at least one character of space.
204 bufState :: BufferState
207 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
209 -- we keep a few spare buffers around in a handle to avoid allocating
210 -- a new one for each hPutStr. These buffers are *guaranteed* to be the
211 -- same size as the main buffer.
214 | BufferListCons RawBuffer BufferList
217 bufferIsWritable :: Buffer -> Bool
218 bufferIsWritable Buffer{ bufState=WriteBuffer } = True
219 bufferIsWritable _other = False
221 bufferEmpty :: Buffer -> Bool
222 bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w
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 isReadableHandleType ReadHandle = True
241 isReadableHandleType ReadWriteHandle = True
242 isReadableHandleType (ReadSideHandle _) = 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 modifyIORef :: IORef a -> (a -> a) -> IO ()
314 modifyIORef ref f = readIORef ref >>= \x -> writeIORef ref (f x)
316 -- deprecated, use modifyIORef
317 updateIORef :: IORef a -> (a -> a) -> IO ()
318 updateIORef = modifyIORef
320 -- ---------------------------------------------------------------------------
321 -- Show instance for Handles
323 -- handle types are 'show'n when printing error msgs, so
324 -- we provide a more user-friendly Show instance for it
325 -- than the derived one.
327 instance Show HandleType where
330 ClosedHandle -> showString "closed"
331 SemiClosedHandle -> showString "semi-closed"
332 ReadHandle -> showString "readable"
333 WriteHandle -> showString "writable"
334 AppendHandle -> showString "writable (append)"
335 ReadWriteHandle -> showString "read-writable"
336 ReadSideHandle _ -> showString "read-writable (duplex)"
338 instance Show Handle where
339 showsPrec p (FileHandle h) = showHandle p h
340 showsPrec p (DuplexHandle h _) = showHandle p h
344 -- (Big) SIGH: unfolded defn of takeMVar to avoid
345 -- an (oh-so) unfortunate module loop with PrelConc.
346 hdl_ = unsafePerformIO (IO $ \ s# ->
347 case h of { MVar h# ->
348 case takeMVar# h# s# of { (# s2# , r #) ->
349 case putMVar# h# r s2# of { s3# ->
353 showHdl (haType hdl_)
354 (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
355 showString "type=" . showsPrec p (haType hdl_) . showChar ',' .
356 showString "binary=" . showsPrec p (haIsBin hdl_) . showChar ',' .
357 showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
359 showHdl :: HandleType -> ShowS -> ShowS
362 ClosedHandle -> showsPrec p ht . showString "}"
365 showBufMode :: Buffer -> BufferMode -> ShowS
366 showBufMode buf bmo =
368 NoBuffering -> showString "none"
369 LineBuffering -> showString "line"
370 BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
371 BlockBuffering Nothing -> showString "block " . showParen True (showsPrec p def)
376 -- ------------------------------------------------------------------------
377 -- Exception datatype and operations
380 = IOException IOException -- IO exceptions
381 | ArithException ArithException -- Arithmetic exceptions
382 | ArrayException ArrayException -- Array-related exceptions
383 | ErrorCall String -- Calls to 'error'
384 | ExitException ExitCode -- Call to System.exitWith
385 | NoMethodError String -- A non-existent method was invoked
386 | PatternMatchFail String -- A pattern match / guard failure
387 | RecSelError String -- Selecting a non-existent field
388 | RecConError String -- Field missing in record construction
389 | RecUpdError String -- Record doesn't contain updated field
390 | AssertionFailed String -- Assertions
391 | DynException Dynamic -- Dynamic exceptions
392 | AsyncException AsyncException -- Externally generated errors
393 | BlockedOnDeadMVar -- Blocking on a dead MVar
412 = IndexOutOfBounds String -- out-of-range array access
413 | UndefinedElement String -- evaluating an undefined element
416 stackOverflow, heapOverflow :: Exception -- for the RTS
417 stackOverflow = AsyncException StackOverflow
418 heapOverflow = AsyncException HeapOverflow
420 instance Show ArithException where
421 showsPrec _ Overflow = showString "arithmetic overflow"
422 showsPrec _ Underflow = showString "arithmetic underflow"
423 showsPrec _ LossOfPrecision = showString "loss of precision"
424 showsPrec _ DivideByZero = showString "divide by zero"
425 showsPrec _ Denormal = showString "denormal"
427 instance Show AsyncException where
428 showsPrec _ StackOverflow = showString "stack overflow"
429 showsPrec _ HeapOverflow = showString "heap overflow"
430 showsPrec _ ThreadKilled = showString "thread killed"
432 instance Show ArrayException where
433 showsPrec _ (IndexOutOfBounds s)
434 = showString "array index out of range"
435 . (if not (null s) then showString ": " . showString s
437 showsPrec _ (UndefinedElement s)
438 = showString "undefined array element"
439 . (if not (null s) then showString ": " . showString s
442 instance Show Exception where
443 showsPrec _ (IOException err) = shows err
444 showsPrec _ (ArithException err) = shows err
445 showsPrec _ (ArrayException err) = shows err
446 showsPrec _ (ErrorCall err) = showString err
447 showsPrec _ (ExitException err) = showString "exit: " . shows err
448 showsPrec _ (NoMethodError err) = showString err
449 showsPrec _ (PatternMatchFail err) = showString err
450 showsPrec _ (RecSelError err) = showString err
451 showsPrec _ (RecConError err) = showString err
452 showsPrec _ (RecUpdError err) = showString err
453 showsPrec _ (AssertionFailed err) = showString err
454 showsPrec _ (DynException _err) = showString "unknown exception"
455 showsPrec _ (AsyncException e) = shows e
456 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
457 showsPrec _ (NonTermination) = showString "<<loop>>"
458 showsPrec _ (UserError err) = showString err
460 -- -----------------------------------------------------------------------------
463 -- The `ExitCode' type defines the exit codes that a program
464 -- can return. `ExitSuccess' indicates successful termination;
465 -- and `ExitFailure code' indicates program failure
466 -- with value `code'. The exact interpretation of `code'
467 -- is operating-system dependent. In particular, some values of
468 -- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
470 -- We need it here because it is used in ExitException in the
471 -- Exception datatype (above).
473 data ExitCode = ExitSuccess | ExitFailure Int
474 deriving (Eq, Ord, Read, Show)
476 -- --------------------------------------------------------------------------
479 throw :: Exception -> a
480 throw exception = raise# exception
482 ioError :: Exception -> IO a
483 ioError err = IO $ \s -> throw err s
485 ioException :: IOException -> IO a
486 ioException err = IO $ \s -> throw (IOException err) s
488 -- ---------------------------------------------------------------------------
491 -- A value @IOError@ encode errors occurred in the @IO@ monad.
492 -- An @IOError@ records a more specific error type, a descriptive
493 -- string and maybe the handle that was used when the error was
496 type IOError = Exception
500 (Maybe Handle) -- the handle used by the action flagging the
502 IOErrorType -- what it was.
504 String -- error type specific information.
505 (Maybe FilePath) -- filename the error is related to.
507 instance Eq IOException where
508 (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
509 e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
512 = AlreadyExists | HardwareFault
513 | IllegalOperation | InappropriateType
514 | Interrupted | InvalidArgument
515 | NoSuchThing | OtherError
516 | PermissionDenied | ProtocolError
517 | ResourceBusy | ResourceExhausted
518 | ResourceVanished | SystemError
519 | TimeExpired | UnsatisfiedConstraints
520 | UnsupportedOperation
522 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
523 | ComError Int -- HRESULT
527 instance Show IOErrorType where
531 AlreadyExists -> "already exists"
532 HardwareFault -> "hardware fault"
533 IllegalOperation -> "illegal operation"
534 InappropriateType -> "inappropriate type"
535 Interrupted -> "interrupted"
536 InvalidArgument -> "invalid argument"
537 NoSuchThing -> "does not exist"
538 OtherError -> "failed"
539 PermissionDenied -> "permission denied"
540 ProtocolError -> "protocol error"
541 ResourceBusy -> "resource busy"
542 ResourceExhausted -> "resource exhausted"
543 ResourceVanished -> "resource vanished"
544 SystemError -> "system error"
545 TimeExpired -> "timeout"
546 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
547 UnsupportedOperation -> "unsupported operation"
549 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
550 ComError _ -> "COM error"
555 userError :: String -> IOError
556 userError str = UserError str
558 -- ---------------------------------------------------------------------------
559 -- Predicates on IOError
561 isAlreadyExistsError :: IOError -> Bool
562 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
563 isAlreadyExistsError _ = False
565 isAlreadyInUseError :: IOError -> Bool
566 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
567 isAlreadyInUseError _ = False
569 isFullError :: IOError -> Bool
570 isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
571 isFullError _ = False
573 isEOFError :: IOError -> Bool
574 isEOFError (IOException (IOError _ EOF _ _ _)) = True
577 isIllegalOperation :: IOError -> Bool
578 isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
579 isIllegalOperation _ = False
581 isPermissionError :: IOError -> Bool
582 isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
583 isPermissionError _ = False
585 isDoesNotExistError :: IOError -> Bool
586 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
587 isDoesNotExistError _ = False
589 isUserError :: IOError -> Bool
590 isUserError (UserError _) = True
591 isUserError _ = False
593 -- ---------------------------------------------------------------------------
596 instance Show IOException where
597 showsPrec p (IOError hdl iot loc s fn) =
601 _ -> showString "\nAction: " . showString loc) .
604 Just h -> showString "\nHandle: " . showsPrec p h) .
607 _ -> showString "\nReason: " . showString s) .
610 Just name -> showString "\nFile: " . showString name)