diff --git a/Data/Vector/Storable/ByteString.hs b/Data/Vector/Storable/ByteString.hs --- a/Data/Vector/Storable/ByteString.hs +++ b/Data/Vector/Storable/ByteString.hs @@ -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 diff --git a/Data/Vector/Storable/ByteString/Char8.hs b/Data/Vector/Storable/ByteString/Char8.hs --- a/Data/Vector/Storable/ByteString/Char8.hs +++ b/Data/Vector/Storable/ByteString/Char8.hs @@ -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' diff --git a/Data/Vector/Storable/ByteString/Internal.hs b/Data/Vector/Storable/ByteString/Internal.hs --- a/Data/Vector/Storable/ByteString/Internal.hs +++ b/Data/Vector/Storable/ByteString/Internal.hs @@ -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) diff --git a/Data/Vector/Storable/ByteString/Lazy.hs b/Data/Vector/Storable/ByteString/Lazy.hs --- a/Data/Vector/Storable/ByteString/Lazy.hs +++ b/Data/Vector/Storable/ByteString/Lazy.hs @@ -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 diff --git a/Data/Vector/Storable/ByteString/Lazy/Char8.hs b/Data/Vector/Storable/ByteString/Lazy/Char8.hs --- a/Data/Vector/Storable/ByteString/Lazy/Char8.hs +++ b/Data/Vector/Storable/ByteString/Lazy/Char8.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP, BangPatterns #-} + +#if __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE Trustworthy #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} -- | diff --git a/Data/Vector/Storable/ByteString/Lazy/Internal.hs b/Data/Vector/Storable/ByteString/Lazy/Internal.hs --- a/Data/Vector/Storable/ByteString/Lazy/Internal.hs +++ b/Data/Vector/Storable/ByteString/Lazy/Internal.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} + +#if __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE Unsafe #-} +#endif -- | -- Module : Data.Vector.Storable.ByteString.Lazy.Internal diff --git a/Data/Vector/Storable/ByteString/Lazy/Legacy.hs b/Data/Vector/Storable/ByteString/Lazy/Legacy.hs --- a/Data/Vector/Storable/ByteString/Lazy/Legacy.hs +++ b/Data/Vector/Storable/ByteString/Lazy/Legacy.hs @@ -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). diff --git a/Data/Vector/Storable/ByteString/Legacy.hs b/Data/Vector/Storable/ByteString/Legacy.hs --- a/Data/Vector/Storable/ByteString/Legacy.hs +++ b/Data/Vector/Storable/ByteString/Legacy.hs @@ -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). diff --git a/Data/Vector/Storable/ByteString/Unsafe.hs b/Data/Vector/Storable/ByteString/Unsafe.hs --- a/Data/Vector/Storable/ByteString/Unsafe.hs +++ b/Data/Vector/Storable/ByteString/Unsafe.hs @@ -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 #-} diff --git a/Utils.hs b/Utils.hs deleted file mode 100644 --- a/Utils.hs +++ /dev/null @@ -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 #-} diff --git a/bench.hs b/bench.hs deleted file mode 100644 --- a/bench.hs +++ /dev/null @@ -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 diff --git a/bench/bench.hs b/bench/bench.hs new file mode 100644 --- /dev/null +++ b/bench/bench.hs @@ -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 diff --git a/tests/QuickCheckUtils.hs b/tests/QuickCheckUtils.hs --- a/tests/QuickCheckUtils.hs +++ b/tests/QuickCheckUtils.hs @@ -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, diff --git a/vector-bytestring.cabal b/vector-bytestring.cabal --- a/vector-bytestring.cabal +++ b/vector-bytestring.cabal @@ -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 author: Bas van Dijk maintainer: Bas van Dijk -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