Some small optimisations, generalise the type of unfold

    Tue May  9 22:36:29 EST 2006  Duncan Coutts <duncan.coutts@worc.ox.ac.uk>
      * Surely the error function should not be inlined.

    Tue May  9 22:35:53 EST 2006  Duncan Coutts <duncan.coutts@worc.ox.ac.uk>
      * Reorder memory writes for better cache locality.

    Tue May  9 23:28:09 EST 2006  Duncan Coutts <duncan.coutts@worc.ox.ac.uk>
      * Generalise the type of unfoldrN

      The type of unfoldrN was overly constrained:
      unfoldrN :: Int -> (Word8 -> Maybe (Word8, Word8)) -> Word8 -> ByteString

      if we compare that to unfoldr:
      unfoldr :: (b -> Maybe (a, b)) -> b -> [a]

      So we can generalise unfoldrN to this type:
      unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> ByteString

      and something similar for the .Char8 version. If people really do want to
      use it a lot with Word8/Char then perhaps we should add a specialise pragma.

    Wed May 10 13:26:40 EST 2006  Don Stewart <dons@cse.unsw.edu.au>
      * Add foldl', and thus a fusion rule for length . {map,filter,fold},
      that avoids creating an array at all if the end of the pipeline is a 'length' reduction

**END OF DESCRIPTION***

Place the long patch description above the ***END OF DESCRIPTION*** marker.
The first line of this file will be the patch name.

This patch contains the following changes:

M ./Data/ByteString.hs -8 +38
M ./Data/ByteString/Char8.hs -6 +12

diff --git a/Data/ByteString.hs b/Data/ByteString.hs
index 7d96302..9980f14 100644 (file)
--- a/Data/ByteString.hs
+++ b/Data/ByteString.hs
@@ -76,6 +76,7 @@ module Data.ByteString (
         foldr,                  -- :: (Word8 -> a -> a) -> a -> ByteString -> a
         foldl1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
         foldr1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
+        foldl',                 -- :: (a -> Word8 -> a) -> a -> ByteString -> a
 
         -- ** Special folds
         concat,                 -- :: [ByteString] -> ByteString
@@ -88,7 +89,7 @@ module Data.ByteString (
 
         -- * Generating and unfolding ByteStrings
         replicate,              -- :: Int -> Word8 -> ByteString
-        unfoldrN,               -- :: (Word8 -> Maybe (Word8, Word8)) -> Word8 -> ByteString
+        unfoldrN,               -- :: (a -> Maybe (Word8, a)) -> a -> ByteString
 
         -- * Substrings
 
@@ -227,7 +228,7 @@ module Data.ByteString (
 #endif
 
         noAL, NoAL, loopArr, loopAcc, loopSndAcc,
-        loopU, mapEFL, filterEFL, foldEFL, fuseEFL,
+        loopU, mapEFL, filterEFL, foldEFL, foldEFL', fuseEFL,
         filterF, mapF
 
   ) where
@@ -524,14 +525,27 @@ null (PS _ _ l) = l == 0
 -- | /O(1)/ 'length' returns the length of a ByteString as an 'Int'.
 length :: ByteString -> Int
 length (PS _ _ l) = l
-{-# INLINE length #-}
+
+#if defined(__GLASGOW_HASKELL__)
+{-# INLINE [1] length #-}
+#endif
+
+{-# 
+
+-- Translate length into a loop. 
+-- Performace ok, but allocates too much, so disable for now.
+
+  "length/loop" forall f acc s .
+  length (loopArr (loopU f acc s)) = foldl' (const . (+1)) (0::Int) (loopArr (loopU f acc s))
+
+  #-}
 
 -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different
 -- complexity, as it requires a memcpy.
 cons :: Word8 -> ByteString -> ByteString
 cons c (PS x s l) = create (l+1) $ \p -> withForeignPtr x $ \f -> do
-        memcpy (p `plusPtr` 1) (f `plusPtr` s) (fromIntegral l)
         poke p c
+        memcpy (p `plusPtr` 1) (f `plusPtr` s) (fromIntegral l)
 {-# INLINE cons #-}
 
 -- todo fuse
@@ -662,6 +676,11 @@ foldl f v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
                                    lgo (f z c) (p `plusPtr` 1) q
 -}
 
+-- | 'foldl\'' is like foldl, but strict in the accumulator.
+foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a
+foldl' f z = loopAcc . loopU (foldEFL' f) z
+{-# INLINE foldl' #-}
+
 -- | 'foldr', applied to a binary operator, a starting value
 -- (typically the right-identity of the operator), and a ByteString,
 -- reduces the ByteString using the binary operator, from right to left.
@@ -840,7 +859,7 @@ replicate w c = inlinePerformIO $ generate w $ \ptr -> go ptr w
 -- The following equation connects the depth-limited unfoldr to the List unfoldr:
 --
 -- > unfoldrN n == take n $ List.unfoldr
-unfoldrN :: Int -> (Word8 -> Maybe (Word8, Word8)) -> Word8 -> ByteString
+unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> ByteString
 unfoldrN i f w = inlinePerformIO $ generate i $ \p -> go p w 0
     where
         STRICT3(go)
@@ -1999,7 +2018,7 @@ withPtr fp io = inlinePerformIO (withForeignPtr fp io)
 -- constant strings created when compiled:
 errorEmptyList :: String -> a
 errorEmptyList fun = error ("Data.ByteString." ++ fun ++ ": empty ByteString")
-{-# INLINE errorEmptyList #-}
+{-# NOINLINE errorEmptyList #-}
 
 -- 'findIndexOrEnd' is a variant of findIndex, that returns the length
 -- of the string if no element is found, rather than Nothing.
@@ -2164,6 +2183,13 @@ foldEFL f = \a e -> (f a e, Nothing)
 {-# INLINE [1] foldEFL #-}
 #endif
 
+-- | A strict foldEFL.
+foldEFL' :: (acc -> Word8 -> acc) -> (acc -> Word8 -> (acc, Maybe Word8))
+foldEFL' f = \a e -> let a' = f a e in a' `seq` (a', Nothing)
+#if defined(__GLASGOW_HASKELL__)
+{-# INLINE [1] foldEFL' #-}
+#endif
+
 -- | No accumulator
 noAL :: NoAL
 noAL = NoAL
@@ -2193,6 +2219,10 @@ loopSndAcc (arr, (_, acc)) = (arr, acc)
 
 ------------------------------------------------------------------------
 
+--
+-- size, and then percentage.
+--
+
 -- | Iteration over over ByteStrings
 loopU :: (acc -> Word8 -> (acc, Maybe Word8))  -- ^ mapping & folding, once per elem
       -> acc                                   -- ^ initial acc value
@@ -2204,7 +2234,7 @@ loopU f start (PS z s i) = inlinePerformIO $ withForeignPtr z $ \a -> do
     (ptr,n,acc) <- withForeignPtr fp $ \p -> do
         (acc, i') <- go (a `plusPtr` s) p start
         if i' == i
-            then return (fp,i,acc)                      -- no realloc for map
+            then return (fp,i',acc)                     -- no realloc for map
             else do fp_ <- mallocByteString (i'+1)      -- realloc
                     withForeignPtr fp_ $ \p' -> do
                         memcpy p' p (fromIntegral i')   -- can't avoid this,  right?
@@ -2248,7 +2278,7 @@ fuseEFL f g (acc1, acc2) e1 =
 
 {-# RULES
 
-"Array fusion!" forall em1 em2 start1 start2 arr.
+"loop/loop fusion!" forall em1 em2 start1 start2 arr.
   loopU em2 start2 (loopArr (loopU em1 start1 arr)) =
     loopSndAcc (loopU (em1 `fuseEFL` em2) (start1, start2) arr)
 

diff --git a/Data/ByteString/Char8.hs b/Data/ByteString/Char8.hs
index 4baf8e3..7cb29b3 100644 (file)
--- a/Data/ByteString/Char8.hs
+++ b/Data/ByteString/Char8.hs
@@ -70,6 +70,7 @@ module Data.ByteString.Char8 (
         foldr,                  -- :: (Char -> a -> a) -> a -> ByteString -> a
         foldl1,                 -- :: (Char -> Char -> Char) -> ByteString -> Char
         foldr1,                 -- :: (Char -> Char -> Char) -> ByteString -> Char
+        foldl',                 -- :: (a -> Char -> a) -> a -> ByteString -> a
 
         -- ** Special folds
         concat,                 -- :: [ByteString] -> ByteString
@@ -82,7 +83,7 @@ module Data.ByteString.Char8 (
 
         -- * Generating and unfolding ByteStrings
         replicate,              -- :: Int -> Char -> ByteString
-        unfoldrN,               -- :: (Char -> Maybe (Char, Char)) -> Char -> ByteString
+        unfoldrN,               -- :: (a -> Maybe (Char, a)) -> a -> ByteString
 
         -- * Substrings
 
@@ -220,7 +221,7 @@ module Data.ByteString.Char8 (
         unpackList,
 #endif
         noAL, NoAL, loopArr, loopAcc, loopSndAcc,
-        loopU, mapEFL, filterEFL, foldEFL, fuseEFL,
+        loopU, mapEFL, filterEFL, foldEFL, foldEFL', fuseEFL,
         filterF, mapF
 
     ) where
@@ -254,7 +255,7 @@ import Data.ByteString (ByteString(..)
                        ,unpackList
 #endif
                        ,noAL, NoAL, loopArr, loopAcc, loopSndAcc
-                       ,loopU, mapEFL, filterEFL, foldEFL, fuseEFL
+                       ,loopU, mapEFL, filterEFL, foldEFL, foldEFL', fuseEFL
                        ,useAsCString, unsafeUseAsCString
                        )
 
@@ -363,6 +364,11 @@ foldl :: (a -> Char -> a) -> a -> ByteString -> a
 foldl f = B.foldl (\a c -> f a (w2c c))
 {-# INLINE foldl #-}
 
+-- | 'foldl\'' is like foldl, but strict in the accumulator.
+foldl' :: (a -> Char -> a) -> a -> ByteString -> a
+foldl' f = B.foldl' (\a c -> f a (w2c c))
+{-# INLINE foldl' #-}
+
 -- | 'foldr', applied to a binary operator, a starting value
 -- (typically the right-identity of the operator), and a packed string,
 -- reduces the packed string using the binary operator, from right to left.
@@ -447,9 +453,9 @@ replicate w = B.replicate w . c2w
 --
 -- > unfoldrN n == take n $ List.unfoldr
 --
-unfoldrN :: Int -> (Char -> Maybe (Char, Char)) -> Char -> ByteString
-unfoldrN n f w = B.unfoldrN n ((k `fmap`) . f . w2c) (c2w w)
-    where k (i,j) = (c2w i, c2w j) -- (c2w *** c2w)
+unfoldrN :: Int -> (a -> Maybe (Char, a)) -> a -> ByteString
+unfoldrN n f w = B.unfoldrN n ((k `fmap`) . f) w
+    where k (i,j) = (c2w i, j)
 {-# INLINE unfoldrN #-}
 
 -- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@,