GHC/IOBase.lhs

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