ghc/lib/ghc/IOBase.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[IOBase]{Module @IOBase@}
   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 "error.h"
  13
  14 module IOBase where
  15
  16 import STBase
  17 import UnsafeST
  18 import PrelTup
  19 import Foreign
  20 import PackBase ( unpackCString )
  21 import PrelBase
  22 import ArrBase  ( ByteArray(..), MutableVar(..) )
  23 import PrelRead
  24
  25 import GHC
  26
  27 infixr 1 `thenIO_Prim`, `seqIO_Prim`
  28 \end{code}
  29
  30 %*********************************************************
  31 %*                                                      *
  32 \subsection{The @IO@ monad}
  33 %*                                                      *
  34 %*********************************************************
  35
  36 \begin{code}
  37 newtype IO a = IO (PrimIO (Either IOError a))
  38
  39 instance  Functor IO where
  40    map f x = x >>= (return . f)
  41
  42 instance  Monad IO  where
  43     {-# INLINE return #-}
  44     {-# INLINE (>>)   #-}
  45     {-# INLINE (>>=)  #-}
  46     m >> k      =  m >>= \ _ -> k
  47     return x    = IO $ ST $ \ s@(S# _) -> (Right x, s)
  48
  49     (IO (ST m)) >>= k =
  50         IO (ST ( \ s ->
  51         let  (r, new_s) = m s  in
  52         case r of
  53           Left err -> (Left err, new_s)
  54           Right  x -> case (k x) of { IO (ST k2) ->
  55                         k2 new_s }))
  56
  57 fixIO :: (a -> IO a) -> IO a
  58     -- not required but worth having around
  59
  60 fixIO k = IO $ ST $ \ s ->
  61     let
  62         (IO (ST k_loop)) = k loop
  63         result           = k_loop s
  64         (Right loop, _)  = result
  65     in
  66     result
  67
  68 fail            :: IOError -> IO a
  69 fail err        =  IO $ ST $ \ s -> (Left err, s)
  70
  71 userError       :: String  -> IOError
  72 userError str   =  IOError Nothing UserError str
  73
  74 catch           :: IO a    -> (IOError -> IO a) -> IO a
  75 catch (IO (ST m)) k  = IO $ ST $ \ s ->
  76   case (m s) of { (r, new_s) ->
  77   case r of
  78     Right  _ -> (r, new_s)
  79     Left err -> case (k err) of { IO (ST k_err) ->
  80                 (k_err new_s) }}
  81
  82 instance  Show (IO a)  where
  83     showsPrec p f  = showString "<<IO action>>"
  84     showList       = showList__ (showsPrec 0)
  85 \end{code}
  86
  87 %*********************************************************
  88 %*                                                      *
  89 \subsection{Coercions to @ST@ and @PrimIO@}
  90 %*                                                      *
  91 %*********************************************************
  92
  93 \begin{code}
  94 stToIO     :: ST RealWorld a -> IO a
  95 primIOToIO :: PrimIO a       -> IO a
  96 ioToST     :: IO a -> ST RealWorld a
  97 ioToPrimIO :: IO a -> PrimIO       a
  98
  99 primIOToIO = stToIO -- for backwards compatibility
 100 ioToPrimIO = ioToST
 101
 102 stToIO (ST m) = IO $ ST $ \ s ->
 103     case (m s) of { (r, new_s) ->
 104     (Right r, new_s) }
 105
 106 ioToST (IO (ST io)) = ST $ \ s ->
 107     case (io s) of { (r, new_s) ->
 108     case r of
 109       Right a -> (a, new_s)
 110       Left  e -> error ("I/O Error (ioToST): " ++ showsPrec 0 e "\n")
 111     }
 112 \end{code}
 113
 114 @thenIO_Prim@ is a useful little number for doing _ccall_s in IO-land:
 115
 116 \begin{code}
 117 thenIO_Prim :: PrimIO a -> (a -> IO b) -> IO b
 118 seqIO_Prim  :: PrimIO a -> IO b -> IO b
 119 {-# INLINE thenIO_Prim   #-}
 120 {-# INLINE seqIO_Prim   #-}
 121
 122 thenIO_Prim (ST m) k = IO $ ST $ \ s ->
 123     case (m s)     of { (m_res, new_s)    ->
 124     case (k m_res) of { (IO (ST k_m_res)) ->
 125     k_m_res new_s }}
 126
 127 seqIO_Prim m k = thenIO_Prim m (\ _ -> k)
 128 \end{code}
 129
 130
 131 %*********************************************************
 132 %*                                                      *
 133 \subsection{Error/trace-ish functions}
 134 %*                                                      *
 135 %*********************************************************
 136
 137 \begin{code}
 138 errorIO :: PrimIO () -> a
 139
 140 errorIO (ST io)
 141   = case (errorIO# io) of
 142       _ -> bottom
 143   where
 144     bottom = bottom -- Never evaluated
 145
 146 --errorIO x = (waitRead#, errorIO#, makeForeignObj#, waitWrite#, (+#))
 147
 148 -- error stops execution and displays an error message
 149 error :: String -> a
 150 error s = error__ ( \ x -> _ccall_ ErrorHdrHook x ) s
 151
 152 error__ :: (Addr{-FILE *-} -> PrimIO ()) -> String -> a
 153
 154 error__ msg_hdr s
 155 #ifdef __PARALLEL_HASKELL__
 156   = errorIO (msg_hdr sTDERR{-msg hdr-}  >>
 157              _ccall_ fflush sTDERR      >>
 158              fputs sTDERR s             >>
 159              _ccall_ fflush sTDERR      >>
 160              _ccall_ stg_exit (1::Int)
 161             )
 162 #else
 163   = errorIO (msg_hdr sTDERR{-msg hdr-}  >>
 164              _ccall_ fflush sTDERR      >>
 165              fputs sTDERR s             >>
 166              _ccall_ fflush sTDERR      >>
 167              _ccall_ getErrorHandler    >>= \ errorHandler ->
 168              if errorHandler == (-1::Int) then
 169                 _ccall_ stg_exit (1::Int)
 170              else
 171                 _casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
 172                                                 >>= \ osptr ->
 173                 _ccall_ decrementErrorCount     >>= \ () ->
 174                 deRefStablePtr osptr            >>= \ oact ->
 175                 oact
 176             )
 177 #endif {- !parallel -}
 178   where
 179     sTDERR = (``stderr'' :: Addr)
 180 \end{code}
 181
 182 \begin{code}
 183 {-# GENERATE_SPECS _trace a #-}
 184 trace :: String -> a -> a
 185
 186 trace string expr
 187   = unsafePerformPrimIO (
 188         ((_ccall_ PreTraceHook sTDERR{-msg-}):: PrimIO ())  >>
 189         fputs sTDERR string                                 >>
 190         ((_ccall_ PostTraceHook sTDERR{-msg-}):: PrimIO ()) >>
 191         returnPrimIO expr )
 192   where
 193     sTDERR = (``stderr'' :: Addr)
 194 \end{code}
 195
 196
 197 %*********************************************************
 198 %*                                                      *
 199 \subsection{Utility functions}
 200 %*                                                      *
 201 %*********************************************************
 202
 203 I'm not sure why this little function is here...
 204
 205 \begin{code}
 206 fputs :: Addr{-FILE*-} -> String -> PrimIO Bool
 207
 208 fputs stream [] = return True
 209
 210 fputs stream (c : cs)
 211   = _ccall_ stg_putc c stream >> -- stg_putc expands to putc
 212     fputs stream cs              -- (just does some casting stream)
 213 \end{code}
 214
 215
 216 %*********************************************************
 217 %*                                                      *
 218 \subsection{Type @IOError@}
 219 %*                                                      *
 220 %*********************************************************
 221
 222 A value @IOError@ encode errors occurred in the @IO@ monad.
 223 An @IOError@ records a more specific error type, a descriptive
 224 string and maybe the handle that was used when the error was
 225 flagged.
 226
 227 \begin{code}
 228 data IOError
 229  = IOError
 230      (Maybe Handle)  -- the handle used by the action flagging the
 231                      -- the error.
 232      IOErrorType     -- what it was.
 233      String          -- error type specific information.
 234
 235
 236 data IOErrorType
 237   = AlreadyExists        | HardwareFault
 238   | IllegalOperation     | InappropriateType
 239   | Interrupted          | InvalidArgument
 240   | NoSuchThing          | OtherError
 241   | PermissionDenied     | ProtocolError
 242   | ResourceBusy         | ResourceExhausted
 243   | ResourceVanished     | SystemError
 244   | TimeExpired          | UnsatisfiedConstraints
 245   | UnsupportedOperation | UserError
 246   | EOF
 247   deriving (Eq, Show)
 248
 249 \end{code}
 250
 251 Predicates on IOError; little effort made on these so far...
 252
 253 \begin{code}
 254
 255 isAlreadyExistsError (IOError _ AlreadyExists _) = True
 256 isAlreadyExistsError _                           = False
 257
 258 isAlreadyInUseError (IOError _ ResourceBusy _) = True
 259 isAlreadyInUseError _                          = False
 260
 261 isFullError (IOError _ ResourceExhausted _) = True
 262 isFullError _                               = False
 263
 264 isEOFError (IOError _ EOF _) = True
 265 isEOFError _                 = True
 266
 267 isIllegalOperation (IOError _ IllegalOperation _) = True
 268 isIllegalOperation _                              = False
 269
 270 isPermissionError (IOError _ PermissionDenied _) = True
 271 isPermissionError _                              = False
 272
 273 isDoesNotExistError (IOError _ NoSuchThing _) = True
 274 isDoesNotExistError _                         = False
 275
 276 isUserError (IOError _ UserError s) = Just s
 277 isUserError _                       = Nothing
 278 \end{code}
 279
 280 Showing @IOError@s
 281
 282 \begin{code}
 283 instance Show IOError where
 284     showsPrec p (IOError _ UserError s) rs =
 285       showString s rs
 286 {-
 287     showsPrec p (IOError _ EOF _) rs =
 288       showsPrec p EOF rs
 289 -}
 290     showsPrec p (IOError _ iot s) rs =
 291       showsPrec p
 292                 iot
 293                 (case s of {
 294                   "" -> rs;
 295                   _ -> showString ": " $
 296                        showString s rs})
 297
 298 \end{code}
 299
 300 The @String@ part of an @IOError@ is platform-dependent.  However, to
 301 provide a uniform mechanism for distinguishing among errors within
 302 these broad categories, each platform-specific standard shall specify
 303 the exact strings to be used for particular errors.  For errors not
 304 explicitly mentioned in the standard, any descriptive string may be
 305 used.
 306
 307 \begin{change}
 308 SOF & 4/96 & added argument to indicate function that flagged error
 309 \end{change}
 310 % Hmm..does these envs work?!...SOF
 311
 312 \begin{code}
 313 constructErrorAndFail :: String -> IO a
 314 constructErrorAndFail call_site
 315   = stToIO (constructError call_site) >>= \ io_error ->
 316     fail io_error
 317
 318 \end{code}
 319
 320 This doesn't seem to be documented/spelled out anywhere,
 321 so here goes: (SOF)
 322
 323 The implementation of the IO prelude uses various C stubs
 324 to do the actual interaction with the OS. The bandwidth
 325 \tr{C<->Haskell} is somewhat limited, so the general strategy
 326 for flaggging any errors (apart from possibly using the
 327 return code of the external call), is to set the @ghc_errtype@
 328 to a value that is one of the \tr{#define}s in @includes/error.h@.
 329 @ghc_errstr@ holds a character string providing error-specific
 330 information.
 331
 332 \begin{code}
 333 constructError        :: String -> PrimIO IOError
 334 constructError call_site =
 335  _casm_ ``%r = ghc_errtype;''    >>= \ (I# errtype#) ->
 336  _casm_ ``%r = ghc_errstr;''     >>= \ str ->
 337  let
 338   iot =
 339    case errtype# of
 340      ERR_ALREADYEXISTS#          -> AlreadyExists
 341      ERR_HARDWAREFAULT#          -> HardwareFault
 342      ERR_ILLEGALOPERATION#       -> IllegalOperation
 343      ERR_INAPPROPRIATETYPE#      -> InappropriateType
 344      ERR_INTERRUPTED#            -> Interrupted
 345      ERR_INVALIDARGUMENT#        -> InvalidArgument
 346      ERR_NOSUCHTHING#            -> NoSuchThing
 347      ERR_OTHERERROR#             -> OtherError
 348      ERR_PERMISSIONDENIED#       -> PermissionDenied
 349      ERR_PROTOCOLERROR#          -> ProtocolError
 350      ERR_RESOURCEBUSY#           -> ResourceBusy
 351      ERR_RESOURCEEXHAUSTED#      -> ResourceExhausted
 352      ERR_RESOURCEVANISHED#       -> ResourceVanished
 353      ERR_SYSTEMERROR#            -> SystemError
 354      ERR_TIMEEXPIRED#            -> TimeExpired
 355      ERR_UNSATISFIEDCONSTRAINTS# -> UnsatisfiedConstraints
 356      ERR_UNSUPPORTEDOPERATION#   -> UnsupportedOperation
 357      ERR_EOF#                    -> EOF
 358      _                           -> OtherError
 359
 360   msg =
 361    call_site ++ ':' : ' ' : unpackCString str ++
 362    case iot of
 363      OtherError -> "(error code: " ++ show (I# errtype#) ++ ")"
 364      _ -> ""
 365  in
 366  return (IOError Nothing iot msg)
 367 \end{code}
 368
 369 %*********************************************************
 370 %*                                                      *
 371 \subsection{Types @Handle@, @Handle__@}
 372 %*                                                      *
 373 %*********************************************************
 374
 375 The type for @Handle@ is defined rather than in @IOHandle@
 376 module, as the @IOError@ type uses it..all operations over
 377 a handles reside in @IOHandle@.
 378
 379 \begin{code}
 380
 381 {-
 382  Sigh, the MVar ops in ConcBase depend on IO, the IO
 383  representation here depend on MVars for handles (when
 384  compiling a concurrent way). Break the cycle by having
 385  the definition of MVars go here:
 386
 387 -}
 388 data MVar a = MVar (SynchVar# RealWorld a)
 389
 390 #if defined(__CONCURRENT_HASKELL__)
 391 type Handle = MVar Handle__
 392 #else
 393 type Handle = MutableVar RealWorld Handle__
 394 #endif
 395
 396 data Handle__
 397   = ErrorHandle         IOError
 398   | ClosedHandle
 399 #ifndef PAR
 400   | SemiClosedHandle    ForeignObj (Addr, Int)
 401   | ReadHandle          ForeignObj (Maybe BufferMode) Bool
 402   | WriteHandle         ForeignObj (Maybe BufferMode) Bool
 403   | AppendHandle        ForeignObj (Maybe BufferMode) Bool
 404   | ReadWriteHandle     ForeignObj (Maybe BufferMode) Bool
 405 #else
 406   | SemiClosedHandle    Addr (Addr, Int)
 407   | ReadHandle          Addr (Maybe BufferMode) Bool
 408   | WriteHandle         Addr (Maybe BufferMode) Bool
 409   | AppendHandle        Addr (Maybe BufferMode) Bool
 410   | ReadWriteHandle     Addr (Maybe BufferMode) Bool
 411 #endif
 412
 413 -- Standard Instances as defined by the Report..
 414 -- instance Eq Handle   (defined in IO)
 415 -- instance Show Handle    ""
 416
 417 \end{code}
 418
 419 %*********************************************************
 420 %*                                                      *
 421 \subsection[BufferMode]{Buffering modes}
 422 %*                                                      *
 423 %*********************************************************
 424
 425 Three kinds of buffering are supported: line-buffering,
 426 block-buffering or no-buffering.  These modes have the following
 427 effects. For output, items are written out from the internal
 428 buffer according to the buffer mode:
 429
 430 \begin{itemize}
 431 \item[line-buffering]  the entire output buffer is written
 432 out whenever a newline is output, the output buffer overflows,
 433 a flush is issued, or the handle is closed.
 434
 435 \item[block-buffering] the entire output buffer is written out whenever
 436 it overflows, a flush is issued, or the handle
 437 is closed.
 438
 439 \item[no-buffering] output is written immediately, and never stored
 440 in the output buffer.
 441 \end{itemize}
 442
 443 The output buffer is emptied as soon as it has been written out.
 444
 445 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
 446 \begin{itemize}
 447 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
 448 the next item is obtained from the buffer;
 449 otherwise, when the input buffer is empty,
 450 characters up to and including the next newline
 451 character are read into the buffer.  No characters
 452 are available until the newline character is
 453 available.
 454 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
 455 the next block of data is read into this buffer.
 456 \item[no-buffering] the next input item is read and returned.
 457 \end{itemize}
 458 For most implementations, physical files will normally be block-buffered
 459 and terminals will normally be line-buffered.
 460
 461 \begin{code}
 462 data BufferMode
 463  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
 464    deriving (Eq, Ord, Read, Show)
 465 \end{code}