GHC/IOBase.lhs

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