{-# 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