ghc/lib/std/PrelIOBase.lhs

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