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{change}
 220 SOF & 4/96 & added argument to indicate function that flagged error
 221 \end{change}
 222 % Hmm..does these envs work?!...SOF
 223
 224 \begin{code}
 225 constructErrorAndFail :: String -> IO a
 226 constructErrorAndFail call_site
 227   = constructError call_site >>= \ 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 =
 247  _casm_ ``%r = ghc_errtype;''    >>= \ (I# errtype#) ->
 248  _casm_ ``%r = ghc_errstr;''     >>= \ str ->
 249  let
 250   iot =
 251    case errtype# of
 252      ERR_ALREADYEXISTS#          -> AlreadyExists
 253      ERR_HARDWAREFAULT#          -> HardwareFault
 254      ERR_ILLEGALOPERATION#       -> IllegalOperation
 255      ERR_INAPPROPRIATETYPE#      -> InappropriateType
 256      ERR_INTERRUPTED#            -> Interrupted
 257      ERR_INVALIDARGUMENT#        -> InvalidArgument
 258      ERR_NOSUCHTHING#            -> NoSuchThing
 259      ERR_OTHERERROR#             -> OtherError
 260      ERR_PERMISSIONDENIED#       -> PermissionDenied
 261      ERR_PROTOCOLERROR#          -> ProtocolError
 262      ERR_RESOURCEBUSY#           -> ResourceBusy
 263      ERR_RESOURCEEXHAUSTED#      -> ResourceExhausted
 264      ERR_RESOURCEVANISHED#       -> ResourceVanished
 265      ERR_SYSTEMERROR#            -> SystemError
 266      ERR_TIMEEXPIRED#            -> TimeExpired
 267      ERR_UNSATISFIEDCONSTRAINTS# -> UnsatisfiedConstraints
 268      ERR_UNSUPPORTEDOPERATION#   -> UnsupportedOperation
 269      ERR_EOF#                    -> EOF
 270      _                           -> OtherError
 271
 272   msg =
 273    call_site ++ ':' : ' ' : unpackCString str ++
 274    case iot of
 275      OtherError -> "(error code: " ++ show (I# errtype#) ++ ")"
 276      _ -> ""
 277  in
 278  return (IOError Nothing iot msg)
 279 \end{code}
 280
 281 %*********************************************************
 282 %*                                                      *
 283 \subsection{Types @Handle@, @Handle__@}
 284 %*                                                      *
 285 %*********************************************************
 286
 287 The type for @Handle@ is defined rather than in @IOHandle@
 288 module, as the @IOError@ type uses it..all operations over
 289 a handles reside in @IOHandle@.
 290
 291 \begin{code}
 292
 293 {-
 294  Sigh, the MVar ops in ConcBase depend on IO, the IO
 295  representation here depend on MVars for handles (when
 296  compiling a concurrent way). Break the cycle by having
 297  the definition of MVars go here:
 298
 299 -}
 300 data MVar a = MVar (SynchVar# RealWorld a)
 301
 302 {-
 303   Double sigh - ForeignObj is needed here too to break a cycle.
 304 -}
 305 data ForeignObj = ForeignObj ForeignObj#   -- another one
 306
 307 #if defined(__CONCURRENT_HASKELL__)
 308 newtype Handle = Handle (MVar Handle__)
 309 #else
 310 newtype Handle = Handle (MutableVar RealWorld Handle__)
 311 #endif
 312
 313 data Handle__
 314   = ErrorHandle         IOError
 315   | ClosedHandle
 316 #ifndef __PARALLEL_HASKELL__
 317   | SemiClosedHandle    ForeignObj (Addr, Int)
 318   | ReadHandle          ForeignObj (Maybe BufferMode) Bool
 319   | WriteHandle         ForeignObj (Maybe BufferMode) Bool
 320   | AppendHandle        ForeignObj (Maybe BufferMode) Bool
 321   | ReadWriteHandle     ForeignObj (Maybe BufferMode) Bool
 322 #else
 323   | SemiClosedHandle    Addr (Addr, Int)
 324   | ReadHandle          Addr (Maybe BufferMode) Bool
 325   | WriteHandle         Addr (Maybe BufferMode) Bool
 326   | AppendHandle        Addr (Maybe BufferMode) Bool
 327   | ReadWriteHandle     Addr (Maybe BufferMode) Bool
 328 #endif
 329
 330 -- Standard Instances as defined by the Report..
 331 -- instance Eq Handle   (defined in IO)
 332 -- instance Show Handle    ""
 333
 334 \end{code}
 335
 336 %*********************************************************
 337 %*                                                      *
 338 \subsection[BufferMode]{Buffering modes}
 339 %*                                                      *
 340 %*********************************************************
 341
 342 Three kinds of buffering are supported: line-buffering,
 343 block-buffering or no-buffering.  These modes have the following
 344 effects. For output, items are written out from the internal
 345 buffer according to the buffer mode:
 346
 347 \begin{itemize}
 348 \item[line-buffering]  the entire output buffer is written
 349 out whenever a newline is output, the output buffer overflows,
 350 a flush is issued, or the handle is closed.
 351
 352 \item[block-buffering] the entire output buffer is written out whenever
 353 it overflows, a flush is issued, or the handle
 354 is closed.
 355
 356 \item[no-buffering] output is written immediately, and never stored
 357 in the output buffer.
 358 \end{itemize}
 359
 360 The output buffer is emptied as soon as it has been written out.
 361
 362 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
 363 \begin{itemize}
 364 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
 365 the next item is obtained from the buffer;
 366 otherwise, when the input buffer is empty,
 367 characters up to and including the next newline
 368 character are read into the buffer.  No characters
 369 are available until the newline character is
 370 available.
 371 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
 372 the next block of data is read into this buffer.
 373 \item[no-buffering] the next input item is read and returned.
 374 \end{itemize}
 375 For most implementations, physical files will normally be block-buffered
 376 and terminals will normally be line-buffered.
 377
 378 \begin{code}
 379 data BufferMode
 380  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
 381    deriving (Eq, Ord, Show)
 382    {- Read instance defined in IO. -}
 383
 384 \end{code}
 385
 386 \begin{code}
 387 performGC :: IO ()
 388 performGC = _ccall_GC_ StgPerformGarbageCollection
 389 \end{code}