[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit dd1f1ab694b62524564493654b56ed0c6daac74c
Author: John Goerzen <jgoerzen at complete.org>
Date:   Mon Oct 10 18:27:07 2005 +0100

    Optimize up hBlockCopy

diff --git a/MissingH/IO/Binary.hs b/MissingH/IO/Binary.hs
index 6f7d07a..8ef3d6f 100644
--- a/MissingH/IO/Binary.hs
+++ b/MissingH/IO/Binary.hs
@@ -247,16 +247,28 @@ hBlockInteractUtil blockreader blocksize hin hout func =
     hPutBlocks hout (func blocks)
 
 {- | Copies everything from the input handle to the output handle using binary
-blocks of the given size.  This is actually a beautiful implementation:
+blocks of the given size.  This was once the following 
+beautiful implementation:
 
 > hBlockCopy bs hin hout = hBlockInteract bs hin hout id
 
 ('id' is the built-in Haskell function that just returns whatever is given
 to it)
+
+In more recent versions of MissingH, it uses a more optimized routine that
+avoids ever having to convert the binary buffer at all.
 -}
 
 hBlockCopy :: (HVIO a, HVIO b) => Int -> a -> b -> IO ()
-hBlockCopy bs hin hout = hBlockInteract bs hin hout id
+hBlockCopy bs hin hout = 
+    do (fbuf::ForeignPtr CChar) <- mallocForeignPtrArray (bs + 1)
+       withForeignPtr fbuf handler
+    where handler ptr =
+              do bytesread <- vGetBuf hin ptr bs
+                 if bytesread > 0
+                    then do vPutBuf hout ptr bytesread
+                            handler ptr
+                    else return ()
 
 {- | Copies from 'stdin' to 'stdout' using binary blocks of the given size.
 An alias for 'hBlockCopy' over 'stdin' and 'stdout'

-- 
haskell-testpack