ghc/lib/std/PrelIOBase.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelIOBase.lhs,v 1.31 2001/01/11 07:04:16 qrczak Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \section[PrelIOBase]{Module @PrelIOBase@}
   8
   9 Definitions for the @IO@ monad and its friends.  Everything is exported
  10 concretely; the @IO@ module itself exports abstractly.
  11
  12 \begin{code}
  13 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
  14 #include "config.h"
  15 #include "cbits/stgerror.h"
  16
  17 #ifndef __HUGS__ /* Hugs just includes this in PreludeBuiltin so no header needed */
  18 module PrelIOBase where
  19
  20 import {-# SOURCE #-} PrelErr ( error )
  21
  22 import PrelST
  23 import PrelBase
  24 import PrelNum    ( fromInteger )       -- Integer literals
  25 import PrelMaybe  ( Maybe(..) )
  26 import PrelAddr   ( Addr(..), nullAddr )
  27 import PrelShow
  28 import PrelList
  29 import PrelDynamic
  30 import PrelPack ( unpackCString )
  31
  32 #if !defined(__CONCURRENT_HASKELL__)
  33 import PrelArr    ( MutableVar, readVar )
  34 #endif
  35 #endif
  36
  37 #ifdef __HUGS__
  38 #define __CONCURRENT_HASKELL__
  39 #define stToIO id
  40 #define unpackCString primUnpackString
  41 #endif
  42
  43 #ifndef __PARALLEL_HASKELL__
  44 #define FILE_OBJECT         ForeignObj
  45 #else
  46 #define FILE_OBJECT         Addr
  47 #endif
  48 \end{code}
  49
  50 %*********************************************************
  51 %*                                                      *
  52 \subsection{The @IO@ monad}
  53 %*                                                      *
  54 %*********************************************************
  55
  56 The IO Monad is just an instance of the ST monad, where the state is
  57 the real world.  We use the exception mechanism (in PrelException) to
  58 implement IO exceptions.
  59
  60 NOTE: The IO representation is deeply wired in to various parts of the
  61 system.  The following list may or may not be exhaustive:
  62
  63 Compiler  - types of various primitives in PrimOp.lhs
  64
  65 RTS       - forceIO (StgMiscClosures.hc)
  66           - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
  67             (Exceptions.hc)
  68           - raiseAsync (Schedule.c)
  69
  70 Prelude   - PrelIOBase.lhs, and several other places including
  71             PrelException.lhs.
  72
  73 Libraries - parts of hslibs/lang.
  74
  75 --SDM
  76
  77 \begin{code}
  78 #ifndef __HUGS__
  79 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
  80
  81 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
  82 unIO (IO a) = a
  83
  84 instance  Functor IO where
  85    fmap f x = x >>= (return . f)
  86
  87 instance  Monad IO  where
  88     {-# INLINE return #-}
  89     {-# INLINE (>>)   #-}
  90     {-# INLINE (>>=)  #-}
  91     m >> k      =  m >>= \ _ -> k
  92     return x    = returnIO x
  93
  94     m >>= k     = bindIO m k
  95     fail s      = ioError (userError s)
  96
  97 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
  98 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
  99
 100 bindIO :: IO a -> (a -> IO b) -> IO b
 101 bindIO (IO m) k = IO ( \ s ->
 102   case m s of
 103     (# new_s, a #) -> unIO (k a) new_s
 104   )
 105
 106 returnIO :: a -> IO a
 107 returnIO x = IO (\ s -> (# s, x #))
 108 #endif
 109 \end{code}
 110
 111 %*********************************************************
 112 %*                                                      *
 113 \subsection{Coercions to @ST@}
 114 %*                                                      *
 115 %*********************************************************
 116
 117 \begin{code}
 118 #ifdef __HUGS__
 119 /* Hugs doesn't distinguish these types so no coercion required) */
 120 #else
 121 stToIO        :: ST RealWorld a -> IO a
 122 stToIO (ST m) = (IO m)
 123
 124 ioToST        :: IO a -> ST RealWorld a
 125 ioToST (IO m) = (ST m)
 126 #endif
 127 \end{code}
 128
 129 %*********************************************************
 130 %*                                                      *
 131 \subsection{Unsafe @IO@ operations}
 132 %*                                                      *
 133 %*********************************************************
 134
 135 \begin{code}
 136 #ifndef __HUGS__
 137 {-# NOINLINE unsafePerformIO #-}
 138 unsafePerformIO :: IO a -> a
 139 unsafePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
 140
 141 unsafeInterleaveIO :: IO a -> IO a
 142 unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST
 143 #endif
 144 \end{code}
 145
 146 %*********************************************************
 147 %*                                                      *
 148 \subsection{Types @Handle@, @Handle__@}
 149 %*                                                      *
 150 %*********************************************************
 151
 152 The type for @Handle@ is defined rather than in @IOHandle@
 153 module, as the @IOError@ type uses it..all operations over
 154 a handles reside in @IOHandle@.
 155
 156 \begin{code}
 157
 158 #ifndef __HUGS__
 159 {-
 160  Sigh, the MVar ops in ConcBase depend on IO, the IO
 161  representation here depend on MVars for handles (when
 162  compiling in a concurrent way). Break the cycle by having
 163  the definition of MVars go here:
 164
 165 -}
 166 data MVar a = MVar (MVar# RealWorld a)
 167
 168 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
 169 instance Eq (MVar a) where
 170         (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
 171
 172 {-
 173   Double sigh - ForeignObj is needed here too to break a cycle.
 174 -}
 175 data ForeignObj = ForeignObj ForeignObj#   -- another one
 176 instance CCallable ForeignObj
 177
 178 eqForeignObj :: ForeignObj  -> ForeignObj -> Bool
 179 eqForeignObj mp1 mp2
 180   = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
 181
 182 foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
 183
 184 instance Eq ForeignObj where
 185     p == q = eqForeignObj p q
 186     p /= q = not (eqForeignObj p q)
 187 #endif /* ndef __HUGS__ */
 188
 189 #if defined(__CONCURRENT_HASKELL__)
 190 newtype Handle = Handle (MVar Handle__)
 191 #else
 192 newtype Handle = Handle (MutableVar RealWorld Handle__)
 193 #endif
 194
 195 instance Eq Handle where
 196  (Handle h1) == (Handle h2) = h1 == h2
 197
 198 {-
 199   A Handle is represented by (a reference to) a record
 200   containing the state of the I/O port/device. We record
 201   the following pieces of info:
 202
 203     * type (read,write,closed etc.)
 204     * pointer to the external file object.
 205     * buffering mode
 206     * user-friendly name (usually the
 207       FilePath used when IO.openFile was called)
 208
 209 Note: when a Handle is garbage collected, we want to flush its buffer
 210 and close the OS file handle, so as to free up a (precious) resource.
 211 -}
 212 data Handle__
 213   = Handle__ {
 214       haFO__          :: FILE_OBJECT,
 215       haType__        :: Handle__Type,
 216       haBufferMode__  :: BufferMode,
 217       haFilePath__    :: FilePath,
 218       haBuffers__     :: [Addr]
 219     }
 220
 221 {-
 222   Internally, we classify handles as being one
 223   of the following:
 224 -}
 225 data Handle__Type
 226  = ClosedHandle
 227  | SemiClosedHandle
 228  | ReadHandle
 229  | WriteHandle
 230  | AppendHandle
 231  | ReadWriteHandle
 232
 233
 234 -- File names are specified using @FilePath@, a OS-dependent
 235 -- string that (hopefully, I guess) maps to an accessible file/object.
 236
 237 type FilePath = String
 238 \end{code}
 239
 240 %*********************************************************
 241 %*                                                      *
 242 \subsection[Show-Handle]{Show instance for Handles}
 243 %*                                                      *
 244 %*********************************************************
 245
 246 \begin{code}
 247 -- handle types are 'show'ed when printing error msgs, so
 248 -- we provide a more user-friendly Show instance for it
 249 -- than the derived one.
 250 instance Show Handle__Type where
 251   showsPrec p t =
 252     case t of
 253       ClosedHandle      -> showString "closed"
 254       SemiClosedHandle  -> showString "semi-closed"
 255       ReadHandle        -> showString "readable"
 256       WriteHandle       -> showString "writeable"
 257       AppendHandle      -> showString "writeable (append)"
 258       ReadWriteHandle   -> showString "read-writeable"
 259
 260 instance Show Handle where
 261   showsPrec p (Handle h) =
 262     let
 263 #if defined(__CONCURRENT_HASKELL__)
 264 #ifdef __HUGS__
 265      hdl_ = unsafePerformIO (primTakeMVar h)
 266 #else
 267      -- (Big) SIGH: unfolded defn of takeMVar to avoid
 268      -- an (oh-so) unfortunate module loop with PrelConc.
 269      hdl_ = unsafePerformIO (IO $ \ s# ->
 270              case h               of { MVar h# ->
 271              case takeMVar# h# s# of { (# s2# , r #) ->
 272                     (# s2#, r #) }})
 273 #endif
 274 #else
 275      hdl_ = unsafePerformIO (stToIO (readVar h))
 276 #endif
 277     in
 278     showChar '{' .
 279     showHdl (haType__ hdl_)
 280             (showString "loc=" . showString (haFilePath__ hdl_) . showChar ',' .
 281              showString "type=" . showsPrec p (haType__ hdl_) . showChar ',' .
 282              showString "buffering=" . showBufMode (haFO__ hdl_) (haBufferMode__ hdl_) . showString "}\n" )
 283    where
 284     showHdl :: Handle__Type -> ShowS -> ShowS
 285     showHdl ht cont =
 286        case ht of
 287         ClosedHandle  -> showsPrec p ht . showString "}\n"
 288         _ -> cont
 289
 290     showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
 291     showBufMode fo bmo =
 292       case bmo of
 293         NoBuffering   -> showString "none"
 294         LineBuffering -> showString "line"
 295         BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
 296         BlockBuffering Nothing  -> showString "block " . showParen True (showsPrec p def)
 297       where
 298        def :: Int
 299        def = unsafePerformIO (getBufSize fo)
 300 \end{code}
 301
 302 %*********************************************************
 303 %*                                                      *
 304 \subsection[BufferMode]{Buffering modes}
 305 %*                                                      *
 306 %*********************************************************
 307
 308 Three kinds of buffering are supported: line-buffering,
 309 block-buffering or no-buffering.  These modes have the following
 310 effects. For output, items are written out from the internal
 311 buffer according to the buffer mode:
 312
 313 \begin{itemize}
 314 \item[line-buffering]  the entire output buffer is written
 315 out whenever a newline is output, the output buffer overflows,
 316 a flush is issued, or the handle is closed.
 317
 318 \item[block-buffering] the entire output buffer is written out whenever
 319 it overflows, a flush is issued, or the handle
 320 is closed.
 321
 322 \item[no-buffering] output is written immediately, and never stored
 323 in the output buffer.
 324 \end{itemize}
 325
 326 The output buffer is emptied as soon as it has been written out.
 327
 328 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
 329 \begin{itemize}
 330 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
 331 the next item is obtained from the buffer;
 332 otherwise, when the input buffer is empty,
 333 characters up to and including the next newline
 334 character are read into the buffer.  No characters
 335 are available until the newline character is
 336 available.
 337 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
 338 the next block of data is read into this buffer.
 339 \item[no-buffering] the next input item is read and returned.
 340 \end{itemize}
 341
 342 For most implementations, physical files will normally be block-buffered
 343 and terminals will normally be line-buffered. (the IO interface provides
 344 operations for changing the default buffering of a handle tho.)
 345
 346 \begin{code}
 347 data BufferMode
 348  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
 349    deriving (Eq, Ord, Show)
 350    {- Read instance defined in IO. -}
 351
 352 \end{code}
 353
 354 Foreign import declarations to helper routines:
 355
 356 \begin{code}
 357 foreign import "libHS_cbits" "getErrStr__"  unsafe getErrStr__  :: IO Addr
 358 foreign import "libHS_cbits" "getErrNo__"   unsafe getErrNo__   :: IO Int
 359 foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
 360
 361 malloc :: Int -> IO Addr
 362 malloc sz = do
 363   a <- _malloc sz
 364   if (a == nullAddr)
 365         then ioException (IOError Nothing ResourceExhausted
 366             "malloc" "out of memory" Nothing)
 367         else return a
 368
 369 foreign import "malloc" unsafe _malloc :: Int -> IO Addr
 370
 371 foreign import "libHS_cbits" "getBufSize"  unsafe
 372            getBufSize       :: FILE_OBJECT -> IO Int
 373 foreign import "libHS_cbits" "setBuf" unsafe
 374            setBuf       :: FILE_OBJECT -> Addr -> Int -> IO ()
 375
 376 \end{code}
 377
 378 %*********************************************************
 379 %*                                                      *
 380 \subsection{Exception datatype and operations}
 381 %*                                                      *
 382 %*********************************************************
 383
 384 \begin{code}
 385 data Exception
 386   = IOException         IOException     -- IO exceptions
 387   | ArithException      ArithException  -- Arithmetic exceptions
 388   | ArrayException      ArrayException  -- Array-related exceptions
 389   | ErrorCall           String          -- Calls to 'error'
 390   | NoMethodError       String          -- A non-existent method was invoked
 391   | PatternMatchFail    String          -- A pattern match / guard failure
 392   | RecSelError         String          -- Selecting a non-existent field
 393   | RecConError         String          -- Field missing in record construction
 394   | RecUpdError         String          -- Record doesn't contain updated field
 395   | AssertionFailed     String          -- Assertions
 396   | DynException        Dynamic         -- Dynamic exceptions
 397   | AsyncException      AsyncException  -- Externally generated errors
 398   | PutFullMVar                         -- Put on a full MVar
 399   | BlockedOnDeadMVar                   -- Blocking on a dead MVar
 400   | NonTermination
 401   | UserError           String
 402
 403 data ArithException
 404   = Overflow
 405   | Underflow
 406   | LossOfPrecision
 407   | DivideByZero
 408   | Denormal
 409   deriving (Eq, Ord)
 410
 411 data AsyncException
 412   = StackOverflow
 413   | HeapOverflow
 414   | ThreadKilled
 415   deriving (Eq, Ord)
 416
 417 data ArrayException
 418   = IndexOutOfBounds    String          -- out-of-range array access
 419   | UndefinedElement    String          -- evaluating an undefined element
 420   deriving (Eq, Ord)
 421
 422 stackOverflow, heapOverflow :: Exception -- for the RTS
 423 stackOverflow = AsyncException StackOverflow
 424 heapOverflow  = AsyncException HeapOverflow
 425
 426 instance Show ArithException where
 427   showsPrec _ Overflow        = showString "arithmetic overflow"
 428   showsPrec _ Underflow       = showString "arithmetic underflow"
 429   showsPrec _ LossOfPrecision = showString "loss of precision"
 430   showsPrec _ DivideByZero    = showString "divide by zero"
 431   showsPrec _ Denormal        = showString "denormal"
 432
 433 instance Show AsyncException where
 434   showsPrec _ StackOverflow   = showString "stack overflow"
 435   showsPrec _ HeapOverflow    = showString "heap overflow"
 436   showsPrec _ ThreadKilled    = showString "thread killed"
 437
 438 instance Show ArrayException where
 439   showsPrec _ (IndexOutOfBounds s)
 440         = showString "array index out of range"
 441         . (if not (null s) then showString ": " . showString s
 442                            else id)
 443   showsPrec _ (UndefinedElement s)
 444         = showString "undefined array element"
 445         . (if not (null s) then showString ": " . showString s
 446                            else id)
 447
 448 instance Show Exception where
 449   showsPrec _ (IOException err)          = shows err
 450   showsPrec _ (ArithException err)       = shows err
 451   showsPrec _ (ArrayException err)       = shows err
 452   showsPrec _ (ErrorCall err)            = showString err
 453   showsPrec _ (NoMethodError err)        = showString err
 454   showsPrec _ (PatternMatchFail err)     = showString err
 455   showsPrec _ (RecSelError err)          = showString err
 456   showsPrec _ (RecConError err)          = showString err
 457   showsPrec _ (RecUpdError err)          = showString err
 458   showsPrec _ (AssertionFailed err)      = showString err
 459   showsPrec _ (DynException _err)        = showString "unknown exception"
 460   showsPrec _ (AsyncException e)         = shows e
 461   showsPrec _ (PutFullMVar)              = showString "putMVar: full MVar"
 462   showsPrec _ (BlockedOnDeadMVar)        = showString "thread blocked indefinitely"
 463   showsPrec _ (NonTermination)           = showString "<<loop>>"
 464   showsPrec _ (UserError err)            = showString err
 465 \end{code}
 466
 467 %*********************************************************
 468 %*                                                      *
 469 \subsection{Primitive throw}
 470 %*                                                      *
 471 %*********************************************************
 472
 473 \begin{code}
 474 throw :: Exception -> a
 475 throw exception = raise# exception
 476
 477 ioError         :: Exception -> IO a
 478 ioError err     =  IO $ \s -> throw err s
 479
 480 ioException     :: IOException -> IO a
 481 ioException err =  IO $ \s -> throw (IOException err) s
 482 \end{code}
 483
 484 %*********************************************************
 485 %*                                                      *
 486 \subsection{Type @IOError@}
 487 %*                                                      *
 488 %*********************************************************
 489
 490 A value @IOError@ encode errors occurred in the @IO@ monad.
 491 An @IOError@ records a more specific error type, a descriptive
 492 string and maybe the handle that was used when the error was
 493 flagged.
 494
 495 \begin{code}
 496 type IOError = Exception
 497
 498 data IOException
 499  = IOError
 500      (Maybe Handle)   -- the handle used by the action flagging the
 501                       --   the error.
 502      IOErrorType      -- what it was.
 503      String           -- location.
 504      String           -- error type specific information.
 505      (Maybe FilePath) -- filename the error is related to.
 506
 507 instance Eq IOException where
 508   (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
 509     e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
 510
 511 data IOErrorType
 512   = AlreadyExists        | HardwareFault
 513   | IllegalOperation     | InappropriateType
 514   | Interrupted          | InvalidArgument
 515   | NoSuchThing          | OtherError
 516   | PermissionDenied     | ProtocolError
 517   | ResourceBusy         | ResourceExhausted
 518   | ResourceVanished     | SystemError
 519   | TimeExpired          | UnsatisfiedConstraints
 520   | UnsupportedOperation
 521   | EOF
 522 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
 523   | ComError Int           -- HRESULT
 524 #endif
 525   deriving (Eq)
 526
 527 instance Show IOErrorType where
 528   showsPrec _ e =
 529     showString $
 530     case e of
 531       AlreadyExists     -> "already exists"
 532       HardwareFault     -> "hardware fault"
 533       IllegalOperation  -> "illegal operation"
 534       InappropriateType -> "inappropriate type"
 535       Interrupted       -> "interrupted"
 536       InvalidArgument   -> "invalid argument"
 537       NoSuchThing       -> "does not exist"
 538       OtherError        -> "failed"
 539       PermissionDenied  -> "permission denied"
 540       ProtocolError     -> "protocol error"
 541       ResourceBusy      -> "resource busy"
 542       ResourceExhausted -> "resource exhausted"
 543       ResourceVanished  -> "resource vanished"
 544       SystemError       -> "system error"
 545       TimeExpired       -> "timeout"
 546       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
 547       UnsupportedOperation -> "unsupported operation"
 548       EOF               -> "end of file"
 549 #if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
 550       ComError _        -> "COM error"
 551 #endif
 552
 553
 554
 555 userError       :: String  -> IOError
 556 userError str   =  UserError str
 557 \end{code}
 558
 559 Predicates on IOError; little effort made on these so far...
 560
 561 \begin{code}
 562
 563 isAlreadyExistsError :: IOError -> Bool
 564 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
 565 isAlreadyExistsError _                                             = False
 566
 567 isAlreadyInUseError :: IOError -> Bool
 568 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
 569 isAlreadyInUseError _                                            = False
 570
 571 isFullError :: IOError -> Bool
 572 isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
 573 isFullError _                                                 = False
 574
 575 isEOFError :: IOError -> Bool
 576 isEOFError (IOException (IOError _ EOF _ _ _)) = True
 577 isEOFError _                                   = False
 578
 579 isIllegalOperation :: IOError -> Bool
 580 isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
 581 isIllegalOperation _                                                = False
 582
 583 isPermissionError :: IOError -> Bool
 584 isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
 585 isPermissionError _                                                = False
 586
 587 isDoesNotExistError :: IOError -> Bool
 588 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
 589 isDoesNotExistError _                                           = False
 590
 591 isUserError :: IOError -> Bool
 592 isUserError (UserError _) = True
 593 isUserError _             = False
 594 \end{code}
 595
 596 Showing @IOError@s
 597
 598 \begin{code}
 599 #ifdef __HUGS__
 600 -- For now we give a fairly uninformative error message which just happens to
 601 -- be like the ones that Hugs used to give.
 602 instance Show IOException where
 603     showsPrec p (IOError _ _ _ s _) = showString s . showChar '\n'
 604 #else
 605 instance Show IOException where
 606     showsPrec p (IOError hdl iot loc s fn) =
 607       showsPrec p iot .
 608       (case loc of
 609          "" -> id
 610          _  -> showString "\nAction: " . showString loc) .
 611       showHdl .
 612       (case s of
 613          "" -> id
 614          _  -> showString "\nReason: " . showString s) .
 615       (case fn of
 616          Nothing -> id
 617          Just name -> showString "\nFile: " . showString name)
 618      where
 619       showHdl =
 620        case hdl of
 621         Nothing -> id
 622         Just h  -> showString "\nHandle: " . showsPrec p h
 623
 624 #endif
 625 \end{code}
 626
 627 The @String@ part of an @IOError@ is platform-dependent.  However, to
 628 provide a uniform mechanism for distinguishing among errors within
 629 these broad categories, each platform-specific standard shall specify
 630 the exact strings to be used for particular errors.  For errors not
 631 explicitly mentioned in the standard, any descriptive string may be
 632 used.
 633
 634 \begin{code}
 635 constructErrorAndFail :: String -> IO a
 636 constructErrorAndFail call_site
 637   = constructError call_site >>= \ io_error ->
 638     ioError (IOException io_error)
 639
 640 constructErrorAndFailWithInfo :: String -> String -> IO a
 641 constructErrorAndFailWithInfo call_site fn
 642   = constructErrorMsg call_site (Just fn) >>= \ io_error ->
 643     ioError (IOException io_error)
 644
 645 \end{code}
 646
 647 This doesn't seem to be documented/spelled out anywhere,
 648 so here goes: (SOF)
 649
 650 The implementation of the IO prelude uses various C stubs
 651 to do the actual interaction with the OS. The bandwidth
 652 \tr{C<->Haskell} is somewhat limited, so the general strategy
 653 for flaggging any errors (apart from possibly using the
 654 return code of the external call), is to set the @ghc_errtype@
 655 to a value that is one of the \tr{#define}s in @includes/error.h@.
 656 @ghc_errstr@ holds a character string providing error-specific
 657 information. Error constructing functions will then reach out
 658 and grab these values when generating
 659
 660 \begin{code}
 661 constructError        :: String -> IO IOException
 662 constructError call_site = constructErrorMsg call_site Nothing
 663
 664 constructErrorMsg             :: String -> Maybe String -> IO IOException
 665 constructErrorMsg call_site fn =
 666  getErrType__            >>= \ errtype ->
 667  getErrStr__             >>= \ str ->
 668  let
 669   iot =
 670    case (errtype::Int) of
 671      ERR_ALREADYEXISTS           -> AlreadyExists
 672      ERR_HARDWAREFAULT           -> HardwareFault
 673      ERR_ILLEGALOPERATION        -> IllegalOperation
 674      ERR_INAPPROPRIATETYPE       -> InappropriateType
 675      ERR_INTERRUPTED             -> Interrupted
 676      ERR_INVALIDARGUMENT         -> InvalidArgument
 677      ERR_NOSUCHTHING             -> NoSuchThing
 678      ERR_OTHERERROR              -> OtherError
 679      ERR_PERMISSIONDENIED        -> PermissionDenied
 680      ERR_PROTOCOLERROR           -> ProtocolError
 681      ERR_RESOURCEBUSY            -> ResourceBusy
 682      ERR_RESOURCEEXHAUSTED       -> ResourceExhausted
 683      ERR_RESOURCEVANISHED        -> ResourceVanished
 684      ERR_SYSTEMERROR             -> SystemError
 685      ERR_TIMEEXPIRED             -> TimeExpired
 686      ERR_UNSATISFIEDCONSTRAINTS  -> UnsatisfiedConstraints
 687      ERR_UNSUPPORTEDOPERATION    -> UnsupportedOperation
 688      ERR_EOF                     -> EOF
 689      _                           -> OtherError
 690
 691   msg =
 692    unpackCString str ++
 693    (case iot of
 694      OtherError -> "(error code: " ++ show errtype ++ ")"
 695      _ -> "")
 696  in
 697  return (IOError Nothing iot call_site msg fn)
 698 \end{code}