From 76180284aace6abc8647bdb120fc81032b691d6b Mon Sep 17 00:00:00 2001 From: Don Stewart Date: Wed, 10 May 2006 04:33:09 +0000 Subject: [PATCH] Some small optimisations, generalise the type of unfold Tue May 9 22:36:29 EST 2006 Duncan Coutts * Surely the error function should not be inlined. Tue May 9 22:35:53 EST 2006 Duncan Coutts * Reorder memory writes for better cache locality. Tue May 9 23:28:09 EST 2006 Duncan Coutts * 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 * 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 --- Data/ByteString.hs | 46 ++++++++++++++++++++++++++++++++++++++-------- Data/ByteString/Char8.hs | 18 ++++++++++++------ 2 files changed, 50 insertions(+), 14 deletions(-) diff --git a/Data/ByteString.hs b/Data/ByteString.hs index 7d96302..9980f14 100644 --- 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 --- 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@, -- 1.7.10.4