ghc/lib/std/PrelIOBase.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[PrelIOBase]{Module @PrelIOBase@}
   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 -#include "cbits/stgio.h" #-}
  12 #include "error.h"
  13
  14 module PrelIOBase where
  15
  16 import {-# SOURCE #-} PrelErr ( error )
  17 import PrelBase
  18 import PrelST     ( ST(..), STret(..), StateAndPtr#(..) )
  19 import PrelMaybe  ( Maybe(..) )
  20 import PrelAddr   ( Addr(..), nullAddr )
  21 import PrelPack   ( unpackCString )
  22 import PrelArr    ( MutableVar, readVar )
  23
  24 \end{code}
  25
  26 %*********************************************************
  27 %*                                                      *
  28 \subsection{The @IO@ monad}
  29 %*                                                      *
  30 %*********************************************************
  31
  32 IO is no longer built on top of PrimIO (which used to be a specialised
  33 version of the ST monad), instead it is now has its own type.  This is
  34 purely for efficiency purposes, since we get to remove several levels
  35 of lifting in the type of the monad.
  36
  37 \begin{code}
  38 newtype IO a = IO (State# RealWorld -> IOResult a)
  39
  40 {-# INLINE unIO #-}
  41 unIO (IO a) = a
  42
  43 data IOResult a = IOok   (State# RealWorld) a
  44                 | IOfail (State# RealWorld) IOError
  45
  46 instance  Functor IO where
  47    map f x = x >>= (return . f)
  48
  49 instance  Monad IO  where
  50     {-# INLINE return #-}
  51     {-# INLINE (>>)   #-}
  52     {-# INLINE (>>=)  #-}
  53     m >> k      =  m >>= \ _ -> k
  54     return x    = IO $ \ s -> IOok s x
  55
  56     (IO m) >>= k =
  57         IO $ \s ->
  58         case m s of
  59             IOfail new_s err -> IOfail new_s err
  60             IOok   new_s a   -> unIO (k a) new_s
  61
  62 fixIO :: (a -> IO a) -> IO a
  63     -- not required but worth having around
  64
  65 fixIO k = IO $ \ s ->
  66     let
  67         (IO k_loop) = k loop
  68         result      = k_loop s
  69         IOok _ loop = result
  70     in
  71     result
  72
  73 fail            :: IOError -> IO a
  74 fail err        =  IO $ \ s -> IOfail s err
  75
  76 userError       :: String  -> IOError
  77 userError str   =  IOError Nothing (UserError Nothing) "" str
  78
  79 catch           :: IO a    -> (IOError -> IO a) -> IO a
  80 catch (IO m) k  = IO $ \ s ->
  81   case m s of
  82     IOok   new_s a -> IOok new_s a
  83     IOfail new_s e -> unIO (k e) new_s
  84
  85 instance  Show (IO a)  where
  86     showsPrec p f  = showString "<<IO action>>"
  87     showList       = showList__ (showsPrec 0)
  88 \end{code}
  89
  90 %*********************************************************
  91 %*                                                      *
  92 \subsection{Coercions to @ST@}
  93 %*                                                      *
  94 %*********************************************************
  95
  96 \begin{code}
  97 stToIO     :: ST RealWorld a -> IO a
  98 stToIO (ST m) = IO $ \ s -> case (m s) of STret new_s r -> IOok new_s r
  99
 100 ioToST     :: IO a -> ST RealWorld a
 101 ioToST (IO io) = ST $ \ s ->
 102     case (io s) of
 103       IOok   new_s a -> STret new_s a
 104       IOfail new_s e -> error ("I/O Error (ioToST): " ++ showsPrec 0 e "\n")
 105 \end{code}
 106
 107 %*********************************************************
 108 %*                                                      *
 109 \subsection{Type @IOError@}
 110 %*                                                      *
 111 %*********************************************************
 112
 113 A value @IOError@ encode errors occurred in the @IO@ monad.
 114 An @IOError@ records a more specific error type, a descriptive
 115 string and maybe the handle that was used when the error was
 116 flagged.
 117
 118 \begin{code}
 119 data IOError
 120  = IOError
 121      (Maybe Handle)  -- the handle used by the action flagging the
 122                      -- the error.
 123      IOErrorType     -- what it was.
 124      String          -- location
 125      String          -- error type specific information.
 126
 127
 128 data IOErrorType
 129   = AlreadyExists        | HardwareFault
 130   | IllegalOperation     | InappropriateType
 131   | Interrupted          | InvalidArgument
 132   | NoSuchThing          | OtherError
 133   | PermissionDenied     | ProtocolError
 134   | ResourceBusy         | ResourceExhausted
 135   | ResourceVanished     | SystemError
 136   | TimeExpired          | UnsatisfiedConstraints
 137   | UnsupportedOperation | UserError (Maybe Addr)
 138   | EOF
 139   deriving (Eq)
 140
 141 instance Show IOErrorType where
 142   showsPrec d e =
 143     showString $
 144     case e of
 145       AlreadyExists     -> "already exists"
 146       HardwareFault     -> "hardware fault"
 147       IllegalOperation  -> "illegal operation"
 148       InappropriateType -> "inappropriate type"
 149       Interrupted       -> "interrupted"
 150       InvalidArgument   -> "invalid argument"
 151       NoSuchThing       -> "does not exist"
 152       OtherError        -> "failed"
 153       PermissionDenied  -> "permission denied"
 154       ProtocolError     -> "protocol error"
 155       ResourceBusy      -> "resource busy"
 156       ResourceExhausted -> "resource exhausted"
 157       ResourceVanished  -> "resource vanished"
 158       SystemError       -> "system error"
 159       TimeExpired       -> "timeout"
 160       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
 161       UserError _       -> "failed"
 162       EOF               -> "end of file"
 163
 164 \end{code}
 165
 166 Predicates on IOError; little effort made on these so far...
 167
 168 \begin{code}
 169
 170 isAlreadyExistsError (IOError _ AlreadyExists _ _) = True
 171 isAlreadyExistsError _                             = False
 172
 173 isAlreadyInUseError (IOError _ ResourceBusy _ _) = True
 174 isAlreadyInUseError _                            = False
 175
 176 isFullError (IOError _ ResourceExhausted _ _) = True
 177 isFullError _                                 = False
 178
 179 isEOFError (IOError _ EOF _ _) = True
 180 isEOFError _                   = False
 181
 182 isIllegalOperation (IOError _ IllegalOperation _ _) = True
 183 isIllegalOperation _                                = False
 184
 185 isPermissionError (IOError _ PermissionDenied _ _) = True
 186 isPermissionError _                                = False
 187
 188 isDoesNotExistError (IOError _ NoSuchThing _ _) = True
 189 isDoesNotExistError _                           = False
 190
 191 isUserError (IOError _ (UserError _) _ _) = True
 192 isUserError _                             = False
 193 \end{code}
 194
 195 Showing @IOError@s
 196
 197 \begin{code}
 198 instance Show IOError where
 199     showsPrec p (IOError hdl iot loc s) =
 200       showsPrec p iot .
 201       showChar '\n' .
 202       (case loc of
 203          "" -> id
 204          _  -> showString "Action: " . showString loc . showChar '\n') .
 205       showHdl .
 206       (case s of
 207          "" -> id
 208          _  -> showString "Reason: " . showString s)
 209      where
 210       showHdl =
 211        case hdl of
 212         Nothing -> id
 213         Just h  -> showString "Handle: " . showsPrec p h
 214
 215
 216 \end{code}
 217
 218 The @String@ part of an @IOError@ is platform-dependent.  However, to
 219 provide a uniform mechanism for distinguishing among errors within
 220 these broad categories, each platform-specific standard shall specify
 221 the exact strings to be used for particular errors.  For errors not
 222 explicitly mentioned in the standard, any descriptive string may be
 223 used.
 224
 225 \begin{code}
 226 constructErrorAndFail :: String -> IO a
 227 constructErrorAndFail call_site
 228   = constructError call_site >>= \ io_error ->
 229     fail io_error
 230
 231 constructErrorAndFailWithInfo :: String -> String -> IO a
 232 constructErrorAndFailWithInfo call_site reason
 233   = constructErrorMsg call_site (Just reason) >>= \ io_error ->
 234     fail io_error
 235
 236 \end{code}
 237
 238 This doesn't seem to be documented/spelled out anywhere,
 239 so here goes: (SOF)
 240
 241 The implementation of the IO prelude uses various C stubs
 242 to do the actual interaction with the OS. The bandwidth
 243 \tr{C<->Haskell} is somewhat limited, so the general strategy
 244 for flaggging any errors (apart from possibly using the
 245 return code of the external call), is to set the @ghc_errtype@
 246 to a value that is one of the \tr{#define}s in @includes/error.h@.
 247 @ghc_errstr@ holds a character string providing error-specific
 248 information. Error constructing functions will then reach out
 249 and grab these values when generating
 250
 251 \begin{code}
 252 constructError        :: String -> IO IOError
 253 constructError call_site = constructErrorMsg call_site Nothing
 254
 255 constructErrorMsg             :: String -> Maybe String -> IO IOError
 256 constructErrorMsg call_site reason =
 257  _ccall_ getErrType__            >>= \ (I# errtype#) ->
 258  _ccall_ getErrStr__             >>= \ str ->
 259  let
 260   iot =
 261    case errtype# of
 262      ERR_ALREADYEXISTS#          -> AlreadyExists
 263      ERR_HARDWAREFAULT#          -> HardwareFault
 264      ERR_ILLEGALOPERATION#       -> IllegalOperation
 265      ERR_INAPPROPRIATETYPE#      -> InappropriateType
 266      ERR_INTERRUPTED#            -> Interrupted
 267      ERR_INVALIDARGUMENT#        -> InvalidArgument
 268      ERR_NOSUCHTHING#            -> NoSuchThing
 269      ERR_OTHERERROR#             -> OtherError
 270      ERR_PERMISSIONDENIED#       -> PermissionDenied
 271      ERR_PROTOCOLERROR#          -> ProtocolError
 272      ERR_RESOURCEBUSY#           -> ResourceBusy
 273      ERR_RESOURCEEXHAUSTED#      -> ResourceExhausted
 274      ERR_RESOURCEVANISHED#       -> ResourceVanished
 275      ERR_SYSTEMERROR#            -> SystemError
 276      ERR_TIMEEXPIRED#            -> TimeExpired
 277      ERR_UNSATISFIEDCONSTRAINTS# -> UnsatisfiedConstraints
 278      ERR_UNSUPPORTEDOPERATION#   -> UnsupportedOperation
 279      ERR_EOF#                    -> EOF
 280      _                           -> OtherError
 281
 282   msg =
 283    unpackCString str ++
 284    (case iot of
 285      OtherError -> "(error code: " ++ show (I# errtype#) ++ ")"
 286      _ -> "") ++
 287    (case reason of
 288       Nothing -> ""
 289       Just m  -> ' ':m)
 290  in
 291  return (IOError Nothing iot call_site msg)
 292 \end{code}
 293
 294 File names are specified using @FilePath@, a OS-dependent
 295 string that (hopefully, I guess) maps to an accessible file/object.
 296
 297 \begin{code}
 298 type FilePath = String
 299 \end{code}
 300
 301 %*********************************************************
 302 %*                                                      *
 303 \subsection{Types @Handle@, @Handle__@}
 304 %*                                                      *
 305 %*********************************************************
 306
 307 The type for @Handle@ is defined rather than in @IOHandle@
 308 module, as the @IOError@ type uses it..all operations over
 309 a handles reside in @IOHandle@.
 310
 311 \begin{code}
 312
 313 {-
 314  Sigh, the MVar ops in ConcBase depend on IO, the IO
 315  representation here depend on MVars for handles (when
 316  compiling in a concurrent way). Break the cycle by having
 317  the definition of MVars go here:
 318
 319 -}
 320 data MVar a = MVar (SynchVar# RealWorld a)
 321
 322 {-
 323   Double sigh - ForeignObj is needed here too to break a cycle.
 324 -}
 325 data ForeignObj = ForeignObj ForeignObj#   -- another one
 326 instance CCallable ForeignObj
 327 instance CCallable ForeignObj#
 328
 329 makeForeignObj  :: Addr        -> Addr       -> IO ForeignObj
 330 makeForeignObj (A# obj) (A# finaliser) = IO ( \ s# ->
 331     case makeForeignObj# obj finaliser s# of
 332       StateAndForeignObj# s1# fo# -> IOok s1# (ForeignObj fo#))
 333
 334 data StateAndForeignObj# s  = StateAndForeignObj# (State# s) ForeignObj#
 335
 336
 337 #if defined(__CONCURRENT_HASKELL__)
 338 newtype Handle = Handle (MVar Handle__)
 339 #else
 340 newtype Handle = Handle (MutableVar RealWorld Handle__)
 341 #endif
 342
 343 #ifndef __PARALLEL_HASKELL__
 344 #define FILE_OBJECT         ForeignObj
 345 #else
 346 #define FILE_OBJECT         Addr
 347 #endif
 348
 349 {-
 350   A Handle is represented by (a reference to) a record
 351   containing the state of the I/O port/device. We record
 352   the following pieces of info:
 353
 354     * type (read,write,closed etc.)
 355     * pointer to the external file object.
 356     * buffering mode
 357     * user-friendly name (usually the
 358       FilePath used when IO.openFile was called)
 359
 360 Note: when a Handle is garbage collected, we want to flush its buffer
 361 and close the OS file handle, so as to free up a (precious) resource.
 362
 363 This means that the finaliser for the handle needs to have access to
 364 the buffer and the OS file handle. The current implementation of foreign
 365 objects requires that the finaliser is implemented in C, so to
 366 arrange for this to happen, openFile() returns a pointer to a structure
 367 big enough to hold the OS file handle and a pointer to the buffer.
 368 This pointer is then wrapped up inside a ForeignObj, and finalised
 369 as desired.
 370
 371 -}
 372 data Handle__
 373   = Handle__ {
 374       haFO__          :: FILE_OBJECT,
 375       haType__        :: Handle__Type,
 376       haBufferMode__  :: BufferMode,
 377       haFilePath__    :: FilePath
 378     }
 379
 380 {-
 381   Internally, we classify handles as being one
 382   of the following:
 383
 384 -}
 385 data Handle__Type
 386  = ErrorHandle  IOError
 387  | ClosedHandle
 388  | SemiClosedHandle
 389  | ReadHandle
 390  | WriteHandle
 391  | AppendHandle
 392  | ReadWriteHandle
 393
 394
 395 -- handle types are 'show'ed when printing error msgs, so
 396 -- we provide a more user-friendly Show instance for it
 397 -- than the derived one.
 398 instance Show Handle__Type where
 399   showsPrec p t =
 400     case t of
 401       ErrorHandle iot   -> showString "error " . showsPrec p iot
 402       ClosedHandle      -> showString "closed"
 403       SemiClosedHandle  -> showString "semi-closed"
 404       ReadHandle        -> showString "readable"
 405       WriteHandle       -> showString "writeable"
 406       AppendHandle      -> showString "writeable (append)"
 407       ReadWriteHandle   -> showString "read-writeable"
 408
 409 instance Show Handle where
 410   showsPrec p (Handle h) =
 411     let
 412 #if defined(__CONCURRENT_HASKELL__)
 413      -- (Big) SIGH: unfolded defn of takeMVar to avoid
 414      -- an (oh-so) unfortunate module loop with PrelConc.
 415      hdl_ = unsafePerformIO (IO $ \ s# ->
 416              case h               of { MVar h# ->
 417              case takeMVar# h# s# of { StateAndPtr# s2# r ->
 418                     IOok s2# r }})
 419 #else
 420      hdl_ = unsafePerformIO (stToIO (readVar h))
 421 #endif
 422     in
 423     showChar '{' .
 424     showHdl (haType__ hdl_)
 425             (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
 426              showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
 427              showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
 428    where
 429     showHdl :: Handle__Type -> ShowS -> ShowS
 430     showHdl ht cont =
 431        case ht of
 432         ClosedHandle  -> showsPrec p ht . showString "}\n"
 433         ErrorHandle _ -> showsPrec p ht . showString "}\n"
 434         _ -> cont
 435
 436     showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
 437     showBufMode fo bmo =
 438       case bmo of
 439         NoBuffering   -> showString "none"
 440         LineBuffering -> showString "line"
 441         BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
 442         BlockBuffering Nothing  -> showString "block " . showParen True (showsPrec p def)
 443       where
 444        def :: Int
 445        def = unsafePerformIO (_ccall_ getBufSize fo)
 446
 447
 448 {-
 449  nullFile__ is only used for closed handles, plugging it in as
 450  a null file object reference.
 451 -}
 452 nullFile__ :: FILE_OBJECT
 453 nullFile__ =
 454 #ifndef __PARALLEL_HASKELL__
 455     unsafePerformIO (makeForeignObj nullAddr nullAddr{-i.e., don't finalise-})
 456 #else
 457     nullAddr
 458 #endif
 459
 460
 461 mkClosedHandle__ :: Handle__
 462 mkClosedHandle__ =
 463   Handle__
 464            nullFile__
 465            ClosedHandle
 466            NoBuffering
 467            "closed file"
 468
 469 mkErrorHandle__ :: IOError -> Handle__
 470 mkErrorHandle__ ioe =
 471   Handle__
 472            nullFile__
 473            (ErrorHandle ioe)
 474            NoBuffering
 475            "error handle"
 476
 477 mkBuffer__ :: FILE_OBJECT -> Int -> IO ()
 478 mkBuffer__ fo sz_in_bytes = do
 479  chunk <-
 480   case sz_in_bytes of
 481     0 -> return nullAddr  -- this has the effect of overwriting the pointer to the old buffer.
 482     _ -> do
 483      chunk <- _ccall_ allocMemory__ sz_in_bytes
 484      if chunk == nullAddr
 485       then fail (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
 486       else return chunk
 487  _ccall_ setBuf fo chunk sz_in_bytes
 488
 489 \end{code}
 490
 491 %*********************************************************
 492 %*                                                      *
 493 \subsection[BufferMode]{Buffering modes}
 494 %*                                                      *
 495 %*********************************************************
 496
 497 Three kinds of buffering are supported: line-buffering,
 498 block-buffering or no-buffering.  These modes have the following
 499 effects. For output, items are written out from the internal
 500 buffer according to the buffer mode:
 501
 502 \begin{itemize}
 503 \item[line-buffering]  the entire output buffer is written
 504 out whenever a newline is output, the output buffer overflows,
 505 a flush is issued, or the handle is closed.
 506
 507 \item[block-buffering] the entire output buffer is written out whenever
 508 it overflows, a flush is issued, or the handle
 509 is closed.
 510
 511 \item[no-buffering] output is written immediately, and never stored
 512 in the output buffer.
 513 \end{itemize}
 514
 515 The output buffer is emptied as soon as it has been written out.
 516
 517 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
 518 \begin{itemize}
 519 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
 520 the next item is obtained from the buffer;
 521 otherwise, when the input buffer is empty,
 522 characters up to and including the next newline
 523 character are read into the buffer.  No characters
 524 are available until the newline character is
 525 available.
 526 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
 527 the next block of data is read into this buffer.
 528 \item[no-buffering] the next input item is read and returned.
 529 \end{itemize}
 530
 531 For most implementations, physical files will normally be block-buffered
 532 and terminals will normally be line-buffered. (the IO interface provides
 533 operations for changing the default buffering of a handle tho.)
 534
 535 \begin{code}
 536 data BufferMode
 537  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
 538    deriving (Eq, Ord, Show)
 539    {- Read instance defined in IO. -}
 540
 541 \end{code}
 542
 543 %*********************************************************
 544 %*                                                      *
 545 \subsection{Unsafe @IO@ operations}
 546 %*                                                      *
 547 %*********************************************************
 548
 549 \begin{code}
 550 {-# NOINLINE unsafePerformIO #-}
 551 unsafePerformIO :: IO a -> a
 552 unsafePerformIO (IO m)
 553   = case m realWorld# of
 554       IOok _ r   -> r
 555       IOfail _ e -> error ("unsafePerformIO: I/O error: " ++ show e ++ "\n")
 556
 557 {-# NOINLINE unsafeInterleaveIO #-}
 558 unsafeInterleaveIO :: IO a -> IO a
 559 unsafeInterleaveIO (IO m) = IO ( \ s ->
 560         let
 561             IOok _ r = m s
 562         in
 563         IOok s r)
 564
 565 \end{code}