GHC/IOBase.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: IOBase.lhs,v 1.2 2001/07/03 14:13:32 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2001
   5 %
   6
   7 % Definitions for the @IO@ monad and its friends.  Everything is exported
   8 % concretely; the @IO@ module itself exports abstractly.
   9
  10 \begin{code}
  11 {-# OPTIONS -fno-implicit-prelude #-}
  12 #include "config.h"
  13
  14 module GHC.IOBase where
  15
  16 import GHC.ST
  17 import GHC.STRef
  18 import GHC.Arr
  19 import GHC.Base
  20 import GHC.Num  -- To get fromInteger etc, needed because of -fno-implicit-prelude
  21 import Data.Maybe  ( Maybe(..) )
  22 import GHC.Show
  23 import GHC.List
  24 import GHC.Read
  25 import GHC.Dynamic
  26
  27 -- ---------------------------------------------------------------------------
  28 -- The IO Monad
  29
  30 {-
  31 The IO Monad is just an instance of the ST monad, where the state is
  32 the real world.  We use the exception mechanism (in GHC.Exception) to
  33 implement IO exceptions.
  34
  35 NOTE: The IO representation is deeply wired in to various parts of the
  36 system.  The following list may or may not be exhaustive:
  37
  38 Compiler  - types of various primitives in PrimOp.lhs
  39
  40 RTS       - forceIO (StgMiscClosures.hc)
  41           - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
  42             (Exceptions.hc)
  43           - raiseAsync (Schedule.c)
  44
  45 Prelude   - GHC.IOBase.lhs, and several other places including
  46             GHC.Exception.lhs.
  47
  48 Libraries - parts of hslibs/lang.
  49
  50 --SDM
  51 -}
  52
  53 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
  54
  55 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
  56 unIO (IO a) = a
  57
  58 instance  Functor IO where
  59    fmap f x = x >>= (return . f)
  60
  61 instance  Monad IO  where
  62     {-# INLINE return #-}
  63     {-# INLINE (>>)   #-}
  64     {-# INLINE (>>=)  #-}
  65     m >> k      =  m >>= \ _ -> k
  66     return x    = returnIO x
  67
  68     m >>= k     = bindIO m k
  69     fail s      = failIO s
  70
  71 failIO :: String -> IO a
  72 failIO s = ioError (userError s)
  73
  74 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
  75 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
  76
  77 bindIO :: IO a -> (a -> IO b) -> IO b
  78 bindIO (IO m) k = IO ( \ s ->
  79   case m s of
  80     (# new_s, a #) -> unIO (k a) new_s
  81   )
  82
  83 returnIO :: a -> IO a
  84 returnIO x = IO (\ s -> (# s, x #))
  85
  86 -- ---------------------------------------------------------------------------
  87 -- Coercions between IO and ST
  88
  89 --stToIO        :: (forall s. ST s a) -> IO a
  90 stToIO        :: ST RealWorld a -> IO a
  91 stToIO (ST m) = IO m
  92
  93 ioToST        :: IO a -> ST RealWorld a
  94 ioToST (IO m) = (ST m)
  95
  96 -- ---------------------------------------------------------------------------
  97 -- Unsafe IO operations
  98
  99 {-# NOINLINE unsafePerformIO #-}
 100 unsafePerformIO :: IO a -> a
 101 unsafePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
 102
 103 {-# NOINLINE unsafeInterleaveIO #-}
 104 unsafeInterleaveIO :: IO a -> IO a
 105 unsafeInterleaveIO (IO m)
 106   = IO ( \ s -> let
 107                    r = case m s of (# _, res #) -> res
 108                 in
 109                 (# s, r #))
 110
 111 -- ---------------------------------------------------------------------------
 112 -- Handle type
 113
 114 data MVar a = MVar (MVar# RealWorld a)
 115
 116 -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module
 117 instance Eq (MVar a) where
 118         (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
 119
 120 --  A Handle is represented by (a reference to) a record
 121 --  containing the state of the I/O port/device. We record
 122 --  the following pieces of info:
 123
 124 --    * type (read,write,closed etc.)
 125 --    * the underlying file descriptor
 126 --    * buffering mode
 127 --    * buffer, and spare buffers
 128 --    * user-friendly name (usually the
 129 --      FilePath used when IO.openFile was called)
 130
 131 -- Note: when a Handle is garbage collected, we want to flush its buffer
 132 -- and close the OS file handle, so as to free up a (precious) resource.
 133
 134 data Handle
 135   = FileHandle                          -- A normal handle to a file
 136         !(MVar Handle__)
 137
 138   | DuplexHandle                        -- A handle to a read/write stream
 139         !(MVar Handle__)                -- The read side
 140         !(MVar Handle__)                -- The write side
 141
 142 -- NOTES:
 143 --    * A 'FileHandle' is seekable.  A 'DuplexHandle' may or may not be
 144 --      seekable.
 145
 146 instance Eq Handle where
 147  (FileHandle h1)     == (FileHandle h2)     = h1 == h2
 148  (DuplexHandle h1 _) == (DuplexHandle h2 _) = h1 == h2
 149  _ == _ = False
 150
 151 type FD = Int -- XXX ToDo: should be CInt
 152
 153 data Handle__
 154   = Handle__ {
 155       haFD          :: !FD,
 156       haType        :: HandleType,
 157       haIsBin       :: Bool,
 158       haBufferMode  :: BufferMode,
 159       haFilePath    :: FilePath,
 160       haBuffer      :: !(IORef Buffer),
 161       haBuffers     :: !(IORef BufferList)
 162     }
 163
 164 -- ---------------------------------------------------------------------------
 165 -- Buffers
 166
 167 -- The buffer is represented by a mutable variable containing a
 168 -- record, where the record contains the raw buffer and the start/end
 169 -- points of the filled portion.  We use a mutable variable so that
 170 -- the common operation of writing (or reading) some data from (to)
 171 -- the buffer doesn't need to modify, and hence copy, the handle
 172 -- itself, it just updates the buffer.
 173
 174 -- There will be some allocation involved in a simple hPutChar in
 175 -- order to create the new Buffer structure (below), but this is
 176 -- relatively small, and this only has to be done once per write
 177 -- operation.
 178
 179 -- The buffer contains its size - we could also get the size by
 180 -- calling sizeOfMutableByteArray# on the raw buffer, but that tends
 181 -- to be rounded up to the nearest Word.
 182
 183 type RawBuffer = MutableByteArray# RealWorld
 184
 185 -- INVARIANTS on a Buffer:
 186 --
 187 --   * A handle *always* has a buffer, even if it is only 1 character long
 188 --     (an unbuffered handle needs a 1 character buffer in order to support
 189 --      hLookAhead and hIsEOF).
 190 --   * r <= w
 191 --   * if r == w, then r == 0 && w == 0
 192 --   * if state == WriteBuffer, then r == 0
 193 --   * a write buffer is never full.  If an operation
 194 --     fills up the buffer, it will always flush it before
 195 --     returning.
 196 --   * a read buffer may be full as a result of hLookAhead.  In normal
 197 --     operation, a read buffer always has at least one character of space.
 198
 199 data Buffer
 200   = Buffer {
 201         bufBuf   :: RawBuffer,
 202         bufRPtr  :: !Int,
 203         bufWPtr  :: !Int,
 204         bufSize  :: !Int,
 205         bufState :: BufferState
 206   }
 207
 208 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
 209
 210 -- we keep a few spare buffers around in a handle to avoid allocating
 211 -- a new one for each hPutStr.  These buffers are *guaranteed* to be the
 212 -- same size as the main buffer.
 213 data BufferList
 214   = BufferListNil
 215   | BufferListCons RawBuffer BufferList
 216
 217
 218 bufferIsWritable :: Buffer -> Bool
 219 bufferIsWritable Buffer{ bufState=WriteBuffer } = True
 220 bufferIsWritable _other = False
 221
 222 bufferEmpty :: Buffer -> Bool
 223 bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w
 224
 225 -- only makes sense for a write buffer
 226 bufferFull :: Buffer -> Bool
 227 bufferFull b@Buffer{ bufWPtr=w } = w >= bufSize b
 228
 229 --  Internally, we classify handles as being one
 230 --  of the following:
 231
 232 data HandleType
 233  = ClosedHandle
 234  | SemiClosedHandle
 235  | ReadHandle
 236  | WriteHandle
 237  | AppendHandle
 238  | ReadWriteHandle
 239  | ReadSideHandle  !(MVar Handle__)     -- read side of a duplex handle
 240
 241 isReadableHandleType ReadHandle         = True
 242 isReadableHandleType ReadWriteHandle    = True
 243 isReadableHandleType (ReadSideHandle _) = True
 244 isReadableHandleType _                  = False
 245
 246 isWritableHandleType AppendHandle    = True
 247 isWritableHandleType WriteHandle     = True
 248 isWritableHandleType ReadWriteHandle = True
 249 isWritableHandleType _               = False
 250
 251 -- File names are specified using @FilePath@, a OS-dependent
 252 -- string that (hopefully, I guess) maps to an accessible file/object.
 253
 254 type FilePath = String
 255
 256 -- ---------------------------------------------------------------------------
 257 -- Buffering modes
 258
 259 -- Three kinds of buffering are supported: line-buffering,
 260 -- block-buffering or no-buffering.  These modes have the following
 261 -- effects. For output, items are written out from the internal
 262 -- buffer according to the buffer mode:
 263 --
 264 -- * line-buffering  the entire output buffer is written
 265 --   out whenever a newline is output, the output buffer overflows,
 266 --   a flush is issued, or the handle is closed.
 267 --
 268 -- * block-buffering the entire output buffer is written out whenever
 269 --   it overflows, a flush is issued, or the handle
 270 --   is closed.
 271 --
 272 -- * no-buffering output is written immediately, and never stored
 273 --   in the output buffer.
 274 --
 275 -- The output buffer is emptied as soon as it has been written out.
 276
 277 -- Similarly, input occurs according to the buffer mode for handle {\em hdl}.
 278
 279 -- * line-buffering when the input buffer for the handle is not empty,
 280 --   the next item is obtained from the buffer;
 281 --   otherwise, when the input buffer is empty,
 282 --   characters up to and including the next newline
 283 --   character are read into the buffer.  No characters
 284 --   are available until the newline character is
 285 --   available.
 286 --
 287 -- * block-buffering when the input buffer for the handle becomes empty,
 288 --   the next block of data is read into this buffer.
 289 --
 290 -- * no-buffering the next input item is read and returned.
 291
 292 -- For most implementations, physical files will normally be block-buffered
 293 -- and terminals will normally be line-buffered. (the IO interface provides
 294 -- operations for changing the default buffering of a handle tho.)
 295
 296 data BufferMode
 297  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
 298    deriving (Eq, Ord, Read, Show)
 299
 300 -- ---------------------------------------------------------------------------
 301 -- IORefs
 302
 303 newtype IORef a = IORef (STRef RealWorld a) deriving Eq
 304
 305 newIORef    :: a -> IO (IORef a)
 306 newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
 307
 308 readIORef   :: IORef a -> IO a
 309 readIORef  (IORef var) = stToIO (readSTRef var)
 310
 311 writeIORef  :: IORef a -> a -> IO ()
 312 writeIORef (IORef var) v = stToIO (writeSTRef var v)
 313
 314 -- ---------------------------------------------------------------------------
 315 -- Show instance for Handles
 316
 317 -- handle types are 'show'n when printing error msgs, so
 318 -- we provide a more user-friendly Show instance for it
 319 -- than the derived one.
 320
 321 instance Show HandleType where
 322   showsPrec p t =
 323     case t of
 324       ClosedHandle      -> showString "closed"
 325       SemiClosedHandle  -> showString "semi-closed"
 326       ReadHandle        -> showString "readable"
 327       WriteHandle       -> showString "writable"
 328       AppendHandle      -> showString "writable (append)"
 329       ReadWriteHandle   -> showString "read-writable"
 330       ReadSideHandle _  -> showString "read-writable (duplex)"
 331
 332 instance Show Handle where
 333   showsPrec p (FileHandle   h)   = showHandle p h
 334   showsPrec p (DuplexHandle h _) = showHandle p h
 335
 336 showHandle p h =
 337     let
 338      -- (Big) SIGH: unfolded defn of takeMVar to avoid
 339      -- an (oh-so) unfortunate module loop with GHC.Conc.
 340      hdl_ = unsafePerformIO (IO $ \ s# ->
 341              case h                 of { MVar h# ->
 342              case takeMVar# h# s#   of { (# s2# , r #) ->
 343              case putMVar# h# r s2# of { s3# ->
 344              (# s3#, r #) }}})
 345     in
 346     showChar '{' .
 347     showHdl (haType hdl_)
 348             (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
 349              showString "type=" . showsPrec p (haType hdl_) . showChar ',' .
 350              showString "binary=" . showsPrec p (haIsBin hdl_) . showChar ',' .
 351              showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
 352    where
 353     showHdl :: HandleType -> ShowS -> ShowS
 354     showHdl ht cont =
 355        case ht of
 356         ClosedHandle  -> showsPrec p ht . showString "}"
 357         _ -> cont
 358
 359     showBufMode :: Buffer -> BufferMode -> ShowS
 360     showBufMode buf bmo =
 361       case bmo of
 362         NoBuffering   -> showString "none"
 363         LineBuffering -> showString "line"
 364         BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
 365         BlockBuffering Nothing  -> showString "block " . showParen True (showsPrec p def)
 366       where
 367        def :: Int
 368        def = bufSize buf
 369
 370 -- ------------------------------------------------------------------------
 371 -- Exception datatype and operations
 372
 373 data Exception
 374   = IOException         IOException     -- IO exceptions
 375   | ArithException      ArithException  -- Arithmetic exceptions
 376   | ArrayException      ArrayException  -- Array-related exceptions
 377   | ErrorCall           String          -- Calls to 'error'
 378   | ExitException       ExitCode        -- Call to System.exitWith
 379   | NoMethodError       String          -- A non-existent method was invoked
 380   | PatternMatchFail    String          -- A pattern match / guard failure
 381   | RecSelError         String          -- Selecting a non-existent field
 382   | RecConError         String          -- Field missing in record construction
 383   | RecUpdError         String          -- Record doesn't contain updated field
 384   | AssertionFailed     String          -- Assertions
 385   | DynException        Dynamic         -- Dynamic exceptions
 386   | AsyncException      AsyncException  -- Externally generated errors
 387   | BlockedOnDeadMVar                   -- Blocking on a dead MVar
 388   | NonTermination
 389   | UserError           String
 390
 391 data ArithException
 392   = Overflow
 393   | Underflow
 394   | LossOfPrecision
 395   | DivideByZero
 396   | Denormal
 397   deriving (Eq, Ord)
 398
 399 data AsyncException
 400   = StackOverflow
 401   | HeapOverflow
 402   | ThreadKilled
 403   deriving (Eq, Ord)
 404
 405 data ArrayException
 406   = IndexOutOfBounds    String          -- out-of-range array access
 407   | UndefinedElement    String          -- evaluating an undefined element
 408   deriving (Eq, Ord)
 409
 410 stackOverflow, heapOverflow :: Exception -- for the RTS
 411 stackOverflow = AsyncException StackOverflow
 412 heapOverflow  = AsyncException HeapOverflow
 413
 414 instance Show ArithException where
 415   showsPrec _ Overflow        = showString "arithmetic overflow"
 416   showsPrec _ Underflow       = showString "arithmetic underflow"
 417   showsPrec _ LossOfPrecision = showString "loss of precision"
 418   showsPrec _ DivideByZero    = showString "divide by zero"
 419   showsPrec _ Denormal        = showString "denormal"
 420
 421 instance Show AsyncException where
 422   showsPrec _ StackOverflow   = showString "stack overflow"
 423   showsPrec _ HeapOverflow    = showString "heap overflow"
 424   showsPrec _ ThreadKilled    = showString "thread killed"
 425
 426 instance Show ArrayException where
 427   showsPrec _ (IndexOutOfBounds s)
 428         = showString "array index out of range"
 429         . (if not (null s) then showString ": " . showString s
 430                            else id)
 431   showsPrec _ (UndefinedElement s)
 432         = showString "undefined array element"
 433         . (if not (null s) then showString ": " . showString s
 434                            else id)
 435
 436 instance Show Exception where
 437   showsPrec _ (IOException err)          = shows err
 438   showsPrec _ (ArithException err)       = shows err
 439   showsPrec _ (ArrayException err)       = shows err
 440   showsPrec _ (ErrorCall err)            = showString err
 441   showsPrec _ (ExitException err)        = showString "exit: " . shows err
 442   showsPrec _ (NoMethodError err)        = showString err
 443   showsPrec _ (PatternMatchFail err)     = showString err
 444   showsPrec _ (RecSelError err)          = showString err
 445   showsPrec _ (RecConError err)          = showString err
 446   showsPrec _ (RecUpdError err)          = showString err
 447   showsPrec _ (AssertionFailed err)      = showString err
 448   showsPrec _ (DynException _err)        = showString "unknown exception"
 449   showsPrec _ (AsyncException e)         = shows e
 450   showsPrec _ (BlockedOnDeadMVar)        = showString "thread blocked indefinitely"
 451   showsPrec _ (NonTermination)           = showString "<<loop>>"
 452   showsPrec _ (UserError err)            = showString err
 453
 454 -- -----------------------------------------------------------------------------
 455 -- The ExitCode type
 456
 457 -- The `ExitCode' type defines the exit codes that a program
 458 -- can return.  `ExitSuccess' indicates successful termination;
 459 -- and `ExitFailure code' indicates program failure
 460 -- with value `code'.  The exact interpretation of `code'
 461 -- is operating-system dependent.  In particular, some values of
 462 -- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
 463
 464 -- We need it here because it is used in ExitException in the
 465 -- Exception datatype (above).
 466
 467 data ExitCode = ExitSuccess | ExitFailure Int
 468                 deriving (Eq, Ord, Read, Show)
 469
 470 -- --------------------------------------------------------------------------
 471 -- Primitive throw
 472
 473 throw :: Exception -> a
 474 throw exception = raise# exception
 475
 476 ioError         :: Exception -> IO a
 477 ioError err     =  IO $ \s -> throw err s
 478
 479 ioException     :: IOException -> IO a
 480 ioException err =  IO $ \s -> throw (IOException err) s
 481
 482 -- ---------------------------------------------------------------------------
 483 -- IOError type
 484
 485 -- A value @IOError@ encode errors occurred in the @IO@ monad.
 486 -- An @IOError@ records a more specific error type, a descriptive
 487 -- string and maybe the handle that was used when the error was
 488 -- flagged.
 489
 490 type IOError = Exception
 491
 492 data IOException
 493  = IOError
 494      (Maybe Handle)   -- the handle used by the action flagging the
 495                       --   the error.
 496      IOErrorType      -- what it was.
 497      String           -- location.
 498      String           -- error type specific information.
 499      (Maybe FilePath) -- filename the error is related to.
 500
 501 instance Eq IOException where
 502   (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
 503     e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
 504
 505 data IOErrorType
 506   = AlreadyExists        | HardwareFault
 507   | IllegalOperation     | InappropriateType
 508   | Interrupted          | InvalidArgument
 509   | NoSuchThing          | OtherError
 510   | PermissionDenied     | ProtocolError
 511   | ResourceBusy         | ResourceExhausted
 512   | ResourceVanished     | SystemError
 513   | TimeExpired          | UnsatisfiedConstraints
 514   | UnsupportedOperation
 515   | EOF
 516 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
 517   | ComError Int           -- HRESULT
 518 #endif
 519   deriving (Eq)
 520
 521 instance Show IOErrorType where
 522   showsPrec _ e =
 523     showString $
 524     case e of
 525       AlreadyExists     -> "already exists"
 526       HardwareFault     -> "hardware fault"
 527       IllegalOperation  -> "illegal operation"
 528       InappropriateType -> "inappropriate type"
 529       Interrupted       -> "interrupted"
 530       InvalidArgument   -> "invalid argument"
 531       NoSuchThing       -> "does not exist"
 532       OtherError        -> "failed"
 533       PermissionDenied  -> "permission denied"
 534       ProtocolError     -> "protocol error"
 535       ResourceBusy      -> "resource busy"
 536       ResourceExhausted -> "resource exhausted"
 537       ResourceVanished  -> "resource vanished"
 538       SystemError       -> "system error"
 539       TimeExpired       -> "timeout"
 540       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
 541       UnsupportedOperation -> "unsupported operation"
 542       EOF               -> "end of file"
 543 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
 544       ComError _        -> "COM error"
 545 #endif
 546
 547
 548
 549 userError       :: String  -> IOError
 550 userError str   =  UserError str
 551
 552 -- ---------------------------------------------------------------------------
 553 -- Predicates on IOError
 554
 555 isAlreadyExistsError :: IOError -> Bool
 556 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
 557 isAlreadyExistsError _                                             = False
 558
 559 isAlreadyInUseError :: IOError -> Bool
 560 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
 561 isAlreadyInUseError _                                            = False
 562
 563 isFullError :: IOError -> Bool
 564 isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
 565 isFullError _                                                 = False
 566
 567 isEOFError :: IOError -> Bool
 568 isEOFError (IOException (IOError _ EOF _ _ _)) = True
 569 isEOFError _                                   = False
 570
 571 isIllegalOperation :: IOError -> Bool
 572 isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
 573 isIllegalOperation _                                                = False
 574
 575 isPermissionError :: IOError -> Bool
 576 isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
 577 isPermissionError _                                                = False
 578
 579 isDoesNotExistError :: IOError -> Bool
 580 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
 581 isDoesNotExistError _                                           = False
 582
 583 isUserError :: IOError -> Bool
 584 isUserError (UserError _) = True
 585 isUserError _             = False
 586
 587 -- ---------------------------------------------------------------------------
 588 -- Showing IOErrors
 589
 590 instance Show IOException where
 591     showsPrec p (IOError hdl iot loc s fn) =
 592       showsPrec p iot .
 593       (case loc of
 594          "" -> id
 595          _  -> showString "\nAction: " . showString loc) .
 596       (case hdl of
 597         Nothing -> id
 598         Just h  -> showString "\nHandle: " . showsPrec p h) .
 599       (case s of
 600          "" -> id
 601          _  -> showString "\nReason: " . showString s) .
 602       (case fn of
 603          Nothing -> id
 604          Just name -> showString "\nFile: " . showString name)
 605 \end{code}