ghc/lib/std/PrelIO.lhs

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