GHC/IOBase.lhs

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