ghc/lib/std/PrelIOBase.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelIOBase.lhs,v 1.39 2001/05/22 15:06:47 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 PrelIOBase where
  15
  16 import PrelST
  17 import PrelRead
  18 import PrelArr
  19 import PrelBase
  20 import PrelNum  -- To get fromInteger etc, needed because of -fno-implicit-prelude
  21 import PrelMaybe  ( Maybe(..) )
  22 import PrelShow
  23 import PrelList
  24 import PrelDynamic
  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 PrelException) 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   - PrelIOBase.lhs, and several other places including
  45             PrelException.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 PrelConc 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       haBufferMode  :: BufferMode,
 157       haFilePath    :: FilePath,
 158       haBuffer      :: !(IORef Buffer),
 159       haBuffers     :: !(IORef BufferList)
 160     }
 161
 162 -- ---------------------------------------------------------------------------
 163 -- Buffers
 164
 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.
 171
 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
 175 -- operation.
 176
 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.
 180
 181 type RawBuffer = MutableByteArray# RealWorld
 182
 183 -- INVARIANTS on a Buffer:
 184 --
 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).
 188 --   * r <= w
 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
 193 --     returning.
 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.
 196
 197 data Buffer
 198   = Buffer {
 199         bufBuf   :: RawBuffer,
 200         bufRPtr  :: !Int,
 201         bufWPtr  :: !Int,
 202         bufSize  :: !Int,
 203         bufState :: BufferState
 204   }
 205
 206 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
 207
 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.
 211 data BufferList
 212   = BufferListNil
 213   | BufferListCons RawBuffer BufferList
 214
 215
 216 bufferIsWritable :: Buffer -> Bool
 217 bufferIsWritable Buffer{ bufState=WriteBuffer } = True
 218 bufferIsWritable _other = False
 219
 220 bufferEmpty :: Buffer -> Bool
 221 bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w
 222 bufferEmpty _other = False
 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 -- File names are specified using @FilePath@, a OS-dependent
 241 -- string that (hopefully, I guess) maps to an accessible file/object.
 242
 243 type FilePath = String
 244
 245 -- ---------------------------------------------------------------------------
 246 -- Buffering modes
 247
 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:
 252 --
 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.
 256 --
 257 -- * block-buffering the entire output buffer is written out whenever
 258 --   it overflows, a flush is issued, or the handle
 259 --   is closed.
 260 --
 261 -- * no-buffering output is written immediately, and never stored
 262 --   in the output buffer.
 263 --
 264 -- The output buffer is emptied as soon as it has been written out.
 265
 266 -- Similarly, input occurs according to the buffer mode for handle {\em hdl}.
 267
 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
 274 --   available.
 275 --
 276 -- * block-buffering when the input buffer for the handle becomes empty,
 277 --   the next block of data is read into this buffer.
 278 --
 279 -- * no-buffering the next input item is read and returned.
 280
 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.)
 284
 285 data BufferMode
 286  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
 287    deriving (Eq, Ord, Show, Read)
 288
 289 -- ---------------------------------------------------------------------------
 290 -- IORefs
 291
 292 newtype IORef a = IORef (STRef RealWorld a) deriving Eq
 293
 294 newIORef    :: a -> IO (IORef a)
 295 newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
 296
 297 readIORef   :: IORef a -> IO a
 298 readIORef  (IORef var) = stToIO (readSTRef var)
 299
 300 writeIORef  :: IORef a -> a -> IO ()
 301 writeIORef (IORef var) v = stToIO (writeSTRef var v)
 302
 303 modifyIORef :: IORef a -> (a -> a) -> IO ()
 304 modifyIORef ref f = readIORef ref >>= \x -> writeIORef ref (f x)
 305
 306 -- deprecated, use modifyIORef
 307 updateIORef :: IORef a -> (a -> a) -> IO ()
 308 updateIORef = modifyIORef
 309
 310 -- ---------------------------------------------------------------------------
 311 -- Show instance for Handles
 312
 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.
 316
 317 instance Show HandleType where
 318   showsPrec p t =
 319     case t of
 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)"
 327
 328 instance Show Handle where
 329   showsPrec p (FileHandle   h)   = showHandle p h
 330   showsPrec p (DuplexHandle h _) = showHandle p h
 331
 332 showHandle p h =
 333     let
 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# ->
 340              (# s3#, r #) }}})
 341     in
 342     showChar '{' .
 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 "}" )
 347    where
 348     showHdl :: HandleType -> ShowS -> ShowS
 349     showHdl ht cont =
 350        case ht of
 351         ClosedHandle  -> showsPrec p ht . showString "}"
 352         _ -> cont
 353
 354     showBufMode :: Buffer -> BufferMode -> ShowS
 355     showBufMode buf bmo =
 356       case bmo of
 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)
 361       where
 362        def :: Int
 363        def = bufSize buf
 364
 365 -- ------------------------------------------------------------------------
 366 -- Exception datatype and operations
 367
 368 data Exception
 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
 383   | NonTermination
 384   | UserError           String
 385
 386 data ArithException
 387   = Overflow
 388   | Underflow
 389   | LossOfPrecision
 390   | DivideByZero
 391   | Denormal
 392   deriving (Eq, Ord)
 393
 394 data AsyncException
 395   = StackOverflow
 396   | HeapOverflow
 397   | ThreadKilled
 398   deriving (Eq, Ord)
 399
 400 data ArrayException
 401   = IndexOutOfBounds    String          -- out-of-range array access
 402   | UndefinedElement    String          -- evaluating an undefined element
 403   deriving (Eq, Ord)
 404
 405 stackOverflow, heapOverflow :: Exception -- for the RTS
 406 stackOverflow = AsyncException StackOverflow
 407 heapOverflow  = AsyncException HeapOverflow
 408
 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"
 415
 416 instance Show AsyncException where
 417   showsPrec _ StackOverflow   = showString "stack overflow"
 418   showsPrec _ HeapOverflow    = showString "heap overflow"
 419   showsPrec _ ThreadKilled    = showString "thread killed"
 420
 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
 425                            else id)
 426   showsPrec _ (UndefinedElement s)
 427         = showString "undefined array element"
 428         . (if not (null s) then showString ": " . showString s
 429                            else id)
 430
 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
 448
 449 -- -----------------------------------------------------------------------------
 450 -- The ExitCode type
 451
 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).
 458
 459 -- We need it here because it is used in ExitException in the
 460 -- Exception datatype (above).
 461
 462 data ExitCode = ExitSuccess | ExitFailure Int
 463                 deriving (Eq, Ord, Read, Show)
 464
 465 -- --------------------------------------------------------------------------
 466 -- Primitive throw
 467
 468 throw :: Exception -> a
 469 throw exception = raise# exception
 470
 471 ioError         :: Exception -> IO a
 472 ioError err     =  IO $ \s -> throw err s
 473
 474 ioException     :: IOException -> IO a
 475 ioException err =  IO $ \s -> throw (IOException err) s
 476
 477 -- ---------------------------------------------------------------------------
 478 -- IOError type
 479
 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
 483 -- flagged.
 484
 485 type IOError = Exception
 486
 487 data IOException
 488  = IOError
 489      (Maybe Handle)   -- the handle used by the action flagging the
 490                       --   the error.
 491      IOErrorType      -- what it was.
 492      String           -- location.
 493      String           -- error type specific information.
 494      (Maybe FilePath) -- filename the error is related to.
 495
 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
 499
 500 data IOErrorType
 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
 510   | EOF
 511 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
 512   | ComError Int           -- HRESULT
 513 #endif
 514   deriving (Eq)
 515
 516 instance Show IOErrorType where
 517   showsPrec _ e =
 518     showString $
 519     case e of
 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"
 537       EOF               -> "end of file"
 538 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
 539       ComError _        -> "COM error"
 540 #endif
 541
 542
 543
 544 userError       :: String  -> IOError
 545 userError str   =  UserError str
 546
 547 -- ---------------------------------------------------------------------------
 548 -- Predicates on IOError
 549
 550 isAlreadyExistsError :: IOError -> Bool
 551 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
 552 isAlreadyExistsError _                                             = False
 553
 554 isAlreadyInUseError :: IOError -> Bool
 555 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
 556 isAlreadyInUseError _                                            = False
 557
 558 isFullError :: IOError -> Bool
 559 isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
 560 isFullError _                                                 = False
 561
 562 isEOFError :: IOError -> Bool
 563 isEOFError (IOException (IOError _ EOF _ _ _)) = True
 564 isEOFError _                                   = False
 565
 566 isIllegalOperation :: IOError -> Bool
 567 isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
 568 isIllegalOperation _                                                = False
 569
 570 isPermissionError :: IOError -> Bool
 571 isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
 572 isPermissionError _                                                = False
 573
 574 isDoesNotExistError :: IOError -> Bool
 575 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
 576 isDoesNotExistError _                                           = False
 577
 578 isUserError :: IOError -> Bool
 579 isUserError (UserError _) = True
 580 isUserError _             = False
 581
 582 -- ---------------------------------------------------------------------------
 583 -- Showing IOErrors
 584
 585 instance Show IOException where
 586     showsPrec p (IOError hdl iot loc s fn) =
 587       showsPrec p iot .
 588       (case loc of
 589          "" -> id
 590          _  -> showString "\nAction: " . showString loc) .
 591       (case hdl of
 592         Nothing -> id
 593         Just h  -> showString "\nHandle: " . showsPrec p h) .
 594       (case s of
 595          "" -> id
 596          _  -> showString "\nReason: " . showString s) .
 597       (case fn of
 598          Nothing -> id
 599          Just name -> showString "\nFile: " . showString name)
 600 \end{code}