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