ghc/lib/std/PrelIO.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelIO.lhs,v 1.14 2000/07/07 11:03:58 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1992-2000
   5 %
   6
   7 \section[PrelIO]{Module @PrelIO@}
   8
   9 This module defines all basic IO operations.
  10 These are needed for the IO operations exported by Prelude,
  11 but as it happens they also do everything required by library
  12 module IO.
  13
  14
  15 \begin{code}
  16 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
  17
  18 module PrelIO where
  19
  20 import PrelBase
  21
  22 import PrelIOBase
  23 import PrelHandle       -- much of the real stuff is in here
  24
  25 import PrelNum
  26 import PrelRead         ( Read(..), readIO )
  27 import PrelShow
  28 import PrelMaybe        ( Maybe(..) )
  29 import PrelAddr         ( Addr(..), AddrOff(..), nullAddr, plusAddr )
  30 import PrelList         ( concat, reverse, null )
  31 import PrelPack         ( unpackNBytesST, unpackNBytesAccST )
  32 import PrelException    ( ioError, catch, catchException, throw )
  33 import PrelConc
  34 \end{code}
  35
  36
  37 %*********************************************************
  38 %*                                                       *
  39 \subsection{Standard IO}
  40 %*                                                       *
  41 %*********************************************************
  42
  43 The Prelude has from Day 1 provided a collection of common
  44 IO functions. We define these here, but let the Prelude
  45 export them.
  46
  47 \begin{code}
  48 putChar         :: Char -> IO ()
  49 putChar c       =  hPutChar stdout c
  50
  51 putStr          :: String -> IO ()
  52 putStr s        =  hPutStr stdout s
  53
  54 putStrLn        :: String -> IO ()
  55 putStrLn s      =  do putStr s
  56                       putChar '\n'
  57
  58 print           :: Show a => a -> IO ()
  59 print x         =  putStrLn (show x)
  60
  61 getChar         :: IO Char
  62 getChar         =  hGetChar stdin
  63
  64 getLine         :: IO String
  65 getLine         =  hGetLine stdin
  66
  67 getContents     :: IO String
  68 getContents     =  hGetContents stdin
  69
  70 interact        ::  (String -> String) -> IO ()
  71 interact f      =   do s <- getContents
  72                        putStr (f s)
  73
  74 readFile        :: FilePath -> IO String
  75 readFile name   =  openFile name ReadMode >>= hGetContents
  76
  77 writeFile       :: FilePath -> String -> IO ()
  78 writeFile name str = do
  79     hdl <- openFile name WriteMode
  80     hPutStr hdl str
  81     hClose hdl
  82
  83 appendFile      :: FilePath -> String -> IO ()
  84 appendFile name str = do
  85     hdl <- openFile name AppendMode
  86     hPutStr hdl str
  87     hClose hdl
  88
  89 readLn          :: Read a => IO a
  90 readLn          =  do l <- getLine
  91                       r <- readIO l
  92                       return r
  93 \end{code}
  94
  95
  96 %*********************************************************
  97 %*                                                      *
  98 \subsection{Simple input operations}
  99 %*                                                      *
 100 %*********************************************************
 101
 102 Computation @hReady hdl@ indicates whether at least
 103 one item is available for input from handle {\em hdl}.
 104
 105 @hWaitForInput@ is the generalisation, wait for \tr{n} milliseconds
 106 before deciding whether the Handle has run dry or not.
 107
 108 If @hWaitForInput@ finds anything in the Handle's buffer, it immediately returns.
 109 If not, it tries to read from the underlying OS handle. Notice that
 110 for buffered Handles connected to terminals this means waiting until a complete
 111 line is available.
 112
 113 \begin{code}
 114 hReady :: Handle -> IO Bool
 115 hReady h = hWaitForInput h 0
 116
 117 hWaitForInput :: Handle -> Int -> IO Bool
 118 hWaitForInput handle msecs =
 119     wantReadableHandle "hWaitForInput" handle $ \ handle_ -> do
 120     rc       <- inputReady (haFO__ handle_) (msecs::Int)     -- ConcHask: SAFE, won't block
 121     case (rc::Int) of
 122       0 -> return False
 123       1 -> return True
 124       _ -> constructErrorAndFail "hWaitForInput"
 125 \end{code}
 126
 127 @hGetChar hdl@ reads the next character from handle @hdl@,
 128 blocking until a character is available.
 129
 130 \begin{code}
 131 hGetChar :: Handle -> IO Char
 132 hGetChar handle = do
 133   c <- mayBlockRead "hGetChar" handle fileGetc
 134   return (chr c)
 135
 136 {-
 137   If EOF is reached before EOL is encountered, ignore the
 138   EOF and return the partial line. Next attempt at calling
 139   hGetLine on the handle will yield an EOF IO exception though.
 140 -}
 141
 142 hGetLine :: Handle -> IO String
 143 hGetLine h = do
 144     buffer_mode <- wantReadableHandle "hGetLine" h
 145                         (\ handle_ -> do return (haBufferMode__ handle_))
 146     case buffer_mode of
 147        NoBuffering      -> hGetLineUnBuffered h
 148        LineBuffering    -> hGetLineBuf' []
 149        BlockBuffering _ -> hGetLineBuf' []
 150
 151   where hGetLineBuf' xss = do
 152            (eol, xss) <- catch
 153             ( do
 154               mayBlockRead' "hGetLine" h
 155                 (\fo -> readLine fo)
 156                 (\fo bytes -> do
 157                   buf <- getBufStart fo bytes
 158                   eol <- readCharOffAddr buf (bytes-1)
 159                   xs <- if (eol == '\n')
 160                           then stToIO (unpackNBytesST buf (bytes-1))
 161                           else stToIO (unpackNBytesST buf bytes)
 162                   return (eol, xs:xss)
 163                )
 164             )
 165             (\e -> if isEOFError e && not (null xss)
 166                         then return ('\n', xss)
 167                         else ioError e)
 168
 169            if (eol == '\n')
 170                 then return (concat (reverse xss))
 171                 else hGetLineBuf' xss
 172
 173
 174 hGetLineUnBuffered :: Handle -> IO String
 175 hGetLineUnBuffered h = do
 176   c <- hGetChar h
 177   if c == '\n' then
 178      return ""
 179    else do
 180     l <- getRest
 181     return (c:l)
 182  where
 183   getRest = do
 184     c <-
 185       catch
 186         (hGetChar h)
 187         (\ err -> do
 188           if isEOFError err then
 189              return '\n'
 190            else
 191              ioError err)
 192     if c == '\n' then
 193        return ""
 194      else do
 195        s <- getRest
 196        return (c:s)
 197
 198
 199 readCharOffAddr (A# a) (I# i)
 200   = IO $ \s -> case readCharOffAddr# a i s of { (# s,x #) -> (# s, C# x #) }
 201 \end{code}
 202
 203 @hLookahead hdl@ returns the next character from handle @hdl@
 204 without removing it from the input buffer, blocking until a
 205 character is available.
 206
 207 \begin{code}
 208 hLookAhead :: Handle -> IO Char
 209 hLookAhead handle = do
 210   rc <- mayBlockRead "hLookAhead" handle fileLookAhead
 211   return (chr rc)
 212 \end{code}
 213
 214
 215 %*********************************************************
 216 %*                                                      *
 217 \subsection{Getting the entire contents of a handle}
 218 %*                                                      *
 219 %*********************************************************
 220
 221 @hGetContents hdl@ returns the list of characters corresponding
 222 to the unread portion of the channel or file managed by @hdl@,
 223 which is made semi-closed.
 224
 225 \begin{code}
 226 hGetContents :: Handle -> IO String
 227 hGetContents handle =
 228         -- can't use wantReadableHandle here, because we want to side effect
 229         -- the handle.
 230     withHandle handle $ \ handle_ -> do
 231     case haType__ handle_ of
 232       ErrorHandle theError -> ioException theError
 233       ClosedHandle         -> ioe_closedHandle "hGetContents" handle
 234       SemiClosedHandle     -> ioe_closedHandle "hGetContents" handle
 235       AppendHandle         -> ioException not_readable_error
 236       WriteHandle          -> ioException not_readable_error
 237       _ -> do
 238           {-
 239             To avoid introducing an extra layer of buffering here,
 240             we provide three lazy read methods, based on character,
 241             line, and block buffering.
 242           -}
 243         let handle_' = handle_{ haType__ = SemiClosedHandle }
 244         case (haBufferMode__ handle_) of
 245          LineBuffering    -> do
 246             str <- unsafeInterleaveIO (lazyReadLine handle (haFO__ handle_))
 247             return (handle_', str)
 248          BlockBuffering _ -> do
 249             str <- unsafeInterleaveIO (lazyReadBlock handle (haFO__ handle_))
 250             return (handle_', str)
 251          NoBuffering      -> do
 252             str <- unsafeInterleaveIO (lazyReadChar handle (haFO__ handle_))
 253             return (handle_', str)
 254   where
 255    not_readable_error =
 256            IOError (Just handle) IllegalOperation "hGetContents"
 257                    ("handle is not open for reading")
 258 \end{code}
 259
 260 Note that someone may close the semi-closed handle (or change its buffering),
 261 so each these lazy read functions are pulled on, they have to check whether
 262 the handle has indeed been closed.
 263
 264 \begin{code}
 265 #ifndef __PARALLEL_HASKELL__
 266 lazyReadBlock :: Handle -> ForeignObj -> IO String
 267 lazyReadLine  :: Handle -> ForeignObj -> IO String
 268 lazyReadChar  :: Handle -> ForeignObj -> IO String
 269 #else
 270 lazyReadBlock :: Handle -> Addr -> IO String
 271 lazyReadLine  :: Handle -> Addr -> IO String
 272 lazyReadChar  :: Handle -> Addr -> IO String
 273 #endif
 274
 275 lazyReadBlock handle fo = do
 276    buf   <- getBufStart fo 0
 277    bytes <- mayBlock fo (readBlock fo) -- ConcHask: UNSAFE, may block.
 278    case (bytes::Int) of
 279      -3 -> -- buffering has been turned off, use lazyReadChar instead
 280            lazyReadChar handle fo
 281      -2 -> return ""
 282      -1 -> -- an error occurred, close the handle
 283           withHandle handle $ \ handle_ -> do
 284           closeFile (haFO__ handle_) 0{-don't bother flushing-}  -- ConcHask: SAFE, won't block.
 285           return (handle_ { haType__    = ClosedHandle,
 286                             haFO__      = nullFile__ },
 287                   "")
 288      _ -> do
 289       more <- unsafeInterleaveIO (lazyReadBlock handle fo)
 290       stToIO (unpackNBytesAccST buf bytes more)
 291
 292 lazyReadLine handle fo = do
 293      bytes <- mayBlock fo (readLine fo)   -- ConcHask: UNSAFE, may block.
 294      case (bytes::Int) of
 295        -3 -> -- buffering has been turned off, use lazyReadChar instead
 296              lazyReadChar handle fo
 297        -2 -> return "" -- handle closed by someone else, stop reading.
 298        -1 -> -- an error occurred, close the handle
 299              withHandle handle $ \ handle_ -> do
 300              closeFile (haFO__ handle_) 0{- don't bother flushing-}  -- ConcHask: SAFE, won't block
 301              return (handle_ { haType__    = ClosedHandle,
 302                                haFO__      = nullFile__ },
 303                      "")
 304        _ -> do
 305           more <- unsafeInterleaveIO (lazyReadLine handle fo)
 306           buf  <- getBufStart fo bytes  -- ConcHask: won't block
 307           stToIO (unpackNBytesAccST buf bytes more)
 308
 309 lazyReadChar handle fo = do
 310     char <- mayBlock fo (readChar fo)   -- ConcHask: UNSAFE, may block.
 311     case (char::Int) of
 312       -4 -> -- buffering is now block-buffered, use lazyReadBlock instead
 313             lazyReadBlock handle fo
 314
 315       -3 -> -- buffering is now line-buffered, use lazyReadLine instead
 316             lazyReadLine handle fo
 317       -2 -> return ""
 318       -1 -> -- error, silently close handle.
 319          withHandle handle $ \ handle_ -> do
 320          closeFile (haFO__ handle_) 0{-don't bother flusing-}  -- ConcHask: SAFE, won't block
 321          return (handle_{ haType__  = ClosedHandle,
 322                           haFO__    = nullFile__ },
 323                  "")
 324       _ -> do
 325          more <- unsafeInterleaveIO (lazyReadChar handle fo)
 326          return (chr char : more)
 327
 328 \end{code}
 329
 330
 331 %*********************************************************
 332 %*                                                      *
 333 \subsection{Simple output functions}
 334 %*                                                      *
 335 %*********************************************************
 336
 337 @hPutChar hdl ch@ writes the character @ch@ to the file
 338 or channel managed by @hdl@.  Characters may be buffered if
 339 buffering is enabled for @hdl@
 340
 341 \begin{code}
 342 hPutChar :: Handle -> Char -> IO ()
 343 hPutChar handle c =
 344     c `seq` do   -- must evaluate c before grabbing the handle lock
 345     wantWriteableHandle "hPutChar" handle $ \ handle_  -> do
 346     let fo = haFO__ handle_
 347     flushConnectedBuf fo
 348     rc <- mayBlock fo (filePutc fo c)   -- ConcHask: UNSAFE, may block.
 349     if rc == 0
 350      then return ()
 351      else constructErrorAndFail "hPutChar"
 352
 353 hPutChars :: Handle -> [Char] -> IO ()
 354 hPutChars handle [] = return ()
 355 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
 356 \end{code}
 357
 358 @hPutStr hdl s@ writes the string @s@ to the file or
 359 channel managed by @hdl@, buffering the output if needs be.
 360
 361
 362 \begin{code}
 363 hPutStr :: Handle -> String -> IO ()
 364 hPutStr handle str = do
 365     buffer_mode <- wantWriteableHandle_ "hPutStr" handle
 366                         (\ handle_ -> do getBuffer handle_)
 367     case buffer_mode of
 368        (NoBuffering, _, _) -> do
 369             hPutChars handle str        -- v. slow, but we don't care
 370        (LineBuffering, buf, bsz) -> do
 371             writeLines handle buf bsz str
 372        (BlockBuffering _, buf, bsz) -> do
 373             writeBlocks handle buf bsz str
 374         -- ToDo: async exceptions during writeLines & writeBlocks will cause
 375         -- the buffer to get lost in the void.  Using ByteArrays instead of
 376         -- malloced buffers is one way around this, but we really ought to
 377         -- be able to handle it with exception handlers/block/unblock etc.
 378
 379 getBuffer :: Handle__ -> IO (Handle__, (BufferMode, Addr, Int))
 380 getBuffer handle_ = do
 381    let bufs = haBuffers__ handle_
 382        fo   = haFO__ handle_
 383        mode = haBufferMode__ handle_
 384    sz <- getBufSize fo
 385    case mode of
 386         NoBuffering -> return (handle_, (mode, nullAddr, 0))
 387         _ -> case bufs of
 388                 [] -> do  buf <- allocMemory__ sz
 389                           return (handle_, (mode, buf, sz))
 390                 (b:bs) -> return (handle_{ haBuffers__ = bs }, (mode, b, sz))
 391
 392 freeBuffer :: Handle__ -> Addr -> Int -> IO Handle__
 393 freeBuffer handle_ buf sz = do
 394    fo_sz <- getBufSize (haFO__ handle_)
 395    if (sz /= fo_sz)
 396         then do { free buf; return handle_ }
 397         else do { return handle_{ haBuffers__ = buf : haBuffers__ handle_ } }
 398
 399 swapBuffers :: Handle__ -> Addr -> Int -> IO Handle__
 400 swapBuffers handle_ buf sz = do
 401    let fo = haFO__ handle_
 402    fo_buf <- getBuf fo
 403    setBuf fo buf sz
 404    return (handle_{ haBuffers__ = fo_buf : haBuffers__ handle_ })
 405
 406 -------------------------------------------------------------------------------
 407 -- commitAndReleaseBuffer handle buf sz count flush
 408 --
 409 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
 410 -- 'count' bytes of data) to handle (handle must be block or line buffered).
 411 --
 412 -- Implementation:
 413 --
 414 --    for block/line buffering,
 415 --       1. If there isn't room in the handle buffer, flush the handle
 416 --          buffer.
 417 --
 418 --       2. If the handle buffer is empty,
 419 --               if flush,
 420 --                   then write buf directly to the device.
 421 --                   else swap the handle buffer with buf.
 422 --
 423 --       3. If the handle buffer is non-empty, copy buf into the
 424 --          handle buffer.  Then, if flush != 0, flush
 425 --          the buffer.
 426
 427 commitAndReleaseBuffer
 428         :: Handle                       -- handle to commit to
 429         -> Addr -> Int                  -- address and size (in bytes) of buffer
 430         -> Int                          -- number of bytes of data in buffer
 431         -> Bool                         -- flush the handle afterward?
 432         -> IO ()
 433
 434 commitAndReleaseBuffer hdl@(Handle h) buf sz count flush = do
 435       h_ <- takeMVar h
 436
 437         -- First deal with any possible exceptions, by freeing the buffer.
 438         -- Async exceptions are blocked, but there are still some interruptible
 439         -- ops below.
 440
 441         -- note that commit doesn't *always* free the buffer, it might
 442         -- swap it for the current handle buffer instead.  This makes things
 443         -- a whole lot more complicated, because we can't just do
 444         -- "finally (... free buffer ...)" here.
 445       catchException (commit hdl h_)
 446                      (\e -> do { h_ <- freeBuffer h_ buf sz; putMVar h h_ })
 447
 448   where
 449    commit hdl@(Handle h) handle_ =
 450      checkWriteableHandle "commitAndReleaseBuffer" hdl handle_ $ do
 451       let fo = haFO__ handle_
 452       flushConnectedBuf fo              -- ????  -SDM
 453       getWriteableBuf fo                -- flush read buf if necessary
 454       fo_buf     <- getBuf fo
 455       fo_wptr    <- getBufWPtr fo
 456       fo_bufSize <- getBufSize fo
 457
 458       let ok    h_ = putMVar h h_ >> return ()
 459
 460           -- enough room in handle buffer for the new data?
 461       if (flush || fo_bufSize - fo_wptr <= count)
 462
 463           -- The <= is to be sure that we never exactly fill up the
 464           -- buffer, which would require a flush.  So if copying the
 465           -- new data into the buffer would make the buffer full, we
 466           -- just flush the existing buffer and the new data immediately,
 467           -- rather than copying before flushing.
 468
 469             then do rc <- mayBlock fo (flushFile fo)
 470                     if (rc < 0)
 471                         then constructErrorAndFail "commitAndReleaseBuffer"
 472                         else
 473                      if (flush || sz /= fo_bufSize || count == sz)
 474                         then do rc <- write_buf fo buf count
 475                                 if (rc < 0)
 476                                     then constructErrorAndFail "commitAndReleaseBuffer"
 477                                     else do handle_ <- freeBuffer handle_ buf sz
 478                                             ok handle_
 479
 480                         -- if:  (a) we don't have to flush, and
 481                         --      (b) size(new buffer) == size(old buffer), and
 482                         --      (c) new buffer is not full,
 483                         -- we can just just swap them over...
 484                         else do handle_ <- swapBuffers handle_ buf sz
 485                                 setBufWPtr fo count
 486                                 ok handle_
 487
 488                 -- not flushing, and there's enough room in the buffer:
 489                 -- just copy the data in and update bufWPtr.
 490             else do memcpy (plusAddr fo_buf (AddrOff# fo_wptr)) buf count
 491                     setBufWPtr fo (fo_wptr + count)
 492                     handle_ <- freeBuffer handle_ buf sz
 493                     ok handle_
 494
 495 --------------------------------------------------------------------------------
 496 -- commitBuffer handle buf sz count flush
 497 --
 498 -- Flushes 'count' bytes from the buffer 'buf' (size 'sz') to 'handle'.
 499 -- There are several cases to consider altogether:
 500 --
 501 -- If flush,
 502 --         - flush handle buffer,
 503 --         - write out new buffer directly
 504 --
 505 -- else
 506 --         - if there's enough room in the handle buffer,
 507 --             then copy new buf into it
 508 --             else flush handle buffer, then copy new buffer into it
 509 --
 510 -- Make sure that we maintain the invariant that the handle buffer is never
 511 -- left in a full state.  Several functions rely on this (eg. filePutc), so
 512 -- if we're about to exactly fill the buffer then we make sure we do a flush
 513 -- here (also see above in commitAndReleaseBuffer).
 514
 515 commitBuffer
 516         :: Handle                       -- handle to commit to
 517         -> Addr -> Int                  -- address and size (in bytes) of buffer
 518         -> Int                          -- number of bytes of data in buffer
 519         -> Bool                         -- flush the handle afterward?
 520         -> IO ()
 521
 522 commitBuffer handle buf sz count flush = do
 523     wantWriteableHandle "commitBuffer" handle $ \handle_ -> do
 524       let fo = haFO__ handle_
 525       flushConnectedBuf fo              -- ????  -SDM
 526       getWriteableBuf fo                -- flush read buf if necessary
 527       fo_buf     <- getBuf fo
 528       fo_wptr    <- getBufWPtr fo
 529       fo_bufSize <- getBufSize fo
 530
 531       new_wptr <-                       -- not enough room in handle buffer?
 532         (if flush || (fo_bufSize - fo_wptr <= count)
 533             then do rc <- mayBlock fo (flushFile fo)
 534                     if (rc < 0) then constructErrorAndFail "commitBuffer"
 535                                 else return 0
 536             else return fo_wptr )
 537
 538       if (flush || fo_bufSize <= count)  -- committed buffer too large?
 539
 540             then do rc <- write_buf fo buf count
 541                     if (rc < 0) then constructErrorAndFail "commitBuffer"
 542                                 else return ()
 543
 544             else do memcpy (plusAddr fo_buf (AddrOff# new_wptr)) buf count
 545                     setBufWPtr fo (new_wptr + count)
 546                     return ()
 547
 548 write_buf fo buf 0 = return 0
 549 write_buf fo buf count = do
 550   rc <- mayBlock fo (write_ fo buf count)
 551   if (rc > 0)
 552         then  write_buf fo buf (count - rc) -- partial write
 553         else  return rc
 554
 555 -- a version of commitBuffer that will free the buffer if an exception is
 556 -- received.  DON'T use this if you intend to use the buffer again!
 557 checkedCommitBuffer handle buf sz count flush
 558   = catchException (commitBuffer handle buf sz count flush)
 559                    (\e -> do withHandle__ handle (\h_ -> freeBuffer h_ buf sz)
 560                              throw e)
 561
 562 foreign import "memcpy" unsafe memcpy :: Addr -> Addr -> Int -> IO ()
 563 \end{code}
 564
 565 Going across the border between Haskell and C is relatively costly,
 566 so for block writes we pack the character strings on the Haskell-side
 567 before passing the external write routine a pointer to the buffer.
 568
 569 \begin{code}
 570 #ifdef __HUGS__
 571
 572 #ifdef __CONCURRENT_HASKELL__
 573 /* See comment in shoveString below for explanation */
 574 #warning delayed update of buffer disnae work with killThread
 575 #endif
 576
 577 writeLines :: Handle -> Addr -> Int -> String -> IO ()
 578 writeLines handle buf bufLen s =
 579   let
 580    shoveString :: Int -> [Char] -> IO ()
 581    shoveString n ls =
 582      case ls of
 583       [] -> commitAndReleaseBuffer handle buf buflen n False{-no need to flush-}
 584
 585       (x:xs) -> do
 586         primWriteCharOffAddr buf n x
 587           {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
 588         let next_n = n + 1
 589         if next_n == bufLen || x == '\n'
 590          then do
 591            checkedCommitBuffer hdl buf len next_n True{-needs flush-}
 592            shoveString 0 xs
 593          else
 594            shoveString next_n xs
 595   in
 596   shoveString 0 s
 597
 598 #else /* ndef __HUGS__ */
 599
 600 writeLines :: Handle -> Addr -> Int -> String -> IO ()
 601 writeLines hdl buf len@(I# bufLen) s =
 602   let
 603    shoveString :: Int# -> [Char] -> IO ()
 604    shoveString n ls =
 605      case ls of
 606       [] -> commitAndReleaseBuffer hdl buf len (I# n) False{-no need to flush-}
 607
 608       ((C# x):xs) -> do
 609         write_char buf n x
 610           -- Flushing on buffer exhaustion or newlines
 611           -- (even if it isn't the last one)
 612         let next_n = n +# 1#
 613         if next_n ==# bufLen || x `eqChar#` '\n'#
 614          then do
 615            checkedCommitBuffer hdl buf len (I# next_n) True{-needs flush-}
 616            shoveString 0# xs
 617          else
 618            shoveString next_n xs
 619   in
 620   shoveString 0# s
 621 #endif /* ndef __HUGS__ */
 622
 623 #ifdef __HUGS__
 624 writeBlocks :: Handle -> Addr -> Int -> String -> IO ()
 625 writeBlocks hdl buf bufLen s =
 626   let
 627    shoveString :: Int -> [Char] -> IO ()
 628    shoveString n ls =
 629      case ls of
 630       [] -> commitAndReleaseBuffer hdl buf len n False{-no need to flush-}
 631
 632       (x:xs) -> do
 633         primWriteCharOffAddr buf n x
 634         let next_n = n + 1
 635         if next_n == bufLen
 636          then do
 637            checkedCommitBuffer hdl buf len next_n True{-needs flush-}
 638            shoveString 0 xs
 639          else
 640            shoveString next_n xs
 641   in
 642   shoveString 0 s
 643
 644 #else /* ndef __HUGS__ */
 645
 646 writeBlocks :: Handle -> Addr -> Int -> String -> IO ()
 647 writeBlocks hdl buf len@(I# bufLen) s =
 648   let
 649    shoveString :: Int# -> [Char] -> IO ()
 650    shoveString n ls =
 651      case ls of
 652       [] -> commitAndReleaseBuffer hdl buf len (I# n) False{-no need to flush-}
 653
 654       ((C# x):xs) -> do
 655         write_char buf n x
 656         let next_n = n +# 1#
 657         if next_n ==# bufLen
 658          then do
 659            checkedCommitBuffer hdl buf len (I# next_n) True{-needs flush-}
 660            shoveString 0# xs
 661          else
 662            shoveString next_n xs
 663   in
 664   shoveString 0# s
 665
 666 write_char :: Addr -> Int# -> Char# -> IO ()
 667 write_char (A# buf#) n# c# =
 668    IO $ \ s# ->
 669    case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
 670 #endif /* ndef __HUGS__ */
 671 \end{code}
 672
 673 Computation @hPrint hdl t@ writes the string representation of {\em t}
 674 given by the @shows@ function to the file or channel managed by {\em
 675 hdl}.
 676
 677 [ Seem to have disappeared from the 1.4 interface  - SOF 2/97 ]
 678
 679 \begin{code}
 680 hPrint :: Show a => Handle -> a -> IO ()
 681 hPrint hdl = hPutStrLn hdl . show
 682 \end{code}
 683
 684 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 685 the handle \tr{hdl}, adding a newline at the end.
 686
 687 \begin{code}
 688 hPutStrLn :: Handle -> String -> IO ()
 689 hPutStrLn hndl str = do
 690  hPutStr  hndl str
 691  hPutChar hndl '\n'
 692 \end{code}