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 #-}
  12 #include "error.h"
  13
  14 module PrelIOBase where
  15
  16 import {-# SOURCE #-} PrelErr ( error )
  17 import PrelST
  18 import PrelTup
  19 import PrelMaybe
  20 import PrelAddr
  21 import PrelPack ( unpackCString )
  22 import PrelBase
  23 import PrelArr  ( ByteArray(..), MutableVar )
  24 import PrelGHC
  25
  26 \end{code}
  27
  28 %*********************************************************
  29 %*                                                      *
  30 \subsection{The @IO@ monad}
  31 %*                                                      *
  32 %*********************************************************
  33
  34 IO is no longer built on top of PrimIO (which used to be a specialised
  35 version of the ST monad), instead it is now has its own type.  This is
  36 purely for efficiency purposes, since we get to remove several levels
  37 of lifting in the type of the monad.
  38
  39 \begin{code}
  40 newtype IO a = IO (State# RealWorld -> IOResult a)
  41
  42 {-# INLINE unIO #-}
  43 unIO (IO a) = a
  44
  45 data IOResult a = IOok   (State# RealWorld) a
  46                 | IOfail (State# RealWorld) IOError
  47
  48 instance  Functor IO where
  49    map f x = x >>= (return . f)
  50
  51 instance  Monad IO  where
  52     {-# INLINE return #-}
  53     {-# INLINE (>>)   #-}
  54     {-# INLINE (>>=)  #-}
  55     m >> k      =  m >>= \ _ -> k
  56     return x    = IO $ \ s -> IOok s x
  57
  58     (IO m) >>= k =
  59         IO $ \s ->
  60         case m s of
  61             IOfail new_s err -> IOfail new_s err
  62             IOok   new_s a   -> unIO (k a) new_s
  63
  64 fixIO :: (a -> IO a) -> IO a
  65     -- not required but worth having around
  66
  67 fixIO k = IO $ \ s ->
  68     let
  69         (IO k_loop) = k loop
  70         result      = k_loop s
  71         IOok _ loop = result
  72     in
  73     result
  74
  75 fail            :: IOError -> IO a
  76 fail err        =  IO $ \ s -> IOfail s err
  77
  78 userError       :: String  -> IOError
  79 userError str   =  IOError Nothing UserError str
  80
  81 catch           :: IO a    -> (IOError -> IO a) -> IO a
  82 catch (IO m) k  = IO $ \ s ->
  83   case m s of
  84     IOok   new_s a -> IOok new_s a
  85     IOfail new_s e -> unIO (k e) new_s
  86
  87 instance  Show (IO a)  where
  88     showsPrec p f  = showString "<<IO action>>"
  89     showList       = showList__ (showsPrec 0)
  90 \end{code}
  91
  92 %*********************************************************
  93 %*                                                      *
  94 \subsection{Coercions to @ST@}
  95 %*                                                      *
  96 %*********************************************************
  97
  98 \begin{code}
  99 stToIO     :: ST RealWorld a -> IO a
 100 stToIO (ST m) = IO $ \ s -> case (m s) of STret new_s r -> IOok new_s r
 101
 102 ioToST     :: IO a -> ST RealWorld a
 103 ioToST (IO io) = ST $ \ s ->
 104     case (io s) of
 105       IOok   new_s a -> STret new_s a
 106       IOfail new_s e -> error ("I/O Error (ioToST): " ++ showsPrec 0 e "\n")
 107 \end{code}
 108
 109 %*********************************************************
 110 %*                                                      *
 111 \subsection{Utility functions}
 112 %*                                                      *
 113 %*********************************************************
 114
 115 I'm not sure why this little function is here...
 116
 117 \begin{code}
 118 fputs :: Addr{-FILE*-} -> String -> IO Bool
 119
 120 fputs stream [] = return True
 121
 122 fputs stream (c : cs)
 123   = _ccall_ stg_putc c stream >>         -- stg_putc expands to putc
 124     fputs stream cs                      -- (just does some casting stream)
 125 \end{code}
 126
 127
 128 %*********************************************************
 129 %*                                                      *
 130 \subsection{Type @IOError@}
 131 %*                                                      *
 132 %*********************************************************
 133
 134 A value @IOError@ encode errors occurred in the @IO@ monad.
 135 An @IOError@ records a more specific error type, a descriptive
 136 string and maybe the handle that was used when the error was
 137 flagged.
 138
 139 \begin{code}
 140 data IOError
 141  = IOError
 142      (Maybe Handle)  -- the handle used by the action flagging the
 143                      -- the error.
 144      IOErrorType     -- what it was.
 145      String          -- error type specific information.
 146
 147
 148 data IOErrorType
 149   = AlreadyExists        | HardwareFault
 150   | IllegalOperation     | InappropriateType
 151   | Interrupted          | InvalidArgument
 152   | NoSuchThing          | OtherError
 153   | PermissionDenied     | ProtocolError
 154   | ResourceBusy         | ResourceExhausted
 155   | ResourceVanished     | SystemError
 156   | TimeExpired          | UnsatisfiedConstraints
 157   | UnsupportedOperation | UserError
 158   | EOF
 159   deriving (Eq, Show)
 160
 161 \end{code}
 162
 163 Predicates on IOError; little effort made on these so far...
 164
 165 \begin{code}
 166
 167 isAlreadyExistsError (IOError _ AlreadyExists _) = True
 168 isAlreadyExistsError _                           = False
 169
 170 isAlreadyInUseError (IOError _ ResourceBusy _) = True
 171 isAlreadyInUseError _                          = False
 172
 173 isFullError (IOError _ ResourceExhausted _) = True
 174 isFullError _                               = False
 175
 176 isEOFError (IOError _ EOF _) = True
 177 isEOFError _                 = True
 178
 179 isIllegalOperation (IOError _ IllegalOperation _) = True
 180 isIllegalOperation _                              = False
 181
 182 isPermissionError (IOError _ PermissionDenied _) = True
 183 isPermissionError _                              = False
 184
 185 isDoesNotExistError (IOError _ NoSuchThing _) = True
 186 isDoesNotExistError _                         = False
 187
 188 isUserError (IOError _ UserError _) = True
 189 isUserError _                       = False
 190 \end{code}
 191
 192 Showing @IOError@s
 193
 194 \begin{code}
 195 instance Show IOError where
 196     showsPrec p (IOError _ UserError s) rs =
 197       showString s rs
 198 {-
 199     showsPrec p (IOError _ EOF _) rs =
 200       showsPrec p EOF rs
 201 -}
 202     showsPrec p (IOError _ iot s) rs =
 203       showsPrec p
 204                 iot
 205                 (case s of {
 206                   "" -> rs;
 207                   _ -> showString ": " $
 208                        showString s rs})
 209
 210 \end{code}
 211
 212 The @String@ part of an @IOError@ is platform-dependent.  However, to
 213 provide a uniform mechanism for distinguishing among errors within
 214 these broad categories, each platform-specific standard shall specify
 215 the exact strings to be used for particular errors.  For errors not
 216 explicitly mentioned in the standard, any descriptive string may be
 217 used.
 218
 219 \begin{code}
 220 constructErrorAndFail :: String -> IO a
 221 constructErrorAndFail call_site
 222   = constructError call_site >>= \ io_error ->
 223     fail io_error
 224
 225 constructErrorAndFailWithInfo :: String -> String -> IO a
 226 constructErrorAndFailWithInfo call_site reason
 227   = constructErrorMsg call_site (Just reason) >>= \ io_error ->
 228     fail io_error
 229
 230 \end{code}
 231
 232 This doesn't seem to be documented/spelled out anywhere,
 233 so here goes: (SOF)
 234
 235 The implementation of the IO prelude uses various C stubs
 236 to do the actual interaction with the OS. The bandwidth
 237 \tr{C<->Haskell} is somewhat limited, so the general strategy
 238 for flaggging any errors (apart from possibly using the
 239 return code of the external call), is to set the @ghc_errtype@
 240 to a value that is one of the \tr{#define}s in @includes/error.h@.
 241 @ghc_errstr@ holds a character string providing error-specific
 242 information.
 243
 244 \begin{code}
 245 constructError        :: String -> IO IOError
 246 constructError call_site = constructErrorMsg call_site Nothing
 247
 248 constructErrorMsg             :: String -> Maybe String -> IO IOError
 249 constructErrorMsg call_site reason =
 250  _casm_ ``%r = ghc_errtype;''    >>= \ (I# errtype#) ->
 251  _casm_ ``%r = ghc_errstr;''     >>= \ str ->
 252  let
 253   iot =
 254    case errtype# of
 255      ERR_ALREADYEXISTS#          -> AlreadyExists
 256      ERR_HARDWAREFAULT#          -> HardwareFault
 257      ERR_ILLEGALOPERATION#       -> IllegalOperation
 258      ERR_INAPPROPRIATETYPE#      -> InappropriateType
 259      ERR_INTERRUPTED#            -> Interrupted
 260      ERR_INVALIDARGUMENT#        -> InvalidArgument
 261      ERR_NOSUCHTHING#            -> NoSuchThing
 262      ERR_OTHERERROR#             -> OtherError
 263      ERR_PERMISSIONDENIED#       -> PermissionDenied
 264      ERR_PROTOCOLERROR#          -> ProtocolError
 265      ERR_RESOURCEBUSY#           -> ResourceBusy
 266      ERR_RESOURCEEXHAUSTED#      -> ResourceExhausted
 267      ERR_RESOURCEVANISHED#       -> ResourceVanished
 268      ERR_SYSTEMERROR#            -> SystemError
 269      ERR_TIMEEXPIRED#            -> TimeExpired
 270      ERR_UNSATISFIEDCONSTRAINTS# -> UnsatisfiedConstraints
 271      ERR_UNSUPPORTEDOPERATION#   -> UnsupportedOperation
 272      ERR_EOF#                    -> EOF
 273      _                           -> OtherError
 274
 275   msg =
 276    call_site ++ ':' : ' ' : unpackCString str ++
 277    (case iot of
 278      OtherError -> "(error code: " ++ show (I# errtype#) ++ ")"
 279      _ -> "") ++
 280    (case reason of
 281       Nothing -> ""
 282       Just m  -> ' ':m)
 283  in
 284  return (IOError Nothing iot msg)
 285 \end{code}
 286
 287 %*********************************************************
 288 %*                                                      *
 289 \subsection{Types @Handle@, @Handle__@}
 290 %*                                                      *
 291 %*********************************************************
 292
 293 The type for @Handle@ is defined rather than in @IOHandle@
 294 module, as the @IOError@ type uses it..all operations over
 295 a handles reside in @IOHandle@.
 296
 297 \begin{code}
 298
 299 {-
 300  Sigh, the MVar ops in ConcBase depend on IO, the IO
 301  representation here depend on MVars for handles (when
 302  compiling a concurrent way). Break the cycle by having
 303  the definition of MVars go here:
 304
 305 -}
 306 data MVar a = MVar (SynchVar# RealWorld a)
 307
 308 {-
 309   Double sigh - ForeignObj is needed here too to break a cycle.
 310 -}
 311 data ForeignObj = ForeignObj ForeignObj#   -- another one
 312
 313 #if defined(__CONCURRENT_HASKELL__)
 314 newtype Handle = Handle (MVar Handle__)
 315 #else
 316 newtype Handle = Handle (MutableVar RealWorld Handle__)
 317 #endif
 318
 319 data Handle__
 320   = ErrorHandle         IOError
 321   | ClosedHandle
 322 #ifndef __PARALLEL_HASKELL__
 323   | SemiClosedHandle    ForeignObj (Addr, Int)
 324   | ReadHandle          ForeignObj (Maybe BufferMode) Bool
 325   | WriteHandle         ForeignObj (Maybe BufferMode) Bool
 326   | AppendHandle        ForeignObj (Maybe BufferMode) Bool
 327   | ReadWriteHandle     ForeignObj (Maybe BufferMode) Bool
 328 #else
 329   | SemiClosedHandle    Addr (Addr, Int)
 330   | ReadHandle          Addr (Maybe BufferMode) Bool
 331   | WriteHandle         Addr (Maybe BufferMode) Bool
 332   | AppendHandle        Addr (Maybe BufferMode) Bool
 333   | ReadWriteHandle     Addr (Maybe BufferMode) Bool
 334 #endif
 335
 336 -- Standard Instances as defined by the Report..
 337 -- instance Eq Handle   (defined in IO)
 338 -- instance Show Handle    ""
 339
 340 \end{code}
 341
 342 %*********************************************************
 343 %*                                                      *
 344 \subsection[BufferMode]{Buffering modes}
 345 %*                                                      *
 346 %*********************************************************
 347
 348 Three kinds of buffering are supported: line-buffering,
 349 block-buffering or no-buffering.  These modes have the following
 350 effects. For output, items are written out from the internal
 351 buffer according to the buffer mode:
 352
 353 \begin{itemize}
 354 \item[line-buffering]  the entire output buffer is written
 355 out whenever a newline is output, the output buffer overflows,
 356 a flush is issued, or the handle is closed.
 357
 358 \item[block-buffering] the entire output buffer is written out whenever
 359 it overflows, a flush is issued, or the handle
 360 is closed.
 361
 362 \item[no-buffering] output is written immediately, and never stored
 363 in the output buffer.
 364 \end{itemize}
 365
 366 The output buffer is emptied as soon as it has been written out.
 367
 368 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
 369 \begin{itemize}
 370 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
 371 the next item is obtained from the buffer;
 372 otherwise, when the input buffer is empty,
 373 characters up to and including the next newline
 374 character are read into the buffer.  No characters
 375 are available until the newline character is
 376 available.
 377 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
 378 the next block of data is read into this buffer.
 379 \item[no-buffering] the next input item is read and returned.
 380 \end{itemize}
 381 For most implementations, physical files will normally be block-buffered
 382 and terminals will normally be line-buffered.
 383
 384 \begin{code}
 385 data BufferMode
 386  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
 387    deriving (Eq, Ord, Show)
 388    {- Read instance defined in IO. -}
 389
 390 \end{code}
 391
 392 \begin{code}
 393 performGC :: IO ()
 394 performGC = _ccall_GC_ StgPerformGarbageCollection
 395 \end{code}