vector-bytestring 0.0.0.0 → 0.0.0.1
raw patch · 14 files changed
+1162/−1138 lines, 14 filesdep +vector-bytestringdep ~basedep ~criteriondep ~deepseqPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: vector-bytestring
Dependency ranges changed: base, criterion, deepseq, random, vector
API changes (from Hackage documentation)
+ Data.Vector.Storable.ByteString.Internal: instance NFData (Vector a)
Files
- Data/Vector/Storable/ByteString.hs +43/−97
- Data/Vector/Storable/ByteString/Char8.hs +9/−6
- Data/Vector/Storable/ByteString/Internal.hs +18/−6
- Data/Vector/Storable/ByteString/Lazy.hs +12/−5
- Data/Vector/Storable/ByteString/Lazy/Char8.hs +6/−1
- Data/Vector/Storable/ByteString/Lazy/Internal.hs +5/−1
- Data/Vector/Storable/ByteString/Lazy/Legacy.hs +5/−1
- Data/Vector/Storable/ByteString/Legacy.hs +5/−1
- Data/Vector/Storable/ByteString/Unsafe.hs +13/−11
- Utils.hs +0/−35
- bench.hs +0/−936
- bench/bench.hs +1013/−0
- tests/QuickCheckUtils.hs +13/−9
- vector-bytestring.cabal +20/−29
Data/Vector/Storable/ByteString.hs view
@@ -1,10 +1,15 @@-{-# LANGUAGE NoImplicitPrelude+{-# LANGUAGE CPP+ , NoImplicitPrelude , BangPatterns , NamedFieldPuns , MagicHash , UnboxedTuples #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- |@@ -226,7 +231,7 @@ import Data.Functor ( fmap ) import Data.IORef ( readIORef, writeIORef ) import Data.Maybe ( Maybe(Nothing, Just), isJust, listToMaybe )-import Data.Ord ( min, (<), (>), (<=), (>=) )+import Data.Ord ( min, (<), (>), (>=) ) import Data.Tuple ( fst, snd ) import Data.Word ( Word8 ) import Foreign.C.String ( CString, CStringLen )@@ -270,8 +275,6 @@ ) import GHC.IO.BufferedIO as Buffered ( fillReadBuffer ) -import GHC.Base ( build )- -- from primitive: import Control.Monad.Primitive ( unsafeInlineIO ) @@ -286,7 +289,6 @@ , memcpy, memset, memchr, memcmp , c_strlen, c_count, c_intersperse )-import Utils ( unsafeFromForeignPtr0, unsafeToForeignPtr0 ) --------------------------------------------------------------------------------@@ -311,67 +313,12 @@ pack = VS.fromList {-# INLINE pack #-} -{--The following pack does not appear to be faster:--import GHC.IO ( stToIO )-import GHC.Prim ( Addr#, plusAddr#, writeWord8OffAddr# )-import GHC.Ptr ( Ptr(..) )-import GHC.ST ( ST(..) )-import GHC.Word ( Word8(W8#) )--pack str = unsafeCreate (L.length str) $ \(Ptr p) -> stToIO (go p str)- where- go :: Addr# -> [Word8] -> ST a ()- go _ [] = return ()- go p (W8# c : cs) = writeByte >> go (p `plusAddr#` 1#) cs- where- writeByte = ST $ \s# ->- case writeWord8OffAddr# p 0# c s# of- s2# -> (# s2#, () #)- {-# INLINE writeByte #-}--}- -- | /O(n)/ Converts a 'ByteString' to a @['Word8']@. unpack :: ByteString -> [Word8]-unpack v = build (unpackFoldr v)+unpack = VS.toList {-# INLINE unpack #-} --- Have unpack fuse with good list consumers------ critical this isn't strict in the acc--- as it will break in the presence of list fusion. this is a known--- issue with seq and build/foldr rewrite rules, which rely on lazy--- demanding to avoid bottoms in the list.----unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a-unpackFoldr v f ch = unsafeInlineIO $ withForeignPtr fp $ \p ->- let go (-1) acc = return acc- go !n acc = do- a <- peekByteOff p n- go (n-1) (a `f` acc)- in go (l-1) ch- where- (fp, l) = unsafeToForeignPtr0 v-{-# INLINE [0] unpackFoldr #-} -unpackList :: ByteString -> [Word8]-unpackList v = unsafeInlineIO $ withForeignPtr fp $ \p ->- let go (-1) acc = return acc- go !n acc = do- a <- peekByteOff p n- go (n-1) (a : acc)- in go (l-1) []- where- (fp, l) = unsafeToForeignPtr0 v-{-# INLINE unpackList #-}--{-# RULES-"ByteString unpack-list" [1] forall p .- unpackFoldr p (:) [] = unpackList p- #-}-- -------------------------------------------------------------------------------- -- * Basic interface --------------------------------------------------------------------------------@@ -460,7 +407,7 @@ | otherwise = unsafeCreate (2*l-1) $ \p' -> withForeignPtr fp $ \p -> c_intersperse p' p (fromIntegral l) c where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE intersperse #-} -- | /O(n)/ The 'intercalate' function takes a 'ByteString' and a list of@@ -486,8 +433,8 @@ poke (ptr `plusPtr` l1) c memcpy (ptr `plusPtr` (l1 + 1)) p2 (fromIntegral l2) where- (fp1, l1) = unsafeToForeignPtr0 v1- (fp2, l2) = unsafeToForeignPtr0 v2+ (fp1, l1) = VS.unsafeToForeignPtr0 v1+ (fp2, l2) = VS.unsafeToForeignPtr0 v2 {-# INLINE intercalateWithByte #-} -- | The 'transpose' function transposes the rows and columns of its@@ -626,7 +573,7 @@ fp' <- mallocByteString l withForeignPtr fp' $ \p' -> let go !a !m- | m >= l = return (a, unsafeFromForeignPtr0 fp' l)+ | m >= l = return (a, VS.unsafeFromForeignPtr0 fp' l) | otherwise = do x <- peekByteOff p m let (a', y) = f a x@@ -634,7 +581,7 @@ go a' (m+1) in go acc 0 where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE mapAccumL #-} -- | The 'mapAccumR' function behaves like a combination of 'map' and@@ -647,7 +594,7 @@ fp' <- mallocByteString l withForeignPtr fp' $ \p' -> let go !a !m- | m < 0 = return (a, unsafeFromForeignPtr0 fp' l)+ | m < 0 = return (a, VS.unsafeFromForeignPtr0 fp' l) | otherwise = do x <- peekByteOff p m let (a', y) = f a x@@ -655,7 +602,7 @@ go a' (m-1) in go acc (l-1) where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE mapAccumR #-} --------------------------------------------------------------------------------@@ -666,14 +613,8 @@ -- -- > replicate n x = unfoldr n (\u -> Just (u,u)) x ----- This implemenation uses @memset(3)@---- TODO: Should I use VS.replicate here? replicate :: Int -> Word8 -> ByteString-replicate n x- | n <= 0 = VS.empty- | otherwise = unsafeCreate n $ \p ->- void $ memset p x (fromIntegral n)+replicate = VS.replicate {-# INLINE replicate #-} -- | /O(n)/, where /n/ is the length of the result. The 'unfoldr'@@ -783,7 +724,7 @@ else go (i+1) in go 0 where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE spanByte #-} -- | 'spanEnd' behaves like 'span' but from the end of the 'ByteString'.@@ -815,7 +756,6 @@ !n = findIndexOrEnd p v {-# INLINE [1] break #-} --- This RULE LHS is not allowed by ghc-6.4 {-# RULES "ByteString specialise break (x==)" forall x. break ((==) x) = breakByte x@@ -903,7 +843,7 @@ split w v | l == 0 = [] | otherwise = go 0 where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v withFP = unsafeInlineIO . withForeignPtr fp @@ -931,9 +871,9 @@ | l == 0 = [] | otherwise = splitWith0 0 l where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v - splitWith0 off len = unsafeInlineIO $ withForeignPtr fp $ \p ->+ splitWith0 !off !len = unsafeInlineIO $ withForeignPtr fp $ \p -> let vec = VS.unsafeFromForeignPtr fp off go !idx | idx >= len = return [vec idx]@@ -944,8 +884,14 @@ then return (vec idx : splitWith0 (sepIx+1) (len-idx-1)) else go (idx+1) in go 0-{-# INLINE splitWith #-}+{-# INLINE [1] splitWith #-} +{-# RULES+"ByteString specialise splitWith (x==)" forall x.+ splitWith ((==) x) = split x+"ByteString specialise splitWith (==x)" forall x.+ splitWith (==x) = split x+ #-} -------------------------------------------------------------------------------- -- * Predicates@@ -963,8 +909,8 @@ i <- memcmp p1 p2 (fromIntegral l1) return $! i == 0 where- (fp1, l1) = unsafeToForeignPtr0 v1- (fp2, l2) = unsafeToForeignPtr0 v2+ (fp1, l1) = VS.unsafeToForeignPtr0 v1+ (fp2, l2) = VS.unsafeToForeignPtr0 v2 {-# INLINE isPrefixOf #-} -- | /O(n)/ The 'isSuffixOf' function takes two ByteStrings and returns 'True'@@ -986,8 +932,8 @@ i <- memcmp p1 (p2 `plusPtr` (l2 - l1)) (fromIntegral l1) return $! i == 0 where- (fp1, l1) = unsafeToForeignPtr0 v1- (fp2, l2) = unsafeToForeignPtr0 v2+ (fp1, l1) = VS.unsafeToForeignPtr0 v1+ (fp2, l2) = VS.unsafeToForeignPtr0 v2 {-# INLINE isSuffixOf #-} -- | Check whether one string is a substring of another. @isInfixOf@@ -1160,7 +1106,7 @@ else go (i-1) in go (l - 1) where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE elemIndexEnd #-} -- | The 'findIndex' function takes a predicate and a 'ByteString' and@@ -1185,7 +1131,7 @@ count x v = unsafeInlineIO $ withForeignPtr fp $ \p -> fmap fromIntegral $ c_count p (fromIntegral l) x where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE count #-} @@ -1243,8 +1189,8 @@ where len = min l1 l2 - (fp1, l1) = unsafeToForeignPtr0 v1- (fp2, l2) = unsafeToForeignPtr0 v2+ (fp1, l1) = VS.unsafeToForeignPtr0 v1+ (fp2, l2) = VS.unsafeToForeignPtr0 v2 {-# INLINE zipWith' #-} -- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of@@ -1287,7 +1233,7 @@ go (i + 1) (ptr `plusPtr` fromIntegral n) go 0 p' where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE sort #-} @@ -1309,7 +1255,7 @@ withForeignPtr fp $ \p -> memcpy p' p (fromIntegral l) where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE copy #-} --------------------------------------------------------------------------------@@ -1350,7 +1296,7 @@ pokeByteOff buf l (0::Word8) action (castPtr buf) where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE useAsCString #-} -- | /O(n) construction/ Use a @ByteString@ with a function requiring a @CStringLen@.@@ -1481,7 +1427,7 @@ | l == 0 = return () | otherwise = withForeignPtr fp $ \p -> hPutBuf h p l where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v -- | Similar to 'hPut' except that it will never block. Instead it returns -- any tail that did not get written. This tail may be 'empty' in the case that@@ -1496,7 +1442,7 @@ bytesWritten <- withForeignPtr fp $ \p-> hPutBufNonBlocking h p l return $! VS.drop bytesWritten v where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v -- | A synonym for @hPut@, for compatibility hPutStr :: Handle -> ByteString -> IO ()@@ -1581,7 +1527,7 @@ if i < start_size then do p' <- reallocBytes p i fp <- newForeignPtr finalizerFree p'- return $! unsafeFromForeignPtr0 fp i+ return $! VS.unsafeFromForeignPtr0 fp i else f p start_size where always = flip finally@@ -1593,7 +1539,7 @@ then do let i' = s + i p'' <- reallocBytes p' i' fp <- newForeignPtr finalizerFree p''- return $! unsafeFromForeignPtr0 fp i'+ return $! VS.unsafeFromForeignPtr0 fp i' else f p' s' @@ -1614,7 +1560,7 @@ else go (ptr `plusPtr` 1) in go p where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE findIndexOrEnd #-} -- | Find from the end of the string using predicate
Data/Vector/Storable/ByteString/Char8.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE NoImplicitPrelude+{-# LANGUAGE CPP+ , NoImplicitPrelude , BangPatterns , TypeSynonymInstances , FlexibleInstances@@ -6,6 +7,10 @@ , UnboxedTuples #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ {-# OPTIONS_GHC -fno-warn-orphans #-} -- |@@ -265,9 +270,7 @@ import Data.Vector.Storable.ByteString ( ByteString ) -import Utils ( unsafeToForeignPtr0, unsafeFromForeignPtr0 ) - ------------------------------------------------------------------------ -- * Introducing and eliminating ByteStrings ------------------------------------------------------------------------@@ -629,7 +632,7 @@ else return $ VS.unsafeFromForeignPtr fp i (l-i) in go 0 where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE dropSpace #-} -- | 'span' @p xs@ breaks the ByteString into two segments. It is@@ -701,8 +704,8 @@ else (vec i, VS.unsafeFromForeignPtr fp i (l-i)) in go 0 where- (fp, l) = unsafeToForeignPtr0 v- vec = unsafeFromForeignPtr0 fp+ (fp, l) = VS.unsafeToForeignPtr0 v+ vec = VS.unsafeFromForeignPtr0 fp {-# INLINE breakSpace #-} -- | 'breakEnd' behaves like 'break' but from the end of the 'ByteString'
Data/Vector/Storable/ByteString/Internal.hs view
@@ -7,6 +7,10 @@ , ForeignFunctionInterface #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Unsafe #-}+#endif+ -- | -- Module : Data.Vector.Storable.ByteString.Internal -- License : BSD-style@@ -83,7 +87,6 @@ import Data.Ord ( (<=), (>=) ) import Data.Word ( Word8 ) import Foreign.C.String ( CString )-import Foreign.C.Types ( CSize, CInt, CULong ) import Foreign.Ptr ( FunPtr ) import Foreign.ForeignPtr ( ForeignPtr, withForeignPtr ) import Foreign.Ptr ( Ptr, plusPtr )@@ -92,6 +95,12 @@ -- import Text.Read ( Read, readsPrec ) -- import Text.Show ( Show, showsPrec ) +#if __GLASGOW_HASKELL__ >= 704+import Foreign.C.Types ( CSize(..), CInt(..), CULong(..) )+#else+import Foreign.C.Types ( CSize, CInt, CULong )+#endif+ #if __GLASGOW_HASKELL__ >= 702 import System.IO.Unsafe ( unsafeDupablePerformIO ) #else@@ -107,8 +116,9 @@ -- from vector: import qualified Data.Vector.Storable as VS --- from vector-bytestring (this package):-import Utils ( unsafeFromForeignPtr0 )+-- TODO: Temporary:+-- from deepseq:+import Control.DeepSeq ( NFData ) --------------------------------------------------------------------------------@@ -119,6 +129,8 @@ -- efficient operations. A 'ByteString' contains 8-bit characters only. type ByteString = VS.Vector Word8 +-- TODO: Temporary:+instance NFData (VS.Vector a) {- -- TODO: Probably not a good idea to add these orphaned instances:@@ -166,7 +178,7 @@ fp <- mallocByteString l withForeignPtr fp $ \p -> do f p- return $! unsafeFromForeignPtr0 fp l+ return $! VS.unsafeFromForeignPtr0 fp l {-# INLINE create #-} -- | A way of creating ByteStrings outside the IO monad. The @Int@@@ -195,7 +207,7 @@ withForeignPtr fp $ \p -> do l' <- f p if assert (l' <= l) $ l' >= l- then return $! unsafeFromForeignPtr0 fp l+ then return $! VS.unsafeFromForeignPtr0 fp l else create l' $ \p' -> memcpy p' p (fromIntegral l') {-# INLINE createAndTrim #-} @@ -205,7 +217,7 @@ withForeignPtr fp $ \p -> do (off, l', res) <- f p if assert (l' <= l) $ l' >= l- then return $! (unsafeFromForeignPtr0 fp l, res)+ then return $! (VS.unsafeFromForeignPtr0 fp l, res) else do v <- create l' $ \p' -> memcpy p' (p `plusPtr` off) (fromIntegral l') return $! (v, res)
Data/Vector/Storable/ByteString/Lazy.hs view
@@ -1,4 +1,9 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP, BangPatterns #-}++#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ {-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-orphans #-}@@ -211,8 +216,6 @@ import qualified Data.Vector.Storable.ByteString.Unsafe as S import Data.Vector.Storable.ByteString.Lazy.Internal -import Utils ( unsafeToForeignPtr0 )- import Data.Monoid (Monoid(..)) import Data.Word (Word8)@@ -227,7 +230,11 @@ import Foreign.Ptr import Foreign.Storable +-- from vector:+import qualified Data.Vector.Storable as VS+ ( unsafeToForeignPtr0, unsafeToForeignPtr0 ) + -- ----------------------------------------------------------------------------- instance Eq ByteString@@ -443,7 +450,7 @@ poke p' w S.c_intersperse (p' `plusPtr` 1) p (fromIntegral l) w where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v -- | The 'transpose' function transposes the rows and columns of its -- 'ByteString' argument.@@ -1340,7 +1347,7 @@ findIndexOrEnd :: (Word8 -> Bool) -> P.ByteString -> Int findIndexOrEnd k v = S.inlinePerformIO $ withForeignPtr fp $ \f -> go f 0 where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v go !ptr !n | n >= l = return l | otherwise = do w <- peek ptr
Data/Vector/Storable/ByteString/Lazy/Char8.hs view
@@ -1,4 +1,9 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP, BangPatterns #-}++#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+ {-# OPTIONS_GHC -fno-warn-orphans #-} -- |
Data/Vector/Storable/ByteString/Lazy/Internal.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP, DeriveDataTypeable #-}++#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Unsafe #-}+#endif -- | -- Module : Data.Vector.Storable.ByteString.Lazy.Internal
Data/Vector/Storable/ByteString/Lazy/Legacy.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}++#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif -- | Convert our lazy @'ByteString's@ to and from /legacy/ lazy -- @'Legacy.ByteString's@ (from the @bytestring@ package).
Data/Vector/Storable/ByteString/Legacy.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}++#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif -- | Convert our @'ByteString's@ to and from /legacy/ @'Legacy.ByteString's@ -- (from the @bytestring@ package).
Data/Vector/Storable/ByteString/Unsafe.hs view
@@ -1,5 +1,9 @@-{-# LANGUAGE NoImplicitPrelude, MagicHash #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} +#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Unsafe #-}+#endif+ -- | -- Module : Data.Vector.Storable.ByteString.Unsafe -- License : BSD-style@@ -65,9 +69,7 @@ import Data.Vector.Storable.ByteString.Internal ( ByteString, c_strlen, c_free_finalizer ) -import Utils ( unsafeToForeignPtr0, unsafeFromForeignPtr0 ) - -------------------------------------------------------------------------------- -- * Unchecked access --------------------------------------------------------------------------------@@ -157,7 +159,7 @@ unsafeUseAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a unsafeUseAsCStringLen v f = withForeignPtr fp $ \p -> f (castPtr p, l) where- (fp, l) = unsafeToForeignPtr0 v+ (fp, l) = VS.unsafeToForeignPtr0 v {-# INLINE unsafeUseAsCStringLen #-} --------------------------------------------------------------------------------@@ -177,7 +179,7 @@ let p = castPtr cstr fp <- newForeignPtr_ p l <- c_strlen cstr- return $! unsafeFromForeignPtr0 fp (fromIntegral l)+ return $! VS.unsafeFromForeignPtr0 fp (fromIntegral l) {-# INLINE unsafePackCString #-} -- | /O(1)/ Build a @ByteString@ from a @CStringLen@. This value will@@ -193,7 +195,7 @@ unsafePackCStringLen (ptr, l) = do let p = castPtr ptr fp <- newForeignPtr_ p- return $! unsafeFromForeignPtr0 fp (fromIntegral l)+ return $! VS.unsafeFromForeignPtr0 fp (fromIntegral l) {-# INLINE unsafePackCStringLen #-} -- | /O(n)/ Build a @ByteString@ from a malloced @CString@. This value will@@ -212,7 +214,7 @@ let p = castPtr cstr fp <- newForeignPtr c_free_finalizer p l <- c_strlen cstr- return $! unsafeFromForeignPtr0 fp (fromIntegral l)+ return $! VS.unsafeFromForeignPtr0 fp (fromIntegral l) {-# INLINE unsafePackMallocCString #-} -- | /O(n)/ Pack a null-terminated sequence of bytes, pointed to by an@@ -246,7 +248,7 @@ fp <- newForeignPtr_ p l <- c_strlen cstr- return $! unsafeFromForeignPtr0 fp (fromIntegral l)+ return $! VS.unsafeFromForeignPtr0 fp (fromIntegral l) {-# INLINE unsafePackAddress #-} -- | /O(1)/ 'unsafePackAddressLen' provides constant-time construction of@@ -271,7 +273,7 @@ let p :: Ptr Word8 p = Ptr addr# fp <- newForeignPtr_ p- return $! unsafeFromForeignPtr0 fp (fromIntegral l)+ return $! VS.unsafeFromForeignPtr0 fp (fromIntegral l) {-# INLINE unsafePackAddressLen #-} -- | /O(1)/ Construct a 'ByteString' given a Ptr Word8 to a buffer, a@@ -286,7 +288,7 @@ unsafePackCStringFinalizer :: Ptr Word8 -> Int -> IO () -> IO ByteString unsafePackCStringFinalizer p l f = do fp <- FC.newForeignPtr p f- return $! unsafeFromForeignPtr0 fp (fromIntegral l)+ return $! VS.unsafeFromForeignPtr0 fp (fromIntegral l) {-# INLINE unsafePackCStringFinalizer #-} -- | Explicitly run the finaliser associated with a 'ByteString'.@@ -299,6 +301,6 @@ -- ever generated from the underlying byte array are no longer live. -- unsafeFinalize :: ByteString -> IO ()-unsafeFinalize v = let (fp, _) = unsafeToForeignPtr0 v+unsafeFinalize v = let (fp, _) = VS.unsafeToForeignPtr0 v in finalizeForeignPtr fp {-# INLINE unsafeFinalize #-}
− Utils.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Utils ( unsafeFromForeignPtr0, unsafeToForeignPtr0 ) where----------------------------------------------------------------------------- Imports----------------------------------------------------------------------------- from base:-import Data.Int ( Int )-import Foreign.Storable ( Storable )-import Foreign.ForeignPtr ( ForeignPtr )---- from vector:-import Data.Vector.Storable ( Vector, unsafeFromForeignPtr, unsafeToForeignPtr )---- TODO: Remove:-import Control.DeepSeq (NFData)-instance NFData (Vector a)----------------------------------------------------------------------------- Utils---------------------------------------------------------------------------unsafeFromForeignPtr0 :: Storable a- => ForeignPtr a- -> Int- -> Vector a-unsafeFromForeignPtr0 fp n = unsafeFromForeignPtr fp 0 n-{-# INLINE unsafeFromForeignPtr0 #-}--unsafeToForeignPtr0 :: Storable a => Vector a -> (ForeignPtr a, Int)-unsafeToForeignPtr0 v = let (fp, _, n) = unsafeToForeignPtr v- in (fp, n)-{-# INLINE unsafeToForeignPtr0 #-}
− bench.hs
@@ -1,936 +0,0 @@-{-# LANGUAGE CPP, BangPatterns #-}---- Disable warnings for the orphaned NFData instances for legacy ByteStrings:-{-# OPTIONS_GHC -fno-warn-orphans #-}---- Disable warnings for the deprecated findSubstring and findSubstrings:-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}--module Main where-------------------------------------------------------------------------------------- Imports------------------------------------------------------------------------------------- from base:-import Control.Exception ( evaluate )-import Data.Word ( Word8 )-import Data.Char ( isUpper )-import Data.Monoid ( mappend )-import System.IO ( withFile, IOMode(ReadMode) )-import Foreign.C.String ( withCString, withCStringLen )--import qualified Data.List as List ( replicate )---- from deepseq:-import Control.DeepSeq ( NFData, rnf )---- from criterion:-import Criterion.Main ( Benchmarkable, Benchmark, defaultMain, bgroup, bench, nf )---- from vector-bytestring:-import qualified Data.Vector.Storable.ByteString as VSB-import qualified Data.Vector.Storable.ByteString.Lazy as VSBL-import qualified Data.Vector.Storable.ByteString.Char8 as VSB8-import qualified Data.Vector.Storable.ByteString.Lazy.Char8 as VSBL8-import qualified Data.Vector.Storable.ByteString.Unsafe as VSBU-import qualified Data.Vector.Storable.ByteString.Internal as VSBI-import Data.Vector.Storable.ByteString.Internal ( c2w, w2c )---- from bytestring:-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Lazy.Char8 as BL8-import qualified Data.ByteString.Unsafe as BU-import qualified Data.ByteString.Internal as BI--import qualified Data.ByteString.Lazy.Internal as BLI-------------------------------------------------------------------------------------- Handy CPP macros-----------------------------------------------------------------------------------#define BOO8(name, vb, b, vb8, b8, vbl, bl, vbl8, bl8) \- boo "name" (nf VSB.name vb) \- (nf B.name b) \- (nf VSB8.name vb8) \- (nf B8.name b8) \- (nf VSBL.name vbl) \- (nf BL.name bl) \- (nf VSBL8.name vbl8) \- (nf BL8.name bl8)--#define BOO4(name, vb, b, vbl, bl) BOO8(name, vb, b, vb, b, vbl, bl, vbl, bl)-#define BOO2(name, a, a8) BOO8(name, a, a, a8, a8, a, a, a8, a8)--#define BOOA(name, a, a8, vb, b, vbl, bl) \- boo "name" (nf (VSB.name a) vb) \- (nf (B.name a) b) \- (nf (VSB8.name a8) vb) \- (nf (B8.name a8) b) \- (nf (VSBL.name a) vbl) \- (nf (BL.name a) bl) \- (nf (VSBL8.name a8) vbl) \- (nf (BL8.name a8) bl) \--#define BOOSL(name, s, l, vb, b, vbl, bl) \- boo "name" (nf (VSB.name s) vb) \- (nf (B.name s) b) \- (nf (VSB8.name s) vb) \- (nf (B8.name s) b) \- (nf (VSBL.name l) vbl) \- (nf (BL.name l) bl) \- (nf (VSBL8.name l) vbl) \- (nf (BL8.name l) bl) \--#define BOOBIN(name, vb1, vb2, b1, b2, vbl1, vbl2, bl1, bl2) \- boo "name" (nf (VSB.name vb1) vb2) \- (nf (B.name b1) b2) \- (nf (VSB8.name vb1) vb2) \- (nf (B8.name b1) b2) \- (nf (VSBL.name vbl1) vbl2) \- (nf (BL.name bl1) bl2) \- (nf (VSBL8.name vbl1) vbl2) \- (nf (BL8.name bl1) bl2) \--#define BOOB(name, a, a8, vb, b, vbl, bl) \- boo "name" (nf (VSB.name vb) a) \- (nf (B.name b) a) \- (nf (VSB8.name vb) a8) \- (nf (B8.name b) a8) \- (nf (VSBL.name vbl) a) \- (nf (BL.name bl) a) \- (nf (VSBL8.name vbl) a8) \- (nf (BL8.name bl) a8)--#define BLAA(name, a, a8, vb, b) \- bla "name" (nf (VSB.name a) vb) \- (nf (B.name a) b) \- (nf (VSB8.name a8) vb) \- (nf (B8.name a8) b)-------------------------------------------------------------------------------------- Main-----------------------------------------------------------------------------------deepEvaluate :: NFData a => a -> IO ()-deepEvaluate = evaluate . rnf--main :: IO ()-main = do- let dict = "tests/data"-- vb <- VSB.readFile dict- b <- B.readFile dict- vbl <-VSBL.readFile dict- bl <- BL.readFile dict-- rnf (vb, b, vbl, bl) `seq`- defaultMain $- [- ----------------------------------------------------------------------------- -- * Introducing and eliminating 'ByteString's- ------------------------------------------------------------------------------ let !z = 0- !z8 = w2c z- in BOO2(singleton, z, z8)-- , let xs = B.unpack b- cs = B8.unpack b- in rnf (xs, cs) `seq`- BOO2(pack, xs, cs)-- , BOO4(unpack, vb, b, vbl, bl)--- ----------------------------------------------------------------------------- -- * Basic interface- ------------------------------------------------------------------------------ , let !z = 0- !z8 = w2c z- in BOOA(cons, z, z8, vb, b, vbl, bl)-- , let !z = 0- !z8 = w2c z- in BOOB(snoc, z, z8, vb, b, vbl, bl)-- , BOOBIN(append, vb, vb, b, b, vbl, vbl, bl, bl)-- , BOO4(head, vb, b, vbl, bl)- , BOO4(tail, vb, b, vbl, bl)- , BOO4(uncons, vb, b, vbl, bl)- , BOO4(last, vb, b, vbl, bl)- , BOO4(init, vb, b, vbl, bl)- , BOO4(null, vb, b, vbl, bl)- , BOO4(length, vb, b, vbl, bl)--- ----------------------------------------------------------------------------- -- * Transforming ByteStrings- ------------------------------------------------------------------------------ , let mapF = (+1)- mapF8 = w2c . mapF . c2w- in BOOA(map, mapF, mapF8, vb, b, vbl, bl)-- , BOO4(reverse, vb, b, vbl, bl)-- , let !z = 0- !z8 = w2c z- in BOOA(intersperse, z, z8, vb, b, vbl, bl)-- , let n = 100- vbsN = List.replicate n vb- bsN = List.replicate n b- vblsN = List.replicate n vbl- blsN = List.replicate n bl- in rnf (vbsN, bsN, vblsN, blsN) `seq`- BOOBIN(intercalate, vb, vbsN, b, bsN, vbl, vblsN, bl, blsN)-- , let m = 5- vbsM = List.replicate m vb- bsM = List.replicate m b- vblsM = List.replicate m vbl- blsM = List.replicate m bl- in rnf (vbsM, bsM, vblsM, blsM) `seq`- BOO4(transpose, vbsM, bsM, vblsM, blsM)--- ----------------------------------------------------------------------------- -- * Reducing 'ByteString's (folds)- ------------------------------------------------------------------------------ , let- foldlF y x = y + x- foldlF8 y x = w2c $ foldlF (c2w y) (c2w x)- !z = 0- !z8 = w2c z-- -- TODO:- -- Enabling these arguments instead of the former causes GHC to loop!!!- -- foldlF xs x = x:xs- -- foldlF8 xs x = x:xs- -- z = []- -- z8 = []-- in BOOA(foldl, foldlF z, foldlF8 z8, vb, b, vbl, bl)-- , let foldl'F y x = x + y- foldl'F8 y x = w2c $ foldl'F (c2w y) (c2w x)- !z = 0- !z8 = w2c z- in boo "foldl'" (nf (VSB.foldl' foldl'F z) vb)- (nf (B.foldl' foldl'F z) b)- (nf (VSB8.foldl' foldl'F8 z8) vb)- (nf (B8.foldl' foldl'F8 z8) b)- (nf (VSBL.foldl' foldl'F z) vbl)- (nf (BL.foldl' foldl'F z) bl)- (nf (VSBL8.foldl' foldl'F8 z8) vbl)- (nf (BL8.foldl' foldl'F8 z8) bl)-- , let foldl1F y x = x + y- foldl1F8 y x = w2c $ foldl1F (c2w y) (c2w x)- n = 100000 -- Increasing this causes stack overflows in:- -- foldl1/strict/Word8/vector !!!- n64 = fromIntegral n- vb2 = VSB.take n vb- b2 = B.take n b- vbl2 = VSBL.take n64 vbl- bl2 = BL.take n64 bl- in rnf (vb2, b2, vbl2, bl2) `seq`- BOOA(foldl1, foldl1F, foldl1F8, vb2, b2, vbl2, bl2)-- , let foldl1'F y x = x + y- foldl1'F8 y x = w2c $ foldl1'F (c2w y) (c2w x)- in boo "foldl1'" (nf (VSB.foldl1' foldl1'F) vb)- (nf (B.foldl1' foldl1'F) b)- (nf (VSB8.foldl1' foldl1'F8) vb)- (nf (B8.foldl1' foldl1'F8) b)- (nf (VSBL.foldl1' foldl1'F) vbl)- (nf (BL.foldl1' foldl1'F) bl)- (nf (VSBL8.foldl1' foldl1'F8) vbl)- (nf (BL8.foldl1' foldl1'F8) bl)-- , let foldrF = (:)- foldrF8 = (:)- z = []- z8 = []- in BOOA(foldr, foldrF z, foldrF8 z8, vb, b, vbl, bl)-- , let foldr'F y x = x + y- foldr'F8 y x = w2c $ foldr'F (c2w y) (c2w x)- !z = 0- !z8 = w2c z- in bla "foldr'" (nf (VSB.foldr' foldr'F z) vb)- (nf (B.foldr' foldr'F z) b)- (nf (VSB8.foldr' foldr'F8 z8) vb)- (nf (B8.foldr' foldr'F8 z8) b)-- , let foldr1F y x = x + y- foldr1F8 y x = w2c $ foldr1F (c2w y) (c2w x)- n = 100000 -- Increasing this causes stack overflows in:- -- foldr1/strict/Char8/vector !!!- n64 = fromIntegral n- vb2 = VSB.take n vb- b2 = B.take n b- vbl2 = VSBL.take n64 vbl- bl2 = BL.take n64 bl- in rnf (vb2, b2, vbl2, bl2) `seq`- BOOA(foldr1, foldr1F, foldr1F8, vb2, b2, vbl2, bl2)-- , let foldr1'F y x = x + y- foldr1'F8 y x = w2c $ foldr1'F (c2w y) (c2w x)- in bla "foldr1'" (nf (VSB.foldr1' foldr1'F) vb)- (nf (B.foldr1' foldr1'F) b)- (nf (VSB8.foldr1' foldr1'F8) vb)- (nf (B8.foldr1' foldr1'F8) b)-- ----------------------------------------------------------------------------- -- ** Special folds-- , let m = 5- vbsM = List.replicate m vb- bsM = List.replicate m b- vblsM = List.replicate m vbl- blsM = List.replicate m bl- in rnf (vbsM, bsM, vblsM, blsM) `seq`- BOO4(concat, vbsM, bsM, vblsM, blsM)-- , let !r = 5- !r64 = fromIntegral r- in boo "concatMap" (nf (VSB.concatMap ( VSB.replicate r)) vb)- (nf (B.concatMap ( B.replicate r)) b)- (nf (VSB8.concatMap ( VSB8.replicate r)) vb)- (nf (B8.concatMap ( B8.replicate r)) b)- (nf (VSBL.concatMap ( VSBL.replicate r64)) vbl)- (nf (BL.concatMap ( BL.replicate r64)) bl)- (nf (VSBL8.concatMap (VSBL8.replicate r64)) vbl)- (nf (BL8.concatMap ( BL8.replicate r64)) bl)-- , let anyF = (== 255)- anyF8 = anyF . c2w- in BOOA(any, anyF, anyF8, vb, b, vbl, bl)-- , let allF = (<= 255)- allF8 = allF . c2w- in BOOA(all, allF, allF8, vb, b, vbl, bl)-- , BOO4(maximum, vb, b, vbl, bl)- , BOO4(minimum, vb, b, vbl, bl)--- ----------------------------------------------------------------------------- -- * Building ByteStrings- ------------------------------------------------------------------------------ ----------------------------------------------------------------------------- -- ** Scans-- , let scanlF x y = x + y- scanlF8 x y = w2c $ scanlF (c2w x) (c2w y)- !z = 1- !z8 = w2c z- n = 1000 -- If you increase this you get stack space overflows in:- -- scanl/lazy/Word8/vector- -- scanl/lazy/Word8/bytestring- -- scanl/lazy/Char8/vector- -- scanl/lazy/Char8/bytestring- n64 = fromIntegral n- vb2 = VSB.take n vb- b2 = B.take n b- vbl2 = VSBL.take n64 vbl- bl2 = BL.take n64 bl- in rnf (vb2, b2, vbl2, bl2) `seq`- BOOA(scanl, scanlF z, scanlF8 z8, vb2, b2, vbl2, bl2)-- , let scanl1F x y = x + y- scanl1F8 x y = w2c $ scanl1F (c2w x) (c2w y)- in BLAA(scanl1, scanl1F, scanl1F8, vb, b)-- , let scanrF x y = x + y- scanrF8 x y = w2c $ scanrF (c2w x) (c2w y)- !z = 1- !z8 = w2c z- in BLAA(scanr, scanrF z, scanrF8 z8, vb, b)-- , let scanr1F x y = x + y- scanr1F8 x y = w2c $ scanr1F (c2w x) (c2w y)- in BLAA(scanr1, scanr1F, scanr1F8, vb, b)-- ----------------------------------------------------------------------------- -- ** Accumulating maps-- , let mapAccumLF acc x = (x:acc, x * x + x)- mapAccumLF8 acc c = (c:acc, w2c $ c2w c * c2w c + c2w c)- in BOOA(mapAccumL, mapAccumLF [], mapAccumLF8 [], vb, b, vbl, bl)-- , let mapAccumRF acc x = (x:acc, x * x + x)- mapAccumRF8 acc c = (c:acc, w2c $ c2w c * c2w c + c2w c)- in BOOA(mapAccumR, mapAccumRF [], mapAccumRF8 [], vb, b, vbl, bl)-- ----------------------------------------------------------------------------- -- ** Generating and unfolding ByteStrings-- , let !o = 1000000- !o64 = fromIntegral o- !z = 0- !z8 = w2c z- in BOOB(replicate, z, z8, o, o, o64, o64)- ]- ++- ( let unfoldrF :: Int -> Maybe (Word8, Int)- unfoldrF 1000000 = Nothing- unfoldrF i = Just (fromIntegral i, i+1)-- unfoldrF8 :: Int -> Maybe (Char, Int)- unfoldrF8 1000000 = Nothing- unfoldrF8 i = Just (w2c $ fromIntegral i, i+1)-- in [ BOOA(unfoldr, unfoldrF, unfoldrF8, 0, 0, 0, 0)- , let !k = 1000000- in BLAA(unfoldrN, k unfoldrF, k unfoldrF8, 0, 0)- ]- ) ++--- ----------------------------------------------------------------------------- -- * Substrings- ------------------------------------------------------------------------------ ----------------------------------------------------------------------------- -- ** Breaking strings-- [ let !t = 260000- !t64 = fromIntegral t- in BOOSL(take, t, t64, vb, b, vbl, bl)-- , let !d = 10000- !d64 = fromIntegral d- in BOOSL(drop, d, d64, vb, b, vbl, bl)-- , let !s = 260000 `div` 2- !s64 = fromIntegral s- in BOOSL(splitAt, s, s64, vb, b, vbl, bl)-- , let takeWhileF = (<= 255) -- take everything- takeWhileF8 = takeWhileF . c2w -- take everything- in BOOA(takeWhile, takeWhileF, takeWhileF8, vb, b, vbl, bl)- -- takeWhile/strict/Char8/vector is suspiciously fast!-- , let dropWhileF = (<= 255) -- drop everything- dropWhileF8 = dropWhileF . c2w -- drop everything- in BOOA(dropWhile, dropWhileF, dropWhileF8, vb, b, vbl, bl)- -- dropWhile/strict/Char8/vector is suspiciously fast!-- , let spanF = (<= 255) -- span till end- spanF8 = spanF . c2w -- span till end- in BOOA(span, spanF, spanF8, vb, b, vbl, bl)-- -- See if the RULE: "ByteString specialise span (x==)" fires:- , let spanEqF = (==p)- spanEqF8 = spanEqF . c2w- rn = 500000- rn64 = fromIntegral rn- p = 1- q = 2- vbSpan = VSB.replicate rn p `mappend` VSB.replicate rn q- bSpan = B.replicate rn p `mappend` B.replicate rn q- vblSpan = VSBL.replicate rn64 p `mappend` VSBL.replicate rn64 q- blSpan = BL.replicate rn64 p `mappend` BL.replicate rn64 q- in rnf (vbSpan, bSpan, vblSpan, blSpan) `seq`- boo "span_eq" (nf (VSB.span spanEqF) vbSpan)- (nf (B.span spanEqF) bSpan)- (nf (VSB8.span spanEqF8) vbSpan)- (nf (B8.span spanEqF8) bSpan)- (nf (VSBL.span spanEqF) vblSpan)- (nf (BL.span spanEqF) blSpan)- (nf (VSBL8.span spanEqF8) vblSpan)- (nf (BL8.span spanEqF8) blSpan)-- , let spanF = (<= 255)- spanF8 = spanF . c2w- in BLAA(spanEnd, spanF, spanF8, vb, b)-- , let breakF = (>= 255)- breakF8 = breakF . c2w- in BOOA(break, breakF, breakF8, vb, b, vbl, bl)-- -- See if the RULE: "ByteString specialise break (x==)" fires:- , let breakEqF = (==q)- breakEqF8 = breakEqF . c2w- rn = 500000- rn64 = fromIntegral rn- p = 1- q = 2- vbSpan = VSB.replicate rn p `mappend` VSB.replicate rn q- bSpan = B.replicate rn p `mappend` B.replicate rn q- vblSpan = VSBL.replicate rn64 p `mappend` VSBL.replicate rn64 q- blSpan = BL.replicate rn64 p `mappend` BL.replicate rn64 q- in rnf (vbSpan, bSpan, vblSpan, blSpan) `seq`- boo "break_eq" (nf (VSB.break breakEqF) vbSpan)- (nf (B.break breakEqF) bSpan)- (nf (VSB8.break breakEqF8) vbSpan)- (nf (B8.break breakEqF8) bSpan)- (nf (VSBL.break breakEqF) vblSpan)- (nf (BL.break breakEqF) blSpan)- (nf (VSBL8.break breakEqF8) vblSpan)- (nf (BL8.break breakEqF8) blSpan)-- , let breakF = (>= 255)- breakF8 = breakF . c2w- in BLAA(breakEnd, breakF, breakF8, vb, b)-- , BOO4(group, vb, b, vbl, bl)-- , let groupByF x y = x < y- groupByF8 x y = groupByF (c2w x) (c2w y)- in BOOA(groupBy, groupByF, groupByF8, vb, b, vbl, bl)-- , BOO4(inits, vb, b, vbl, bl)- , BOO4(tails, vb, b, vbl, bl)-- ----------------------------------------------------------------------------- -- ** Breaking into many substrings-- , let !nlWord = c2w nlChar- !nlChar = '\n'- in BOOA(split, nlWord, nlChar, vb, b, vbl, bl)-- , let splitWithF = splitWithF8 . w2c- splitWithF8 = (=='a')- in BOOA(splitWith, splitWithF, splitWithF8, vb, b, vbl, bl)--- ----------------------------------------------------------------------------- -- * Predicates- ------------------------------------------------------------------------------ , let p = 1- p64 = fromIntegral p- vbp = VSB.take p vb- bp = B.take p b- vblp = VSBL.take p64 vbl- blp = BL.take p64 bl- in rnf (vbp, bp, vblp, blp) `seq`- BOOBIN(isPrefixOf, vbp, vb, bp, b, vblp, vbl, blp, bl)-- , let p = VSB.length vb - 1- vbp = VSB.drop p vb- bp = B.drop p b- in rnf (vbp, bp) `seq`- bla "isSuffixOf" (nf (VSB.isSuffixOf vbp) vb)- (nf (B.isSuffixOf bp) b)- (nf (VSB8.isSuffixOf vbp) vb)- (nf (B8.isSuffixOf bp) b)-- , let p = 100- m = VSB.length vb `div` 2- n = m - p- o = 2 * p- vbp = VSB.take o (VSB.drop n vb)- bp = B.take o (B.drop n b)- in rnf (vbp, bp) `seq`- bla "isInfixOf" (nf (VSB.isInfixOf vbp) vb)- (nf (B.isInfixOf bp) b)- (nf (VSB8.isInfixOf vbp) vb)- (nf (B8.isInfixOf bp) b)-- ----------------------------------------------------------------------------- -- ** Search for arbitrary substrings-- , let p = 100- m = VSB.length vb `div` 2- n = m - p- o = 2 * p- vbp = VSB.take o (VSB.drop n vb)- bp = B.take o (B.drop n b)- in rnf (vbp, bp) `seq`- bla "breakSubstring" (nf (VSB.breakSubstring vbp) vb)- (nf (B.breakSubstring bp) b)- (nf (VSB8.breakSubstring vbp) vb)- (nf (B8.breakSubstring bp) b)-- , let p = 100- m = VSB.length vb `div` 2- n = m - p- o = 2 * p- vbp = VSB.take o (VSB.drop n vb)- bp = B.take o (B.drop n b)- in rnf (vbp, bp) `seq`- bla "findSubstring" (nf (VSB.findSubstring vbp) vb)- (nf (B.findSubstring bp) b)- (nf (VSB8.findSubstring vbp) vb)- (nf (B8.findSubstring bp) b)-- , let s = "the"- vbp = VSB8.pack s- bp = B8.pack s- in rnf (vbp, bp) `seq`- bla "findSubstrings" (nf (VSB.findSubstrings vbp) vb)- (nf (B.findSubstrings bp) b)- (nf (VSB8.findSubstrings vbp) vb)- (nf (B8.findSubstrings bp) b)--- ----------------------------------------------------------------------------- -- * Searching ByteStrings- ------------------------------------------------------------------------------ ----------------------------------------------------------------------------- -- ** Searching by equality-- , let !a = 255- !a8 = w2c a- in BOOA(elem, a, a8, vb, b, vbl, bl)-- , let !a = 255- !a8 = w2c a- in BOOA(notElem, a, a8, vb, b, vbl, bl)-- ----------------------------------------------------------------------------- -- ** Searching with a predicate-- , let findF = (==255)- findF8 = findF . c2w- in BOOA(find, findF, findF8, vb, b, vbl, bl)-- , let filterF = filterF8 . w2c- filterF8 = isUpper- in BOOA(filter, filterF, filterF8, vb, b, vbl, bl)-- , let partitionF = isUpper . w2c- in blo "partition" (nf (VSB.partition partitionF) vb)- (nf (B.partition partitionF) b)- (nf (VSBL.partition partitionF) vbl)- (nf (BL.partition partitionF) bl)--- ----------------------------------------------------------------------------- -- * Indexing ByteStrings- ------------------------------------------------------------------------------ , let !ix = VSB.length vb - 1- !ix64 = fromIntegral ix- in blo "index" (nf (VSB.index vb) ix)- (nf (B.index b) ix)- (nf (VSBL.index vbl) ix64)- (nf (BL.index bl) ix64)-- , let !a = 255- !a8 = w2c a- in BOOA(elemIndex, a, a8, vb, b, vbl, bl)-- , let !a = c2w a8- !a8 = 'a'- in BOOA(elemIndices, a, a8, vb, b, vbl, bl)-- , let !a = 255- !a8 = w2c a- in BLAA(elemIndexEnd, a, a8, vb, b)-- , let findF = (==255)- findF8 = findF . c2w- in BOOA(findIndex, findF, findF8, vb, b, vbl, bl)-- , let findIndicesF = findIndicesF8 . w2c- findIndicesF8 = isUpper- in BOOA(findIndices, findIndicesF, findIndicesF8, vb, b, vbl, bl)-- , let !c = c2w c8- !c8 = 'a'- in BOOA(count, c, c8, vb, b, vbl, bl)-- ----------------------------------------------------------------------------- -- * Zipping and unzipping ByteStrings- ------------------------------------------------------------------------------ , BOOBIN(zip, vb, vb, b, b, vbl, vbl, bl, bl)-- , let zipWithF x y = fromIntegral x + fromIntegral y :: Int- zipWithF8 x y = zipWithF (c2w x) (c2w y)- in boo "zipWith" (nf (VSB.zipWith zipWithF vb) vb)- (nf (B.zipWith zipWithF b) b)- (nf (VSB8.zipWith zipWithF8 vb) vb)- (nf (B8.zipWith zipWithF8 b) b)- (nf (VSBL.zipWith zipWithF vbl) vbl)- (nf (BL.zipWith zipWithF bl) bl)- (nf (VSBL8.zipWith zipWithF8 vbl) vbl)- (nf (BL8.zipWith zipWithF8 bl) bl)-- , let zipWithF x y = x + y :: Word8- zipWithF8 x y = zipWithF (c2w x) (c2w y)- in boo "zipWith_Word8"- (nf (VSB.zipWith zipWithF vb) vb)- (nf (B.zipWith zipWithF b) b)- (nf (VSB8.zipWith zipWithF8 vb) vb)- (nf (B8.zipWith zipWithF8 b) b)- (nf (VSBL.zipWith zipWithF vbl) vbl)- (nf (BL.zipWith zipWithF bl) bl)- (nf (VSBL8.zipWith zipWithF8 vbl) vbl)- (nf (BL8.zipWith zipWithF8 bl) bl)-- , let xs = VSB.zip vb vb- xs8 = VSB8.zip vb vb- in rnf (xs, xs8) `seq`- bgroup "unzip"- [ bgroup "strict" $ foo (nf VSB.unzip xs)- (nf B.unzip xs)- (nf VSB8.unzip xs8)- (nf B8.unzip xs8)- , bgroup "lazy"- [ bgroup "Word8" $ bar (nf VSBL.unzip xs)- (nf BL.unzip xs)- ]- ]--- ----------------------------------------------------------------------------- -- * Ordered ByteStrings- ------------------------------------------------------------------------------ , bla "sort" (nf VSB.sort vb)- (nf B.sort b)- (nf VSB8.sort vb)- (nf B8.sort b)--- ----------------------------------------------------------------------------- -- * Low level conversions- ------------------------------------------------------------------------------ , BOO4(copy, vb, b, vbl, bl)-- ----------------------------------------------------------------------------- -- ** Packing 'CString's and pointers-- , let str = VSB8.unpack vb -- "I'm going to be a CString, Yippy!!"- in rnf str `seq`- bli "packCString" (withCString str $ \cStr ->- VSB.packCString cStr >>= deepEvaluate)- (withCString str $ \cStr ->- B.packCString cStr >>= deepEvaluate)-- , let str = VSB8.unpack vb -- "I'm going to be a CString, Yippy!!"- in rnf str `seq`- bli "packCStringLen" (withCStringLen str $ \cStrLen ->- VSB.packCStringLen cStrLen >>= deepEvaluate)- (withCStringLen str $ \cStrLen ->- B.packCStringLen cStrLen >>= deepEvaluate)-- ----------------------------------------------------------------------------- -- ** Using ByteStrings as 'CString's-- , let f _ = return ()- in bli "useAsCString" (VSB.useAsCString vb f)- ( B.useAsCString b f)-- , let f _ = return ()- in bli "useAsCStringLen" (VSB.useAsCStringLen vb f)- ( B.useAsCStringLen b f)--- ----------------------------------------------------------------------------- -- * I\/O with 'ByteString's- ------------------------------------------------------------------------------ , blo "readFile" ( VSB.readFile dict >>= deepEvaluate)- ( B.readFile dict >>= deepEvaluate)- (VSBL.readFile dict >>= deepEvaluate)- ( BL.readFile dict >>= deepEvaluate)-- , let devnull = "/dev/null"- in blo "writeFile" ( VSB.writeFile devnull vb)- ( B.writeFile devnull b)- (VSBL.writeFile devnull vbl)- ( BL.writeFile devnull bl)-- , blo "hGetContents" (withFile dict ReadMode $ \h ->- VSB.hGetContents h >>= deepEvaluate)- (withFile dict ReadMode $ \h ->- B.hGetContents h >>= deepEvaluate)- (withFile dict ReadMode $ \h ->- VSBL.hGetContents h >>= deepEvaluate)- (withFile dict ReadMode $ \h ->- BL.hGetContents h >>= deepEvaluate)--- ----------------------------------------------------------------------------- -- * Low level introduction and elimination- ------------------------------------------------------------------------------ , let !n = 1000000- f _ = return ()- in bli "create" (VSBI.create n f >>= deepEvaluate)- ( BI.create n f >>= deepEvaluate)-- , let !n = 1000000- f _ = return 500000- in bli "createAndTrim" (VSBI.createAndTrim n f >>= deepEvaluate)- ( BI.createAndTrim n f >>= deepEvaluate)--- ----------------------------------------------------------------------------- -- * Unchecked access- ------------------------------------------------------------------------------ , bli "unsafeHead" (nf VSBU.unsafeHead vb)- (nf BU.unsafeHead b)-- , bli "unsafeTail" (nf VSBU.unsafeTail vb)- (nf BU.unsafeTail b)-- , let !ix = 1000- in bli "unsafeIndex" (nf (VSBU.unsafeIndex vb) ix)- (nf (BU.unsafeIndex b) ix)-- , let !n = VSB.length vb `div` 2- in bli "unsafeTake" (nf (VSBU.unsafeTake n) vb)- (nf (BU.unsafeTake n) b)-- , let !n = VSB.length vb `div` 2- in bli "unsafeDrop" (nf (VSBU.unsafeDrop n) vb)- (nf (BU.unsafeDrop n) b)--- ----------------------------------------------------------------------------- -- Benchmarking fusion- ------------------------------------------------------------------------------ , bgroup "fusion" $- let fuse name f g = bgroup name $ bar (nf f vb)- (nf g b)- in [ bgroup "non_directional"- [ fuse "map-map" (VSB.map (*2) . VSB.map (+4))- ( B.map (*2) . B.map (+4))- , fuse "filter-filter" (VSB.filter (/=101) . VSB.filter (/=102))- ( B.filter (/=101) . B.filter (/=102))- , fuse "filter-map" (VSB.filter (/=103) . VSB.map (+5))- ( B.filter (/=103) . B.map (+5))- , fuse "map-filter" (VSB.map (*3) . VSB.filter (/=104))- ( B.map (*3) . B.filter (/=104))- , fuse "map-noacc" ((VSB.map (+1) . VSB.filter (/=112)) . VSB.map (*2))- (( B.map (+1) . B.filter (/=112)) . B.map (*2))- , fuse "noacc-map" (VSB.map (+1) . (VSB.map (+2) . VSB.filter (/=113)))- ( B.map (+1) . ( B.map (+2) . B.filter (/=113)))- , fuse "filter-noacc" ((VSB.map (+1) . VSB.filter (/=101)) . VSB.filter (/=114))- (( B.map (+1) . B.filter (/=101)) . B.filter (/=114))- , fuse "noacc-filter" (VSB.filter (/=101) . (VSB.map (*2) . VSB.filter (/=115)))- ( B.filter (/=101) . ( B.map (*2) . B.filter (/=115)))- , fuse "noacc-noacc" ((VSB.map (*3) . VSB.filter (/=108)) . (VSB.map (*4) . VSB.filter (/=109)))- (( B.map (*3) . B.filter (/=108)) . ( B.map (*4) . B.filter (/=109)))- ]-- , bgroup "up_loops"- [ fuse "up-up" (VSB.foldl' (const.(+1)) (0::Int) . VSB.scanl (flip const) (0::Word8))- ( B.foldl' (const.(+1)) (0::Int) . B.scanl (flip const) (0::Word8))- , fuse "map-up" (VSB.foldl' (const.(+6)) (0::Int) . VSB.map (*4))- ( B.foldl' (const.(+6)) (0::Int) . B.map (*4))- , fuse "up-map" (VSB.map (+7) . VSB.scanl const (0::Word8))- ( B.map (+7) . B.scanl const (0::Word8))- , fuse "filter-up" (VSB.foldl' (const.(+8)) (0::Int) . VSB.filter (/=105))- ( B.foldl' (const.(+8)) (0::Int) . B.filter (/=105))- , fuse "up-filter" (VSB.filter (/=106) . VSB.scanl (flip const) (0::Word8))- ( B.filter (/=106) . B.scanl (flip const) (0::Word8))- , fuse "noacc-up" (VSB.foldl' (const.(+1)) (0::Word8) . (VSB.map (+1) . VSB.filter (/=110)))- ( B.foldl' (const.(+1)) (0::Word8) . ( B.map (+1) . B.filter (/=110)))- , fuse "up-noacc" ((VSB.map (+1) . VSB.filter (/=111)) . VSB.scanl (flip const) (0::Word8))- (( B.map (+1) . B.filter (/=111)) . B.scanl (flip const) (0::Word8))- ]-- , bgroup "down_loops"- [ fuse "down-down" (VSB.foldr (const (+9)) (0::Word8) . VSB.scanr const (0::Word8))- ( B.foldr (const (+9)) (0::Word8) . B.scanr const (0::Word8))- , fuse "map-down" (VSB.foldr (const (+10)) (0::Word8) . VSB.map (*2))- ( B.foldr (const (+10)) (0::Word8) . B.map (*2))- , fuse "down-map" (VSB.map (*2) . VSB.scanr const (0::Word8))- ( B.map (*2) . B.scanr const (0::Word8))- , fuse "filter-down" (VSB.foldr (const (+11)) (0::Word8) . VSB.filter (/=106))- ( B.foldr (const (+11)) (0::Word8) . B.filter (/=106))- , fuse "down-filter" (VSB.filter (/=107) . VSB.scanr const (0::Word8))- ( B.filter (/=107) . B.scanr const (0::Word8))- , fuse "noacc-down" (VSB.foldr (const (+1)) (0::Word8) . (VSB.map (+1) . VSB.filter (/=116)))- ( B.foldr (const (+1)) (0::Word8) . ( B.map (+1) . B.filter (/=116)))- , fuse "down-noacc" ((VSB.map (+1) . VSB.filter (/=101)) . VSB.scanr const (0::Word8))- (( B.map (+1) . B.filter (/=101)) . B.scanr const (0::Word8))- ]-- , bgroup "misc"- [ fuse "length-loop" (VSB.length . VSB.filter (/=105))- ( B.length . B.filter (/=105))- , fuse "maximum-loop" (VSB.maximum . VSB.map (*4))- ( B.maximum . B.map (*4))- , fuse "minimum-loop" (VSB.minimum . VSB.map (+6))- ( B.minimum . B.map (+6))- ]-- , bgroup "big"- [ fuse "big_map-map" (VSB.map (subtract 3) . VSB.map (+7) . VSB.map (*2) . VSB.map (+4))- ( B.map (subtract 3) . B.map (+7) . B.map (*2) . B.map (+4))- , fuse "big_filter-filter" (VSB.filter (/=103) . VSB.filter (/=104) . VSB.filter (/=101) . VSB.filter (/=102))- ( B.filter (/=103) . B.filter (/=104) . B.filter (/=101) . B.filter (/=102))- , fuse "big_filter-map" (VSB.map (*2) . VSB.filter (/=104) . VSB.map (+6) . VSB.filter (/=103) . VSB.map (+5))- ( B.map (*2) . B.filter (/=104) . B.map (+6) . B.filter (/=103) . B.map (+5))- ]- ]- ]-------------------------------------------------------------------------------------- Grouping-----------------------------------------------------------------------------------boo :: Benchmarkable b => String -> b -> b -> b -> b -> b -> b -> b -> b -> Benchmark-boo name vb b- vb8 b8- vbl bl- vbl8 bl8 =- bgroup name [ bgroup "strict" $ foo vb b- vb8 b8- , bgroup "lazy" $ foo vbl bl- vbl8 bl8- ]--blo :: Benchmarkable b => String -> b -> b -> b -> b -> Benchmark-blo name vb b- vbl bl = bgroup name [ bgroup "strict" $ bar vb b- , bgroup "lazy" $ bar vbl bl- ]--bla :: Benchmarkable b => String -> b -> b -> b -> b -> Benchmark-bla name vb b- vb8 b8 = bgroup name [ bgroup "strict" $ foo vb b- vb8 b8- ]--bli :: Benchmarkable b => String -> b -> b -> Benchmark-bli name vb b = bgroup name $ bar vb b------------------------------------------------------------------------------------foo :: Benchmarkable b => b -> b -> b -> b -> [Benchmark]-foo vb b- vb8 b8 = [ bgroup "Word8" $ bar vb b- , bgroup "Char8" $ bar vb8 b8- ]--bar :: Benchmarkable b => b -> b -> [Benchmark]-bar vb b = [ bench "vector" vb- , bench "bytestring" b- ]-------------------------------------------------------------------------------------- Orphaned NFData instances for legacy ByteStrings-----------------------------------------------------------------------------------instance NFData B.ByteString--instance NFData BL.ByteString where- rnf BLI.Empty = ()- rnf (BLI.Chunk _ cs) = rnf cs
+ bench/bench.hs view
@@ -0,0 +1,1013 @@+{-# LANGUAGE CPP, BangPatterns #-}++-- Disable warnings for the orphaned NFData instances for legacy ByteStrings:+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- Disable warnings for the deprecated findSubstring and findSubstrings:+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}++module Main where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Control.Exception ( evaluate )+import Data.List ( sortBy )+import Data.Word ( Word8 )+import Data.Char ( isUpper, isAlpha, toLower )+import Data.Monoid ( mappend )+import System.IO ( withFile, IOMode(ReadMode) )+import Foreign.C.String ( withCString, withCStringLen )++import qualified Data.List as List ( replicate )++-- from deepseq:+import Control.DeepSeq ( NFData, rnf, deepseq )++-- from criterion:+import Criterion.Main ( Benchmarkable, Benchmark, defaultMain, bgroup, bench, nf )++-- from vector-bytestring:+import qualified Data.Vector.Storable.ByteString as VSB+import qualified Data.Vector.Storable.ByteString.Lazy as VSBL+import qualified Data.Vector.Storable.ByteString.Char8 as VSB8+import qualified Data.Vector.Storable.ByteString.Lazy.Char8 as VSBL8+import qualified Data.Vector.Storable.ByteString.Unsafe as VSBU+import qualified Data.Vector.Storable.ByteString.Internal as VSBI+import Data.Vector.Storable.ByteString.Internal ( c2w, w2c )++-- from bytestring:+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy.Char8 as BL8+import qualified Data.ByteString.Unsafe as BU+import qualified Data.ByteString.Internal as BI++import qualified Data.ByteString.Lazy.Internal as BLI+++--------------------------------------------------------------------------------+-- Handy CPP macros+--------------------------------------------------------------------------------++#define BOO8(name, vb, b, vb8, b8, vbl, bl, vbl8, bl8) \+ (boo "name" (nf VSB.name vb) \+ (nf B.name b) \+ (nf VSB8.name vb8) \+ (nf B8.name b8) \+ (nf VSBL.name vbl) \+ (nf BL.name bl) \+ (nf VSBL8.name vbl8) \+ (nf BL8.name bl8))++#define BOO4(name, vb, b, vbl, bl) BOO8(name, vb, b, vb, b, vbl, bl, vbl, bl)+#define BOO2(name, a, a8) BOO8(name, a, a, a8, a8, a, a, a8, a8)++#define BOOA8(name, vb, vb_, b, b_, vb8, vb8_, b8, b8_ \+ , vbl, vbl_, bl, bl_, vbl8, vbl8_, bl8, bl8_) \+ (boo "name" (nf (VSB.name vb) vb_) \+ (nf (B.name b) b_) \+ (nf (VSB8.name vb8) vb8_) \+ (nf (B8.name b8) b8_) \+ (nf (VSBL.name vbl) vbl_) \+ (nf (BL.name bl) bl_) \+ (nf (VSBL8.name vbl8) vbl8_) \+ (nf (BL8.name bl8) bl8_)) \++#define BOOA(name, a, a8, vb, b, vbl, bl) \+ BOOA8(name, a, vb, a, b, a8, vb, a8, b \+ , a, vbl, a, bl, a8, vbl, a8, bl)++#define BOOB(name, a, a8, vb, b, vbl, bl) \+ BOOA8(name, vb, a, b, a, vb, a8, b, a8 \+ , vbl, a, bl, a, vbl, a8, bl, a8)++#define BLOO(name, vb, vb_, b, b_, vbl, vbl_, bl, bl_) \+ (blo "name" (nf (VSB.name vb) vb_) \+ (nf (B.name b) b_) \+ (nf (VSBL.name vbl) vbl_) \+ (nf (BL.name bl) bl_)) \++#define BLOSL(name, s, l, vb, b, vbl, bl) \+ BLOO(name, s, vb, s, b, l, vbl, l, bl)++#define BLOBIN(name, vb1, vb2, b1, b2, vbl1, vbl2, bl1, bl2) \+ BLOO(name, vb1, vb2, b1, b2, vbl1, vbl2, bl1, bl2)++#define BLAA(name, a, a8, vb, b) \+ (bla "name" (nf (VSB.name a) vb) \+ (nf (B.name a) b) \+ (nf (VSB8.name a8) vb) \+ (nf (B8.name a8) b))++#define BLO(name, vb, b, vbl, bl) \+ (blo "name" (nf VSB.name vb) \+ (nf B.name b) \+ (nf VSBL.name vbl) \+ (nf BL.name bl))+++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++deepEvaluate :: NFData a => a -> IO ()+deepEvaluate = evaluate . rnf++main :: IO ()+main = do+ let dict = "tests/data"++ vb <- VSB.readFile dict+ b <- B.readFile dict+ vbl <-VSBL.readFile dict+ bl <- BL.readFile dict++ deepseq (vb, b, vbl, bl) $+ defaultMain $+ [+ ----------------------------------------------------------------------------+ -- * Introducing and eliminating 'ByteString's+ ----------------------------------------------------------------------------++ blo "empty" (nf (const VSB.empty) ())+ (nf (const B.empty) ())+ (nf (const VSBL.empty) ())+ (nf (const BL.empty) ())++ , let !z = 0+ !z8 = w2c z+ in BOO2(singleton, z, z8)++ , let xs = B.unpack b+ cs = B8.unpack b+ in (xs, cs) `deepseq`+ BOO2(pack, xs, cs)++ , BOO4(unpack, vb, b, vbl, bl)++ , let f = (+1)+ f8 = f . c2w+ consume = foldr (\_ z -> z) (0 :: Word8)+ in boo "unpack_list_fuse" (nf (consume . map f . VSB.unpack) vb)+ (nf (consume . map f . B.unpack) b)+ (nf (consume . map f8 . VSB8.unpack) vb)+ (nf (consume . map f8 . B8.unpack) b)+ (nf (consume . map f . VSBL.unpack) vbl)+ (nf (consume . map f . BL.unpack) bl)+ (nf (consume . map f8 . VSBL8.unpack) vbl)+ (nf (consume . map f8 . BL8.unpack) bl)+++ ----------------------------------------------------------------------------+ -- * Basic interface+ ----------------------------------------------------------------------------++ , let !z = 0+ !z8 = w2c z+ in BOOA(cons, z, z8, vb, b, vbl, bl)++ , let !z = 0+ !z8 = w2c z+ in BOOB(snoc, z, z8, vb, b, vbl, bl)++ , BLOBIN(append, vb, vb, b, b, vbl, vbl, bl, bl)++ , BOO4(head, vb, b, vbl, bl)+ , BOO4(uncons, vb, b, vbl, bl)+ , BOO4(last, vb, b, vbl, bl)++ , BLO(tail, vb, b, vbl, bl)+ , BLO(init, vb, b, vbl, bl)+ , BLO(null, vb, b, vbl, bl)+ , BLO(length, vb, b, vbl, bl)+++ ----------------------------------------------------------------------------+ -- * Transforming ByteStrings+ ----------------------------------------------------------------------------++ , let f = (+1)+ f8 = w2c . f . c2w+ in BOOA(map, f, f8, vb, b, vbl, bl)++ , BLO(reverse, vb, b, vbl, bl)++ , let !z = 0+ !z8 = w2c z+ in BOOA(intersperse, z, z8, vb, b, vbl, bl)++ , let n = 100+ vbsN = List.replicate n vb+ bsN = List.replicate n b+ vblsN = List.replicate n vbl+ blsN = List.replicate n bl+ in (vbsN, bsN, vblsN, blsN) `deepseq`+ BLOBIN(intercalate, vb, vbsN, b, bsN, vbl, vblsN, bl, blsN)++ -- TODO: See if the RULE+ -- "ByteString specialise intercalate c -> intercalateByte" fires:+ , let n = 100+ vbsN = List.replicate n vb+ bsN = List.replicate n b+ !z = 0+ in (vbsN, bsN) `deepseq`+ bli "intercalate_singleton"+ (nf (VSB.intercalate (VSB.singleton z)) vbsN)+ (nf (B.intercalate ( B.singleton z)) bsN)++ , let m = 5+ vbsM = List.replicate m vb+ bsM = List.replicate m b+ vblsM = List.replicate m vbl+ blsM = List.replicate m bl+ in (vbsM, bsM, vblsM, blsM) `deepseq`+ BLO(transpose, vbsM, bsM, vblsM, blsM)+++ ----------------------------------------------------------------------------+ -- * Reducing 'ByteString's (folds)+ ----------------------------------------------------------------------------++ , let+ f y x = y + x+ f8 y x = w2c $ f (c2w y) (c2w x)+ !z = 0+ !z8 = w2c z++ -- TODO:+ -- Enabling these arguments instead of the former causes GHC to loop!!!+ -- See ticket: http://hackage.haskell.org/trac/ghc/ticket/5550++ -- f xs x = x:xs+ -- f8 xs x = x:xs+ -- z = []+ -- z8 = []++ in BOOA(foldl, f z, f8 z8, vb, b, vbl, bl)++ , let f y x = x + y+ f8 y x = w2c $ f (c2w y) (c2w x)+ !z = 0+ !z8 = w2c z+ in boo "foldl'" (nf (VSB.foldl' f z) vb)+ (nf (B.foldl' f z) b)+ (nf (VSB8.foldl' f8 z8) vb)+ (nf (B8.foldl' f8 z8) b)+ (nf (VSBL.foldl' f z) vbl)+ (nf (BL.foldl' f z) bl)+ (nf (VSBL8.foldl' f8 z8) vbl)+ (nf (BL8.foldl' f8 z8) bl)++ , let f y x = x + y+ f8 y x = w2c $ f (c2w y) (c2w x)+ n = 100000 -- TODO: Increasing this causes stack overflows in:+ -- foldl1/strict/Word8/vector !+ -- But why not in:+ -- foldl1/strict/Word8/bytestring ?+ n64 = fromIntegral n+ vb2 = VSB.take n vb+ b2 = B.take n b+ vbl2 = VSBL.take n64 vbl+ bl2 = BL.take n64 bl+ in (vb2, b2, vbl2, bl2) `deepseq`+ BOOA(foldl1, f, f8, vb2, b2, vbl2, bl2)++ , let f y x = x + y+ f8 y x = w2c $ f (c2w y) (c2w x)+ in boo "foldl1'" (nf (VSB.foldl1' f) vb)+ (nf (B.foldl1' f) b)+ (nf (VSB8.foldl1' f8) vb)+ (nf (B8.foldl1' f8) b)+ (nf (VSBL.foldl1' f) vbl)+ (nf (BL.foldl1' f) bl)+ (nf (VSBL8.foldl1' f8) vbl)+ (nf (BL8.foldl1' f8) bl)++ , let f = (:)+ f8 = (:)+ z = []+ z8 = []+ in BOOA(foldr, f z, f8 z8, vb, b, vbl, bl)++ , let f y x = x + y+ f8 y x = w2c $ f (c2w y) (c2w x)+ !z = 0+ !z8 = w2c z+ in bla "foldr'" (nf (VSB.foldr' f z) vb)+ (nf (B.foldr' f z) b)+ (nf (VSB8.foldr' f8 z8) vb)+ (nf (B8.foldr' f8 z8) b)++ , let f y x = x + y+ f8 y x = w2c $ f (c2w y) (c2w x)+ n = 100000 -- TODO: Increasing this causes stack overflows in:+ -- foldr1/strict/Char8/vector !+ -- But why not in:+ -- foldr1/strict/Char8/bytestring ?+ n64 = fromIntegral n+ vb2 = VSB.take n vb+ b2 = B.take n b+ vbl2 = VSBL.take n64 vbl+ bl2 = BL.take n64 bl+ in (vb2, b2, vbl2, bl2) `deepseq`+ BOOA(foldr1, f, f8, vb2, b2, vbl2, bl2)++ , let f y x = x + y+ f8 y x = w2c $ f (c2w y) (c2w x)+ in bla "foldr1'" (nf (VSB.foldr1' f) vb)+ (nf (B.foldr1' f) b)+ (nf (VSB8.foldr1' f8) vb)+ (nf (B8.foldr1' f8) b)++ ----------------------------------------------------------------------------+ -- ** Special folds++ , let m = 5+ vbsM = List.replicate m vb+ bsM = List.replicate m b+ vblsM = List.replicate m vbl+ blsM = List.replicate m bl+ in (vbsM, bsM, vblsM, blsM) `deepseq`+ BLO(concat, vbsM, bsM, vblsM, blsM)++ , let !r = 5+ !r64 = fromIntegral r+ in boo "concatMap" (nf (VSB.concatMap ( VSB.replicate r)) vb)+ (nf (B.concatMap ( B.replicate r)) b)+ (nf (VSB8.concatMap ( VSB8.replicate r)) vb)+ (nf (B8.concatMap ( B8.replicate r)) b)+ (nf (VSBL.concatMap ( VSBL.replicate r64)) vbl)+ (nf (BL.concatMap ( BL.replicate r64)) bl)+ (nf (VSBL8.concatMap (VSBL8.replicate r64)) vbl)+ (nf (BL8.concatMap ( BL8.replicate r64)) bl)++ , let p = (== 255)+ p8 = p . c2w+ in BOOA(any, p, p8, vb, b, vbl, bl)++ , let p = (<= 255)+ p8 = p . c2w+ in BOOA(all, p, p8, vb, b, vbl, bl)++ , BOO4(maximum, vb, b, vbl, bl)+ , BOO4(minimum, vb, b, vbl, bl)+++ ----------------------------------------------------------------------------+ -- * Building ByteStrings+ ----------------------------------------------------------------------------++ ----------------------------------------------------------------------------+ -- ** Scans++ , let f x y = x + y+ f8 x y = w2c $ f (c2w x) (c2w y)+ !z = 1+ !z8 = w2c z+ n = 1000 -- TODO: Increasing this causes stack space overflows in:+ -- scanl/lazy/Word8/vector+ -- scanl/lazy/Word8/bytestring+ -- scanl/lazy/Char8/vector+ -- scanl/lazy/Char8/bytestring+ n64 = fromIntegral n+ vb2 = VSB.take n vb+ b2 = B.take n b+ vbl2 = VSBL.take n64 vbl+ bl2 = BL.take n64 bl+ in (vb2, b2, vbl2, bl2) `deepseq`+ BOOA(scanl, f z, f8 z8, vb2, b2, vbl2, bl2)++ , let f x y = x + y+ f8 x y = w2c $ f (c2w x) (c2w y)+ in BLAA(scanl1, f, f8, vb, b)++ , let f x y = x + y+ f8 x y = w2c $ f (c2w x) (c2w y)+ !z = 1+ !z8 = w2c z+ in BLAA(scanr, f z, f8 z8, vb, b)++ , let f x y = x + y+ f8 x y = w2c $ f (c2w x) (c2w y)+ in BLAA(scanr1, f, f8, vb, b)++ ----------------------------------------------------------------------------+ -- ** Accumulating maps++ , let f acc x = (x:acc, x * x + x)+ f8 acc c = (c:acc, w2c $ c2w c * c2w c + c2w c)+ in BOOA(mapAccumL, f [], f8 [], vb, b, vbl, bl)++ , let f acc x = (x:acc, x * x + x)+ f8 acc c = (c:acc, w2c $ c2w c * c2w c + c2w c)+ in BOOA(mapAccumR, f [], f8 [], vb, b, vbl, bl)++ ----------------------------------------------------------------------------+ -- ** Generating and unfolding ByteStrings++ , let !o = 1000000+ !o64 = fromIntegral o+ !z = 0+ !z8 = w2c z+ in BOOB(replicate, z, z8, o, o, o64, o64)+ ]+ +++ ( let f :: Int -> Maybe (Word8, Int)+ f 1000000 = Nothing+ f i = Just (fromIntegral i, i+1)++ f8 :: Int -> Maybe (Char, Int)+ f8 1000000 = Nothing+ f8 i = Just (w2c $ fromIntegral i, i+1)++ in [ BOOA(unfoldr, f, f8, 0, 0, 0, 0)+ , let !k = 1000000+ in BLAA(unfoldrN, k f, k f8, 0, 0)+ ]+ ) +++++ ----------------------------------------------------------------------------+ -- * Substrings+ ----------------------------------------------------------------------------++ ----------------------------------------------------------------------------+ -- ** Breaking strings++ [ let !t = 260000+ !t64 = fromIntegral t+ in BLOSL(take, t, t64, vb, b, vbl, bl)++ , let !d = 10000+ !d64 = fromIntegral d+ in BLOSL(drop, d, d64, vb, b, vbl, bl)++ , let !s = 260000 `div` 2+ !s64 = fromIntegral s+ in BLOSL(splitAt, s, s64, vb, b, vbl, bl)++ , let p = (<= 255) -- take everything+ p8 = p . c2w+ in BOOA(takeWhile, p, p8, vb, b, vbl, bl)+ -- TODO: takeWhile/strict/Char8/vector is suspiciously fast!++ , let p = (<= 255) -- drop everything+ p8 = p . c2w+ in BOOA(dropWhile, p, p8, vb, b, vbl, bl)+ -- TODO: dropWhile/strict/Char8/vector is suspiciously fast!++ , let p = (<= 255) -- span till end+ p8 = p . c2w+ in BOOA(span, p, p8, vb, b, vbl, bl)++ -- See if the RULE: "ByteString specialise span (==x)" fires:+ , let !n = 500000+ !n64 = fromIntegral n+ !x = 1+ !y = 2+ vbSpan = VSB.replicate n x `mappend` VSB.replicate n y+ bSpan = B.replicate n x `mappend` B.replicate n y+ vblSpan = VSBL.replicate n64 x `mappend` VSBL.replicate n64 y+ blSpan = BL.replicate n64 x `mappend` BL.replicate n64 y+ p = (==x)+ p8 = p . c2w+ {-# INLINE p #-}+ {-# INLINE p8 #-}+ in (vbSpan, bSpan, vblSpan, blSpan) `deepseq`+ boo "span_eq" (nf (VSB.span p) vbSpan) -- TODO: Does the RULE fire?+ (nf (B.span p) bSpan)+ (nf (VSB8.span p8) vbSpan)+ (nf (B8.span p8) bSpan)+ (nf (VSBL.span p) vblSpan)+ (nf (BL.span p) blSpan)+ (nf (VSBL8.span p8) vblSpan)+ (nf (BL8.span p8) blSpan)++ , let p = (<= 255)+ p8 = p . c2w+ in BLAA(spanEnd, p, p8, vb, b)++ , let p = (>= 255)+ p8 = p . c2w+ in BOOA(break, p, p8, vb, b, vbl, bl)++ -- See if the RULE: "ByteString specialise break (==x)" fires:+ , let !n = 500000+ !n64 = fromIntegral n+ !x = 1+ !y = 2+ vbSpan = VSB.replicate n x `mappend` VSB.replicate n y+ bSpan = B.replicate n x `mappend` B.replicate n y+ vblSpan = VSBL.replicate n64 x `mappend` VSBL.replicate n64 y+ blSpan = BL.replicate n64 x `mappend` BL.replicate n64 y+ p = (==y)+ p8 = p . c2w+ {-# INLINE p #-}+ {-# INLINE p8 #-}+ in (vbSpan, bSpan, vblSpan, blSpan) `deepseq`+ boo "break_eq" (nf (VSB.break p) vbSpan) -- TODO: Does the RULE fire?+ (nf (B.break p) bSpan)+ (nf (VSB8.break p8) vbSpan)+ (nf (B8.break p8) bSpan)+ (nf (VSBL.break p) vblSpan)+ (nf (BL.break p) blSpan)+ (nf (VSBL8.break p8) vblSpan)+ (nf (BL8.break p8) blSpan)++ , let p = (>= 255)+ p8 = p . c2w+ in BLAA(breakEnd, p, p8, vb, b)++ , BLO(group, vb, b, vbl, bl)++ , let r x y = x < y+ r8 x y = r (c2w x) (c2w y)+ in BOOA(groupBy, r, r8, vb, b, vbl, bl)++ , BLO(inits, vb, b, vbl, bl)+ , BLO(tails, vb, b, vbl, bl)++ ----------------------------------------------------------------------------+ -- ** Breaking into many substrings++ , let !nlWord = c2w nlChar+ !nlChar = '\n'+ in BOOA(split, nlWord, nlChar, vb, b, vbl, bl)++ , let !w = c2w 'k'+ p = (>=w)+ p8 = p . c2w+ in BOOA(splitWith, p, p8, vb, b, vbl, bl)++ -- See if the RULE: "ByteString specialise splitWith (==x)" fires:+ , let !nlWord = c2w nlChar+ !nlChar = '\n'+ p = (==nlWord)+ p8 = p . c2w+ {-# INLINE p #-}+ {-# INLINE p8 #-}+ in boo "splitWith_eq"+ (nf (VSB.splitWith p) vb) -- TODO: Should be as fast as split+ -- but isn't !!!+ (nf (B.splitWith p) b)+ (nf (VSB8.splitWith p8) vb)+ (nf (B8.splitWith p8) b)+ (nf (VSBL.splitWith p) vbl)+ (nf (BL.splitWith p) bl)+ (nf (VSBL8.splitWith p8) vbl)+ (nf (BL8.splitWith p8) bl)+++ ----------------------------------------------------------------------------+ -- * Predicates+ ----------------------------------------------------------------------------++ , let p = 1+ p64 = fromIntegral p+ vbp = VSB.take p vb+ bp = B.take p b+ vblp = VSBL.take p64 vbl+ blp = BL.take p64 bl+ in (vbp, bp, vblp, blp) `deepseq`+ BLOBIN(isPrefixOf, vbp, vb, bp, b, vblp, vbl, blp, bl)++ , let p = VSB.length vb - 1+ vbp = VSB.drop p vb+ bp = B.drop p b+ in (vbp, bp) `deepseq`+ bli "isSuffixOf" (nf (VSB.isSuffixOf vbp) vb)+ (nf (B.isSuffixOf bp) b)++ , let p = 100+ m = VSB.length vb `div` 2+ n = m - p+ o = 2 * p+ vbp = VSB.take o (VSB.drop n vb)+ bp = B.take o (B.drop n b)+ in (vbp, bp) `deepseq`+ bli "isInfixOf" (nf (VSB.isInfixOf vbp) vb)+ (nf (B.isInfixOf bp) b)++ ----------------------------------------------------------------------------+ -- ** Search for arbitrary substrings++ , let p = 100+ m = VSB.length vb `div` 2+ n = m - p+ o = 2 * p+ vbp = VSB.take o (VSB.drop n vb)+ bp = B.take o (B.drop n b)+ in (vbp, bp) `deepseq`+ bli "breakSubstring" (nf (VSB.breakSubstring vbp) vb)+ (nf (B.breakSubstring bp) b)++ , let p = 100+ m = VSB.length vb `div` 2+ n = m - p+ o = 2 * p+ vbp = VSB.take o (VSB.drop n vb)+ bp = B.take o (B.drop n b)+ in (vbp, bp) `deepseq`+ bli "findSubstring" (nf (VSB.findSubstring vbp) vb)+ (nf (B.findSubstring bp) b)++ , let s = "the"+ vbp = VSB8.pack s+ bp = B8.pack s+ in (vbp, bp) `deepseq`+ bli "findSubstrings" (nf (VSB.findSubstrings vbp) vb)+ (nf (B.findSubstrings bp) b)+++ ----------------------------------------------------------------------------+ -- * Searching ByteStrings+ ----------------------------------------------------------------------------++ ----------------------------------------------------------------------------+ -- ** Searching by equality++ , let !a = 255+ !a8 = w2c a+ in BOOA(elem, a, a8, vb, b, vbl, bl)++ , let !a = 255+ !a8 = w2c a+ in BOOA(notElem, a, a8, vb, b, vbl, bl)++ ----------------------------------------------------------------------------+ -- ** Searching with a predicate++ , let p = (==255)+ p8 = p . c2w+ in BOOA(find, p, p8, vb, b, vbl, bl)++ , let p = p8 . w2c+ p8 = isUpper+ in BOOA(filter, p, p8, vb, b, vbl, bl)++ , let p = isUpper . w2c+ in blo "partition" (nf (VSB.partition p) vb)+ (nf (B.partition p) b)+ (nf (VSBL.partition p) vbl)+ (nf (BL.partition p) bl)+++ ----------------------------------------------------------------------------+ -- * Indexing ByteStrings+ ----------------------------------------------------------------------------++ , let !ix = VSB.length vb - 1+ !ix64 = fromIntegral ix+ in blo "index" (nf (VSB.index vb) ix)+ (nf (B.index b) ix)+ (nf (VSBL.index vbl) ix64)+ (nf (BL.index bl) ix64)++ , let !a = 255+ !a8 = w2c a+ in BOOA(elemIndex, a, a8, vb, b, vbl, bl)++ , let !a = c2w a8+ !a8 = 'a'+ in BOOA(elemIndices, a, a8, vb, b, vbl, bl)++ , let !a = 255+ !a8 = w2c a+ in BLAA(elemIndexEnd, a, a8, vb, b)++ , let p = (==255)+ p8 = p . c2w+ in BOOA(findIndex, p, p8, vb, b, vbl, bl)++ , let p = p8 . w2c+ p8 = isUpper+ in BOOA(findIndices, p, p8, vb, b, vbl, bl)++ , let !c = c2w c8+ !c8 = 'a'+ in BOOA(count, c, c8, vb, b, vbl, bl)+++ ----------------------------------------------------------------------------+ -- * Zipping and unzipping ByteStrings+ ----------------------------------------------------------------------------++ , boo "zip" (nf (VSB.zip vb) vb)+ (nf (B.zip b) b)+ (nf (VSB8.zip vb) vb)+ (nf (B8.zip b) b)+ (nf (VSBL.zip vbl) vbl)+ (nf (BL.zip bl) bl)+ (nf (VSBL8.zip vbl) vbl)+ (nf (BL8.zip bl) bl)++ , let f x y = fromIntegral x + fromIntegral y :: Int+ f8 x y = f (c2w x) (c2w y)+ in boo "zipWith" (nf (VSB.zipWith f vb) vb)+ (nf (B.zipWith f b) b)+ (nf (VSB8.zipWith f8 vb) vb)+ (nf (B8.zipWith f8 b) b)+ (nf (VSBL.zipWith f vbl) vbl)+ (nf (BL.zipWith f bl) bl)+ (nf (VSBL8.zipWith f8 vbl) vbl)+ (nf (BL8.zipWith f8 bl) bl)++ -- See if the RULE "ByteString specialise zipWith" fires:+ , let f x y = x + y :: Word8+ f8 x y = f (c2w x) (c2w y)+ in boo "zipWith_Word8"+ (nf (VSB.zipWith f vb) vb) -- TODO: Does the RULE fire?+ (nf (B.zipWith f b) b)+ (nf (VSB8.zipWith f8 vb) vb)+ (nf (B8.zipWith f8 b) b)+ (nf (VSBL.zipWith f vbl) vbl)+ (nf (BL.zipWith f bl) bl)+ (nf (VSBL8.zipWith f8 vbl) vbl)+ (nf (BL8.zipWith f8 bl) bl)++ , let xs = VSB.zip vb vb+ xs8 = VSB8.zip vb vb+ in (xs, xs8) `deepseq`+ bgroup "unzip"+ [ bgroup "strict" $ foo (nf VSB.unzip xs)+ (nf B.unzip xs)+ (nf VSB8.unzip xs8)+ (nf B8.unzip xs8)+ , bgroup "lazy"+ [ bgroup "Word8" $ bar (nf VSBL.unzip xs)+ (nf BL.unzip xs)+ ]+ ]+++ ----------------------------------------------------------------------------+ -- * Ordered ByteStrings+ ----------------------------------------------------------------------------++ , bli "sort" (nf VSB.sort vb)+ (nf B.sort b)+++ ----------------------------------------------------------------------------+ -- * Low level conversions+ ----------------------------------------------------------------------------++ , BLO(copy, vb, b, vbl, bl)++ ----------------------------------------------------------------------------+ -- ** Packing 'CString's and pointers++ , let str = VSB8.unpack vb -- "I'm going to be a CString, Yippy!!"+ doPackCString packCString =+ withCString str $ \cStr ->+ packCString cStr >>= deepEvaluate+ in str `deepseq`+ bli "packCString" (doPackCString VSB.packCString)+ (doPackCString B.packCString)++ , let str = VSB8.unpack vb -- "I'm going to be a CString, Yippy!!"+ doPackCStringLen packCStringLen =+ withCStringLen str $ \cStrLen ->+ packCStringLen cStrLen >>= deepEvaluate+ in str `deepseq`+ bli "packCStringLen" (doPackCStringLen VSB.packCStringLen)+ (doPackCStringLen B.packCStringLen)++ ----------------------------------------------------------------------------+ -- ** Using ByteStrings as 'CString's++ , let f _ = return ()+ in bli "useAsCString" (VSB.useAsCString vb f)+ ( B.useAsCString b f)++ , let f _ = return ()+ in bli "useAsCStringLen" (VSB.useAsCStringLen vb f)+ ( B.useAsCStringLen b f)+++ ----------------------------------------------------------------------------+ -- * I\/O with 'ByteString's+ ----------------------------------------------------------------------------++ , let doReadFile readF = readF dict >>= deepEvaluate+ in blo "readFile" (doReadFile VSB.readFile)+ (doReadFile B.readFile)+ (doReadFile VSBL.readFile)+ (doReadFile BL.readFile)++ , let devnull = "/dev/null"+ in blo "writeFile" ( VSB.writeFile devnull vb)+ ( B.writeFile devnull b)+ (VSBL.writeFile devnull vbl)+ ( BL.writeFile devnull bl)++ , let doHGetContents f = withFile dict ReadMode $ \h -> f h >>= deepEvaluate+ in blo "hGetContents" (doHGetContents VSB.hGetContents)+ (doHGetContents B.hGetContents)+ (doHGetContents VSBL.hGetContents)+ (doHGetContents BL.hGetContents)+++ ----------------------------------------------------------------------------+ -- * Low level introduction and elimination+ ----------------------------------------------------------------------------++ , let !n = 1000000+ f _ = return ()+ doCreate create = create n f >>= deepEvaluate+ in bli "create" (doCreate VSBI.create)+ (doCreate BI.create)++ , let !n = 1000000+ f _ = return 500000+ doCreateAndTrim createAndTrim = createAndTrim n f >>= deepEvaluate+ in bli "createAndTrim" (doCreateAndTrim VSBI.createAndTrim)+ (doCreateAndTrim BI.createAndTrim)+++ ----------------------------------------------------------------------------+ -- * Unchecked access+ ----------------------------------------------------------------------------++ , bli "unsafeHead" (nf VSBU.unsafeHead vb)+ (nf BU.unsafeHead b)++ , bli "unsafeTail" (nf VSBU.unsafeTail vb)+ (nf BU.unsafeTail b)++ , let !ix = 1000+ in bli "unsafeIndex" (nf (VSBU.unsafeIndex vb) ix)+ (nf (BU.unsafeIndex b) ix)++ , let !n = VSB.length vb `div` 2+ in bli "unsafeTake" (nf (VSBU.unsafeTake n) vb)+ (nf (BU.unsafeTake n) b)++ , let !n = VSB.length vb `div` 2+ in bli "unsafeDrop" (nf (VSBU.unsafeDrop n) vb)+ (nf (BU.unsafeDrop n) b)+++ ----------------------------------------------------------------------------+ -- Benchmarking fusion+ ----------------------------------------------------------------------------++ , bgroup "fusion" $+ let fuse name f g = bgroup name $ bar (nf f vb)+ (nf g b)+ in [ bgroup "non_directional"+ [ fuse "map-map" (VSB.map (*2) . VSB.map (+4))+ ( B.map (*2) . B.map (+4))+ , fuse "filter-filter" (VSB.filter (/=101) . VSB.filter (/=102))+ ( B.filter (/=101) . B.filter (/=102))+ , fuse "filter-map" (VSB.filter (/=103) . VSB.map (+5))+ ( B.filter (/=103) . B.map (+5))+ , fuse "map-filter" (VSB.map (*3) . VSB.filter (/=104))+ ( B.map (*3) . B.filter (/=104))+ , fuse "map-noacc" ((VSB.map (+1) . VSB.filter (/=112)) . VSB.map (*2))+ (( B.map (+1) . B.filter (/=112)) . B.map (*2))+ , fuse "noacc-map" (VSB.map (+1) . (VSB.map (+2) . VSB.filter (/=113)))+ ( B.map (+1) . ( B.map (+2) . B.filter (/=113)))+ , fuse "filter-noacc" ((VSB.map (+1) . VSB.filter (/=101)) . VSB.filter (/=114))+ (( B.map (+1) . B.filter (/=101)) . B.filter (/=114))+ , fuse "noacc-filter" (VSB.filter (/=101) . (VSB.map (*2) . VSB.filter (/=115)))+ ( B.filter (/=101) . ( B.map (*2) . B.filter (/=115)))+ , fuse "noacc-noacc" ((VSB.map (*3) . VSB.filter (/=108)) . (VSB.map (*4) . VSB.filter (/=109)))+ (( B.map (*3) . B.filter (/=108)) . ( B.map (*4) . B.filter (/=109)))+ ]++ , bgroup "up_loops"+ [ fuse "up-up" (VSB.foldl' (const.(+1)) (0::Int) . VSB.scanl (flip const) (0::Word8))+ ( B.foldl' (const.(+1)) (0::Int) . B.scanl (flip const) (0::Word8))+ , fuse "map-up" (VSB.foldl' (const.(+6)) (0::Int) . VSB.map (*4))+ ( B.foldl' (const.(+6)) (0::Int) . B.map (*4))+ , fuse "up-map" (VSB.map (+7) . VSB.scanl const (0::Word8))+ ( B.map (+7) . B.scanl const (0::Word8))+ , fuse "filter-up" (VSB.foldl' (const.(+8)) (0::Int) . VSB.filter (/=105))+ ( B.foldl' (const.(+8)) (0::Int) . B.filter (/=105))+ , fuse "up-filter" (VSB.filter (/=106) . VSB.scanl (flip const) (0::Word8))+ ( B.filter (/=106) . B.scanl (flip const) (0::Word8))+ , fuse "noacc-up" (VSB.foldl' (const.(+1)) (0::Word8) . (VSB.map (+1) . VSB.filter (/=110)))+ ( B.foldl' (const.(+1)) (0::Word8) . ( B.map (+1) . B.filter (/=110)))+ , fuse "up-noacc" ((VSB.map (+1) . VSB.filter (/=111)) . VSB.scanl (flip const) (0::Word8))+ (( B.map (+1) . B.filter (/=111)) . B.scanl (flip const) (0::Word8))+ ]++ , bgroup "down_loops"+ [ fuse "down-down" (VSB.foldr (const (+9)) (0::Word8) . VSB.scanr const (0::Word8))+ ( B.foldr (const (+9)) (0::Word8) . B.scanr const (0::Word8))+ , fuse "map-down" (VSB.foldr (const (+10)) (0::Word8) . VSB.map (*2))+ ( B.foldr (const (+10)) (0::Word8) . B.map (*2))+ , fuse "down-map" (VSB.map (*2) . VSB.scanr const (0::Word8))+ ( B.map (*2) . B.scanr const (0::Word8))+ , fuse "filter-down" (VSB.foldr (const (+11)) (0::Word8) . VSB.filter (/=106))+ ( B.foldr (const (+11)) (0::Word8) . B.filter (/=106))+ , fuse "down-filter" (VSB.filter (/=107) . VSB.scanr const (0::Word8))+ ( B.filter (/=107) . B.scanr const (0::Word8))+ , fuse "noacc-down" (VSB.foldr (const (+1)) (0::Word8) . (VSB.map (+1) . VSB.filter (/=116)))+ ( B.foldr (const (+1)) (0::Word8) . ( B.map (+1) . B.filter (/=116)))+ , fuse "down-noacc" ((VSB.map (+1) . VSB.filter (/=101)) . VSB.scanr const (0::Word8))+ (( B.map (+1) . B.filter (/=101)) . B.scanr const (0::Word8))+ ]++ , bgroup "misc"+ [ fuse "length-loop" (VSB.length . VSB.filter (/=105))+ ( B.length . B.filter (/=105))+ , fuse "maximum-loop" (VSB.maximum . VSB.map (*4))+ ( B.maximum . B.map (*4))+ , fuse "minimum-loop" (VSB.minimum . VSB.map (+6))+ ( B.minimum . B.map (+6))+ ]++ , bgroup "big"+ [ fuse "big_map-map" (VSB.map (subtract 3) . VSB.map (+7) . VSB.map (*2) . VSB.map (+4))+ ( B.map (subtract 3) . B.map (+7) . B.map (*2) . B.map (+4))+ , fuse "big_filter-filter" (VSB.filter (/=103) . VSB.filter (/=104) . VSB.filter (/=101) . VSB.filter (/=102))+ ( B.filter (/=103) . B.filter (/=104) . B.filter (/=101) . B.filter (/=102))+ , fuse "big_filter-map" (VSB.map (*2) . VSB.filter (/=104) . VSB.map (+6) . VSB.filter (/=103) . VSB.map (+5))+ ( B.map (*2) . B.filter (/=104) . B.map (+6) . B.filter (/=103) . B.map (+5))+ ]+ ]+++ ----------------------------------------------------------------------------+ -- Benchmarking "real world" programs+ ----------------------------------------------------------------------------++ , bgroup "real_world"+ [ bli "letter_freq" ( VSB.readFile dict >>=+ deepEvaluate . sortBy (\x y -> snd y `compare` snd x)+ . map (\x -> (w2c . VSBU.unsafeHead $ x, VSB8.length x))+ . VSB8.group+ . VSB8.sort+ . VSB8.map toLower+ . VSB8.filter isAlpha )+ ( B.readFile dict >>=+ deepEvaluate . sortBy (\x y -> snd y `compare` snd x)+ . map (\x -> (w2c . BU.unsafeHead $ x, B8.length x))+ . B8.group+ . B8.sort+ . B8.map toLower+ . B8.filter isAlpha )+ ]+ ]+++--------------------------------------------------------------------------------+-- Grouping+--------------------------------------------------------------------------------++boo :: Benchmarkable b => String -> b -> b -> b -> b -> b -> b -> b -> b -> Benchmark+boo name vb b+ vb8 b8+ vbl bl+ vbl8 bl8 =+ bgroup name [ bgroup "strict" $ foo vb b+ vb8 b8+ , bgroup "lazy" $ foo vbl bl+ vbl8 bl8+ ]++blo :: Benchmarkable b => String -> b -> b -> b -> b -> Benchmark+blo name vb b+ vbl bl = bgroup name [ bgroup "strict" $ bar vb b+ , bgroup "lazy" $ bar vbl bl+ ]++bla :: Benchmarkable b => String -> b -> b -> b -> b -> Benchmark+bla name vb b+ vb8 b8 = bgroup name [ bgroup "strict" $ foo vb b+ vb8 b8+ ]++bli :: Benchmarkable b => String -> b -> b -> Benchmark+bli name vb b = bgroup name $ bar vb b++--------------------------------------------------------------------------------++foo :: Benchmarkable b => b -> b -> b -> b -> [Benchmark]+foo vb b+ vb8 b8 = [ bgroup "Word8" $ bar vb b+ , bgroup "Char8" $ bar vb8 b8+ ]++bar :: Benchmarkable b => b -> b -> [Benchmark]+bar vb b = [ bench "vector" vb+ , bench "bytestring" b+ ]+++--------------------------------------------------------------------------------+-- Orphaned NFData instances for legacy ByteStrings+--------------------------------------------------------------------------------++instance NFData B.ByteString++instance NFData BL.ByteString where+ rnf BLI.Empty = ()+ rnf (BLI.Chunk _ cs) = rnf cs
tests/QuickCheckUtils.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, OverlappingInstances #-}+ -- -- Uses multi-param type classes --@@ -74,17 +75,20 @@ ------------------------------------------------------------------------ -instance Random Word8 where- randomR = integralRandomR- random = randomR (minBound,maxBound)+-- TODO: File bug report that the following macro is not generated by cabal:+-- #if !MIN_VERSION_random(1,0,1)+-- instance Random Word8 where+-- randomR = integralRandomR+-- random = randomR (minBound,maxBound) -instance Random CChar where- randomR = integralRandomR- random = randomR (minBound,maxBound)+-- instance Random CChar where+-- randomR = integralRandomR+-- random = randomR (minBound,maxBound) -instance Random Int64 where- randomR = integralRandomR- random = randomR (minBound,maxBound)+-- instance Random Int64 where+-- randomR = integralRandomR+-- random = randomR (minBound,maxBound)+-- #endif integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g) integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
vector-bytestring.cabal view
@@ -1,5 +1,5 @@ name: vector-bytestring-version: 0.0.0.0+version: 0.0.0.1 cabal-version: >=1.9.2 build-type: Simple license: BSD3@@ -7,7 +7,7 @@ copyright: 2011 Bas van Dijk <v.dijk.bas@gmail.com> author: Bas van Dijk <v.dijk.bas@gmail.com> maintainer: Bas van Dijk <v.dijk.bas@gmail.com>-homepage: https://github.com/basvandijk/vector-bytestring/+homepage: https://github.com/basvandijk/vector-bytestring bug-reports: https://github.com/basvandijk/vector-bytestring/issues stability: experimental category: Data@@ -33,11 +33,11 @@ Default: False Library- build-depends: base >= 4 && < 4.5+ build-depends: base >= 4 && < 4.6 , primitive >= 0.3.1 && < 0.5 , ghc-prim >= 0.2 && < 0.3- , vector >= 0.9 && < 0.10- , deepseq >= 1.1 && < 1.3+ , vector >= 0.9.1 && < 0.10+ , deepseq >= 1.1 && < 1.4 , bytestring >= 0.9 && < 0.10 exposed-modules: Data.Vector.Storable.ByteString@@ -50,8 +50,6 @@ Data.Vector.Storable.ByteString.Lazy.Char8 Data.Vector.Storable.ByteString.Lazy.Legacy - other-modules: Utils- ghc-options: -Wall -O2 -funbox-strict-fields c-sources: cbits/bytestring.c@@ -60,37 +58,30 @@ install-includes: bytestring.h test-suite prop-compiled- type: exitcode-stdio-1.0- main-is: Properties.hs- hs-source-dirs: . tests+ type: exitcode-stdio-1.0 - build-depends: base >= 4 && < 4.5- , primitive >= 0.3.1 && < 0.5- , ghc-prim >= 0.2 && < 0.3- , vector >= 0.9 && < 0.10- , deepseq >= 1.1 && < 1.3- , random >= 1.0 && < 1.1+ main-is: Properties.hs+ hs-source-dirs: tests++ build-depends: vector-bytestring+ , base >= 4 && < 4.6+ , random >= 1.0.1 && < 1.1 , directory >= 1.0 && < 1.2 , QuickCheck >= 2.3 && < 3 - ghc-options: -fno-enable-rewrite-rules- c-sources: cbits/bytestring.c- include-dirs: include+ ghc-options: -fno-enable-rewrite-rules executable bench if !flag(benchmark) buildable: False - main-is: bench.hs+ main-is: bench.hs+ hs-source-dirs: bench - build-depends: base >= 4 && < 4.5- , primitive >= 0.3.1 && < 0.5- , ghc-prim >= 0.2 && < 0.3- , vector >= 0.9 && < 0.10- , deepseq >= 1.1 && < 1.3+ build-depends: vector-bytestring+ , base >= 4 && < 4.6+ , deepseq >= 1.1 && < 1.4 , bytestring >= 0.9 && < 0.10- , criterion >= 0.5 && < 0.6+ , criterion >= 0.5 && < 0.7 - ghc-options: -Wall -O2 -funbox-strict-fields- c-sources: cbits/bytestring.c- include-dirs: include+ ghc-options: -Wall -O2 -funbox-strict-fields