[commit: ghc] wip/binary-bytestring: Binary: Use ByteString's copy in getBS (f6c257b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/binary-bytestring
Link       : http://ghc.haskell.org/trac/ghc/changeset/f6c257bf7c0f6aeef77db5e27d533f6175b05dab/ghc

>---------------------------------------------------------------

commit f6c257bf7c0f6aeef77db5e27d533f6175b05dab
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Sun Jul 10 16:19:04 2016 +0200

    Binary: Use ByteString's copy in getBS
    
    It's unclear how much of an effect on runtime this will have, but if
    nothing else it's simpler.


>---------------------------------------------------------------

f6c257bf7c0f6aeef77db5e27d533f6175b05dab
 compiler/utils/Binary.hs | 29 +++++++++++------------------
 1 file changed, 11 insertions(+), 18 deletions(-)

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 9f8d926..640c529 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -70,7 +70,7 @@ import SrcLoc
 import Foreign
 import Data.Array
 import Data.ByteString (ByteString)
-import qualified Data.ByteString.Internal as BS
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Unsafe   as BS
 import Data.IORef
 import Data.Char                ( ord, chr )
@@ -692,25 +692,18 @@ putBS bh bs =
                 go (n+1)
   go 0
 
-{- -- possible faster version, not quite there yet:
-getBS bh at BinMem{} = do
-  (I# l) <- get bh
-  arr <- readIORef (arr_r bh)
-  off <- readFastMutInt (off_r bh)
-  return $! (mkFastSubBytesBA# arr off l)
--}
 getBS :: BinHandle -> IO ByteString
 getBS bh = do
-  l <- get bh
-  fp <- mallocForeignPtrBytes l
-  withForeignPtr fp $ \ptr -> do
-    let go n | n == l = return $ BS.fromForeignPtr fp 0 l
-             | otherwise = do
-                b <- getByte bh
-                pokeElemOff ptr n b
-                go (n+1)
-    --
-    go 0
+  l <- get bh :: IO Int
+  arr <- readIORef (_arr_r bh)
+  sz <- readFastMutInt (_sz_r bh)
+  off <- readFastMutInt (_off_r bh)
+  when (off + l > sz) $
+        ioError (mkIOError eofErrorType "Data.Binary.getBS" Nothing Nothing)
+  writeFastMutInt (_off_r bh) (off+l)
+  withForeignPtr arr $ \ptr -> do
+      bs <- BS.unsafePackCStringLen (castPtr $ ptr `plusPtr` off, fromIntegral l)
+      return $! BS.copy bs
 
 instance Binary ByteString where
   put_ bh f = putBS bh f