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.1 2001/11/07 18:25:35 sof 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"
 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             fd  = haFD handle_
 354         r <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
 355                 (read_off (fromIntegral fd) raw 0 1)
 356                 (threadWaitRead fd)
 357         if r == 0
 358            then do handle_ <- hClose_help handle_
 359                    return (handle_, "")
 360            else do (c,_) <- readCharFromBuffer raw 0
 361                    rest <- lazyRead h
 362                    return (handle_, c : rest)
 363
 364      LineBuffering    -> lazyReadBuffered h handle_ fd ref buf
 365      BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
 366
 367 -- we never want to block during the read, so we call fillReadBuffer with
 368 -- is_line==True, which tells it to "just read what there is".
 369 lazyReadBuffered h handle_ fd ref buf = do
 370    catch
 371         (do buf <- fillReadBuffer fd True{-is_line-} buf
 372             lazyReadHaveBuffer h handle_ fd ref buf
 373         )
 374         -- all I/O errors are discarded.  Additionally, we close the handle.
 375         (\e -> do handle_ <- hClose_help handle_
 376                   return (handle_, "")
 377         )
 378
 379 lazyReadHaveBuffer h handle_ fd ref buf = do
 380    more <- lazyRead h
 381    writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
 382    s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
 383    return (handle_, s)
 384
 385
 386 unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
 387 unpackAcc buf r 0 acc  = return ""
 388 unpackAcc buf (I# r) (I# len) acc = IO $ \s -> unpack acc (len -# 1#) s
 389    where
 390     unpack acc i s
 391      | i <# r  = (# s, acc #)
 392      | otherwise =
 393           case readCharArray# buf i s of
 394             (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s
 395
 396 -- ---------------------------------------------------------------------------
 397 -- hPutChar
 398
 399 -- `hPutChar hdl ch' writes the character `ch' to the file or channel
 400 -- managed by `hdl'.  Characters may be buffered if buffering is
 401 -- enabled for `hdl'.
 402
 403 hPutChar :: Handle -> Char -> IO ()
 404 hPutChar handle c =
 405     c `seq` do   -- must evaluate c before grabbing the handle lock
 406     wantWritableHandle "hPutChar" handle $ \ handle_  -> do
 407     let fd = haFD handle_
 408     case haBufferMode handle_ of
 409         LineBuffering    -> hPutcBuffered handle_ True  c
 410         BlockBuffering _ -> hPutcBuffered handle_ False c
 411         NoBuffering      ->
 412                 withObject (castCharToCChar c) $ \buf ->
 413                 throwErrnoIfMinus1RetryMayBlock_ "hPutChar"
 414                    (c_write (fromIntegral fd) buf 1)
 415                    (threadWaitWrite fd)
 416
 417
 418 hPutcBuffered handle_ is_line c = do
 419   let ref = haBuffer handle_
 420   buf <- readIORef ref
 421   let w = bufWPtr buf
 422   w'  <- writeCharIntoBuffer (bufBuf buf) w c
 423   let new_buf = buf{ bufWPtr = w' }
 424   if bufferFull new_buf || is_line && c == '\n'
 425      then do
 426         flushed_buf <- flushWriteBuffer (haFD handle_) new_buf
 427         writeIORef ref flushed_buf
 428      else do
 429         writeIORef ref new_buf
 430
 431
 432 hPutChars :: Handle -> [Char] -> IO ()
 433 hPutChars handle [] = return ()
 434 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
 435
 436 -- ---------------------------------------------------------------------------
 437 -- hPutStr
 438
 439 -- `hPutStr hdl s' writes the string `s' to the file or
 440 -- hannel managed by `hdl', buffering the output if needs be.
 441
 442 -- We go to some trouble to avoid keeping the handle locked while we're
 443 -- evaluating the string argument to hPutStr, in case doing so triggers another
 444 -- I/O operation on the same handle which would lead to deadlock.  The classic
 445 -- case is
 446 --
 447 --              putStr (trace "hello" "world")
 448 --
 449 -- so the basic scheme is this:
 450 --
 451 --      * copy the string into a fresh buffer,
 452 --      * "commit" the buffer to the handle.
 453 --
 454 -- Committing may involve simply copying the contents of the new
 455 -- buffer into the handle's buffer, flushing one or both buffers, or
 456 -- maybe just swapping the buffers over (if the handle's buffer was
 457 -- empty).  See commitBuffer below.
 458
 459 hPutStr :: Handle -> String -> IO ()
 460 hPutStr handle str = do
 461     buffer_mode <- wantWritableHandle "hPutStr" handle
 462                         (\ handle_ -> do getSpareBuffer handle_)
 463     case buffer_mode of
 464        (NoBuffering, _) -> do
 465             hPutChars handle str        -- v. slow, but we don't care
 466        (LineBuffering, buf) -> do
 467             writeLines handle buf str
 468        (BlockBuffering _, buf) -> do
 469             writeBlocks handle buf str
 470
 471
 472 getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer)
 473 getSpareBuffer Handle__{haBuffer=ref,
 474                         haBuffers=spare_ref,
 475                         haBufferMode=mode}
 476  = do
 477    case mode of
 478      NoBuffering -> return (mode, error "no buffer!")
 479      _ -> do
 480           bufs <- readIORef spare_ref
 481           buf  <- readIORef ref
 482           case bufs of
 483             BufferListCons b rest -> do
 484                 writeIORef spare_ref rest
 485                 return ( mode, newEmptyBuffer b WriteBuffer (bufSize buf))
 486             BufferListNil -> do
 487                 new_buf <- allocateBuffer (bufSize buf) WriteBuffer
 488                 return (mode, new_buf)
 489
 490
 491 writeLines :: Handle -> Buffer -> String -> IO ()
 492 writeLines hdl Buffer{ bufBuf=raw, bufSize=len } s =
 493   let
 494    shoveString :: Int -> [Char] -> IO ()
 495         -- check n == len first, to ensure that shoveString is strict in n.
 496    shoveString n cs | n == len = do
 497         new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
 498         writeLines hdl new_buf cs
 499    shoveString n [] = do
 500         commitBuffer hdl raw len n False{-no flush-} True{-release-}
 501         return ()
 502    shoveString n (c:cs) = do
 503         n' <- writeCharIntoBuffer raw n c
 504         if (c == '\n')
 505            then do
 506                 new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False
 507                 writeLines hdl new_buf cs
 508            else
 509                 shoveString n' cs
 510   in
 511   shoveString 0 s
 512
 513 writeBlocks :: Handle -> Buffer -> String -> IO ()
 514 writeBlocks hdl Buffer{ bufBuf=raw, bufSize=len } s =
 515   let
 516    shoveString :: Int -> [Char] -> IO ()
 517         -- check n == len first, to ensure that shoveString is strict in n.
 518    shoveString n cs | n == len = do
 519         new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
 520         writeBlocks hdl new_buf cs
 521    shoveString n [] = do
 522         commitBuffer hdl raw len n False{-no flush-} True{-release-}
 523         return ()
 524    shoveString n (c:cs) = do
 525         n' <- writeCharIntoBuffer raw n c
 526         shoveString n' cs
 527   in
 528   shoveString 0 s
 529
 530 -- -----------------------------------------------------------------------------
 531 -- commitBuffer handle buf sz count flush release
 532 --
 533 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
 534 -- 'count' bytes of data) to handle (handle must be block or line buffered).
 535 --
 536 -- Implementation:
 537 --
 538 --    for block/line buffering,
 539 --       1. If there isn't room in the handle buffer, flush the handle
 540 --          buffer.
 541 --
 542 --       2. If the handle buffer is empty,
 543 --               if flush,
 544 --                   then write buf directly to the device.
 545 --                   else swap the handle buffer with buf.
 546 --
 547 --       3. If the handle buffer is non-empty, copy buf into the
 548 --          handle buffer.  Then, if flush != 0, flush
 549 --          the buffer.
 550
 551 commitBuffer
 552         :: Handle                       -- handle to commit to
 553         -> RawBuffer -> Int             -- address and size (in bytes) of buffer
 554         -> Int                          -- number of bytes of data in buffer
 555         -> Bool                         -- True <=> flush the handle afterward
 556         -> Bool                         -- release the buffer?
 557         -> IO Buffer
 558
 559 commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do
 560   wantWritableHandle "commitAndReleaseBuffer" hdl $
 561      commitBuffer' hdl raw sz count flush release
 562
 563 -- Explicitly lambda-lift this function to subvert GHC's full laziness
 564 -- optimisations, which otherwise tends to float out subexpressions
 565 -- past the \handle, which is really a pessimisation in this case because
 566 -- that lambda is a one-shot lambda.
 567 --
 568 -- Don't forget to export the function, to stop it being inlined too
 569 -- (this appears to be better than NOINLINE, because the strictness
 570 -- analyser still gets to worker-wrapper it).
 571 --
 572 -- This hack is a fairly big win for hPutStr performance.  --SDM 18/9/2001
 573 --
 574 commitBuffer' hdl raw sz@(I# _) count@(I# _) flush release
 575   handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do
 576
 577 #ifdef DEBUG_DUMP
 578       puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
 579             ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++"\n")
 580 #endif
 581
 582       old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
 583           <- readIORef ref
 584
 585       buf_ret <-
 586         -- enough room in handle buffer?
 587          if (not flush && (size - w > count))
 588                 -- The > is to be sure that we never exactly fill
 589                 -- up the buffer, which would require a flush.  So
 590                 -- if copying the new data into the buffer would
 591                 -- make the buffer full, we just flush the existing
 592                 -- buffer and the new data immediately, rather than
 593                 -- copying before flushing.
 594
 595                 -- not flushing, and there's enough room in the buffer:
 596                 -- just copy the data in and update bufWPtr.
 597             then do memcpy_off old_raw w raw (fromIntegral count)
 598                     writeIORef ref old_buf{ bufWPtr = w + count }
 599                     return (newEmptyBuffer raw WriteBuffer sz)
 600
 601                 -- else, we have to flush
 602             else do flushed_buf <- flushWriteBuffer fd old_buf
 603
 604                     let this_buf =
 605                             Buffer{ bufBuf=raw, bufState=WriteBuffer,
 606                                     bufRPtr=0, bufWPtr=count, bufSize=sz }
 607
 608                         -- if:  (a) we don't have to flush, and
 609                         --      (b) size(new buffer) == size(old buffer), and
 610                         --      (c) new buffer is not full,
 611                         -- we can just just swap them over...
 612                     if (not flush && sz == size && count /= sz)
 613                         then do
 614                           writeIORef ref this_buf
 615                           return flushed_buf
 616
 617                         -- otherwise, we have to flush the new data too,
 618                         -- and start with a fresh buffer
 619                         else do
 620                           flushWriteBuffer fd this_buf
 621                           writeIORef ref flushed_buf
 622                             -- if the sizes were different, then allocate
 623                             -- a new buffer of the correct size.
 624                           if sz == size
 625                              then return (newEmptyBuffer raw WriteBuffer sz)
 626                              else allocateBuffer size WriteBuffer
 627
 628       -- release the buffer if necessary
 629       case buf_ret of
 630         Buffer{ bufSize=buf_ret_sz, bufBuf=buf_ret_raw } -> do
 631           if release && buf_ret_sz == size
 632             then do
 633               spare_bufs <- readIORef spare_buf_ref
 634               writeIORef spare_buf_ref
 635                 (BufferListCons buf_ret_raw spare_bufs)
 636               return buf_ret
 637             else
 638               return buf_ret
 639
 640
 641 foreign import "prel_PrelIO_memcpy" unsafe
 642    memcpy_off :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
 643
 644 -- ---------------------------------------------------------------------------
 645 -- hPutStrLn
 646
 647 -- Derived action `hPutStrLn hdl str' writes the string `str' to
 648 -- the handle `hdl', adding a newline at the end.
 649
 650 hPutStrLn :: Handle -> String -> IO ()
 651 hPutStrLn hndl str = do
 652  hPutStr  hndl str
 653  hPutChar hndl '\n'
 654
 655 -- ---------------------------------------------------------------------------
 656 -- hPrint
 657
 658 -- Computation `hPrint hdl t' writes the string representation of `t'
 659 -- given by the `shows' function to the file or channel managed by `hdl'.
 660
 661 hPrint :: Show a => Handle -> a -> IO ()
 662 hPrint hdl = hPutStrLn hdl . show