diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index cc18e3a31..ff7811a20 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -13,10 +13,9 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE Unsafe #-} - -{-# OPTIONS_GHC -fno-warn-name-shadowing -fexpose-all-unfoldings #-} {-# OPTIONS_HADDOCK not-home #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing -fexpose-all-unfoldings #-} -- Not all architectures are forgiving of unaligned accesses; whitelist ones -- which are known not to trap (either to the kernel for emulation, or crash). #if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ @@ -267,7 +266,6 @@ import Prelude import qualified Data.ByteString.Internal as BS -import qualified Data.Foldable as Foldable import qualified Data.List as List import qualified GHC.Exts import qualified Language.Haskell.TH.Lib as TH @@ -338,7 +336,7 @@ instance Read ShortByteString where instance GHC.Exts.IsList ShortByteString where type Item ShortByteString = Word8 fromList = packBytes - toList = unpackBytes + toList = unpack -- | Beware: 'fromString' truncates multi-byte characters to octets. -- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n� @@ -346,7 +344,7 @@ instance IsString ShortByteString where fromString = packChars instance Data ShortByteString where - gfoldl f z txt = z packBytes `f` unpackBytes txt + gfoldl f z txt = z packBytes `f` unpack txt toConstr _ = error "Data.ByteString.Short.ShortByteString.toConstr" gunfold _ _ = error "Data.ByteString.Short.ShortByteString.gunfold" dataTypeOf _ = mkNoRepType "Data.ByteString.Short.ShortByteString" @@ -543,7 +541,20 @@ pack = packBytes -- | /O(n)/. Convert a 'ShortByteString' into a list. unpack :: ShortByteString -> [Word8] -unpack = unpackBytes +unpack sbs = GHC.Exts.build (unpackFoldr sbs) +{-# INLINE unpack #-} + +-- +-- Have unpack fuse with good list consumers +-- +unpackFoldr :: ShortByteString -> (Word8 -> a -> a) -> a -> a +unpackFoldr sbs k z = foldr k z sbs +{-# INLINE [0] unpackFoldr #-} + +{-# RULES +"ShortByteString unpack-list" [1] forall bs . + unpackFoldr bs (:) [] = unpackBytes bs + #-} packChars :: [Char] -> ShortByteString packChars = \cs -> packLenBytes (List.length cs) (List.map BS.c2w cs) @@ -578,6 +589,7 @@ unpackChars sbs = unpackAppendCharsLazy sbs [] unpackBytes :: ShortByteString -> [Word8] unpackBytes sbs = unpackAppendBytesLazy sbs [] + -- Why 100 bytes you ask? Because on a 64bit machine the list we allocate -- takes just shy of 4k which seems like a reasonable amount. -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes) @@ -610,7 +622,7 @@ unpackAppendBytesLazy sbs = go 0 (length sbs) unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char] unpackAppendCharsStrict !sbs off len = go (off-1) (off-1 + len) where - go !sentinal !i !acc + go !sentinal !i acc | i == sentinal = acc | otherwise = let !c = indexCharArray (asBA sbs) i in go sentinal (i-1) (c:acc) @@ -618,7 +630,7 @@ unpackAppendCharsStrict !sbs off len = go (off-1) (off-1 + len) unpackAppendBytesStrict :: ShortByteString -> Int -> Int -> [Word8] -> [Word8] unpackAppendBytesStrict !sbs off len = go (off-1) (off-1 + len) where - go !sentinal !i !acc + go !sentinal !i acc | i == sentinal = acc | otherwise = let !w = indexWord8Array (asBA sbs) i in go sentinal (i-1) (w:acc) @@ -910,13 +922,27 @@ foldl' f v = List.foldl' f v . unpack -- -- @since 0.11.3.0 foldr :: (Word8 -> a -> a) -> a -> ShortByteString -> a -foldr f v = List.foldr f v . unpack +foldr k v = \sbs -> + let l = length sbs + ba = asBA sbs + w = indexWord8Array ba + go !n | n >= l = v + | otherwise = k (w n) (go (n + 1)) + in go 0 +{-# INLINE foldr #-} -- | 'foldr'' is like 'foldr', but strict in the accumulator. -- -- @since 0.11.3.0 foldr' :: (Word8 -> a -> a) -> a -> ShortByteString -> a -foldr' k v = Foldable.foldr' k v . unpack +foldr' k v = \sbs -> + let l = length sbs + ba = asBA sbs + w = indexWord8Array ba + go !ix !v' | ix < 0 = v' + | otherwise = go (ix - 1) (k (w ix) v') + in go (l - 1) v +{-# INLINE foldr' #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value -- argument, and thus must be applied to non-empty 'ShortByteString's. @@ -1102,7 +1128,8 @@ breakEnd p = \sbs -> splitAt (findFromEndUntil p sbs) sbs -- -- @since 0.11.3.0 break :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString) -break = \p -> \sbs -> case findIndexOrLength p sbs of n -> (take n sbs, drop n sbs) +break p = \sbs -> case findIndexOrLength p sbs of n -> (take n sbs, drop n sbs) +{-# INLINE break #-} -- | Similar to 'Prelude.span', -- returns the longest (possibly empty) prefix of elements @@ -1296,6 +1323,7 @@ unfoldrN i f = \x0 -> Just (w, x'') -> do writeWord8Array mba n' w go' x'' (n'+1) +{-# INLINE unfoldrN #-} @@ -1455,6 +1483,7 @@ filter k = \sbs -> let l = length sbs go' (br+1) (bw+1) else go' (br+1) bw +{-# INLINE filter #-} -- | /O(n)/ The 'find' function takes a predicate and a ShortByteString, -- and returns the first element in matching the predicate, or 'Nothing' @@ -1467,6 +1496,7 @@ find :: (Word8 -> Bool) -> ShortByteString -> Maybe Word8 find f = \sbs -> case findIndex f sbs of Just n -> Just (sbs `index` n) _ -> Nothing +{-# INLINE find #-} -- | /O(n)/ The 'partition' function takes a predicate a ShortByteString and returns -- the pair of ShortByteStrings with elements which do and do not satisfy the @@ -1548,6 +1578,7 @@ findIndex k = \sbs -> | k (w n) = Just n | otherwise = go (n + 1) in go 0 +{-# INLINE findIndex #-} -- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the diff --git a/bench/BenchShort.hs b/bench/BenchShort.hs index f6c37662e..17609b4b1 100644 --- a/bench/BenchShort.hs +++ b/bench/BenchShort.hs @@ -6,6 +6,7 @@ module BenchShort (benchShort) where +import Control.DeepSeq (force) import Data.Foldable (foldMap) import Data.Maybe (listToMaybe) import Data.Monoid @@ -107,6 +108,9 @@ w = fromIntegral hashWord8 :: Word8 -> Word8 hashWord8 = fromIntegral . hashInt . fromIntegral +foldInputs' :: [[Word8]] +foldInputs' = force (S.unpack <$> foldInputs) + foldInputs :: [S.ShortByteString] foldInputs = map (\k -> S.pack $ if k <= 6 then take (2 ^ k) [32..95] else concat (replicate (2 ^ (k - 6)) [32..95])) [0..16] @@ -188,8 +192,12 @@ benchShort = bgroup "ShortByteString" ] , bgroup "folds" [ bgroup "strict" - [ bgroup "foldl'" $ map (\s -> bench (show $ S.length s) $ + [ bgroup "foldl" $ map (\s -> bench (show $ S.length s) $ + nf (S.foldl (\acc x -> acc + fromIntegral x) (0 :: Int)) s) foldInputs + , bgroup "foldl'" $ map (\s -> bench (show $ S.length s) $ nf (S.foldl' (\acc x -> acc + fromIntegral x) (0 :: Int)) s) foldInputs + , bgroup "foldr" $ map (\s -> bench (show $ S.length s) $ + nf (S.foldr (\x acc -> fromIntegral x + acc) (0 :: Int)) s) foldInputs , bgroup "foldr'" $ map (\s -> bench (show $ S.length s) $ nf (S.foldr' (\x acc -> fromIntegral x + acc) (0 :: Int)) s) foldInputs , bgroup "foldr1'" $ map (\s -> bench (show $ S.length s) $ @@ -231,5 +239,12 @@ benchShort = bgroup "ShortByteString" , bench "FindIndex/inlined" $ nf (S.findIndex (== nl)) absurdlong , bench "FindIndex/non-inlined" $ nf (S.findIndex (nilEq nl)) absurdlong ] + , bgroup "ShortByteString conversions" $ + [ bgroup "unpack" $ map (\s -> bench (show $ S.length s) $ + nf (\x -> S.unpack x) s) foldInputs + , bgroup "pack" $ map (\s -> bench (show $ length s) $ + nf S.pack s) foldInputs' + , bench "unpack and get last element" $ nf (\x -> last . S.unpack $ x) absurdlong + , bench "unpack and get first 120 elements" $ nf (\x -> take 120 . S.unpack $ x) absurdlong + ] ] -