Source

text / tests / Benchmarks.hs

The default branch has multiple heads

{-# LANGUAGE GADTs, MagicHash #-}

import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.ByteString.Lazy.Internal as BL
import Control.Monad.Trans (liftIO)
import Control.Exception (evaluate)
import Criterion.Main
import Data.Char
import qualified Codec.Binary.UTF8.Generic as UTF8
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import qualified Data.List as L
import qualified Data.Text.Encoding as TS
import qualified Data.Text.Lazy.Encoding as TL
import qualified Criterion.MultiMap as M
import Criterion.Config
import GHC.Base


myConfig
    | False     = defaultConfig {
                    -- Always display an 800x600 window.
                    cfgPlot = M.singleton KernelDensity (Window 800 600)
                  }
    | otherwise = defaultConfig

instance NFData BS.ByteString

instance NFData BL.ByteString where
    rnf BL.Empty        = ()
    rnf (BL.Chunk _ ts) = rnf ts

data B where
    B :: NFData a => a -> B

instance NFData B where
    rnf (B b) = rnf b

main = do
  bsa <- BS.readFile "text/test/russian.txt"
  let tsa     = TS.decodeUtf8 bsa
      tsb     = TS.toUpper tsa
      tla     = TL.fromChunks (TS.chunksOf 16376 tsa)
      tlb     = TL.fromChunks (TS.chunksOf 16376 tsb)
      bsb     = TS.encodeUtf8 tsb
      bla     = BL.fromChunks (chunksOf 16376 bsa)
      blb     = BL.fromChunks (chunksOf 16376 bsb)
      bsa_len = BS.length bsa
      tsa_len = TS.length tsa
      bla_len = BL.length bla
      tla_len = TL.length tla
      la      = UTF8.toString bsa
      la_len  = L.length la
      tsb_len = TS.length tsb
      lb      = TS.unpack tsb
      bsl     = BS.lines bsa
      bll     = BL.lines bla
      tsl     = TS.lines tsa
      tll     = TL.lines tla
      ll      = L.lines la
  defaultMainWith
    myConfig
    (liftIO . evaluate $
     rnf [B tsa, B tsb, B tla, B tlb, B bsa, B bsb, B bla, B blb,
          B bsa_len, B tsa_len, B bla_len, B tla_len, B la, B la_len,
          B tsb_len, B lb, B bsl, B bll, B tsl, B tll, B ll])
    [
      bgroup "append" [
        bench "ts" $ nf (TS.append tsb) tsa
      , bench "tl" $ nf (TL.append tlb) tla
      , bench "bs" $ nf (BS.append bsb) bsa
      , bench "bl" $ nf (BL.append blb) bla
      , bench "l" $ nf ((++) lb) la
      ],
      bgroup "concat" [
        bench "ts" $ nf TS.concat tsl
      , bench "tl" $ nf TL.concat tll
      , bench "bs" $ nf BS.concat bsl
      , bench "bl" $ nf BL.concat bll
      , bench "l" $ nf L.concat ll
      ],
      bgroup "cons" [
        bench "ts" $ nf (TS.cons c) tsa
      , bench "tl" $ nf (TL.cons c) tla
      , bench "bs" $ nf (BS.cons c) bsa
      , bench "bl" $ nf (BL.cons c) bla
      , bench "l" $ nf (c:) la
      ],
      bgroup "concatMap" [
        bench "ts" $ nf (TS.concatMap (TS.replicate 3 . TS.singleton)) tsa
      , bench "tl" $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla
      , bench "bs" $ nf (BS.concatMap (BS.replicate 3)) bsa
      , bench "bl" $ nf (BL.concatMap (BL.replicate 3)) bla
      , bench "l" $ nf (L.concatMap (L.replicate 3 . (:[]))) la
      ],
      bgroup "decode" [
        bench "ts" $ nf TS.decodeUtf8 bsa
      , bench "tl" $ nf TL.decodeUtf8 bla
      , bench "bs" $ nf BS.unpack bsa
      , bench "bl" $ nf BL.unpack bla
      , bench "l" $ nf UTF8.toString bsa
      ],
      bgroup "drop" [
        bench "ts" $ nf (TS.drop (tsa_len `div` 3)) tsa
      , bench "tl" $ nf (TL.drop (tla_len `div` 3)) tla
      , bench "bs" $ nf (BS.drop (bsa_len `div` 3)) bsa
      , bench "bl" $ nf (BL.drop (bla_len `div` 3)) bla
      , bench "l" $ nf (L.drop (la_len `div` 3)) la
      ],
      bgroup "filter" [
        bench "ts" $ nf (TS.filter p0) tsa
      , bench "tl" $ nf (TL.filter p0) tla
      , bench "bs" $ nf (BS.filter p0) bsa
      , bench "bl" $ nf (BL.filter p0) bla
      , bench "l" $ nf (L.filter p0) la
      ],
      bgroup "filter.filter" [
        bench "ts" $ nf (TS.filter p1 . TS.filter p0) tsa
      , bench "tl" $ nf (TL.filter p1 . TL.filter p0) tla
      , bench "bs" $ nf (BS.filter p1 . BS.filter p0) bsa
      , bench "bl" $ nf (BL.filter p1 . BL.filter p0) bla
      , bench "l" $ nf (L.filter p1 . L.filter p0) la
      ],
      bgroup "foldl'" [
        bench "ts" $ nf (TS.foldl' len 0) tsa
      , bench "tl" $ nf (TL.foldl' len 0) tla
      , bench "bs" $ nf (BS.foldl' len 0) bsa
      , bench "bl" $ nf (BL.foldl' len 0) bla
      , bench "l" $ nf (L.foldl' len 0) la
      ],
      bgroup "foldr" [
        bench "ts" $ nf (L.length . TS.foldr (:) []) tsa
      , bench "tl" $ nf (L.length . TL.foldr (:) []) tla
      , bench "bs" $ nf (L.length . BS.foldr (:) []) bsa
      , bench "bl" $ nf (L.length . BL.foldr (:) []) bla
      , bench "l" $ nf (L.length . L.foldr (:) []) la
      ],
      bgroup "head" [
        bench "ts" $ nf TS.head tsa
      , bench "tl" $ nf TL.head tla
      , bench "bs" $ nf BS.head bsa
      , bench "bl" $ nf BL.head bla
      , bench "l" $ nf L.head la
      ],
      bgroup "init" [
        bench "ts" $ nf TS.init tsa
      , bench "tl" $ nf TL.init tla
      , bench "bs" $ nf BS.init bsa
      , bench "bl" $ nf BL.init bla
      , bench "l" $ nf L.init la
      ],
      bgroup "intercalate" [
        bench "ts" $ nf (TS.intercalate tsw) tsl
      , bench "tl" $ nf (TL.intercalate tlw) tll
      , bench "bs" $ nf (BS.intercalate bsw) bsl
      , bench "bl" $ nf (BL.intercalate blw) bll
      , bench "l" $ nf (L.intercalate lw) ll
      ],
      bgroup "intersperse" [
        bench "ts" $ nf (TS.intersperse c) tsa
      , bench "tl" $ nf (TL.intersperse c) tla
      , bench "bs" $ nf (BS.intersperse c) bsa
      , bench "bl" $ nf (BL.intersperse c) bla
      , bench "l" $ nf (L.intersperse c) la
      ],
      bgroup "isInfixOf" [
        bench "ts" $ nf (TS.isInfixOf tsw) tsa
      , bench "tl" $ nf (TL.isInfixOf tlw) tla
      , bench "bs" $ nf (BS.isInfixOf bsw) bsa
        -- no isInfixOf for lazy bytestrings
      , bench "l" $ nf (L.isInfixOf lw) la
      ],
      bgroup "last" [
        bench "ts" $ nf TS.last tsa
      , bench "tl" $ nf TL.last tla
      , bench "bs" $ nf BS.last bsa
      , bench "bl" $ nf BL.last bla
      , bench "l" $ nf L.last la
      ],
      bgroup "map" [
        bench "ts" $ nf (TS.map f) tsa
      , bench "tl" $ nf (TL.map f) tla
      , bench "bs" $ nf (BS.map f) bsa
      , bench "bl" $ nf (BL.map f) bla
      , bench "l" $ nf (L.map f) la
      ],
      bgroup "map.map" [
        bench "ts" $ nf (TS.map f . TS.map f) tsa
      , bench "tl" $ nf (TL.map f . TL.map f) tla
      , bench "bs" $ nf (BS.map f . BS.map f) bsa
      , bench "bl" $ nf (BL.map f . BL.map f) bla
      , bench "l" $ nf (L.map f . L.map f) la
      ],
      bgroup "replicate char" [
        bench "ts" $ nf (TS.replicate bsa_len) (TS.singleton c)
      , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
      , bench "bs" $ nf (BS.replicate bsa_len) c
      , bench "bl" $ nf (BL.replicate (fromIntegral bsa_len)) c
      , bench "l" $ nf (L.replicate bsa_len) c
      ],
      bgroup "replicate string" [
        bench "ts" $ nf (TS.replicate (bsa_len `div` TS.length tsw)) tsw
      , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
      , bench "l" $ nf (replicat (bsa_len `div` TS.length tsw)) lw
      ],
      bgroup "reverse" [
        bench "ts" $ nf TS.reverse tsa
      , bench "tl" $ nf TL.reverse tla
      , bench "bs" $ nf BS.reverse bsa
      , bench "bl" $ nf BL.reverse bla
      , bench "l" $ nf L.reverse la
      ],
      bgroup "take" [
        bench "ts" $ nf (TS.take (tsa_len `div` 3)) tsa
      , bench "tl" $ nf (TL.take (tla_len `div` 3)) tla
      , bench "bs" $ nf (BS.take (bsa_len `div` 3)) bsa
      , bench "bl" $ nf (BL.take (bla_len `div` 3)) bla
      , bench "l" $ nf (L.take (la_len `div` 3)) la
      ],
      bgroup "tail" [
        bench "ts" $ nf TS.tail tsa
      , bench "tl" $ nf TL.tail tla
      , bench "bs" $ nf BS.tail bsa
      , bench "bl" $ nf BL.tail bla
      , bench "l" $ nf L.tail la
      ],
      bgroup "toLower" [
        bench "ts" $ nf TS.toLower tsa
      , bench "tl" $ nf TL.toLower tla
      , bench "bs" $ nf (BS.map toLower) bsa
      , bench "bl" $ nf (BL.map toLower) bla
      , bench "l" $ nf (L.map toLower) la
      ],
      bgroup "toUpper" [
        bench "ts" $ nf TS.toUpper tsa
      , bench "tl" $ nf TL.toUpper tla
      , bench "bs" $ nf (BS.map toUpper) bsa
      , bench "bl" $ nf (BL.map toUpper) bla
      , bench "l" $ nf (L.map toUpper) la
      ],
      bgroup "words" [
        bench "ts" $ nf TS.words tsa
      , bench "tl" $ nf TL.words tla
      , bench "bs" $ nf BS.words bsa
      , bench "bl" $ nf BL.words bla
      , bench "l" $ nf L.words la
      ],
      bgroup "zipWith" [
        bench "ts" $ nf (TS.zipWith min tsb) tsa
      , bench "tl" $ nf (TL.zipWith min tlb) tla
      , bench "bs" $ nf (BS.zipWith min bsb) bsa
      , bench "bl" $ nf (BL.zipWith min blb) bla
      , bench "l" $ nf (L.zipWith min lb) la
      ],
      bgroup "length" [
        bgroup "cons" [
          bench "ts" $ nf (TS.length . TS.cons c) tsa
        , bench "tl" $ nf (TL.length . TL.cons c) tla
        , bench "bs" $ nf (BS.length . BS.cons c) bsa
        , bench "bl" $ nf (BL.length . BL.cons c) bla
        , bench "l" $ nf (L.length . (:) c) la
        ],
        bgroup "decode" [
          bench "ts" $ nf (TS.length . TS.decodeUtf8) bsa
        , bench "tl" $ nf (TL.length . TL.decodeUtf8) bla
        , bench "bs" $ nf (L.length . BS.unpack) bsa
        , bench "bl" $ nf (L.length . BL.unpack) bla
        , bench "utf8-string" $ nf (L.length . UTF8.toString) bsa
        ],
        bgroup "drop" [
          bench "ts" $ nf (TS.length . TS.drop (tsa_len `div` 3)) tsa
        , bench "tl" $ nf (TL.length . TL.drop (tla_len `div` 3)) tla
        , bench "bs" $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa
        , bench "bl" $ nf (BL.length . BL.drop (bla_len `div` 3)) bla
        , bench "l" $ nf (L.length . L.drop (la_len `div` 3)) la
        ],
        bgroup "filter" [
          bench "ts" $ nf (TS.length . TS.filter p0) tsa
        , bench "tl" $ nf (TL.length . TL.filter p0) tla
        , bench "bs" $ nf (BS.length . BS.filter p0) bsa
        , bench "bl" $ nf (BL.length . BL.filter p0) bla
        , bench "l" $ nf (L.length . L.filter p0) la
        ],
        bgroup "filter.filter" [
          bench "ts" $ nf (TS.length . TS.filter p1 . TS.filter p0) tsa
        , bench "tl" $ nf (TL.length . TL.filter p1 . TL.filter p0) tla
        , bench "bs" $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa
        , bench "bl" $ nf (BL.length . BL.filter p1 . BL.filter p0) bla
        , bench "l" $ nf (L.length . L.filter p1 . L.filter p0) la
        ],
        bgroup "init" [
          bench "ts" $ nf (TS.length . TS.init) tsa
        , bench "tl" $ nf (TL.length . TL.init) tla
        , bench "bs" $ nf (BS.length . BS.init) bsa
        , bench "bl" $ nf (BL.length . BL.init) bla
        , bench "l" $ nf (L.length . L.init) la
        ],
        bgroup "intercalate" [
          bench "ts" $ nf (TS.length . TS.intercalate tsw) tsl
        , bench "tl" $ nf (TL.length . TL.intercalate tlw) tll
        , bench "bs" $ nf (BS.length . BS.intercalate bsw) bsl
        , bench "bl" $ nf (BL.length . BL.intercalate blw) bll
        , bench "l" $ nf (L.length . L.intercalate lw) ll
        ],
        bgroup "intersperse" [
          bench "ts" $ nf (TS.length . TS.intersperse c) tsa
        , bench "tl" $ nf (TL.length . TL.intersperse c) tla
        , bench "bs" $ nf (BS.length . BS.intersperse c) bsa
        , bench "bl" $ nf (BL.length . BL.intersperse c) bla
        , bench "l" $ nf (L.length . L.intersperse c) la
        ],
        bgroup "map" [
          bench "ts" $ nf (TS.length . TS.map f) tsa
        , bench "tl" $ nf (TL.length . TL.map f) tla
        , bench "bs" $ nf (BS.length . BS.map f) bsa
        , bench "bl" $ nf (BL.length . BL.map f) bla
        , bench "l" $ nf (L.length . L.map f) la
        ],
        bgroup "map.map" [
          bench "ts" $ nf (TS.length . TS.map f . TS.map f) tsa
        , bench "tl" $ nf (TL.length . TL.map f . TL.map f) tla
        , bench "bs" $ nf (BS.length . BS.map f . BS.map f) bsa
        , bench "l" $ nf (L.length . L.map f . L.map f) la
        ],
        bgroup "replicate char" [
          bench "ts" $ nf (TS.length . TS.replicate bsa_len) (TS.singleton c)
        , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
        , bench "bs" $ nf (BS.length . BS.replicate bsa_len) c
        , bench "bl" $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c
        , bench "l" $ nf (L.length . L.replicate bsa_len) c
        ],
        bgroup "replicate string" [
          bench "ts" $ nf (TS.length . TS.replicate (bsa_len `div` TS.length tsw)) tsw
        , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
        , bench "l" $ nf (L.length . replicat (bsa_len `div` TS.length tsw)) lw
        ],
        bgroup "take" [
          bench "ts" $ nf (TS.length . TS.take (tsa_len `div` 3)) tsa
        , bench "tl" $ nf (TL.length . TL.take (tla_len `div` 3)) tla
        , bench "bs" $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa
        , bench "bl" $ nf (BL.length . BL.take (bla_len `div` 3)) bla
        , bench "l" $ nf (L.length . L.take (la_len `div` 3)) la
        ],
        bgroup "tail" [
          bench "ts" $ nf (TS.length . TS.tail) tsa
        , bench "tl" $ nf (TL.length . TL.tail) tla
        , bench "bs" $ nf (BS.length . BS.tail) bsa
        , bench "bl" $ nf (BL.length . BL.tail) bla
        , bench "l" $ nf (L.length . L.tail) la
        ],
        bgroup "toLower" [
          bench "ts" $ nf (TS.length . TS.toLower) tsa
        , bench "tl" $ nf (TL.length . TL.toLower) tla
        , bench "bs" $ nf (BS.length . BS.map toLower) bsa
        , bench "bl" $ nf (BL.length . BL.map toLower) bla
        , bench "l" $ nf (L.length . L.map toLower) la
        ],
        bgroup "toUpper" [
          bench "ts" $ nf (TS.length . TS.toUpper) tsa
        , bench "tl" $ nf (TL.length . TL.toUpper) tla
        , bench "bs" $ nf (BS.length . BS.map toUpper) bsa
        , bench "bl" $ nf (BL.length . BL.map toUpper) bla
        , bench "l" $ nf (L.length . L.map toUpper) la
        ],
        bgroup "words" [
          bench "ts" $ nf (L.length . TS.words) tsa
        , bench "tl" $ nf (L.length . TL.words) tla
        , bench "bs" $ nf (L.length . BS.words) bsa
        , bench "bl" $ nf (L.length . BL.words) bla
        , bench "l" $ nf (L.length . L.words) la
        ],
        bgroup "zipWith" [
          bench "ts" $ nf (TS.length . TS.zipWith min tsb) tsa
        , bench "tl" $ nf (TL.length . TL.zipWith min tlb) tla
        , bench "bs" $ nf (L.length . BS.zipWith min bsb) bsa
        , bench "bl" $ nf (L.length . BL.zipWith min blb) bla
        , bench "l" $ nf (L.length . L.zipWith min lb) la
        ]
      ]
    ]
  where
    c  = 'й'
    p0 = (== c)
    p1 = (/= 'д')
    lw  = "право"
    bsw  = UTF8.fromString lw
    blw  = BL.fromChunks [bsw]
    tsw  = TS.pack lw
    tlw  = TL.fromChunks [tsw]
    f (C# c#) = C# (chr# (ord# c# +# 1#))
    len l _ = l + (1::Int)
    replicat n = concat . L.replicate n

chunksOf :: Int -> BS.ByteString -> [BS.ByteString]
chunksOf k = go
  where
    go t = case BS.splitAt k t of
             (a,b) | BS.null a -> []
                   | otherwise -> a : go b
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.