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