ghc/lib/std/PrelIO.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelIO.lhs,v 1.16 2000/11/07 10:42:56 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(..), 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       ClosedHandle         -> ioe_closedHandle "hGetContents" handle
 233       SemiClosedHandle     -> ioe_closedHandle "hGetContents" handle
 234       AppendHandle         -> ioException not_readable_error
 235       WriteHandle          -> ioException 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      _ -> do
 286       more <- unsafeInterleaveIO (lazyReadBlock handle fo)
 287       stToIO (unpackNBytesAccST buf bytes more)
 288
 289 lazyReadLine handle fo = do
 290      bytes <- mayBlock fo (readLine fo)   -- ConcHask: UNSAFE, may block.
 291      case (bytes::Int) of
 292        -3 -> -- buffering has been turned off, use lazyReadChar instead
 293              lazyReadChar handle fo
 294        -2 -> return "" -- handle closed by someone else, stop reading.
 295        -1 -> -- an error occurred, close the handle
 296              withHandle handle $ \ handle_ -> do
 297              closeFile (haFO__ handle_) 0{- don't bother flushing-}  -- ConcHask: SAFE, won't block
 298              return (handle_ { haType__    = ClosedHandle }, "")
 299        _ -> do
 300           more <- unsafeInterleaveIO (lazyReadLine handle fo)
 301           buf  <- getBufStart fo bytes  -- ConcHask: won't block
 302           stToIO (unpackNBytesAccST buf bytes more)
 303
 304 lazyReadChar handle fo = do
 305     char <- mayBlock fo (readChar fo)   -- ConcHask: UNSAFE, may block.
 306     case (char::Int) of
 307       -4 -> -- buffering is now block-buffered, use lazyReadBlock instead
 308             lazyReadBlock handle fo
 309
 310       -3 -> -- buffering is now line-buffered, use lazyReadLine instead
 311             lazyReadLine handle fo
 312       -2 -> return ""
 313       -1 -> -- error, silently close handle.
 314          withHandle handle $ \ handle_ -> do
 315          closeFile (haFO__ handle_) 0{-don't bother flusing-}  -- ConcHask: SAFE, won't block
 316          return (handle_{ haType__  = ClosedHandle }, "")
 317       _ -> do
 318          more <- unsafeInterleaveIO (lazyReadChar handle fo)
 319          return (chr char : more)
 320
 321 \end{code}
 322
 323
 324 %*********************************************************
 325 %*                                                      *
 326 \subsection{Simple output functions}
 327 %*                                                      *
 328 %*********************************************************
 329
 330 @hPutChar hdl ch@ writes the character @ch@ to the file
 331 or channel managed by @hdl@.  Characters may be buffered if
 332 buffering is enabled for @hdl@
 333
 334 \begin{code}
 335 hPutChar :: Handle -> Char -> IO ()
 336 hPutChar handle c =
 337     c `seq` do   -- must evaluate c before grabbing the handle lock
 338     wantWriteableHandle "hPutChar" handle $ \ handle_  -> do
 339     let fo = haFO__ handle_
 340     flushConnectedBuf fo
 341     rc <- mayBlock fo (filePutc fo c)   -- ConcHask: UNSAFE, may block.
 342     if rc == 0
 343      then return ()
 344      else constructErrorAndFail "hPutChar"
 345
 346 hPutChars :: Handle -> [Char] -> IO ()
 347 hPutChars handle [] = return ()
 348 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
 349 \end{code}
 350
 351 @hPutStr hdl s@ writes the string @s@ to the file or
 352 channel managed by @hdl@, buffering the output if needs be.
 353
 354
 355 \begin{code}
 356 hPutStr :: Handle -> String -> IO ()
 357 hPutStr handle str = do
 358     buffer_mode <- wantWriteableHandle_ "hPutStr" handle
 359                         (\ handle_ -> do getBuffer handle_)
 360     case buffer_mode of
 361        (NoBuffering, _, _) -> do
 362             hPutChars handle str        -- v. slow, but we don't care
 363        (LineBuffering, buf, bsz) -> do
 364             writeLines handle buf bsz str
 365        (BlockBuffering _, buf, bsz) -> do
 366             writeBlocks handle buf bsz str
 367         -- ToDo: async exceptions during writeLines & writeBlocks will cause
 368         -- the buffer to get lost in the void.  Using ByteArrays instead of
 369         -- malloced buffers is one way around this, but we really ought to
 370         -- be able to handle it with exception handlers/block/unblock etc.
 371
 372 getBuffer :: Handle__ -> IO (Handle__, (BufferMode, Addr, Int))
 373 getBuffer handle_ = do
 374    let bufs = haBuffers__ handle_
 375        fo   = haFO__ handle_
 376        mode = haBufferMode__ handle_
 377    sz <- getBufSize fo
 378    case mode of
 379         NoBuffering -> return (handle_, (mode, nullAddr, 0))
 380         _ -> case bufs of
 381                 [] -> do  buf <- malloc sz
 382                           return (handle_, (mode, buf, sz))
 383                 (b:bs) -> return (handle_{ haBuffers__ = bs }, (mode, b, sz))
 384
 385 freeBuffer :: Handle__ -> Addr -> Int -> IO Handle__
 386 freeBuffer handle_ buf sz = do
 387    fo_sz <- getBufSize (haFO__ handle_)
 388    if (sz /= fo_sz)
 389         then do { free buf; return handle_ }
 390         else do { return handle_{ haBuffers__ = buf : haBuffers__ handle_ } }
 391
 392 swapBuffers :: Handle__ -> Addr -> Int -> IO Handle__
 393 swapBuffers handle_ buf sz = do
 394    let fo = haFO__ handle_
 395    fo_buf <- getBuf fo
 396    setBuf fo buf sz
 397    return (handle_{ haBuffers__ = fo_buf : haBuffers__ handle_ })
 398
 399 -------------------------------------------------------------------------------
 400 -- commitAndReleaseBuffer handle buf sz count flush
 401 --
 402 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
 403 -- 'count' bytes of data) to handle (handle must be block or line buffered).
 404 --
 405 -- Implementation:
 406 --
 407 --    for block/line buffering,
 408 --       1. If there isn't room in the handle buffer, flush the handle
 409 --          buffer.
 410 --
 411 --       2. If the handle buffer is empty,
 412 --               if flush,
 413 --                   then write buf directly to the device.
 414 --                   else swap the handle buffer with buf.
 415 --
 416 --       3. If the handle buffer is non-empty, copy buf into the
 417 --          handle buffer.  Then, if flush != 0, flush
 418 --          the buffer.
 419
 420 commitAndReleaseBuffer
 421         :: Handle                       -- handle to commit to
 422         -> Addr -> Int                  -- address and size (in bytes) of buffer
 423         -> Int                          -- number of bytes of data in buffer
 424         -> Bool                         -- flush the handle afterward?
 425         -> IO ()
 426
 427 commitAndReleaseBuffer hdl@(Handle h) buf sz count flush = do
 428       h_ <- takeMVar h
 429
 430         -- First deal with any possible exceptions, by freeing the buffer.
 431         -- Async exceptions are blocked, but there are still some interruptible
 432         -- ops below.
 433
 434         -- note that commit doesn't *always* free the buffer, it might
 435         -- swap it for the current handle buffer instead.  This makes things
 436         -- a whole lot more complicated, because we can't just do
 437         -- "finally (... free buffer ...)" here.
 438       catchException (commit hdl h_)
 439                      (\e -> do { h_ <- freeBuffer h_ buf sz; putMVar h h_ })
 440
 441   where
 442    commit hdl@(Handle h) handle_ =
 443      checkWriteableHandle "commitAndReleaseBuffer" hdl handle_ $ do
 444       let fo = haFO__ handle_
 445       flushConnectedBuf fo              -- ????  -SDM
 446       getWriteableBuf fo                -- flush read buf if necessary
 447       fo_buf     <- getBuf fo
 448       fo_wptr    <- getBufWPtr fo
 449       fo_bufSize <- getBufSize fo
 450
 451       let ok    h_ = putMVar h h_ >> return ()
 452
 453           -- enough room in handle buffer for the new data?
 454       if (flush || fo_bufSize - fo_wptr <= count)
 455
 456           -- The <= is to be sure that we never exactly fill up the
 457           -- buffer, which would require a flush.  So if copying the
 458           -- new data into the buffer would make the buffer full, we
 459           -- just flush the existing buffer and the new data immediately,
 460           -- rather than copying before flushing.
 461
 462             then do rc <- mayBlock fo (flushFile fo)
 463                     if (rc < 0)
 464                         then constructErrorAndFail "commitAndReleaseBuffer"
 465                         else
 466                      if (flush || sz /= fo_bufSize || count == sz)
 467                         then do rc <- write_buf fo buf count
 468                                 if (rc < 0)
 469                                     then constructErrorAndFail "commitAndReleaseBuffer"
 470                                     else do handle_ <- freeBuffer handle_ buf sz
 471                                             ok handle_
 472
 473                         -- if:  (a) we don't have to flush, and
 474                         --      (b) size(new buffer) == size(old buffer), and
 475                         --      (c) new buffer is not full,
 476                         -- we can just just swap them over...
 477                         else do handle_ <- swapBuffers handle_ buf sz
 478                                 setBufWPtr fo count
 479                                 ok handle_
 480
 481                 -- not flushing, and there's enough room in the buffer:
 482                 -- just copy the data in and update bufWPtr.
 483             else do memcpy (plusAddr fo_buf fo_wptr) buf count
 484                     setBufWPtr fo (fo_wptr + count)
 485                     handle_ <- freeBuffer handle_ buf sz
 486                     ok handle_
 487
 488 --------------------------------------------------------------------------------
 489 -- commitBuffer handle buf sz count flush
 490 --
 491 -- Flushes 'count' bytes from the buffer 'buf' (size 'sz') to 'handle'.
 492 -- There are several cases to consider altogether:
 493 --
 494 -- If flush,
 495 --         - flush handle buffer,
 496 --         - write out new buffer directly
 497 --
 498 -- else
 499 --         - if there's enough room in the handle buffer,
 500 --             then copy new buf into it
 501 --             else flush handle buffer, then copy new buffer into it
 502 --
 503 -- Make sure that we maintain the invariant that the handle buffer is never
 504 -- left in a full state.  Several functions rely on this (eg. filePutc), so
 505 -- if we're about to exactly fill the buffer then we make sure we do a flush
 506 -- here (also see above in commitAndReleaseBuffer).
 507
 508 commitBuffer
 509         :: Handle                       -- handle to commit to
 510         -> Addr -> Int                  -- address and size (in bytes) of buffer
 511         -> Int                          -- number of bytes of data in buffer
 512         -> Bool                         -- flush the handle afterward?
 513         -> IO ()
 514
 515 commitBuffer handle buf sz count flush = do
 516     wantWriteableHandle "commitBuffer" handle $ \handle_ -> do
 517       let fo = haFO__ handle_
 518       flushConnectedBuf fo              -- ????  -SDM
 519       getWriteableBuf fo                -- flush read buf if necessary
 520       fo_buf     <- getBuf fo
 521       fo_wptr    <- getBufWPtr fo
 522       fo_bufSize <- getBufSize fo
 523
 524       new_wptr <-                       -- not enough room in handle buffer?
 525         (if flush || (fo_bufSize - fo_wptr <= count)
 526             then do rc <- mayBlock fo (flushFile fo)
 527                     if (rc < 0) then constructErrorAndFail "commitBuffer"
 528                                 else return 0
 529             else return fo_wptr )
 530
 531       if (flush || fo_bufSize <= count)  -- committed buffer too large?
 532
 533             then do rc <- write_buf fo buf count
 534                     if (rc < 0) then constructErrorAndFail "commitBuffer"
 535                                 else return ()
 536
 537             else do memcpy (plusAddr fo_buf new_wptr) buf count
 538                     setBufWPtr fo (new_wptr + count)
 539                     return ()
 540
 541 write_buf fo buf 0 = return 0
 542 write_buf fo buf count = do
 543   rc <- mayBlock fo (write_ fo buf count)
 544   if (rc > 0)
 545         then  write_buf fo buf (count - rc) -- partial write
 546         else  return rc
 547
 548 -- a version of commitBuffer that will free the buffer if an exception is
 549 -- received.  DON'T use this if you intend to use the buffer again!
 550 checkedCommitBuffer handle buf sz count flush
 551   = catchException (commitBuffer handle buf sz count flush)
 552                    (\e -> do withHandle__ handle (\h_ -> freeBuffer h_ buf sz)
 553                              throw e)
 554
 555 foreign import "memcpy" unsafe memcpy :: Addr -> Addr -> Int -> IO ()
 556 \end{code}
 557
 558 Going across the border between Haskell and C is relatively costly,
 559 so for block writes we pack the character strings on the Haskell-side
 560 before passing the external write routine a pointer to the buffer.
 561
 562 \begin{code}
 563 #ifdef __HUGS__
 564
 565 #ifdef __CONCURRENT_HASKELL__
 566 /* See comment in shoveString below for explanation */
 567 #warning delayed update of buffer disnae work with killThread
 568 #endif
 569
 570 writeLines :: Handle -> Addr -> Int -> String -> IO ()
 571 writeLines handle buf bufLen s =
 572   let
 573    shoveString :: Int -> [Char] -> IO ()
 574    shoveString n ls =
 575      case ls of
 576       [] -> commitAndReleaseBuffer handle buf buflen n False{-no need to flush-}
 577
 578       (x:xs) -> do
 579         primWriteCharOffAddr buf n x
 580           {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
 581         let next_n = n + 1
 582         if next_n == bufLen || x == '\n'
 583          then do
 584            checkedCommitBuffer hdl buf len next_n True{-needs flush-}
 585            shoveString 0 xs
 586          else
 587            shoveString next_n xs
 588   in
 589   shoveString 0 s
 590
 591 #else /* ndef __HUGS__ */
 592
 593 writeLines :: Handle -> Addr -> Int -> String -> IO ()
 594 writeLines hdl buf len@(I# bufLen) s =
 595   let
 596    shoveString :: Int# -> [Char] -> IO ()
 597    shoveString n ls =
 598      case ls of
 599       [] -> commitAndReleaseBuffer hdl buf len (I# n) False{-no need to flush-}
 600
 601       ((C# x):xs) -> do
 602         write_char buf n x
 603           -- Flushing on buffer exhaustion or newlines
 604           -- (even if it isn't the last one)
 605         let next_n = n +# 1#
 606         if next_n ==# bufLen || x `eqChar#` '\n'#
 607          then do
 608            checkedCommitBuffer hdl buf len (I# next_n) True{-needs flush-}
 609            shoveString 0# xs
 610          else
 611            shoveString next_n xs
 612   in
 613   shoveString 0# s
 614 #endif /* ndef __HUGS__ */
 615
 616 #ifdef __HUGS__
 617 writeBlocks :: Handle -> Addr -> Int -> String -> IO ()
 618 writeBlocks hdl buf bufLen s =
 619   let
 620    shoveString :: Int -> [Char] -> IO ()
 621    shoveString n ls =
 622      case ls of
 623       [] -> commitAndReleaseBuffer hdl buf len n False{-no need to flush-}
 624
 625       (x:xs) -> do
 626         primWriteCharOffAddr buf n x
 627         let next_n = n + 1
 628         if next_n == bufLen
 629          then do
 630            checkedCommitBuffer hdl buf len next_n True{-needs flush-}
 631            shoveString 0 xs
 632          else
 633            shoveString next_n xs
 634   in
 635   shoveString 0 s
 636
 637 #else /* ndef __HUGS__ */
 638
 639 writeBlocks :: Handle -> Addr -> Int -> String -> IO ()
 640 writeBlocks hdl buf len@(I# bufLen) s =
 641   let
 642    shoveString :: Int# -> [Char] -> IO ()
 643    shoveString n ls =
 644      case ls of
 645       [] -> commitAndReleaseBuffer hdl buf len (I# n) False{-no need to flush-}
 646
 647       ((C# x):xs) -> do
 648         write_char buf n x
 649         let next_n = n +# 1#
 650         if next_n ==# bufLen
 651          then do
 652            checkedCommitBuffer hdl buf len (I# next_n) True{-needs flush-}
 653            shoveString 0# xs
 654          else
 655            shoveString next_n xs
 656   in
 657   shoveString 0# s
 658
 659 write_char :: Addr -> Int# -> Char# -> IO ()
 660 write_char (A# buf#) n# c# =
 661    IO $ \ s# ->
 662    case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
 663 #endif /* ndef __HUGS__ */
 664 \end{code}
 665
 666 Computation @hPrint hdl t@ writes the string representation of {\em t}
 667 given by the @shows@ function to the file or channel managed by {\em
 668 hdl}.
 669
 670 [ Seem to have disappeared from the 1.4 interface  - SOF 2/97 ]
 671
 672 \begin{code}
 673 hPrint :: Show a => Handle -> a -> IO ()
 674 hPrint hdl = hPutStrLn hdl . show
 675 \end{code}
 676
 677 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 678 the handle \tr{hdl}, adding a newline at the end.
 679
 680 \begin{code}
 681 hPutStrLn :: Handle -> String -> IO ()
 682 hPutStrLn hndl str = do
 683  hPutStr  hndl str
 684  hPutChar hndl '\n'
 685 \end{code}