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