ghc/lib/std/PrelIOBase.lhs

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