ghc/lib/std/PrelIOBase.lhs

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