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 = hGetLineBuf' []
 143   where hGetLineBuf' xss = do
 144            (eol, xss) <- catch
 145             ( do
 146               mayBlockRead' "hGetLine" h
 147                 (\fo -> readLine fo)
 148                 (\fo bytes -> do
 149                   buf <- getBufStart fo bytes
 150                   eol <- readCharOffAddr buf (bytes-1)
 151                   xs <- if (eol == '\n')
 152                           then stToIO (unpackNBytesST buf (bytes-1))
 153                           else stToIO (unpackNBytesST buf bytes)
 154                   return (eol, xs:xss)
 155                )
 156             )
 157             (\e -> if isEOFError e && not (null xss)
 158                         then return ('\n', xss)
 159                         else ioError e)
 160
 161            if (eol == '\n')
 162                 then return (concat (reverse xss))
 163                 else hGetLineBuf' xss
 164
 165 readCharOffAddr (A# a) (I# i)
 166   = IO $ \s -> case readCharOffAddr# a i s of { (# s,x #) -> (# s, C# x #) }
 167 \end{code}
 168
 169 @hLookahead hdl@ returns the next character from handle @hdl@
 170 without removing it from the input buffer, blocking until a
 171 character is available.
 172
 173 \begin{code}
 174 hLookAhead :: Handle -> IO Char
 175 hLookAhead handle = do
 176   rc <- mayBlockRead "hLookAhead" handle fileLookAhead
 177   return (chr rc)
 178 \end{code}
 179
 180
 181 %*********************************************************
 182 %*                                                      *
 183 \subsection{Getting the entire contents of a handle}
 184 %*                                                      *
 185 %*********************************************************
 186
 187 @hGetContents hdl@ returns the list of characters corresponding
 188 to the unread portion of the channel or file managed by @hdl@,
 189 which is made semi-closed.
 190
 191 \begin{code}
 192 hGetContents :: Handle -> IO String
 193 hGetContents handle =
 194         -- can't use wantReadableHandle here, because we want to side effect
 195         -- the handle.
 196     withHandle handle $ \ handle_ -> do
 197     case haType__ handle_ of
 198       ErrorHandle theError -> ioError theError
 199       ClosedHandle         -> ioe_closedHandle "hGetContents" handle
 200       SemiClosedHandle     -> ioe_closedHandle "hGetContents" handle
 201       AppendHandle         -> ioError not_readable_error
 202       WriteHandle          -> ioError not_readable_error
 203       _ -> do
 204           {-
 205             To avoid introducing an extra layer of buffering here,
 206             we provide three lazy read methods, based on character,
 207             line, and block buffering.
 208           -}
 209         let handle_' = handle_{ haType__ = SemiClosedHandle }
 210         case (haBufferMode__ handle_) of
 211          LineBuffering    -> do
 212             str <- unsafeInterleaveIO (lazyReadLine handle (haFO__ handle_))
 213             return (handle_', str)
 214          BlockBuffering _ -> do
 215             str <- unsafeInterleaveIO (lazyReadBlock handle (haFO__ handle_))
 216             return (handle_', str)
 217          NoBuffering      -> do
 218             str <- unsafeInterleaveIO (lazyReadChar handle (haFO__ handle_))
 219             return (handle_', str)
 220   where
 221    not_readable_error =
 222            IOError (Just handle) IllegalOperation "hGetContents"
 223                    ("handle is not open for reading")
 224 \end{code}
 225
 226 Note that someone may close the semi-closed handle (or change its buffering),
 227 so each these lazy read functions are pulled on, they have to check whether
 228 the handle has indeed been closed.
 229
 230 \begin{code}
 231 #ifndef __PARALLEL_HASKELL__
 232 lazyReadBlock :: Handle -> ForeignObj -> IO String
 233 lazyReadLine  :: Handle -> ForeignObj -> IO String
 234 lazyReadChar  :: Handle -> ForeignObj -> IO String
 235 #else
 236 lazyReadBlock :: Handle -> Addr -> IO String
 237 lazyReadLine  :: Handle -> Addr -> IO String
 238 lazyReadChar  :: Handle -> Addr -> IO String
 239 #endif
 240
 241 lazyReadBlock handle fo = do
 242    buf   <- getBufStart fo 0
 243    bytes <- mayBlock fo (readBlock fo) -- ConcHask: UNSAFE, may block.
 244    case (bytes::Int) of
 245      -3 -> -- buffering has been turned off, use lazyReadChar instead
 246            lazyReadChar handle fo
 247      -2 -> return ""
 248      -1 -> -- an error occurred, close the handle
 249           withHandle handle $ \ handle_ -> do
 250           closeFile (haFO__ handle_) 0{-don't bother flushing-}  -- ConcHask: SAFE, won't block.
 251           return (handle_ { haType__    = ClosedHandle,
 252                             haFO__      = nullFile__ },
 253                   "")
 254      _ -> do
 255       more <- unsafeInterleaveIO (lazyReadBlock handle fo)
 256       stToIO (unpackNBytesAccST buf bytes more)
 257
 258 lazyReadLine handle fo = do
 259      bytes <- mayBlock fo (readLine fo)   -- ConcHask: UNSAFE, may block.
 260      case (bytes::Int) of
 261        -3 -> -- buffering has been turned off, use lazyReadChar instead
 262              lazyReadChar handle fo
 263        -2 -> return "" -- handle closed by someone else, stop reading.
 264        -1 -> -- an error occurred, close the handle
 265              withHandle handle $ \ handle_ -> do
 266              closeFile (haFO__ handle_) 0{- don't bother flushing-}  -- ConcHask: SAFE, won't block
 267              return (handle_ { haType__    = ClosedHandle,
 268                                haFO__      = nullFile__ },
 269                      "")
 270        _ -> do
 271           more <- unsafeInterleaveIO (lazyReadLine handle fo)
 272           buf  <- getBufStart fo bytes  -- ConcHask: won't block
 273           stToIO (unpackNBytesAccST buf bytes more)
 274
 275 lazyReadChar handle fo = do
 276     char <- mayBlock fo (readChar fo)   -- ConcHask: UNSAFE, may block.
 277     case (char::Int) of
 278       -4 -> -- buffering is now block-buffered, use lazyReadBlock instead
 279             lazyReadBlock handle fo
 280
 281       -3 -> -- buffering is now line-buffered, use lazyReadLine instead
 282             lazyReadLine handle fo
 283       -2 -> return ""
 284       -1 -> -- error, silently close handle.
 285          withHandle handle $ \ handle_ -> do
 286          closeFile (haFO__ handle_) 0{-don't bother flusing-}  -- ConcHask: SAFE, won't block
 287          return (handle_{ haType__  = ClosedHandle,
 288                           haFO__    = nullFile__ },
 289                  "")
 290       _ -> do
 291          more <- unsafeInterleaveIO (lazyReadChar handle fo)
 292          return (chr char : more)
 293
 294 \end{code}
 295
 296
 297 %*********************************************************
 298 %*                                                      *
 299 \subsection{Simple output functions}
 300 %*                                                      *
 301 %*********************************************************
 302
 303 @hPutChar hdl ch@ writes the character @ch@ to the file
 304 or channel managed by @hdl@.  Characters may be buffered if
 305 buffering is enabled for @hdl@
 306
 307 \begin{code}
 308 hPutChar :: Handle -> Char -> IO ()
 309 hPutChar handle c =
 310     c `seq` do   -- must evaluate c before grabbing the handle lock
 311     wantWriteableHandle "hPutChar" handle $ \ handle_  -> do
 312     let fo = haFO__ handle_
 313     flushConnectedBuf fo
 314     rc <- mayBlock fo (filePutc fo c)   -- ConcHask: UNSAFE, may block.
 315     if rc == 0
 316      then return ()
 317      else constructErrorAndFail "hPutChar"
 318
 319 hPutChars :: Handle -> [Char] -> IO ()
 320 hPutChars handle [] = return ()
 321 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
 322 \end{code}
 323
 324 @hPutStr hdl s@ writes the string @s@ to the file or
 325 channel managed by @hdl@, buffering the output if needs be.
 326
 327
 328 \begin{code}
 329 hPutStr :: Handle -> String -> IO ()
 330 hPutStr handle str = do
 331     buffer_mode <- wantWriteableHandle_ "hPutStr" handle
 332                         (\ handle_ -> do getBuffer handle_)
 333     case buffer_mode of
 334        (NoBuffering, _, _) -> do
 335             hPutChars handle str        -- v. slow, but we don't care
 336        (LineBuffering, buf, bsz) -> do
 337             writeLines handle buf bsz str
 338        (BlockBuffering _, buf, bsz) -> do
 339             writeBlocks handle buf bsz str
 340         -- ToDo: async exceptions during writeLines & writeBlocks will cause
 341         -- the buffer to get lost in the void.  Using ByteArrays instead of
 342         -- malloced buffers is one way around this, but we really ought to
 343         -- be able to handle it with exception handlers/block/unblock etc.
 344
 345 getBuffer :: Handle__ -> IO (Handle__, (BufferMode, Addr, Int))
 346 getBuffer handle_ = do
 347    let bufs = haBuffers__ handle_
 348        fo   = haFO__ handle_
 349        mode = haBufferMode__ handle_
 350    sz <- getBufSize fo
 351    case mode of
 352         NoBuffering -> return (handle_, (mode, nullAddr, 0))
 353         _ -> case bufs of
 354                 [] -> do  buf <- allocMemory__ sz
 355                           return (handle_, (mode, buf, sz))
 356                 (b:bs) -> return (handle_{ haBuffers__ = bs }, (mode, b, sz))
 357
 358 freeBuffer :: Handle__ -> Addr -> Int -> IO Handle__
 359 freeBuffer handle_ buf sz = do
 360    fo_sz <- getBufSize (haFO__ handle_)
 361    if (sz /= fo_sz)
 362         then do { free buf; return handle_ }
 363         else do { return handle_{ haBuffers__ = buf : haBuffers__ handle_ } }
 364
 365 swapBuffers :: Handle__ -> Addr -> Int -> IO Handle__
 366 swapBuffers handle_ buf sz = do
 367    let fo = haFO__ handle_
 368    fo_buf <- getBuf fo
 369    setBuf fo buf sz
 370    return (handle_{ haBuffers__ = fo_buf : haBuffers__ handle_ })
 371
 372 -------------------------------------------------------------------------------
 373 -- commitAndReleaseBuffer handle buf sz count flush
 374 --
 375 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
 376 -- 'count' bytes of data) to handle (handle must be block or line buffered).
 377 --
 378 -- Implementation:
 379 --
 380 --    for block/line buffering,
 381 --       1. If there isn't room in the handle buffer, flush the handle
 382 --          buffer.
 383 --
 384 --       2. If the handle buffer is empty,
 385 --               if flush,
 386 --                   then write buf directly to the device.
 387 --                   else swap the handle buffer with buf.
 388 --
 389 --       3. If the handle buffer is non-empty, copy buf into the
 390 --          handle buffer.  Then, if flush != 0, flush
 391 --          the buffer.
 392
 393 commitAndReleaseBuffer
 394         :: Handle                       -- handle to commit to
 395         -> Addr -> Int                  -- address and size (in bytes) of buffer
 396         -> Int                          -- number of bytes of data in buffer
 397         -> Bool                         -- flush the handle afterward?
 398         -> IO ()
 399
 400 commitAndReleaseBuffer hdl@(Handle h) buf sz count flush = do
 401       h_ <- takeMVar h
 402
 403         -- First deal with any possible exceptions, by freeing the buffer.
 404         -- Async exceptions are blocked, but there are still some interruptible
 405         -- ops below.
 406
 407         -- note that commit doesn't *always* free the buffer, it might
 408         -- swap it for the current handle buffer instead.  This makes things
 409         -- a whole lot more complicated, because we can't just do
 410         -- "finally (... free buffer ...)" here.
 411       catchException (commit hdl h_)
 412                      (\e -> do { h_ <- freeBuffer h_ buf sz; putMVar h h_ })
 413
 414   where
 415    commit hdl@(Handle h) handle_ =
 416      checkWriteableHandle "commitAndReleaseBuffer" hdl handle_ $ do
 417       let fo = haFO__ handle_
 418       flushConnectedBuf fo              -- ????  -SDM
 419       getWriteableBuf fo                -- flush read buf if necessary
 420       fo_buf     <- getBuf fo
 421       fo_wptr    <- getBufWPtr fo
 422       fo_bufSize <- getBufSize fo
 423
 424       let ok    h_ = putMVar h h_ >> return ()
 425
 426           -- enough room in handle buffer for the new data?
 427       if (flush || fo_bufSize - fo_wptr <= count)
 428
 429           -- The <= is to be sure that we never exactly fill up the
 430           -- buffer, which would require a flush.  So if copying the
 431           -- new data into the buffer would make the buffer full, we
 432           -- just flush the existing buffer and the new data immediately,
 433           -- rather than copying before flushing.
 434
 435             then do rc <- mayBlock fo (flushFile fo)
 436                     if (rc < 0)
 437                         then constructErrorAndFail "commitAndReleaseBuffer"
 438                         else
 439                      if (flush || sz /= fo_bufSize || count == sz)
 440                         then do rc <- write_buf fo buf count
 441                                 if (rc < 0)
 442                                     then constructErrorAndFail "commitAndReleaseBuffer"
 443                                     else do handle_ <- freeBuffer handle_ buf sz
 444                                             ok handle_
 445
 446                         -- if:  (a) we don't have to flush, and
 447                         --      (b) size(new buffer) == size(old buffer), and
 448                         --      (c) new buffer is not full,
 449                         -- we can just just swap them over...
 450                         else do handle_ <- swapBuffers handle_ buf sz
 451                                 setBufWPtr fo count
 452                                 ok handle_
 453
 454                 -- not flushing, and there's enough room in the buffer:
 455                 -- just copy the data in and update bufWPtr.
 456             else do memcpy (plusAddr fo_buf (AddrOff# fo_wptr)) buf count
 457                     setBufWPtr fo (fo_wptr + count)
 458                     handle_ <- freeBuffer handle_ buf sz
 459                     ok handle_
 460
 461 --------------------------------------------------------------------------------
 462 -- commitBuffer handle buf sz count flush
 463 --
 464 -- Flushes 'count' bytes from the buffer 'buf' (size 'sz') to 'handle'.
 465 -- There are several cases to consider altogether:
 466 --
 467 -- If flush,
 468 --         - flush handle buffer,
 469 --         - write out new buffer directly
 470 --
 471 -- else
 472 --         - if there's enough room in the handle buffer,
 473 --             then copy new buf into it
 474 --             else flush handle buffer, then copy new buffer into it
 475 --
 476 -- Make sure that we maintain the invariant that the handle buffer is never
 477 -- left in a full state.  Several functions rely on this (eg. filePutc), so
 478 -- if we're about to exactly fill the buffer then we make sure we do a flush
 479 -- here (also see above in commitAndReleaseBuffer).
 480
 481 commitBuffer
 482         :: Handle                       -- handle to commit to
 483         -> Addr -> Int                  -- address and size (in bytes) of buffer
 484         -> Int                          -- number of bytes of data in buffer
 485         -> Bool                         -- flush the handle afterward?
 486         -> IO ()
 487
 488 commitBuffer handle buf sz count flush = do
 489     wantWriteableHandle "commitBuffer" handle $ \handle_ -> do
 490       let fo = haFO__ handle_
 491       flushConnectedBuf fo              -- ????  -SDM
 492       getWriteableBuf fo                -- flush read buf if necessary
 493       fo_buf     <- getBuf fo
 494       fo_wptr    <- getBufWPtr fo
 495       fo_bufSize <- getBufSize fo
 496
 497       new_wptr <-                       -- not enough room in handle buffer?
 498         (if flush || (fo_bufSize - fo_wptr <= count)
 499             then do rc <- mayBlock fo (flushFile fo)
 500                     if (rc < 0) then constructErrorAndFail "commitBuffer"
 501                                 else return 0
 502             else return fo_wptr )
 503
 504       if (flush || fo_bufSize <= count)  -- committed buffer too large?
 505
 506             then do rc <- write_buf fo buf count
 507                     if (rc < 0) then constructErrorAndFail "commitBuffer"
 508                                 else return ()
 509
 510             else do memcpy (plusAddr fo_buf (AddrOff# new_wptr)) buf count
 511                     setBufWPtr fo (new_wptr + count)
 512                     return ()
 513
 514 write_buf fo buf 0 = return 0
 515 write_buf fo buf count = do
 516   rc <- mayBlock fo (write_ fo buf count)
 517   if (rc > 0)
 518         then  write_buf fo buf (count - rc) -- partial write
 519         else  return rc
 520
 521 -- a version of commitBuffer that will free the buffer if an exception is
 522 -- received.  DON'T use this if you intend to use the buffer again!
 523 checkedCommitBuffer handle buf sz count flush
 524   = catchException (commitBuffer handle buf sz count flush)
 525                    (\e -> do withHandle__ handle (\h_ -> freeBuffer h_ buf sz)
 526                              throw e)
 527
 528 foreign import "memcpy" unsafe memcpy :: Addr -> Addr -> Int -> IO ()
 529 \end{code}
 530
 531 Going across the border between Haskell and C is relatively costly,
 532 so for block writes we pack the character strings on the Haskell-side
 533 before passing the external write routine a pointer to the buffer.
 534
 535 \begin{code}
 536 #ifdef __HUGS__
 537
 538 #ifdef __CONCURRENT_HASKELL__
 539 /* See comment in shoveString below for explanation */
 540 #warning delayed update of buffer disnae work with killThread
 541 #endif
 542
 543 writeLines :: Handle -> Addr -> Int -> String -> IO ()
 544 writeLines handle buf bufLen s =
 545   let
 546    shoveString :: Int -> [Char] -> IO ()
 547    shoveString n ls =
 548      case ls of
 549       [] -> commitAndReleaseBuffer handle buf buflen n False{-no need to flush-}
 550
 551       (x:xs) -> do
 552         primWriteCharOffAddr buf n x
 553           {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
 554         let next_n = n + 1
 555         if next_n == bufLen || x == '\n'
 556          then do
 557            checkedCommitBuffer hdl buf len next_n True{-needs flush-}
 558            shoveString 0 xs
 559          else
 560            shoveString next_n xs
 561   in
 562   shoveString 0 s
 563
 564 #else /* ndef __HUGS__ */
 565
 566 writeLines :: Handle -> Addr -> Int -> String -> IO ()
 567 writeLines hdl buf len@(I# bufLen) s =
 568   let
 569    shoveString :: Int# -> [Char] -> IO ()
 570    shoveString n ls =
 571      case ls of
 572       [] -> commitAndReleaseBuffer hdl buf len (I# n) False{-no need to flush-}
 573
 574       ((C# x):xs) -> do
 575         write_char buf n x
 576           -- Flushing on buffer exhaustion or newlines
 577           -- (even if it isn't the last one)
 578         let next_n = n +# 1#
 579         if next_n ==# bufLen || x `eqChar#` '\n'#
 580          then do
 581            checkedCommitBuffer hdl buf len (I# next_n) True{-needs flush-}
 582            shoveString 0# xs
 583          else
 584            shoveString next_n xs
 585   in
 586   shoveString 0# s
 587 #endif /* ndef __HUGS__ */
 588
 589 #ifdef __HUGS__
 590 writeBlocks :: Handle -> Addr -> Int -> String -> IO ()
 591 writeBlocks hdl buf bufLen s =
 592   let
 593    shoveString :: Int -> [Char] -> IO ()
 594    shoveString n ls =
 595      case ls of
 596       [] -> commitAndReleaseBuffer hdl buf len n False{-no need to flush-}
 597
 598       (x:xs) -> do
 599         primWriteCharOffAddr buf n x
 600         let next_n = n + 1
 601         if next_n == bufLen
 602          then do
 603            checkedCommitBuffer hdl buf len next_n True{-needs flush-}
 604            shoveString 0 xs
 605          else
 606            shoveString next_n xs
 607   in
 608   shoveString 0 s
 609
 610 #else /* ndef __HUGS__ */
 611
 612 writeBlocks :: Handle -> Addr -> Int -> String -> IO ()
 613 writeBlocks hdl buf len@(I# bufLen) s =
 614   let
 615    shoveString :: Int# -> [Char] -> IO ()
 616    shoveString n ls =
 617      case ls of
 618       [] -> commitAndReleaseBuffer hdl buf len (I# n) False{-no need to flush-}
 619
 620       ((C# x):xs) -> do
 621         write_char buf n x
 622         let next_n = n +# 1#
 623         if next_n ==# bufLen
 624          then do
 625            checkedCommitBuffer hdl buf len (I# next_n) True{-needs flush-}
 626            shoveString 0# xs
 627          else
 628            shoveString next_n xs
 629   in
 630   shoveString 0# s
 631
 632 write_char :: Addr -> Int# -> Char# -> IO ()
 633 write_char (A# buf#) n# c# =
 634    IO $ \ s# ->
 635    case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
 636 #endif /* ndef __HUGS__ */
 637 \end{code}
 638
 639 Computation @hPrint hdl t@ writes the string representation of {\em t}
 640 given by the @shows@ function to the file or channel managed by {\em
 641 hdl}.
 642
 643 [ Seem to have disappeared from the 1.4 interface  - SOF 2/97 ]
 644
 645 \begin{code}
 646 hPrint :: Show a => Handle -> a -> IO ()
 647 hPrint hdl = hPutStrLn hdl . show
 648 \end{code}
 649
 650 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 651 the handle \tr{hdl}, adding a newline at the end.
 652
 653 \begin{code}
 654 hPutStrLn :: Handle -> String -> IO ()
 655 hPutStrLn hndl str = do
 656  hPutStr  hndl str
 657  hPutChar hndl '\n'
 658 \end{code}