ghc/lib/std/PrelIOBase.lhs

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