ghc/lib/std/IO.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1998
   3 %
   4 \section[IO]{Module @IO@}
   5
   6 Implementation of the standard Haskell IO interface, see
   7 @http://haskell.org/onlinelibrary/io.html@ for the official
   8 definition.
   9
  10 \begin{code}
  11 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
  12
  13 #ifndef BODY /* Hugs just includes this in PreludeBuiltin so no header needed */
  14 module IO (
  15     Handle,             -- abstract, instance of: Eq, Show.
  16     HandlePosn(..),     -- abstract, instance of: Eq, Show.
  17
  18     IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
  19     BufferMode(NoBuffering,LineBuffering,BlockBuffering),
  20     SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
  21
  22     stdin, stdout, stderr,   -- :: Handle
  23
  24     openFile,                  -- :: FilePath -> IOMode -> IO Handle
  25     hClose,                    -- :: Handle -> IO ()
  26     hFileSize,                 -- :: Handle -> IO Integer
  27     hIsEOF,                    -- :: Handle -> IO Bool
  28     isEOF,                     -- :: IO Bool
  29
  30     hSetBuffering,             -- :: Handle -> BufferMode -> IO ()
  31     hGetBuffering,             -- :: Handle -> IO BufferMode
  32     hFlush,                    -- :: Handle -> IO ()
  33     hGetPosn,                  -- :: Handle -> IO HandlePosn
  34     hSetPosn,                  -- :: Handle -> HandlePosn -> IO ()
  35     hSeek,                     -- :: Handle -> SeekMode -> Integer -> IO ()
  36     hWaitForInput,             -- :: Handle -> Int -> IO Bool
  37     hReady,                    -- :: Handle -> IO Bool
  38     hGetChar,                  -- :: Handle -> IO Char
  39     hGetLine,                  -- :: Handle -> IO [Char]
  40     hLookAhead,                -- :: Handle -> IO Char
  41     hGetContents,              -- :: Handle -> IO [Char]
  42     hPutChar,                  -- :: Handle -> Char -> IO ()
  43     hPutStr,                   -- :: Handle -> [Char] -> IO ()
  44     hPutStrLn,                 -- :: Handle -> [Char] -> IO ()
  45     hPrint,                    -- :: Show a => Handle -> a -> IO ()
  46     hIsOpen, hIsClosed,        -- :: Handle -> IO Bool
  47     hIsReadable, hIsWritable,  -- :: Handle -> IO Bool
  48     hIsSeekable,               -- :: Handle -> IO Bool
  49
  50     isAlreadyExistsError, isDoesNotExistError,  -- :: IOError -> Bool
  51     isAlreadyInUseError, isFullError,
  52     isEOFError, isIllegalOperation,
  53     isPermissionError, isUserError,
  54
  55     ioeGetErrorString,         -- :: IOError -> String
  56     ioeGetHandle,              -- :: IOError -> Maybe Handle
  57     ioeGetFileName,            -- :: IOError -> Maybe FilePath
  58
  59     try,                       -- :: IO a -> IO (Either IOError a)
  60     bracket,                   -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
  61     bracket_,                  -- :: IO a -> (a -> IO b) -> IO c -> IO c
  62
  63     -- Non-standard extension (but will hopefully become standard with 1.5) is
  64     -- to export the Prelude io functions via IO (in addition to exporting them
  65     -- from the prelude...for now.)
  66     IO,
  67     FilePath,                  -- :: String
  68     IOError,
  69     ioError,                   -- :: IOError -> IO a
  70     userError,                 -- :: String  -> IOError
  71     catch,                     -- :: IO a    -> (IOError -> IO a) -> IO a
  72     interact,                  -- :: (String -> String) -> IO ()
  73
  74     putChar,                   -- :: Char   -> IO ()
  75     putStr,                    -- :: String -> IO ()
  76     putStrLn,                  -- :: String -> IO ()
  77     print,                     -- :: Show a => a -> IO ()
  78     getChar,                   -- :: IO Char
  79     getLine,                   -- :: IO String
  80     getContents,               -- :: IO String
  81     readFile,                  -- :: FilePath -> IO String
  82     writeFile,                 -- :: FilePath -> String -> IO ()
  83     appendFile,                -- :: FilePath -> String -> IO ()
  84     readIO,                    -- :: Read a => String -> IO a
  85     readLn,                    -- :: Read a => IO a
  86
  87     -- extensions
  88     hPutBuf,
  89 #ifndef __HUGS__
  90     hPutBufBA,
  91 #endif
  92     slurpFile
  93
  94   ) where
  95
  96 #ifdef __HUGS__
  97
  98 import PreludeBuiltin
  99
 100 #else
 101
 102 --import PrelST
 103 import PrelBase
 104
 105 import PrelIOBase
 106 import PrelHandle               -- much of the real stuff is in here
 107
 108 import PrelRead         ( readParen, Read(..), reads, lex,
 109                           readIO
 110                         )
 111 import PrelShow
 112 import PrelMaybe        ( Either(..) )
 113 import PrelAddr         ( Addr(..), nullAddr )
 114 import PrelArr          ( ByteArray )
 115 import PrelPack         ( unpackNBytesAccST )
 116 import PrelException    ( ioError, catch )
 117
 118 #ifndef __PARALLEL_HASKELL__
 119 import PrelForeign  ( ForeignObj )
 120 #endif
 121
 122 import Char             ( ord, chr )
 123
 124 #endif /* ndef __HUGS__ */
 125 #endif /* ndef BODY */
 126
 127 #ifndef HEAD
 128
 129 #ifdef __HUGS__
 130 #define cat2(x,y)  x##y
 131 #define CCALL(fun) cat2(prim_,fun)
 132 #define __CONCURRENT_HASKELL__
 133 #define stToIO id
 134 #define unpackNBytesAccST primUnpackCStringAcc
 135 #else
 136 #define CCALL(fun) _ccall_ fun
 137 #define ref_freeStdFileObject (``&freeStdFileObject''::Addr)
 138 #define ref_freeFileObject    (``&freeFileObject''::Addr)
 139 #define const_BUFSIZ ``BUFSIZ''
 140 #endif
 141
 142 \end{code}
 143
 144 Standard instances for @Handle@:
 145
 146 \begin{code}
 147 instance Eq IOError where
 148   (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
 149     e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
 150
 151 instance Eq Handle where
 152  (Handle h1) == (Handle h2) = h1 == h2
 153
 154 --Type declared in IOHandle, instance here because it depends on Eq.Handle
 155 instance Eq HandlePosn where
 156     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
 157
 158 -- Type declared in IOBase, instance here because it
 159 -- depends on PrelRead.(Read Maybe) instance.
 160 instance Read BufferMode where
 161     readsPrec _ =
 162       readParen False
 163         (\r ->  let lr = lex r
 164                 in
 165                 [(NoBuffering, rest)       | ("NoBuffering", rest) <- lr] ++
 166                 [(LineBuffering,rest)      | ("LineBuffering",rest) <- lr] ++
 167                 [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr,
 168                                              (mb, rest2) <- reads rest1])
 169
 170 \end{code}
 171
 172 %*********************************************************
 173 %*                                                      *
 174 \subsection{Simple input operations}
 175 %*                                                      *
 176 %*********************************************************
 177
 178 Computation @hReady hdl@ indicates whether at least
 179 one item is available for input from handle {\em hdl}.
 180
 181 @hWaitForInput@ is the generalisation, wait for \tr{n} milliseconds
 182 before deciding whether the Handle has run dry or not.
 183
 184 If @hWaitForInput@ finds anything in the Handle's buffer, it immediately returns.
 185 If not, it tries to read from the underlying OS handle. Notice that
 186 for buffered Handles connected to terminals this means waiting until a complete
 187 line is available.
 188
 189 \begin{code}
 190 hReady :: Handle -> IO Bool
 191 hReady h = hWaitForInput h 0
 192
 193 hWaitForInput :: Handle -> Int -> IO Bool
 194 hWaitForInput handle msecs =
 195     wantReadableHandle "hWaitForInput" handle $ \ handle_ -> do
 196     rc       <- CCALL(inputReady) (haFO__ handle_) (msecs::Int)     -- ConcHask: SAFE, won't block
 197     writeHandle handle handle_
 198     case (rc::Int) of
 199       0 -> return False
 200       1 -> return True
 201       _ -> constructErrorAndFail "hWaitForInput"
 202 \end{code}
 203
 204 @hGetChar hdl@ reads the next character from handle @hdl@,
 205 blocking until a character is available.
 206
 207 \begin{code}
 208 hGetChar :: Handle -> IO Char
 209 hGetChar handle =
 210     wantReadableHandle "hGetChar" handle $ \ handle_ -> do
 211     let fo = haFO__ handle_
 212     intc     <- mayBlock fo (CCALL(fileGetc) fo)  -- ConcHask: UNSAFE, may block
 213     writeHandle handle handle_
 214     if intc /= ((-1)::Int)
 215      then return (chr intc)
 216      else constructErrorAndFail "hGetChar"
 217
 218 {-
 219   If EOF is reached before EOL is encountered, ignore the
 220   EOF and return the partial line. Next attempt at calling
 221   hGetLine on the handle will yield an EOF IO exception though.
 222 -}
 223 hGetLine :: Handle -> IO String
 224 hGetLine h = do
 225   c <- hGetChar h
 226   if c == '\n' then
 227      return ""
 228    else do
 229     l <- getRest
 230     return (c:l)
 231  where
 232   getRest = do
 233     c <-
 234       catch
 235         (hGetChar h)
 236         (\ err -> do
 237           if isEOFError err then
 238              return '\n'
 239            else
 240              ioError err)
 241     if c == '\n' then
 242        return ""
 243      else do
 244        s <- getRest
 245        return (c:s)
 246
 247 \end{code}
 248
 249 @hLookahead hdl@ returns the next character from handle @hdl@
 250 without removing it from the input buffer, blocking until a
 251 character is available.
 252
 253 \begin{code}
 254 hLookAhead :: Handle -> IO Char
 255 hLookAhead handle =
 256     wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
 257     let fo = haFO__ handle_
 258     intc    <- mayBlock fo (CCALL(fileLookAhead) fo)  -- ConcHask: UNSAFE, may block
 259     writeHandle handle handle_
 260     if intc /= (-1)
 261      then return (chr intc)
 262      else constructErrorAndFail "hLookAhead"
 263
 264 \end{code}
 265
 266
 267 %*********************************************************
 268 %*                                                      *
 269 \subsection{Getting the entire contents of a handle}
 270 %*                                                      *
 271 %*********************************************************
 272
 273 @hGetContents hdl@ returns the list of characters corresponding
 274 to the unread portion of the channel or file managed by @hdl@,
 275 which is made semi-closed.
 276
 277 \begin{code}
 278 hGetContents :: Handle -> IO String
 279 hGetContents handle =
 280     wantReadableHandle "hGetContents" handle $ \ handle_ -> do
 281       {-
 282         To avoid introducing an extra layer of buffering here,
 283         we provide three lazy read methods, based on character,
 284         line, and block buffering.
 285       -}
 286     writeHandle handle (handle_{ haType__ = SemiClosedHandle })
 287     case (haBufferMode__ handle_) of
 288      LineBuffering    -> unsafeInterleaveIO (lazyReadLine handle (haFO__ handle_))
 289      BlockBuffering _ -> unsafeInterleaveIO (lazyReadBlock handle (haFO__ handle_))
 290      NoBuffering      -> unsafeInterleaveIO (lazyReadChar handle (haFO__ handle_))
 291
 292 \end{code}
 293
 294 Note that someone may close the semi-closed handle (or change its buffering),
 295 so each these lazy read functions are pulled on, they have to check whether
 296 the handle has indeed been closed.
 297
 298 \begin{code}
 299 #ifndef __PARALLEL_HASKELL__
 300 lazyReadBlock :: Handle -> ForeignObj -> IO String
 301 lazyReadLine  :: Handle -> ForeignObj -> IO String
 302 lazyReadChar  :: Handle -> ForeignObj -> IO String
 303 #else
 304 lazyReadBlock :: Handle -> Addr -> IO String
 305 lazyReadLine  :: Handle -> Addr -> IO String
 306 lazyReadChar  :: Handle -> Addr -> IO String
 307 #endif
 308
 309 lazyReadBlock handle fo = do
 310    buf   <- CCALL(getBufStart) fo (0::Int)
 311    bytes <- mayBlock fo (CCALL(readBlock) fo) -- ConcHask: UNSAFE, may block.
 312    case (bytes::Int) of
 313      -3 -> -- buffering has been turned off, use lazyReadChar instead
 314            lazyReadChar handle fo
 315      -2 -> return ""
 316      -1 -> -- an error occurred, close the handle
 317           withHandle handle $ \ handle_ -> do
 318           CCALL(closeFile) (haFO__ handle_) (0::Int){-don't bother flushing-}  -- ConcHask: SAFE, won't block.
 319           writeHandle handle (handle_ { haType__    = ClosedHandle,
 320                                         haFO__      = nullFile__ })
 321           return ""
 322      _ -> do
 323       more <- unsafeInterleaveIO (lazyReadBlock handle fo)
 324       stToIO (unpackNBytesAccST buf bytes more)
 325
 326 lazyReadLine handle fo = do
 327      bytes <- mayBlock fo (CCALL(readLine) fo)   -- ConcHask: UNSAFE, may block.
 328      case (bytes::Int) of
 329        -3 -> -- buffering has been turned off, use lazyReadChar instead
 330              lazyReadChar handle fo
 331        -2 -> return "" -- handle closed by someone else, stop reading.
 332        -1 -> -- an error occurred, close the handle
 333              withHandle handle $ \ handle_ -> do
 334              CCALL(closeFile) (haFO__ handle_) (0::Int){- don't bother flushing-}  -- ConcHask: SAFE, won't block
 335              writeHandle handle (handle_ { haType__    = ClosedHandle,
 336                                            haFO__      = nullFile__ })
 337              return ""
 338        _ -> do
 339           more <- unsafeInterleaveIO (lazyReadLine handle fo)
 340           buf  <- CCALL(getBufStart) fo bytes  -- ConcHask: won't block
 341           stToIO (unpackNBytesAccST buf bytes more)
 342
 343 lazyReadChar handle fo = do
 344     char <- mayBlock fo (CCALL(readChar) fo)   -- ConcHask: UNSAFE, may block.
 345     case (char::Int) of
 346       -4 -> -- buffering is now block-buffered, use lazyReadBlock instead
 347             lazyReadBlock handle fo
 348
 349       -3 -> -- buffering is now line-buffered, use lazyReadLine instead
 350             lazyReadLine handle fo
 351       -2 -> return ""
 352       -1 -> -- error, silently close handle.
 353          withHandle handle $ \ handle_ -> do
 354          CCALL(closeFile) (haFO__ handle_) (0::Int){-don't bother flusing-}  -- ConcHask: SAFE, won't block
 355          writeHandle handle (handle_{ haType__  = ClosedHandle,
 356                                       haFO__    = nullFile__ })
 357          return ""
 358       _ -> do
 359          more <- unsafeInterleaveIO (lazyReadChar handle fo)
 360          return (chr char : more)
 361
 362 \end{code}
 363
 364
 365 %*********************************************************
 366 %*                                                      *
 367 \subsection{Simple output functions}
 368 %*                                                      *
 369 %*********************************************************
 370
 371 @hPutChar hdl ch@ writes the character @ch@ to the file
 372 or channel managed by @hdl@.  Characters may be buffered if
 373 buffering is enabled for @hdl@
 374
 375 \begin{code}
 376 hPutChar :: Handle -> Char -> IO ()
 377 hPutChar handle c =
 378     wantWriteableHandle "hPutChar" handle $ \ handle_  -> do
 379     let fo = haFO__ handle_
 380     flushConnectedBuf fo
 381     rc       <- mayBlock fo (CCALL(filePutc) fo c)   -- ConcHask: UNSAFE, may block.
 382     writeHandle handle handle_
 383     if rc == 0
 384      then return ()
 385      else constructErrorAndFail "hPutChar"
 386
 387 \end{code}
 388
 389 @hPutStr hdl s@ writes the string @s@ to the file or
 390 channel managed by @hdl@, buffering the output if needs be.
 391
 392 \begin{code}
 393 hPutStr :: Handle -> String -> IO ()
 394 hPutStr handle str =
 395     wantWriteableHandle "hPutStr" handle $ \ handle_ -> do
 396     let fo = haFO__ handle_
 397     flushConnectedBuf fo
 398     case haBufferMode__ handle_ of
 399        LineBuffering -> do
 400             buf <- CCALL(getWriteableBuf) fo
 401             pos <- CCALL(getBufWPtr) fo
 402             bsz <- CCALL(getBufSize) fo
 403             writeLines fo buf bsz pos str
 404        BlockBuffering _ -> do
 405             buf <- CCALL(getWriteableBuf) fo
 406             pos <- CCALL(getBufWPtr) fo
 407             bsz <- CCALL(getBufSize) fo
 408             writeBlocks fo buf bsz pos str
 409        NoBuffering -> do
 410             writeChars fo str
 411     writeHandle handle handle_
 412
 413 \end{code}
 414
 415 Going across the border between Haskell and C is relatively costly,
 416 so for block writes we pack the character strings on the Haskell-side
 417 before passing the external write routine a pointer to the buffer.
 418
 419 \begin{code}
 420 #ifdef __HUGS__
 421
 422 #ifdef __CONCURRENT_HASKELL__
 423 /* See comment in shoveString below for explanation */
 424 #warning delayed update of buffer disnae work with killThread
 425 #endif
 426
 427 #ifndef __PARALLEL_HASKELL__
 428 writeLines :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 429 #else
 430 writeLines :: Addr -> Addr -> Int -> Int -> String -> IO ()
 431 #endif
 432 writeLines obj buf bufLen initPos s =
 433   let
 434    shoveString :: Int -> [Char] -> IO ()
 435    shoveString n ls =
 436      case ls of
 437       [] ->
 438         if n == 0 then
 439           CCALL(setBufWPtr) obj (0::Int)
 440         else do
 441           {-
 442             At the end of a buffer write, update the buffer position
 443             in the underlying file object, so that if the handle
 444             is subsequently dropped by the program, the whole
 445             buffer will be properly flushed.
 446
 447             There's one case where this delayed up-date of the buffer
 448             position can go wrong: if a thread is killed, it might be
 449             in the middle of filling up a buffer, with the result that
 450             the partial buffer update is lost upon finalisation. Not
 451             that killing of threads is supported at the moment.
 452
 453           -}
 454           CCALL(setBufWPtr) obj n
 455
 456       (x:xs) -> do
 457         primWriteCharOffAddr buf n x
 458           {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
 459         if n == bufLen || x == '\n'
 460          then do
 461            rc <-  mayBlock obj (CCALL(writeFileObject) obj (n + 1))  -- ConcHask: UNSAFE, may block.
 462            if rc == 0
 463             then shoveString 0 xs
 464             else constructErrorAndFail "writeLines"
 465          else
 466            shoveString (n + 1) xs
 467   in
 468   shoveString initPos s
 469 #else /* ndef __HUGS__ */
 470 #ifndef __PARALLEL_HASKELL__
 471 writeLines :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 472 #else
 473 writeLines :: Addr -> Addr -> Int -> Int -> String -> IO ()
 474 #endif
 475 writeLines obj buf (I# bufLen) (I# initPos#) s =
 476   let
 477    write_char :: Addr -> Int# -> Char# -> IO ()
 478    write_char (A# buf#) n# c# =
 479       IO $ \ s# ->
 480       case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
 481
 482    shoveString :: Int# -> [Char] -> IO ()
 483    shoveString n ls =
 484      case ls of
 485       [] ->
 486         if n ==# 0# then
 487           CCALL(setBufWPtr) obj (0::Int)
 488         else do
 489           {-
 490             At the end of a buffer write, update the buffer position
 491             in the underlying file object, so that if the handle
 492             is subsequently dropped by the program, the whole
 493             buffer will be properly flushed.
 494
 495             There's one case where this delayed up-date of the buffer
 496             position can go wrong: if a thread is killed, it might be
 497             in the middle of filling up a buffer, with the result that
 498             the partial buffer update is lost upon finalisation. Not
 499             that killing of threads is supported at the moment.
 500
 501           -}
 502           CCALL(setBufWPtr) obj (I# n)
 503
 504       ((C# x):xs) -> do
 505         write_char buf n x
 506           {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
 507         if n ==# bufLen || x `eqChar#` '\n'#
 508          then do
 509            rc <-  mayBlock obj (CCALL(writeFileObject) obj (I# (n +# 1#)))  -- ConcHask: UNSAFE, may block.
 510            if rc == 0
 511             then shoveString 0# xs
 512             else constructErrorAndFail "writeLines"
 513          else
 514            shoveString (n +# 1#) xs
 515   in
 516   shoveString initPos# s
 517 #endif /* ndef __HUGS__ */
 518
 519 #ifdef __HUGS__
 520 #ifndef __PARALLEL_HASKELL__
 521 writeBlocks :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 522 #else
 523 writeBlocks :: Addr -> Addr -> Int -> Int -> String -> IO ()
 524 #endif
 525 writeBlocks obj buf bufLen initPos s =
 526   let
 527    shoveString :: Int -> [Char] -> IO ()
 528    shoveString n ls =
 529      case ls of
 530       [] ->
 531         if n == 0 then
 532           CCALL(setBufWPtr) obj (0::Int)
 533         else do
 534           {-
 535             At the end of a buffer write, update the buffer position
 536             in the underlying file object, so that if the handle
 537             is subsequently dropped by the program, the whole
 538             buffer will be properly flushed.
 539
 540             There's one case where this delayed up-date of the buffer
 541             position can go wrong: if a thread is killed, it might be
 542             in the middle of filling up a buffer, with the result that
 543             the partial buffer update is lost upon finalisation. However,
 544             by the time killThread is supported, Haskell finalisers are also
 545             likely to be in, which means the 'IOFileObject' hack can go
 546             alltogether.
 547
 548           -}
 549           CCALL(setBufWPtr) obj n
 550
 551       (x:xs) -> do
 552         primWriteCharOffAddr buf n x
 553         if n == bufLen
 554          then do
 555            rc <-  mayBlock obj (CCALL(writeFileObject) obj (n + 1))   -- ConcHask: UNSAFE, may block.
 556            if rc == 0
 557             then shoveString 0 xs
 558             else constructErrorAndFail "writeChunks"
 559          else
 560            shoveString (n + 1) xs
 561   in
 562   shoveString initPos s
 563 #else /* ndef __HUGS__ */
 564 #ifndef __PARALLEL_HASKELL__
 565 writeBlocks :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 566 #else
 567 writeBlocks :: Addr -> Addr -> Int -> Int -> String -> IO ()
 568 #endif
 569 writeBlocks obj buf (I# bufLen) (I# initPos#) s =
 570   let
 571    write_char :: Addr -> Int# -> Char# -> IO ()
 572    write_char (A# buf#) n# c# =
 573       IO $ \ s# ->
 574       case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
 575
 576    shoveString :: Int# -> [Char] -> IO ()
 577    shoveString n ls =
 578      case ls of
 579       [] ->
 580         if n ==# 0# then
 581           CCALL(setBufWPtr) obj (0::Int)
 582         else do
 583           {-
 584             At the end of a buffer write, update the buffer position
 585             in the underlying file object, so that if the handle
 586             is subsequently dropped by the program, the whole
 587             buffer will be properly flushed.
 588
 589             There's one case where this delayed up-date of the buffer
 590             position can go wrong: if a thread is killed, it might be
 591             in the middle of filling up a buffer, with the result that
 592             the partial buffer update is lost upon finalisation. However,
 593             by the time killThread is supported, Haskell finalisers are also
 594             likely to be in, which means the 'IOFileObject' hack can go
 595             alltogether.
 596
 597           -}
 598           CCALL(setBufWPtr) obj (I# n)
 599
 600       ((C# x):xs) -> do
 601         write_char buf n x
 602         if n ==# bufLen
 603          then do
 604            rc <-  mayBlock obj (CCALL(writeFileObject) obj (I# (n +# 1#)))   -- ConcHask: UNSAFE, may block.
 605            if rc == 0
 606             then shoveString 0# xs
 607             else constructErrorAndFail "writeChunks"
 608          else
 609            shoveString (n +# 1#) xs
 610   in
 611   shoveString initPos# s
 612 #endif /* ndef __HUGS__ */
 613
 614 #ifndef __PARALLEL_HASKELL__
 615 writeChars :: ForeignObj -> String -> IO ()
 616 #else
 617 writeChars :: Addr -> String -> IO ()
 618 #endif
 619 writeChars _fo ""    = return ()
 620 writeChars fo (c:cs) = do
 621   rc <- mayBlock fo (CCALL(filePutc) fo c)   -- ConcHask: UNSAFE, may block.
 622   if rc == 0
 623    then writeChars fo cs
 624    else constructErrorAndFail "writeChars"
 625
 626 \end{code}
 627
 628 Computation @hPrint hdl t@ writes the string representation of {\em t}
 629 given by the @shows@ function to the file or channel managed by {\em
 630 hdl}.
 631
 632 [ Seem to have disappeared from the 1.4 interface  - SOF 2/97 ]
 633
 634 \begin{code}
 635 hPrint :: Show a => Handle -> a -> IO ()
 636 hPrint hdl = hPutStrLn hdl . show
 637 \end{code}
 638
 639 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 640 the handle \tr{hdl}, adding a newline at the end.
 641
 642 \begin{code}
 643 hPutStrLn :: Handle -> String -> IO ()
 644 hPutStrLn hndl str = do
 645  hPutStr  hndl str
 646  hPutChar hndl '\n'
 647
 648 \end{code}
 649
 650
 651 %*********************************************************
 652 %*                                                      *
 653 \subsection{Try and bracket}
 654 %*                                                      *
 655 %*********************************************************
 656
 657 The construct @try comp@ exposes errors which occur within a
 658 computation, and which are not fully handled.  It always succeeds.
 659
 660 \begin{code}
 661 try            :: IO a -> IO (Either IOError a)
 662 try f          =  catch (do r <- f
 663                             return (Right r))
 664                         (return . Left)
 665
 666 bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 667 bracket before after m = do
 668         x  <- before
 669         rs <- try (m x)
 670         after x
 671         case rs of
 672            Right r -> return r
 673            Left  e -> ioError e
 674
 675 -- variant of the above where middle computation doesn't want x
 676 bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
 677 bracket_ before after m = do
 678          x  <- before
 679          rs <- try m
 680          after x
 681          case rs of
 682             Right r -> return r
 683             Left  e -> ioError e
 684 \end{code}
 685
 686 %*********************************************************
 687 %*                                                       *
 688 \subsection{Standard IO}
 689 %*                                                       *
 690 %*********************************************************
 691
 692 The Prelude has from Day 1 provided a collection of common
 693 IO functions. We define these here, but let the Prelude
 694 export them.
 695
 696 \begin{code}
 697 putChar         :: Char -> IO ()
 698 putChar c       =  hPutChar stdout c
 699
 700 putStr          :: String -> IO ()
 701 putStr s        =  hPutStr stdout s
 702
 703 putStrLn        :: String -> IO ()
 704 putStrLn s      =  do putStr s
 705                       putChar '\n'
 706
 707 print           :: Show a => a -> IO ()
 708 print x         =  putStrLn (show x)
 709
 710 getChar         :: IO Char
 711 getChar         =  hGetChar stdin
 712
 713 getLine         :: IO String
 714 getLine         =  hGetLine stdin
 715
 716 getContents     :: IO String
 717 getContents     =  hGetContents stdin
 718
 719 interact        ::  (String -> String) -> IO ()
 720 interact f      =   do s <- getContents
 721                        putStr (f s)
 722
 723 readFile        :: FilePath -> IO String
 724 readFile name   =  openFile name ReadMode >>= hGetContents
 725
 726 writeFile       :: FilePath -> String -> IO ()
 727 writeFile name str = do
 728     hdl <- openFile name WriteMode
 729     hPutStr hdl str
 730     hClose hdl
 731
 732 appendFile      :: FilePath -> String -> IO ()
 733 appendFile name str = do
 734     hdl <- openFile name AppendMode
 735     hPutStr hdl str
 736     hClose hdl
 737
 738 readLn          :: Read a => IO a
 739 readLn          =  do l <- getLine
 740                       r <- readIO l
 741                       return r
 742
 743 #endif /* ndef HEAD */
 744
 745 \end{code}