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