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