ghc/lib/std/PrelIOBase.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelIOBase.lhs,v 1.44 2001/11/14 11:39:29 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2001
   5 %
   6
   7 % Definitions for the @IO@ monad and its friends.  Everything is exported
   8 % concretely; the @IO@ module itself exports abstractly.
   9
  10 \begin{code}
  11 {-# OPTIONS -fno-implicit-prelude #-}
  12 module PrelIOBase where
  13
  14 import PrelST
  15 import PrelArr
  16 import PrelBase
  17 import PrelNum  -- To get fromInteger etc, needed because of -fno-implicit-prelude
  18 import PrelMaybe  ( Maybe(..) )
  19 import PrelShow
  20 import PrelList
  21 import PrelRead
  22 import PrelDynamic
  23
  24 -- ---------------------------------------------------------------------------
  25 -- The IO Monad
  26
  27 {-
  28 The IO Monad is just an instance of the ST monad, where the state is
  29 the real world.  We use the exception mechanism (in PrelException) to
  30 implement IO exceptions.
  31
  32 NOTE: The IO representation is deeply wired in to various parts of the
  33 system.  The following list may or may not be exhaustive:
  34
  35 Compiler  - types of various primitives in PrimOp.lhs
  36
  37 RTS       - forceIO (StgMiscClosures.hc)
  38           - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
  39             (Exceptions.hc)
  40           - raiseAsync (Schedule.c)
  41
  42 Prelude   - PrelIOBase.lhs, and several other places including
  43             PrelException.lhs.
  44
  45 Libraries - parts of hslibs/lang.
  46
  47 --SDM
  48 -}
  49
  50 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
  51
  52 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
  53 unIO (IO a) = a
  54
  55 instance  Functor IO where
  56    fmap f x = x >>= (return . f)
  57
  58 instance  Monad IO  where
  59     {-# INLINE return #-}
  60     {-# INLINE (>>)   #-}
  61     {-# INLINE (>>=)  #-}
  62     m >> k      =  m >>= \ _ -> k
  63     return x    = returnIO x
  64
  65     m >>= k     = bindIO m k
  66     fail s      = failIO s
  67
  68 failIO :: String -> IO a
  69 failIO s = ioError (userError s)
  70
  71 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
  72 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
  73
  74 bindIO :: IO a -> (a -> IO b) -> IO b
  75 bindIO (IO m) k = IO ( \ s ->
  76   case m s of
  77     (# new_s, a #) -> unIO (k a) new_s
  78   )
  79
  80 returnIO :: a -> IO a
  81 returnIO x = IO (\ s -> (# s, x #))
  82
  83 -- ---------------------------------------------------------------------------
  84 -- Coercions between IO and ST
  85
  86 --stToIO        :: (forall s. ST s a) -> IO a
  87 stToIO        :: ST RealWorld a -> IO a
  88 stToIO (ST m) = IO m
  89
  90 ioToST        :: IO a -> ST RealWorld a
  91 ioToST (IO m) = (ST m)
  92
  93 -- ---------------------------------------------------------------------------
  94 -- Unsafe IO operations
  95
  96 {-# NOINLINE unsafePerformIO #-}
  97 unsafePerformIO :: IO a -> a
  98 unsafePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
  99
 100 {-# NOINLINE unsafeInterleaveIO #-}
 101 unsafeInterleaveIO :: IO a -> IO a
 102 unsafeInterleaveIO (IO m)
 103   = IO ( \ s -> let
 104                    r = case m s of (# _, res #) -> res
 105                 in
 106                 (# s, r #))
 107
 108 -- ---------------------------------------------------------------------------
 109 -- Handle type
 110
 111 data MVar a = MVar (MVar# RealWorld a)
 112
 113 -- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
 114 instance Eq (MVar a) where
 115         (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
 116
 117 --  A Handle is represented by (a reference to) a record
 118 --  containing the state of the I/O port/device. We record
 119 --  the following pieces of info:
 120
 121 --    * type (read,write,closed etc.)
 122 --    * the underlying file descriptor
 123 --    * buffering mode
 124 --    * buffer, and spare buffers
 125 --    * user-friendly name (usually the
 126 --      FilePath used when IO.openFile was called)
 127
 128 -- Note: when a Handle is garbage collected, we want to flush its buffer
 129 -- and close the OS file handle, so as to free up a (precious) resource.
 130
 131 data Handle
 132   = FileHandle                          -- A normal handle to a file
 133         !(MVar Handle__)
 134
 135   | DuplexHandle                        -- A handle to a read/write stream
 136         !(MVar Handle__)                -- The read side
 137         !(MVar Handle__)                -- The write side
 138
 139 -- NOTES:
 140 --    * A 'FileHandle' is seekable.  A 'DuplexHandle' may or may not be
 141 --      seekable.
 142
 143 instance Eq Handle where
 144  (FileHandle h1)     == (FileHandle h2)     = h1 == h2
 145  (DuplexHandle h1 _) == (DuplexHandle h2 _) = h1 == h2
 146  _ == _ = False
 147
 148 type FD = Int -- XXX ToDo: should be CInt
 149
 150 data Handle__
 151   = Handle__ {
 152       haFD          :: !FD,                  -- file descriptor
 153       haType        :: HandleType,           -- type (read/write/append etc.)
 154       haIsBin       :: Bool,                 -- binary mode?
 155       haBufferMode  :: BufferMode,           -- buffer contains read/write data?
 156       haFilePath    :: FilePath,             -- file name, possibly
 157       haBuffer      :: !(IORef Buffer),      -- the current buffer
 158       haBuffers     :: !(IORef BufferList),  -- spare buffers
 159       haOtherSide   :: Maybe (MVar Handle__) -- ptr to the write side of a
 160                                              -- duplex handle.
 161     }
 162
 163 -- ---------------------------------------------------------------------------
 164 -- Buffers
 165
 166 -- The buffer is represented by a mutable variable containing a
 167 -- record, where the record contains the raw buffer and the start/end
 168 -- points of the filled portion.  We use a mutable variable so that
 169 -- the common operation of writing (or reading) some data from (to)
 170 -- the buffer doesn't need to modify, and hence copy, the handle
 171 -- itself, it just updates the buffer.
 172
 173 -- There will be some allocation involved in a simple hPutChar in
 174 -- order to create the new Buffer structure (below), but this is
 175 -- relatively small, and this only has to be done once per write
 176 -- operation.
 177
 178 -- The buffer contains its size - we could also get the size by
 179 -- calling sizeOfMutableByteArray# on the raw buffer, but that tends
 180 -- to be rounded up to the nearest Word.
 181
 182 type RawBuffer = MutableByteArray# RealWorld
 183
 184 -- INVARIANTS on a Buffer:
 185 --
 186 --   * A handle *always* has a buffer, even if it is only 1 character long
 187 --     (an unbuffered handle needs a 1 character buffer in order to support
 188 --      hLookAhead and hIsEOF).
 189 --   * r <= w
 190 --   * if r == w, then r == 0 && w == 0
 191 --   * if state == WriteBuffer, then r == 0
 192 --   * a write buffer is never full.  If an operation
 193 --     fills up the buffer, it will always flush it before
 194 --     returning.
 195 --   * a read buffer may be full as a result of hLookAhead.  In normal
 196 --     operation, a read buffer always has at least one character of space.
 197
 198 data Buffer
 199   = Buffer {
 200         bufBuf   :: RawBuffer,
 201         bufRPtr  :: !Int,
 202         bufWPtr  :: !Int,
 203         bufSize  :: !Int,
 204         bufState :: BufferState
 205   }
 206
 207 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
 208
 209 -- we keep a few spare buffers around in a handle to avoid allocating
 210 -- a new one for each hPutStr.  These buffers are *guaranteed* to be the
 211 -- same size as the main buffer.
 212 data BufferList
 213   = BufferListNil
 214   | BufferListCons RawBuffer BufferList
 215
 216
 217 bufferIsWritable :: Buffer -> Bool
 218 bufferIsWritable Buffer{ bufState=WriteBuffer } = True
 219 bufferIsWritable _other = False
 220
 221 bufferEmpty :: Buffer -> Bool
 222 bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w
 223
 224 -- only makes sense for a write buffer
 225 bufferFull :: Buffer -> Bool
 226 bufferFull b@Buffer{ bufWPtr=w } = w >= bufSize b
 227
 228 --  Internally, we classify handles as being one
 229 --  of the following:
 230
 231 data HandleType
 232  = ClosedHandle
 233  | SemiClosedHandle
 234  | ReadHandle
 235  | WriteHandle
 236  | AppendHandle
 237  | ReadWriteHandle
 238
 239 isReadableHandleType ReadHandle         = True
 240 isReadableHandleType ReadWriteHandle    = True
 241 isReadableHandleType _                  = False
 242
 243 isWritableHandleType AppendHandle    = True
 244 isWritableHandleType WriteHandle     = True
 245 isWritableHandleType ReadWriteHandle = True
 246 isWritableHandleType _               = False
 247
 248 -- File names are specified using @FilePath@, a OS-dependent
 249 -- string that (hopefully, I guess) maps to an accessible file/object.
 250
 251 type FilePath = String
 252
 253 -- ---------------------------------------------------------------------------
 254 -- Buffering modes
 255
 256 -- Three kinds of buffering are supported: line-buffering,
 257 -- block-buffering or no-buffering.  These modes have the following
 258 -- effects. For output, items are written out from the internal
 259 -- buffer according to the buffer mode:
 260 --
 261 -- * line-buffering  the entire output buffer is written
 262 --   out whenever a newline is output, the output buffer overflows,
 263 --   a flush is issued, or the handle is closed.
 264 --
 265 -- * block-buffering the entire output buffer is written out whenever
 266 --   it overflows, a flush is issued, or the handle
 267 --   is closed.
 268 --
 269 -- * no-buffering output is written immediately, and never stored
 270 --   in the output buffer.
 271 --
 272 -- The output buffer is emptied as soon as it has been written out.
 273
 274 -- Similarly, input occurs according to the buffer mode for handle {\em hdl}.
 275
 276 -- * line-buffering when the input buffer for the handle is not empty,
 277 --   the next item is obtained from the buffer;
 278 --   otherwise, when the input buffer is empty,
 279 --   characters up to and including the next newline
 280 --   character are read into the buffer.  No characters
 281 --   are available until the newline character is
 282 --   available.
 283 --
 284 -- * block-buffering when the input buffer for the handle becomes empty,
 285 --   the next block of data is read into this buffer.
 286 --
 287 -- * no-buffering the next input item is read and returned.
 288
 289 -- For most implementations, physical files will normally be block-buffered
 290 -- and terminals will normally be line-buffered. (the IO interface provides
 291 -- operations for changing the default buffering of a handle tho.)
 292
 293 data BufferMode
 294  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
 295    deriving (Eq, Ord, Read, Show)
 296
 297 -- ---------------------------------------------------------------------------
 298 -- IORefs
 299
 300 newtype IORef a = IORef (STRef RealWorld a) deriving Eq
 301
 302 newIORef    :: a -> IO (IORef a)
 303 newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
 304
 305 readIORef   :: IORef a -> IO a
 306 readIORef  (IORef var) = stToIO (readSTRef var)
 307
 308 writeIORef  :: IORef a -> a -> IO ()
 309 writeIORef (IORef var) v = stToIO (writeSTRef var v)
 310
 311 modifyIORef :: IORef a -> (a -> a) -> IO ()
 312 modifyIORef ref f = readIORef ref >>= \x -> writeIORef ref (f x)
 313
 314 -- deprecated, use modifyIORef
 315 updateIORef :: IORef a -> (a -> a) -> IO ()
 316 updateIORef = modifyIORef
 317
 318 -- ---------------------------------------------------------------------------
 319 -- Show instance for Handles
 320
 321 -- handle types are 'show'n when printing error msgs, so
 322 -- we provide a more user-friendly Show instance for it
 323 -- than the derived one.
 324
 325 instance Show HandleType where
 326   showsPrec p t =
 327     case t of
 328       ClosedHandle      -> showString "closed"
 329       SemiClosedHandle  -> showString "semi-closed"
 330       ReadHandle        -> showString "readable"
 331       WriteHandle       -> showString "writable"
 332       AppendHandle      -> showString "writable (append)"
 333       ReadWriteHandle   -> showString "read-writable"
 334
 335 instance Show Handle where
 336   showsPrec p (FileHandle   h)   = showHandle p h False
 337   showsPrec p (DuplexHandle _ h) = showHandle p h True
 338
 339 showHandle p h duplex =
 340     let
 341      -- (Big) SIGH: unfolded defn of takeMVar to avoid
 342      -- an (oh-so) unfortunate module loop with PrelConc.
 343      hdl_ = unsafePerformIO (IO $ \ s# ->
 344              case h                 of { MVar h# ->
 345              case takeMVar# h# s#   of { (# s2# , r #) ->
 346              case putMVar# h# r s2# of { s3# ->
 347              (# s3#, r #) }}})
 348
 349      showType | duplex = showString "duplex (read-write)"
 350               | otherwise = showsPrec p (haType hdl_)
 351     in
 352     showChar '{' .
 353     showHdl (haType hdl_)
 354             (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
 355              showString "type=" . showType . showChar ',' .
 356              showString "binary=" . showsPrec p (haIsBin hdl_) . showChar ',' .
 357              showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
 358    where
 359
 360     showHdl :: HandleType -> ShowS -> ShowS
 361     showHdl ht cont =
 362        case ht of
 363         ClosedHandle  -> showsPrec p ht . showString "}"
 364         _ -> cont
 365
 366     showBufMode :: Buffer -> BufferMode -> ShowS
 367     showBufMode buf bmo =
 368       case bmo of
 369         NoBuffering   -> showString "none"
 370         LineBuffering -> showString "line"
 371         BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
 372         BlockBuffering Nothing  -> showString "block " . showParen True (showsPrec p def)
 373       where
 374        def :: Int
 375        def = bufSize buf
 376
 377 -- ------------------------------------------------------------------------
 378 -- Exception datatype and operations
 379
 380 data Exception
 381   = IOException         IOException     -- IO exceptions
 382   | ArithException      ArithException  -- Arithmetic exceptions
 383   | ArrayException      ArrayException  -- Array-related exceptions
 384   | ErrorCall           String          -- Calls to 'error'
 385   | ExitException       ExitCode        -- Call to System.exitWith
 386   | NoMethodError       String          -- A non-existent method was invoked
 387   | PatternMatchFail    String          -- A pattern match / guard failure
 388   | RecSelError         String          -- Selecting a non-existent field
 389   | RecConError         String          -- Field missing in record construction
 390   | RecUpdError         String          -- Record doesn't contain updated field
 391   | AssertionFailed     String          -- Assertions
 392   | DynException        Dynamic         -- Dynamic exceptions
 393   | AsyncException      AsyncException  -- Externally generated errors
 394   | BlockedOnDeadMVar                   -- Blocking on a dead MVar
 395   | NonTermination
 396   | UserError           String
 397
 398 data ArithException
 399   = Overflow
 400   | Underflow
 401   | LossOfPrecision
 402   | DivideByZero
 403   | Denormal
 404   deriving (Eq, Ord)
 405
 406 data AsyncException
 407   = StackOverflow
 408   | HeapOverflow
 409   | ThreadKilled
 410   deriving (Eq, Ord)
 411
 412 data ArrayException
 413   = IndexOutOfBounds    String          -- out-of-range array access
 414   | UndefinedElement    String          -- evaluating an undefined element
 415   deriving (Eq, Ord)
 416
 417 stackOverflow, heapOverflow :: Exception -- for the RTS
 418 stackOverflow = AsyncException StackOverflow
 419 heapOverflow  = AsyncException HeapOverflow
 420
 421 instance Show ArithException where
 422   showsPrec _ Overflow        = showString "arithmetic overflow"
 423   showsPrec _ Underflow       = showString "arithmetic underflow"
 424   showsPrec _ LossOfPrecision = showString "loss of precision"
 425   showsPrec _ DivideByZero    = showString "divide by zero"
 426   showsPrec _ Denormal        = showString "denormal"
 427
 428 instance Show AsyncException where
 429   showsPrec _ StackOverflow   = showString "stack overflow"
 430   showsPrec _ HeapOverflow    = showString "heap overflow"
 431   showsPrec _ ThreadKilled    = showString "thread killed"
 432
 433 instance Show ArrayException where
 434   showsPrec _ (IndexOutOfBounds s)
 435         = showString "array index out of range"
 436         . (if not (null s) then showString ": " . showString s
 437                            else id)
 438   showsPrec _ (UndefinedElement s)
 439         = showString "undefined array element"
 440         . (if not (null s) then showString ": " . showString s
 441                            else id)
 442
 443 instance Show Exception where
 444   showsPrec _ (IOException err)          = shows err
 445   showsPrec _ (ArithException err)       = shows err
 446   showsPrec _ (ArrayException err)       = shows err
 447   showsPrec _ (ErrorCall err)            = showString err
 448   showsPrec _ (ExitException err)        = showString "exit: " . shows err
 449   showsPrec _ (NoMethodError err)        = showString err
 450   showsPrec _ (PatternMatchFail err)     = showString err
 451   showsPrec _ (RecSelError err)          = showString err
 452   showsPrec _ (RecConError err)          = showString err
 453   showsPrec _ (RecUpdError err)          = showString err
 454   showsPrec _ (AssertionFailed err)      = showString err
 455   showsPrec _ (DynException _err)        = showString "unknown exception"
 456   showsPrec _ (AsyncException e)         = shows e
 457   showsPrec _ (BlockedOnDeadMVar)        = showString "thread blocked indefinitely"
 458   showsPrec _ (NonTermination)           = showString "<<loop>>"
 459   showsPrec _ (UserError err)            = showString err
 460
 461 -- -----------------------------------------------------------------------------
 462 -- The ExitCode type
 463
 464 -- The `ExitCode' type defines the exit codes that a program
 465 -- can return.  `ExitSuccess' indicates successful termination;
 466 -- and `ExitFailure code' indicates program failure
 467 -- with value `code'.  The exact interpretation of `code'
 468 -- is operating-system dependent.  In particular, some values of
 469 -- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
 470
 471 -- We need it here because it is used in ExitException in the
 472 -- Exception datatype (above).
 473
 474 data ExitCode = ExitSuccess | ExitFailure Int
 475                 deriving (Eq, Ord, Read, Show)
 476
 477 -- --------------------------------------------------------------------------
 478 -- Primitive throw
 479
 480 throw :: Exception -> a
 481 throw exception = raise# exception
 482
 483 ioError         :: Exception -> IO a
 484 ioError err     =  IO $ \s -> throw err s
 485
 486 ioException     :: IOException -> IO a
 487 ioException err =  IO $ \s -> throw (IOException err) s
 488
 489 -- ---------------------------------------------------------------------------
 490 -- IOError type
 491
 492 -- A value @IOError@ encode errors occurred in the @IO@ monad.
 493 -- An @IOError@ records a more specific error type, a descriptive
 494 -- string and maybe the handle that was used when the error was
 495 -- flagged.
 496
 497 type IOError = Exception
 498
 499 data IOException
 500  = IOError
 501      (Maybe Handle)   -- the handle used by the action flagging the
 502                       --   the error.
 503      IOErrorType      -- what it was.
 504      String           -- location.
 505      String           -- error type specific information.
 506      (Maybe FilePath) -- filename the error is related to.
 507
 508 instance Eq IOException where
 509   (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
 510     e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
 511
 512 data IOErrorType
 513   = AlreadyExists        | HardwareFault
 514   | IllegalOperation     | InappropriateType
 515   | Interrupted          | InvalidArgument
 516   | NoSuchThing          | OtherError
 517   | PermissionDenied     | ProtocolError
 518   | ResourceBusy         | ResourceExhausted
 519   | ResourceVanished     | SystemError
 520   | TimeExpired          | UnsatisfiedConstraints
 521   | UnsupportedOperation
 522   | EOF
 523   | DynIOError Dynamic -- cheap&cheerful extensible IO error type.
 524
 525 instance Eq IOErrorType where
 526    x == y =
 527      case x of
 528        DynIOError{} -> False -- from a strictness POV, compatible with a derived Eq inst?
 529        _ -> getTag# x ==# getTag# y
 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       DynIOError{}      -> "unknown IO error"
 554
 555 userError       :: String  -> IOError
 556 userError str   =  UserError str
 557
 558 -- ---------------------------------------------------------------------------
 559 -- Predicates on IOError
 560
 561 isAlreadyExistsError :: IOError -> Bool
 562 isAlreadyExistsError (IOException (IOError _ AlreadyExists _ _ _)) = True
 563 isAlreadyExistsError _                                             = False
 564
 565 isAlreadyInUseError :: IOError -> Bool
 566 isAlreadyInUseError (IOException (IOError _ ResourceBusy _ _ _)) = True
 567 isAlreadyInUseError _                                            = False
 568
 569 isFullError :: IOError -> Bool
 570 isFullError (IOException (IOError _ ResourceExhausted _ _ _)) = True
 571 isFullError _                                                 = False
 572
 573 isEOFError :: IOError -> Bool
 574 isEOFError (IOException (IOError _ EOF _ _ _)) = True
 575 isEOFError _                                   = False
 576
 577 isIllegalOperation :: IOError -> Bool
 578 isIllegalOperation (IOException (IOError _ IllegalOperation _ _ _)) = True
 579 isIllegalOperation _                                                = False
 580
 581 isPermissionError :: IOError -> Bool
 582 isPermissionError (IOException (IOError _ PermissionDenied _ _ _)) = True
 583 isPermissionError _                                                = False
 584
 585 isDoesNotExistError :: IOError -> Bool
 586 isDoesNotExistError (IOException (IOError _ NoSuchThing _ _ _)) = True
 587 isDoesNotExistError _                                           = False
 588
 589 isUserError :: IOError -> Bool
 590 isUserError (UserError _) = True
 591 isUserError _             = False
 592
 593 -- ---------------------------------------------------------------------------
 594 -- Showing IOErrors
 595
 596 instance Show IOException where
 597     showsPrec p (IOError hdl iot loc s fn) =
 598       showsPrec p iot .
 599       (case loc of
 600          "" -> id
 601          _  -> showString "\nAction: " . showString loc) .
 602       (case hdl of
 603         Nothing -> id
 604         Just h  -> showString "\nHandle: " . showsPrec p h) .
 605       (case s of
 606          "" -> id
 607          _  -> showString "\nReason: " . showString s) .
 608       (case fn of
 609          Nothing -> id
 610          Just name -> showString "\nFile: " . showString name)
 611 \end{code}