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