From 12a606952c0dbceca4598acef9bc27ec35c15724 Mon Sep 17 00:00:00 2001 From: Jaro Reinders Date: Sat, 5 Mar 2022 11:49:07 +0100 Subject: [PATCH 1/5] Add packing benchmarks --- bench/BenchAll.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/bench/BenchAll.hs b/bench/BenchAll.hs index 451eebc65..572ae7d23 100644 --- a/bench/BenchAll.hs +++ b/bench/BenchAll.hs @@ -23,6 +23,7 @@ import Prelude hiding (words) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 +import qualified Data.ByteString.Internal as SI import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8 @@ -481,6 +482,9 @@ main = do [ bench "lazy" $ nf L8.unlines (map (L8.pack . show) intData) , bench "strict" $ nf S8.unlines (map (S8.pack . show) intData) ] + , bench "pack" $ nf S.pack (fromIntegral <$> intData) + , bench "unsafePackLenBytes" $ nf (SI.unsafePackLenBytes nRepl) (fromIntegral <$> intData) + , bench "unsafePackLenChars" $ nf (SI.unsafePackLenChars nRepl) (take nRepl (cycle ['\0'..'\255'])) , benchBoundsCheckFusion , benchCount , benchCSV From 969ec2a46e2c4abedfd117bc085b8f8e320ce236 Mon Sep 17 00:00:00 2001 From: Jaro Reinders Date: Sat, 5 Mar 2022 13:47:52 +0100 Subject: [PATCH 2/5] Expand packing benchmarks --- bench/BenchAll.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/bench/BenchAll.hs b/bench/BenchAll.hs index 572ae7d23..641205124 100644 --- a/bench/BenchAll.hs +++ b/bench/BenchAll.hs @@ -482,9 +482,18 @@ main = do [ bench "lazy" $ nf L8.unlines (map (L8.pack . show) intData) , bench "strict" $ nf S8.unlines (map (S8.pack . show) intData) ] - , bench "pack" $ nf S.pack (fromIntegral <$> intData) - , bench "unsafePackLenBytes" $ nf (SI.unsafePackLenBytes nRepl) (fromIntegral <$> intData) - , bench "unsafePackLenChars" $ nf (SI.unsafePackLenChars nRepl) (take nRepl (cycle ['\0'..'\255'])) + , bgroup "pack" + [ bench "not fused" $ nf S.pack (replicate nRepl 0) + , bench "fused" $ nf (S.pack . replicate nRepl) 0 + ] + , bgroup "unsafePackLenBytes" + [ bench "not fused" $ nf (SI.unsafePackLenBytes nRepl) (replicate nRepl 0) + , bench "fused" $ nf (SI.unsafePackLenBytes nRepl . replicate nRepl) 0 + ] + , bgroup "unsafePackLenChar" + [ bench "not fused" $ nf (SI.unsafePackLenChars nRepl) (replicate nRepl 'A') + , bench "fused" $ nf (SI.unsafePackLenChars nRepl . replicate nRepl) 'A' + ] , benchBoundsCheckFusion , benchCount , benchCSV From a04d938bc0e95b489ca99f93a7cf23a8664cc6bc Mon Sep 17 00:00:00 2001 From: Jaro Reinders Date: Thu, 3 Mar 2022 22:11:04 +0100 Subject: [PATCH 3/5] Enable fusion of unsafePackLen{Bytes,Chars} --- Data/ByteString/Internal.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/Data/ByteString/Internal.hs b/Data/ByteString/Internal.hs index c31cec086..f9b88a5f1 100644 --- a/Data/ByteString/Internal.hs +++ b/Data/ByteString/Internal.hs @@ -339,18 +339,18 @@ packChars cs = unsafePackLenChars (List.length cs) cs #-} unsafePackLenBytes :: Int -> [Word8] -> ByteString -unsafePackLenBytes len xs0 = - unsafeCreate len $ \p -> go p xs0 - where - go !_ [] = return () - go !p (x:xs) = poke p x >> go (p `plusPtr` 1) xs +unsafePackLenBytes len xs = + unsafeCreate len $ \p -> foldr + (\x go p -> poke p x >> go (p `plusPtr` 1)) + (\_ -> return ()) xs p +{-# INLINE unsafePackLenBytes #-} unsafePackLenChars :: Int -> [Char] -> ByteString -unsafePackLenChars len cs0 = - unsafeCreate len $ \p -> go p cs0 - where - go !_ [] = return () - go !p (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) cs +unsafePackLenChars len cs = + unsafeCreate len $ \p -> foldr + (\x go p -> poke p (c2w x) >> go (p `plusPtr` 1)) + (\_ -> return ()) cs p +{-# INLINE unsafePackLenChars #-} -- | /O(n)/ Pack a null-terminated sequence of bytes, pointed to by an From 2ef63dfb14b1439a3a29dae6f3eed86c77f9d55b Mon Sep 17 00:00:00 2001 From: Jaro Reinders Date: Thu, 3 Mar 2022 22:22:58 +0100 Subject: [PATCH 4/5] Fix name shadowing warnings --- Data/ByteString/Internal.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Data/ByteString/Internal.hs b/Data/ByteString/Internal.hs index f9b88a5f1..8951d18aa 100644 --- a/Data/ByteString/Internal.hs +++ b/Data/ByteString/Internal.hs @@ -340,16 +340,16 @@ packChars cs = unsafePackLenChars (List.length cs) cs unsafePackLenBytes :: Int -> [Word8] -> ByteString unsafePackLenBytes len xs = - unsafeCreate len $ \p -> foldr + unsafeCreate len $ \p0 -> foldr (\x go p -> poke p x >> go (p `plusPtr` 1)) - (\_ -> return ()) xs p + (\_ -> return ()) xs p0 {-# INLINE unsafePackLenBytes #-} unsafePackLenChars :: Int -> [Char] -> ByteString unsafePackLenChars len cs = - unsafeCreate len $ \p -> foldr + unsafeCreate len $ \p0 -> foldr (\x go p -> poke p (c2w x) >> go (p `plusPtr` 1)) - (\_ -> return ()) cs p + (\_ -> return ()) cs p0 {-# INLINE unsafePackLenChars #-} From b43d295933223d226cfe1b8d49bfef7a025d7ea5 Mon Sep 17 00:00:00 2001 From: Jaro Reinders Date: Thu, 3 Mar 2022 22:33:47 +0100 Subject: [PATCH 5/5] Remove some points --- Data/ByteString/Internal.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Data/ByteString/Internal.hs b/Data/ByteString/Internal.hs index 8951d18aa..4b98755fd 100644 --- a/Data/ByteString/Internal.hs +++ b/Data/ByteString/Internal.hs @@ -339,17 +339,17 @@ packChars cs = unsafePackLenChars (List.length cs) cs #-} unsafePackLenBytes :: Int -> [Word8] -> ByteString -unsafePackLenBytes len xs = - unsafeCreate len $ \p0 -> foldr +unsafePackLenBytes len = + unsafeCreate len . foldr (\x go p -> poke p x >> go (p `plusPtr` 1)) - (\_ -> return ()) xs p0 + (\_ -> return ()) {-# INLINE unsafePackLenBytes #-} unsafePackLenChars :: Int -> [Char] -> ByteString -unsafePackLenChars len cs = - unsafeCreate len $ \p0 -> foldr +unsafePackLenChars len = + unsafeCreate len . foldr (\x go p -> poke p (c2w x) >> go (p `plusPtr` 1)) - (\_ -> return ()) cs p0 + (\_ -> return ()) {-# INLINE unsafePackLenChars #-}