zipWith' to packZipWith as per #208

Data/ByteString.hs

@@ -167,6 +167,7 @@ module Data.ByteString (
         -- * Zipping and unzipping ByteStrings
         zip,                    -- :: ByteString -> ByteString -> [(Word8,Word8)]
         zipWith,                -- :: (Word8 -> Word8 -> c) -> ByteString -> ByteString -> [c]
+        packZipWith,            -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
         unzip,                  -- :: [(Word8,Word8)] -> (ByteString,ByteString)
 
         -- * Ordered ByteStrings
@@ -1623,13 +1624,10 @@ zipWith f ps qs
 {-# NOINLINE [1] zipWith #-}
 
 --
--- | A specialised version of zipWith for the common case of a
--- simultaneous map over two bytestrings, to build a 3rd. Rewrite rules
--- are used to automatically covert zipWith into zipWith' when a pack is
--- performed on the result of zipWith.
---
-zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
-zipWith' f (BS fp l) (BS fq m) = unsafeDupablePerformIO $
+-- | A specialised version of `zipWith` for the common case of a
+-- simultaneous map over two ByteStrings, to build a 3rd.
+packZipWith :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
+packZipWith f (BS fp l) (BS fq m) = unsafeDupablePerformIO $
     withForeignPtr fp $ \a ->
     withForeignPtr fq $ \b ->
     create len $ go a b
@@ -1646,11 +1644,11 @@ zipWith' f (BS fp l) (BS fq m) = unsafeDupablePerformIO $
                 zipWith_ (n+1) r
 
     len = min l m
-{-# INLINE zipWith' #-}
+{-# INLINE packZipWith #-}
 
 {-# RULES
 "ByteString specialise zipWith" forall (f :: Word8 -> Word8 -> Word8) p q .
-    zipWith f p q = unpack (zipWith' f p q)
+    zipWith f p q = unpack (packZipWith f p q)
   #-}
 
 -- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of

Data/ByteString/Char8.hs

@@ -176,6 +176,7 @@ module Data.ByteString.Char8 (
         -- * Zipping and unzipping ByteStrings
         zip,                    -- :: ByteString -> ByteString -> [(Char,Char)]
         zipWith,                -- :: (Char -> Char -> c) -> ByteString -> ByteString -> [c]
+        packZipWith,            -- :: (Char -> Char -> Char) -> ByteString -> ByteString -> ByteString
         unzip,                  -- :: [(Char,Char)] -> (ByteString,ByteString)
 
         -- * Ordered ByteStrings
@@ -271,6 +272,7 @@ import GHC.Char (eqChar)
 import qualified Data.List as List (intersperse)
 
 import System.IO    (Handle,stdout)
+import GHC.IO       (unsafeDupablePerformIO)
 import Foreign
 
 
@@ -837,6 +839,29 @@ zip ps qs
 zipWith :: (Char -> Char -> a) -> ByteString -> ByteString -> [a]
 zipWith f = B.zipWith ((. w2c) . f . w2c)
 
+--
+-- | A specialised version of `zipWith` for the common case of a
+-- simultaneous map over two ByteStrings, to build a 3rd.
+packZipWith :: (Char -> Char -> Char) -> ByteString -> ByteString -> ByteString
+packZipWith f (BS fp l) (BS fq m) = unsafeDupablePerformIO $
+    withForeignPtr fp $ \a ->
+    withForeignPtr fq $ \b ->
+    create len $ go a b
+  where
+    go p1 p2 = zipWith_ 0
+      where
+        zipWith_ :: Int -> Ptr Word8 -> IO ()
+        zipWith_ !n !r
+           | n >= len = return ()
+           | otherwise = do
+                x <- peekByteOff p1 n
+                y <- peekByteOff p2 n
+                pokeByteOff r n (f x y)
+                zipWith_ (n+1) r
+
+    len = min l m
+{-# INLINE packZipWith #-}
+
 -- | 'unzip' transforms a list of pairs of Chars into a pair of
 -- ByteStrings. Note that this performs two 'pack' operations.
 unzip :: [(Char,Char)] -> (ByteString,ByteString)

tests/Properties.hs

@@ -540,7 +540,7 @@ prop_scanr1CL f = eqnotnull2
     (scanr1 :: (Char -> Char -> Char) -> [Char] -> [Char])
     (castFn f)
 
--- prop_zipWithPL'   = P.zipWith'  `eq3` (zipWith :: (W -> W -> W) -> [W] -> [W] -> [W])
+prop_packZipWithPL   = P.packZipWith  `eq3` (zipWith :: (W -> W -> W) -> [W] -> [W] -> [W])
 
 prop_zipWithPL    = (P.zipWith  :: (W -> W -> X) -> P   -> P   -> [X]) `eq3`
                       (zipWith  :: (W -> W -> X) -> [W] -> [W] -> [X])
@@ -1350,7 +1350,7 @@ prop_zip1BB xs ys = P.zip xs ys == zip (P.unpack xs) (P.unpack ys)
 prop_zipWithBB xs ys = P.zipWith (,) xs ys == P.zip xs ys
 prop_zipWithCC xs ys = C.zipWith (,) xs ys == C.zip xs ys
 prop_zipWithLC xs ys = LC.zipWith (,) xs ys == LC.zip xs ys
--- prop_zipWith'BB xs ys = P.pack (P.zipWith (+) xs ys) == P.zipWith' (+) xs ys
+prop_packZipWithBB xs ys = P.pack (P.zipWith (+) xs ys) == P.packZipWith (+) xs ys
 
 prop_unzipBB x = let (xs,ys) = unzip x in (P.pack xs, P.pack ys) == P.unzip x
 
@@ -2077,9 +2077,8 @@ pl_tests =
     , testProperty "unzip"       prop_unzipLL
     , testProperty "unzip"       prop_unzipCL
     , testProperty "zipWith"          prop_zipWithPL
---  , testProperty "zipWith"          prop_zipWithCL
     , testProperty "zipWith rules"   prop_zipWithPL_rules
---  , testProperty "zipWith/zipWith'" prop_zipWithPL'
+    , testProperty "zipWith/packZipWith" prop_packZipWithPL
 
     , testProperty "isPrefixOf"  prop_isPrefixOfPL
     , testProperty "isSuffixOf"  prop_isSuffixOfPL
@@ -2333,7 +2332,7 @@ bb_tests =
     , testProperty "zipWith"        prop_zipWithBB
     , testProperty "zipWith"        prop_zipWithCC
     , testProperty "zipWith"        prop_zipWithLC
---  , testProperty "zipWith'"       prop_zipWith'BB
+    , testProperty "packZipWith"       prop_packZipWithBB
     , testProperty "unzip"          prop_unzipBB
     , testProperty "concatMap"      prop_concatMapBB
 --  , testProperty "join/joinByte"  prop_join_spec