ghc/lib/std/PrelIO.hs

   1 {-# OPTIONS -fno-implicit-prelude -#include "PrelIOUtils.h" #-}
   2
   3 #undef DEBUG_DUMP
   4
   5 -- -----------------------------------------------------------------------------
   6 -- $Id: PrelIO.hs,v 1.3 2001/11/14 11:35:23 simonmar Exp $
   7 --
   8 -- (c) The University of Glasgow, 1992-2001
   9 --
  10 -- Module PrelIO
  11
  12 -- This module defines all basic IO operations.
  13 -- These are needed for the IO operations exported by Prelude,
  14 -- but as it happens they also do everything required by library
  15 -- module IO.
  16
  17 module PrelIO (
  18    putChar, putStr, putStrLn, print, getChar, getLine, getContents,
  19    interact, readFile, writeFile, appendFile, readLn, readIO, hReady,
  20    hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
  21    hPutStrLn, hPrint,
  22    commitBuffer',       -- hack, see below
  23    hGetcBuffered,       -- needed by ghc/compiler/utils/StringBuffer.lhs
  24  ) where
  25
  26 import PrelBase
  27
  28 import PrelPosix
  29 import PrelMarshalUtils
  30 import PrelStorable
  31 import PrelCError
  32 import PrelCString
  33 import PrelCTypes
  34 import PrelCTypesISO
  35
  36 import PrelIOBase
  37 import PrelHandle       -- much of the real stuff is in here
  38
  39 import PrelMaybe
  40 import PrelReal
  41 import PrelNum
  42 import PrelRead
  43 import PrelShow
  44 import PrelMaybe        ( Maybe(..) )
  45 import PrelPtr
  46 import PrelList
  47 import PrelException    ( ioError, catch, throw )
  48 import PrelConc
  49
  50 -- -----------------------------------------------------------------------------
  51 -- Standard IO
  52
  53 putChar         :: Char -> IO ()
  54 putChar c       =  hPutChar stdout c
  55
  56 putStr          :: String -> IO ()
  57 putStr s        =  hPutStr stdout s
  58
  59 putStrLn        :: String -> IO ()
  60 putStrLn s      =  do putStr s
  61                       putChar '\n'
  62
  63 print           :: Show a => a -> IO ()
  64 print x         =  putStrLn (show x)
  65
  66 getChar         :: IO Char
  67 getChar         =  hGetChar stdin
  68
  69 getLine         :: IO String
  70 getLine         =  hGetLine stdin
  71
  72 getContents     :: IO String
  73 getContents     =  hGetContents stdin
  74
  75 interact        ::  (String -> String) -> IO ()
  76 interact f      =   do s <- getContents
  77                        putStr (f s)
  78
  79 readFile        :: FilePath -> IO String
  80 readFile name   =  openFile name ReadMode >>= hGetContents
  81
  82 writeFile       :: FilePath -> String -> IO ()
  83 writeFile name str = do
  84     hdl <- openFile name WriteMode
  85     hPutStr hdl str
  86     hClose hdl
  87
  88 appendFile      :: FilePath -> String -> IO ()
  89 appendFile name str = do
  90     hdl <- openFile name AppendMode
  91     hPutStr hdl str
  92     hClose hdl
  93
  94 readLn          :: Read a => IO a
  95 readLn          =  do l <- getLine
  96                       r <- readIO l
  97                       return r
  98
  99   -- raises an exception instead of an error
 100 readIO          :: Read a => String -> IO a
 101 readIO s        =  case (do { (x,t) <- reads s ;
 102                               ("","") <- lex t ;
 103                               return x }) of
 104 #ifndef NEW_READS_REP
 105                         [x]    -> return x
 106                         []     -> ioError (userError "Prelude.readIO: no parse")
 107                         _      -> ioError (userError "Prelude.readIO: ambiguous parse")
 108 #else
 109                         Just x -> return x
 110                         Nothing  -> ioError (userError "Prelude.readIO: no parse")
 111 #endif
 112
 113 -- ---------------------------------------------------------------------------
 114 -- Simple input operations
 115
 116 -- Computation "hReady hdl" indicates whether at least
 117 -- one item is available for input from handle "hdl".
 118
 119 -- If hWaitForInput finds anything in the Handle's buffer, it
 120 -- immediately returns.  If not, it tries to read from the underlying
 121 -- OS handle. Notice that for buffered Handles connected to terminals
 122 -- this means waiting until a complete line is available.
 123
 124 hReady :: Handle -> IO Bool
 125 hReady h = hWaitForInput h 0
 126
 127 hWaitForInput :: Handle -> Int -> IO Bool
 128 hWaitForInput h msecs = do
 129   wantReadableHandle "hReady" h $ \ handle_ -> do
 130   let ref = haBuffer handle_
 131   buf <- readIORef ref
 132
 133   if not (bufferEmpty buf)
 134         then return True
 135         else do
 136
 137   r <- throwErrnoIfMinus1Retry "hReady"
 138           (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs))
 139   return (r /= 0)
 140
 141 foreign import "inputReady" unsafe
 142   inputReady :: CInt -> CInt -> IO CInt
 143
 144 -- ---------------------------------------------------------------------------
 145 -- hGetChar
 146
 147 -- hGetChar reads the next character from a handle,
 148 -- blocking until a character is available.
 149
 150 hGetChar :: Handle -> IO Char
 151 hGetChar handle =
 152   wantReadableHandle "hGetChar" handle $ \handle_ -> do
 153
 154   let fd = haFD handle_
 155       ref = haBuffer handle_
 156
 157   buf <- readIORef ref
 158   if not (bufferEmpty buf)
 159         then hGetcBuffered fd ref buf
 160         else do
 161
 162   -- buffer is empty.
 163   case haBufferMode handle_ of
 164     LineBuffering    -> do
 165         new_buf <- fillReadBuffer fd True buf
 166         hGetcBuffered fd ref new_buf
 167     BlockBuffering _ -> do
 168         new_buf <- fillReadBuffer fd False buf
 169         hGetcBuffered fd ref new_buf
 170     NoBuffering -> do
 171         -- make use of the minimal buffer we already have
 172         let raw = bufBuf buf
 173         r <- throwErrnoIfMinus1RetryMayBlock "hGetChar"
 174                 (read_off (fromIntegral fd) raw 0 1)
 175                 (threadWaitRead fd)
 176         if r == 0
 177            then ioe_EOF
 178            else do (c,_) <- readCharFromBuffer raw 0
 179                    return c
 180
 181 hGetcBuffered fd ref buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }
 182  = do (c,r) <- readCharFromBuffer b r
 183       let new_buf | r == w    = buf{ bufRPtr=0, bufWPtr=0 }
 184                   | otherwise = buf{ bufRPtr=r }
 185       writeIORef ref new_buf
 186       return c
 187
 188 -- ---------------------------------------------------------------------------
 189 -- hGetLine
 190
 191 -- If EOF is reached before EOL is encountered, ignore the EOF and
 192 -- return the partial line. Next attempt at calling hGetLine on the
 193 -- handle will yield an EOF IO exception though.
 194
 195 -- ToDo: the unbuffered case is wrong: it doesn't lock the handle for
 196 -- the duration.
 197 hGetLine :: Handle -> IO String
 198 hGetLine h = do
 199   m <- wantReadableHandle "hGetLine" h $ \ handle_ -> do
 200         case haBufferMode handle_ of
 201            NoBuffering      -> return Nothing
 202            LineBuffering    -> do
 203               l <- hGetLineBuffered handle_
 204               return (Just l)
 205            BlockBuffering _ -> do
 206               l <- hGetLineBuffered handle_
 207               return (Just l)
 208   case m of
 209         Nothing -> hGetLineUnBuffered h
 210         Just l  -> return l
 211
 212
 213 hGetLineBuffered handle_ = do
 214   let ref = haBuffer handle_
 215   buf <- readIORef ref
 216   hGetLineBufferedLoop handle_ ref buf []
 217
 218
 219 hGetLineBufferedLoop handle_ ref
 220         buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } xss =
 221   let
 222         -- find the end-of-line character, if there is one
 223         loop raw r
 224            | r == w = return (False, w)
 225            | otherwise =  do
 226                 (c,r') <- readCharFromBuffer raw r
 227                 if c == '\n'
 228                    then return (True, r) -- NB. not r': don't include the '\n'
 229                    else loop raw r'
 230   in do
 231   (eol, off) <- loop raw r
 232
 233 #ifdef DEBUG_DUMP
 234   puts ("hGetLineBufferedLoop: r=" ++ show r ++ ", w=" ++ show w ++ ", off=" ++ show off ++ "\n")
 235 #endif
 236
 237   xs <- unpack raw r off
 238   if eol
 239         then do if w == off + 1
 240                    then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
 241                    else writeIORef ref buf{ bufRPtr = off + 1 }
 242                 return (concat (reverse (xs:xss)))
 243         else do
 244              maybe_buf <- maybeFillReadBuffer (haFD handle_) True
 245                                 buf{ bufWPtr=0, bufRPtr=0 }
 246              case maybe_buf of
 247                 -- Nothing indicates we caught an EOF, and we may have a
 248                 -- partial line to return.
 249                 Nothing -> let str = concat (reverse (xs:xss)) in
 250                            if not (null str)
 251                               then return str
 252                               else ioe_EOF
 253                 Just new_buf ->
 254                      hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
 255
 256
 257 maybeFillReadBuffer fd is_line buf
 258   = catch
 259      (do buf <- fillReadBuffer fd is_line buf
 260          return (Just buf)
 261      )
 262      (\e -> do if isEOFError e
 263                   then return Nothing
 264                   else throw e)
 265
 266
 267 unpack :: RawBuffer -> Int -> Int -> IO [Char]
 268 unpack buf r 0   = return ""
 269 unpack buf (I# r) (I# len) = IO $ \s -> unpack [] (len -# 1#) s
 270    where
 271     unpack acc i s
 272      | i <# r  = (# s, acc #)
 273      | otherwise =
 274           case readCharArray# buf i s of
 275             (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s
 276
 277
 278 hGetLineUnBuffered :: Handle -> IO String
 279 hGetLineUnBuffered h = do
 280   c <- hGetChar h
 281   if c == '\n' then
 282      return ""
 283    else do
 284     l <- getRest
 285     return (c:l)
 286  where
 287   getRest = do
 288     c <-
 289       catch
 290         (hGetChar h)
 291         (\ err -> do
 292           if isEOFError err then
 293              return '\n'
 294            else
 295              ioError err)
 296     if c == '\n' then
 297        return ""
 298      else do
 299        s <- getRest
 300        return (c:s)
 301
 302 -- -----------------------------------------------------------------------------
 303 -- hGetContents
 304
 305 -- hGetContents returns the list of characters corresponding to the
 306 -- unread portion of the channel or file managed by the handle, which
 307 -- is made semi-closed.
 308
 309 -- hGetContents on a DuplexHandle only affects the read side: you can
 310 -- carry on writing to it afterwards.
 311
 312 hGetContents :: Handle -> IO String
 313 hGetContents handle =
 314     withHandle "hGetContents" handle $ \handle_ ->
 315     case haType handle_ of
 316       ClosedHandle         -> ioe_closedHandle
 317       SemiClosedHandle     -> ioe_closedHandle
 318       AppendHandle         -> ioe_notReadable
 319       WriteHandle          -> ioe_notReadable
 320       _ -> do xs <- lazyRead handle
 321               return (handle_{ haType=SemiClosedHandle}, xs )
 322
 323 -- Note that someone may close the semi-closed handle (or change its
 324 -- buffering), so each time these lazy read functions are pulled on,
 325 -- they have to check whether the handle has indeed been closed.
 326
 327 lazyRead :: Handle -> IO String
 328 lazyRead handle =
 329    unsafeInterleaveIO $
 330         withHandle "lazyRead" handle $ \ handle_ -> do
 331         case haType handle_ of
 332           ClosedHandle     -> return (handle_, "")
 333           SemiClosedHandle -> lazyRead' handle handle_
 334           _ -> ioException
 335                   (IOError (Just handle) IllegalOperation "lazyRead"
 336                         "illegal handle type" Nothing)
 337
 338 lazyRead' h handle_ = do
 339   let ref = haBuffer handle_
 340       fd  = haFD handle_
 341
 342   -- even a NoBuffering handle can have a char in the buffer...
 343   -- (see hLookAhead)
 344   buf <- readIORef ref
 345   if not (bufferEmpty buf)
 346         then lazyReadHaveBuffer h handle_ fd ref buf
 347         else do
 348
 349   case haBufferMode handle_ of
 350      NoBuffering      -> do
 351         -- make use of the minimal buffer we already have
 352         let raw = bufBuf buf
 353         r <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
 354                 (read_off (fromIntegral fd) raw 0 1)
 355                 (threadWaitRead fd)
 356         if r == 0
 357            then do handle_ <- hClose_help handle_
 358                    return (handle_, "")
 359            else do (c,_) <- readCharFromBuffer raw 0
 360                    rest <- lazyRead h
 361                    return (handle_, c : rest)
 362
 363      LineBuffering    -> lazyReadBuffered h handle_ fd ref buf
 364      BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
 365
 366 -- we never want to block during the read, so we call fillReadBuffer with
 367 -- is_line==True, which tells it to "just read what there is".
 368 lazyReadBuffered h handle_ fd ref buf = do
 369    catch
 370         (do buf <- fillReadBuffer fd True{-is_line-} buf
 371             lazyReadHaveBuffer h handle_ fd ref buf
 372         )
 373         -- all I/O errors are discarded.  Additionally, we close the handle.
 374         (\e -> do handle_ <- hClose_help handle_
 375                   return (handle_, "")
 376         )
 377
 378 lazyReadHaveBuffer h handle_ fd ref buf = do
 379    more <- lazyRead h
 380    writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
 381    s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
 382    return (handle_, s)
 383
 384
 385 unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
 386 unpackAcc buf r 0 acc  = return ""
 387 unpackAcc buf (I# r) (I# len) acc = IO $ \s -> unpack acc (len -# 1#) s
 388    where
 389     unpack acc i s
 390      | i <# r  = (# s, acc #)
 391      | otherwise =
 392           case readCharArray# buf i s of
 393             (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s
 394
 395 -- ---------------------------------------------------------------------------
 396 -- hPutChar
 397
 398 -- `hPutChar hdl ch' writes the character `ch' to the file or channel
 399 -- managed by `hdl'.  Characters may be buffered if buffering is
 400 -- enabled for `hdl'.
 401
 402 hPutChar :: Handle -> Char -> IO ()
 403 hPutChar handle c =
 404     c `seq` do   -- must evaluate c before grabbing the handle lock
 405     wantWritableHandle "hPutChar" handle $ \ handle_  -> do
 406     let fd = haFD handle_
 407     case haBufferMode handle_ of
 408         LineBuffering    -> hPutcBuffered handle_ True  c
 409         BlockBuffering _ -> hPutcBuffered handle_ False c
 410         NoBuffering      ->
 411                 withObject (castCharToCChar c) $ \buf ->
 412                 throwErrnoIfMinus1RetryMayBlock_ "hPutChar"
 413                    (c_write (fromIntegral fd) buf 1)
 414                    (threadWaitWrite fd)
 415
 416
 417 hPutcBuffered handle_ is_line c = do
 418   let ref = haBuffer handle_
 419   buf <- readIORef ref
 420   let w = bufWPtr buf
 421   w'  <- writeCharIntoBuffer (bufBuf buf) w c
 422   let new_buf = buf{ bufWPtr = w' }
 423   if bufferFull new_buf || is_line && c == '\n'
 424      then do
 425         flushed_buf <- flushWriteBuffer (haFD handle_) new_buf
 426         writeIORef ref flushed_buf
 427      else do
 428         writeIORef ref new_buf
 429
 430
 431 hPutChars :: Handle -> [Char] -> IO ()
 432 hPutChars handle [] = return ()
 433 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
 434
 435 -- ---------------------------------------------------------------------------
 436 -- hPutStr
 437
 438 -- `hPutStr hdl s' writes the string `s' to the file or
 439 -- hannel managed by `hdl', buffering the output if needs be.
 440
 441 -- We go to some trouble to avoid keeping the handle locked while we're
 442 -- evaluating the string argument to hPutStr, in case doing so triggers another
 443 -- I/O operation on the same handle which would lead to deadlock.  The classic
 444 -- case is
 445 --
 446 --              putStr (trace "hello" "world")
 447 --
 448 -- so the basic scheme is this:
 449 --
 450 --      * copy the string into a fresh buffer,
 451 --      * "commit" the buffer to the handle.
 452 --
 453 -- Committing may involve simply copying the contents of the new
 454 -- buffer into the handle's buffer, flushing one or both buffers, or
 455 -- maybe just swapping the buffers over (if the handle's buffer was
 456 -- empty).  See commitBuffer below.
 457
 458 hPutStr :: Handle -> String -> IO ()
 459 hPutStr handle str = do
 460     buffer_mode <- wantWritableHandle "hPutStr" handle
 461                         (\ handle_ -> do getSpareBuffer handle_)
 462     case buffer_mode of
 463        (NoBuffering, _) -> do
 464             hPutChars handle str        -- v. slow, but we don't care
 465        (LineBuffering, buf) -> do
 466             writeLines handle buf str
 467        (BlockBuffering _, buf) -> do
 468             writeBlocks handle buf str
 469
 470
 471 getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer)
 472 getSpareBuffer Handle__{haBuffer=ref,
 473                         haBuffers=spare_ref,
 474                         haBufferMode=mode}
 475  = do
 476    case mode of
 477      NoBuffering -> return (mode, error "no buffer!")
 478      _ -> do
 479           bufs <- readIORef spare_ref
 480           buf  <- readIORef ref
 481           case bufs of
 482             BufferListCons b rest -> do
 483                 writeIORef spare_ref rest
 484                 return ( mode, newEmptyBuffer b WriteBuffer (bufSize buf))
 485             BufferListNil -> do
 486                 new_buf <- allocateBuffer (bufSize buf) WriteBuffer
 487                 return (mode, new_buf)
 488
 489
 490 writeLines :: Handle -> Buffer -> String -> IO ()
 491 writeLines hdl Buffer{ bufBuf=raw, bufSize=len } s =
 492   let
 493    shoveString :: Int -> [Char] -> IO ()
 494         -- check n == len first, to ensure that shoveString is strict in n.
 495    shoveString n cs | n == len = do
 496         new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
 497         writeLines hdl new_buf cs
 498    shoveString n [] = do
 499         commitBuffer hdl raw len n False{-no flush-} True{-release-}
 500         return ()
 501    shoveString n (c:cs) = do
 502         n' <- writeCharIntoBuffer raw n c
 503         if (c == '\n')
 504            then do
 505                 new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False
 506                 writeLines hdl new_buf cs
 507            else
 508                 shoveString n' cs
 509   in
 510   shoveString 0 s
 511
 512 writeBlocks :: Handle -> Buffer -> String -> IO ()
 513 writeBlocks hdl Buffer{ bufBuf=raw, bufSize=len } s =
 514   let
 515    shoveString :: Int -> [Char] -> IO ()
 516         -- check n == len first, to ensure that shoveString is strict in n.
 517    shoveString n cs | n == len = do
 518         new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
 519         writeBlocks hdl new_buf cs
 520    shoveString n [] = do
 521         commitBuffer hdl raw len n False{-no flush-} True{-release-}
 522         return ()
 523    shoveString n (c:cs) = do
 524         n' <- writeCharIntoBuffer raw n c
 525         shoveString n' cs
 526   in
 527   shoveString 0 s
 528
 529 -- -----------------------------------------------------------------------------
 530 -- commitBuffer handle buf sz count flush release
 531 --
 532 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
 533 -- 'count' bytes of data) to handle (handle must be block or line buffered).
 534 --
 535 -- Implementation:
 536 --
 537 --    for block/line buffering,
 538 --       1. If there isn't room in the handle buffer, flush the handle
 539 --          buffer.
 540 --
 541 --       2. If the handle buffer is empty,
 542 --               if flush,
 543 --                   then write buf directly to the device.
 544 --                   else swap the handle buffer with buf.
 545 --
 546 --       3. If the handle buffer is non-empty, copy buf into the
 547 --          handle buffer.  Then, if flush != 0, flush
 548 --          the buffer.
 549
 550 commitBuffer
 551         :: Handle                       -- handle to commit to
 552         -> RawBuffer -> Int             -- address and size (in bytes) of buffer
 553         -> Int                          -- number of bytes of data in buffer
 554         -> Bool                         -- True <=> flush the handle afterward
 555         -> Bool                         -- release the buffer?
 556         -> IO Buffer
 557
 558 commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do
 559   wantWritableHandle "commitAndReleaseBuffer" hdl $
 560      commitBuffer' hdl raw sz count flush release
 561
 562 -- Explicitly lambda-lift this function to subvert GHC's full laziness
 563 -- optimisations, which otherwise tends to float out subexpressions
 564 -- past the \handle, which is really a pessimisation in this case because
 565 -- that lambda is a one-shot lambda.
 566 --
 567 -- Don't forget to export the function, to stop it being inlined too
 568 -- (this appears to be better than NOINLINE, because the strictness
 569 -- analyser still gets to worker-wrapper it).
 570 --
 571 -- This hack is a fairly big win for hPutStr performance.  --SDM 18/9/2001
 572 --
 573 commitBuffer' hdl raw sz@(I# _) count@(I# _) flush release
 574   handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do
 575
 576 #ifdef DEBUG_DUMP
 577       puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
 578             ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++"\n")
 579 #endif
 580
 581       old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
 582           <- readIORef ref
 583
 584       buf_ret <-
 585         -- enough room in handle buffer?
 586          if (not flush && (size - w > count))
 587                 -- The > is to be sure that we never exactly fill
 588                 -- up the buffer, which would require a flush.  So
 589                 -- if copying the new data into the buffer would
 590                 -- make the buffer full, we just flush the existing
 591                 -- buffer and the new data immediately, rather than
 592                 -- copying before flushing.
 593
 594                 -- not flushing, and there's enough room in the buffer:
 595                 -- just copy the data in and update bufWPtr.
 596             then do memcpy_off old_raw w raw (fromIntegral count)
 597                     writeIORef ref old_buf{ bufWPtr = w + count }
 598                     return (newEmptyBuffer raw WriteBuffer sz)
 599
 600                 -- else, we have to flush
 601             else do flushed_buf <- flushWriteBuffer fd old_buf
 602
 603                     let this_buf =
 604                             Buffer{ bufBuf=raw, bufState=WriteBuffer,
 605                                     bufRPtr=0, bufWPtr=count, bufSize=sz }
 606
 607                         -- if:  (a) we don't have to flush, and
 608                         --      (b) size(new buffer) == size(old buffer), and
 609                         --      (c) new buffer is not full,
 610                         -- we can just just swap them over...
 611                     if (not flush && sz == size && count /= sz)
 612                         then do
 613                           writeIORef ref this_buf
 614                           return flushed_buf
 615
 616                         -- otherwise, we have to flush the new data too,
 617                         -- and start with a fresh buffer
 618                         else do
 619                           flushWriteBuffer fd this_buf
 620                           writeIORef ref flushed_buf
 621                             -- if the sizes were different, then allocate
 622                             -- a new buffer of the correct size.
 623                           if sz == size
 624                              then return (newEmptyBuffer raw WriteBuffer sz)
 625                              else allocateBuffer size WriteBuffer
 626
 627       -- release the buffer if necessary
 628       case buf_ret of
 629         Buffer{ bufSize=buf_ret_sz, bufBuf=buf_ret_raw } -> do
 630           if release && buf_ret_sz == size
 631             then do
 632               spare_bufs <- readIORef spare_buf_ref
 633               writeIORef spare_buf_ref
 634                 (BufferListCons buf_ret_raw spare_bufs)
 635               return buf_ret
 636             else
 637               return buf_ret
 638
 639
 640 foreign import "prel_PrelIO_memcpy" unsafe
 641    memcpy_off :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
 642
 643 -- ---------------------------------------------------------------------------
 644 -- hPutStrLn
 645
 646 -- Derived action `hPutStrLn hdl str' writes the string `str' to
 647 -- the handle `hdl', adding a newline at the end.
 648
 649 hPutStrLn :: Handle -> String -> IO ()
 650 hPutStrLn hndl str = do
 651  hPutStr  hndl str
 652  hPutChar hndl '\n'
 653
 654 -- ---------------------------------------------------------------------------
 655 -- hPrint
 656
 657 -- Computation `hPrint hdl t' writes the string representation of `t'
 658 -- given by the `shows' function to the file or channel managed by `hdl'.
 659
 660 hPrint :: Show a => Handle -> a -> IO ()
 661 hPrint hdl = hPutStrLn hdl . show