Commits

Bryan O'Sullivan  committed 85a3324

Make the benchmarks subtree saner

  • Participants
  • Parent commits 77260c1

Comments (0)

Files changed (68)

File Data/Text/Lazy/Fusion.hs

         where Iter c d = iter t i
 {-# INLINE [0] stream #-}
 
+data UC s = UC s {-# UNPACK #-} !Int
+
 -- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
 -- chunk size.
 unstreamChunks :: Int -> Stream Char -> Text
                 Done       -> Empty
                 Skip s'    -> outer s'
                 Yield x s' -> I.Text arr 0 len `chunk` outer s''
-                  where (arr,(s'',len)) = A.run2 fill
+                  where (arr, UC s'' len) = A.run2 fill
                         fill = do a <- A.new unknownLength
                                   unsafeWrite a 0 x >>= inner a unknownLength s'
                         unknownLength = 4
     inner marr len s !i
-        | i + 1 >= chunkSize = return (marr, (s,i))
+        | i + 1 >= chunkSize = return (marr, UC s i)
         | i + 1 >= len       = {-# SCC "unstreamChunks/resize" #-} do
             let newLen = min (len `shiftL` 1) chunkSize
             marr' <- A.new newLen
         | otherwise =
             {-# SCC "unstreamChunks/inner" #-}
             case next s of
-              Done        -> return (marr,(s,i))
+              Done        -> return (marr, UC s i)
               Skip s'     -> inner marr len s' i
               Yield x s'  -> do d <- unsafeWrite marr i x
                                 inner marr len s' (i+d)

File benchmarks/.gitignore

+dist

File benchmarks/Setup.hs

+import Distribution.Simple
+main = defaultMain

File benchmarks/cbits/time_iconv.c

+#include <iconv.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdint.h>
+
+int time_iconv(char *srcbuf, size_t srcbufsize)
+{
+  uint16_t *destbuf = NULL;
+  size_t destbufsize;
+  static uint16_t *origdestbuf;
+  static size_t origdestbufsize;
+  iconv_t ic = (iconv_t) -1;
+  int ret = 0;
+
+  if (ic == (iconv_t) -1) {
+    ic = iconv_open("UTF-16LE", "UTF-8");
+    if (ic == (iconv_t) -1) {
+      ret = -1;
+      goto done;
+    }
+  }
+  
+  destbufsize = srcbufsize * sizeof(uint16_t);
+  if (destbufsize > origdestbufsize) {
+    free(origdestbuf);
+    origdestbuf = destbuf = malloc(origdestbufsize = destbufsize);
+  } else {
+    destbuf = origdestbuf;
+  }
+
+  iconv(ic, &srcbuf, &srcbufsize, (char**) &destbuf, &destbufsize);
+
+ done:
+  return ret;
+}

File benchmarks/haskell/Benchmarks.hs

+-- | Main module to run the micro benchmarks
+--
+{-# LANGUAGE OverloadedStrings #-}
+module Main
+    ( main
+    ) where
+
+import Criterion.Main (Benchmark, defaultMain, bgroup)
+import System.FilePath ((</>))
+import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
+
+import qualified Benchmarks.Builder as Builder
+import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
+import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
+import qualified Benchmarks.Equality as Equality
+import qualified Benchmarks.FileRead as FileRead
+import qualified Benchmarks.FoldLines as FoldLines
+import qualified Benchmarks.Pure as Pure
+import qualified Benchmarks.ReadNumbers as ReadNumbers
+import qualified Benchmarks.Replace as Replace
+import qualified Benchmarks.Search as Search
+import qualified Benchmarks.Stream as Stream
+import qualified Benchmarks.WordFrequencies as WordFrequencies
+
+import qualified Benchmarks.Programs.BigTable as Programs.BigTable
+import qualified Benchmarks.Programs.Cut as Programs.Cut
+import qualified Benchmarks.Programs.Fold as Programs.Fold
+import qualified Benchmarks.Programs.Sort as Programs.Sort
+import qualified Benchmarks.Programs.StripTags as Programs.StripTags
+import qualified Benchmarks.Programs.Throughput as Programs.Throughput
+
+main :: IO ()
+main = benchmarks >>= defaultMain
+
+benchmarks :: IO [Benchmark]
+benchmarks = do
+    sink <- openFile "/dev/null" WriteMode
+    hSetEncoding sink utf8
+
+    -- Traditional benchmarks
+    bs <- sequence
+        [ Builder.benchmark
+        , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
+        , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
+        , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")
+        , DecodeUtf8.benchmark "russian" (tf "russian.txt")
+        , DecodeUtf8.benchmark "japanese" (tf "japanese.txt")
+        , EncodeUtf8.benchmark "επανάληψη 竺法蘭共譯"
+        , Equality.benchmark (tf "japanese.txt")
+        , FileRead.benchmark (tf "russian.txt")
+        , FoldLines.benchmark (tf "russian.txt")
+        , Pure.benchmark (tf "japanese.txt")
+        , ReadNumbers.benchmark (tf "numbers.txt")
+        , Replace.benchmark (tf "russian.txt") "принимая" "своем"
+        , Search.benchmark (tf "russian.txt") "принимая"
+        , Stream.benchmark (tf "russian.txt")
+        , WordFrequencies.benchmark (tf "russian.txt")
+        ]
+
+    -- Program-like benchmarks
+    ps <- bgroup "Programs" `fmap` sequence
+        [ Programs.BigTable.benchmark sink
+        , Programs.Cut.benchmark (tf "russian.txt") sink 20 40
+        , Programs.Fold.benchmark (tf "russian.txt") sink
+        , Programs.Sort.benchmark (tf "russian.txt") sink
+        , Programs.StripTags.benchmark (tf "yiwiki.xml") sink
+        , Programs.Throughput.benchmark (tf "russian.txt") sink
+        ]
+
+    return $ bs ++ [ps]
+  where
+    -- Location of a test file
+    tf = ("../text-test-data" </>)

File benchmarks/haskell/Benchmarks/Builder.hs

+-- | Testing the internal builder monoid
+--
+-- Tested in this benchmark:
+--
+-- * Concatenating many small strings using a builder
+--
+{-# LANGUAGE OverloadedStrings #-}
+module Benchmarks.Builder
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bgroup, bench, nf)
+import Data.Binary.Builder as B
+import Data.ByteString.Char8 ()
+import Data.Monoid (mconcat)
+import qualified Blaze.ByteString.Builder as Blaze
+import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
+import qualified Data.ByteString as SB
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.Text.Lazy.Builder as LTB
+
+benchmark :: IO Benchmark
+benchmark = return $ bgroup "Builder"
+    [ bench "LazyText" $ nf
+        (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts
+    , bench "Binary" $ nf
+        (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)
+        byteStrings
+    , bench "Blaze" $ nf
+        (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)
+        strings
+    ]
+
+texts :: [T.Text]
+texts = take 200000 $ cycle ["foo", "λx", "由の"]
+{-# NOINLINE texts #-}
+
+-- Note that the non-ascii characters will be chopped
+byteStrings :: [SB.ByteString]
+byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]
+{-# NOINLINE byteStrings #-}
+
+-- Note that the non-ascii characters will be chopped
+strings :: [String]
+strings = take 200000 $ cycle ["foo", "λx", "由の"]
+{-# NOINLINE strings #-}

File benchmarks/haskell/Benchmarks/DecodeUtf8.hs

+{-# LANGUAGE ForeignFunctionInterface #-}
+
+-- | Test decoding of UTF-8
+--
+-- Tested in this benchmark:
+--
+-- * Decoding bytes using UTF-8
+--
+-- In some tests:
+--
+-- * Taking the length of the result
+--
+-- * Taking the init of the result
+--
+-- The latter are used for testing stream fusion.
+--
+module Benchmarks.DecodeUtf8
+    ( benchmark
+    ) where
+
+import Foreign.C.Types (CInt, CSize)
+import Data.ByteString.Internal (ByteString(..))
+import Foreign.Ptr (Ptr, plusPtr)
+import Foreign.ForeignPtr (withForeignPtr)
+import Data.Word (Word8)
+import qualified Criterion as C
+import Criterion (Benchmark, bgroup, nf)
+import qualified Codec.Binary.UTF8.Generic as U8
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+
+benchmark :: String -> FilePath -> IO Benchmark
+benchmark kind fp = do
+    bs  <- B.readFile fp
+    lbs <- BL.readFile fp
+    let bench name = C.bench (name ++ "+" ++ kind)
+    return $ bgroup "DecodeUtf8"
+        [ bench "Strict" $ nf T.decodeUtf8 bs
+        , bench "IConv" $ iconv bs
+        , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs
+        , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs
+        , bench "Lazy" $ nf TL.decodeUtf8 lbs
+        , bench "LazyLength" $ nf (TL.length . TL.decodeUtf8) lbs
+        , bench "LazyInitLength" $ nf (TL.length . TL.init . TL.decodeUtf8) lbs
+        , bench "StrictStringUtf8" $ nf U8.toString bs
+        , bench "StrictStringUtf8Length" $ nf (length . U8.toString) bs
+        , bench "LazyStringUtf8" $ nf U8.toString lbs
+        , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs
+        ]
+
+iconv :: ByteString -> IO CInt
+iconv (PS fp off len) = withForeignPtr fp $ \ptr ->
+                        time_iconv (ptr `plusPtr` off) (fromIntegral len)
+
+foreign import ccall unsafe time_iconv :: Ptr Word8 -> CSize -> IO CInt

File benchmarks/haskell/Benchmarks/EncodeUtf8.hs

+-- | UTF-8 encode a text
+--
+-- Tested in this benchmark:
+--
+-- * Replicating a string a number of times
+--
+-- * UTF-8 encoding it
+--
+module Benchmarks.EncodeUtf8
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bgroup, bench, whnf)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+
+benchmark :: String -> IO Benchmark
+benchmark string = do
+    return $ bgroup "EncodeUtf8"
+        [ bench "Text"     $ whnf (B.length . T.encodeUtf8)   text
+        , bench "LazyText" $ whnf (BL.length . TL.encodeUtf8) lazyText
+        ]
+  where
+    -- The string in different formats
+    text = T.replicate k $ T.pack string
+    lazyText = TL.replicate (fromIntegral k) $ TL.pack string
+
+    -- Amount
+    k = 100000

File benchmarks/haskell/Benchmarks/Equality.hs

+-- | Compare a string with a copy of itself that is identical except
+-- for the last character.
+--
+-- Tested in this benchmark:
+--
+-- * Comparison of strings (Eq instance)
+--
+module Benchmarks.Equality
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bgroup, bench, whnf)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+
+benchmark :: FilePath -> IO Benchmark
+benchmark fp = do
+  b <- B.readFile fp
+  bl1 <- BL.readFile fp
+  -- A lazy bytestring is a list of chunks. When we do not explicitly create two
+  -- different lazy bytestrings at a different address, the bytestring library
+  -- will compare the chunk addresses instead of the chunk contents. This is why
+  -- we read the lazy bytestring twice here.
+  bl2 <- BL.readFile fp
+  l <- readFile fp
+  let t  = T.decodeUtf8 b
+      tl = TL.decodeUtf8 bl1
+  return $ bgroup "Equality"
+    [ bench "Text" $ whnf (== T.init t `T.snoc` '\xfffd') t
+    , bench "LazyText" $ whnf (== TL.init tl `TL.snoc` '\xfffd') tl
+    , bench "ByteString" $ whnf (== B.init b `B.snoc` '\xfffd') b
+    , bench "LazyByteString" $ whnf (== BL.init bl2 `BL.snoc` '\xfffd') bl1
+    , bench "String" $ whnf (== init l ++ "\xfffd") l
+    ]

File benchmarks/haskell/Benchmarks/FileRead.hs

+-- | Benchmarks simple file reading
+--
+-- Tested in this benchmark:
+--
+-- * Reading a file from the disk
+--
+module Benchmarks.FileRead
+    ( benchmark
+    ) where
+
+import Control.Exception (evaluate)
+import Criterion (Benchmark, bgroup, bench)
+import qualified Data.ByteString as SB
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as LT
+import qualified Data.Text.Lazy.Encoding as LT
+import qualified Data.Text.Lazy.IO as LT
+
+benchmark :: FilePath -> IO Benchmark
+benchmark p = return $ bgroup "FileRead"
+    [ bench "String" $ readFile p >>= evaluate . length
+    , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length
+    , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length
+    , bench "Text" $ T.readFile p >>= evaluate . T.length
+    , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length
+    , bench "TextByteString" $
+        SB.readFile p >>= evaluate . T.length . T.decodeUtf8
+    , bench "LazyTextByteString" $
+        LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8
+    ]

File benchmarks/haskell/Benchmarks/FoldLines.hs

+-- | Read a file line-by-line using handles, and perform a fold over the lines.
+-- The fold is used here to calculate the number of lines in the file.
+--
+-- Tested in this benchmark:
+--
+-- * Buffered, line-based IO
+--
+{-# LANGUAGE BangPatterns #-}
+module Benchmarks.FoldLines
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bgroup, bench)
+import System.IO
+import qualified Data.ByteString as B
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+benchmark :: FilePath -> IO Benchmark
+benchmark fp = return $ bgroup "ReadLines"
+    [ bench "Text"       $ withHandle $ foldLinesT (\n _ -> n + 1) (0 :: Int)
+    , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)
+    ]
+  where
+    withHandle f = do
+        h <- openFile fp ReadMode
+        hSetBuffering h (BlockBuffering (Just 16384))
+        x <- f h
+        hClose h
+        return x
+
+-- | Text line fold
+--
+foldLinesT :: (a -> T.Text -> a) -> a -> Handle -> IO a
+foldLinesT f z0 h = go z0
+  where
+    go !z = do
+        eof <- hIsEOF h
+        if eof
+            then return z
+            else do
+                l <- T.hGetLine h
+                let z' = f z l in go z'
+{-# INLINE foldLinesT #-}
+
+-- | ByteString line fold
+--
+foldLinesB :: (a -> B.ByteString -> a) -> a -> Handle -> IO a
+foldLinesB f z0 h = go z0
+  where
+    go !z = do
+        eof <- hIsEOF h
+        if eof
+            then return z
+            else do
+                l <- B.hGetLine h
+                let z' = f z l in go z'
+{-# INLINE foldLinesB #-}

File benchmarks/haskell/Benchmarks/Programs/BigTable.hs

+-- | Create a large HTML table and dump it to a handle
+--
+-- Tested in this benchmark:
+--
+-- * Creating a large HTML document using a builder
+--
+-- * Writing to a handle
+--
+{-# LANGUAGE OverloadedStrings #-}
+module Benchmarks.Programs.BigTable
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bench)
+import Data.Monoid (mappend, mconcat)
+import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
+import Data.Text.Lazy.IO (hPutStr)
+import System.IO (Handle)
+import qualified Data.Text as T
+
+benchmark :: Handle -> IO Benchmark
+benchmark sink = return $ bench "BigTable" $ do
+    hPutStr sink "Content-Type: text/html\n\n<table>"
+    hPutStr sink . toLazyText . makeTable =<< rows
+    hPutStr sink "</table>"
+  where
+    -- We provide the number of rows in IO so the builder value isn't shared
+    -- between the benchmark samples.
+    rows :: IO Int
+    rows = return 20000
+    {-# NOINLINE rows #-}
+
+makeTable :: Int -> Builder
+makeTable n = mconcat $ replicate n $ mconcat $ map makeCol [1 .. 50]
+
+makeCol :: Int -> Builder
+makeCol 1 = fromText "<tr><td>1</td>"
+makeCol 50 = fromText "<td>50</td></tr>"
+makeCol i = fromText "<td>" `mappend` (fromInt i `mappend` fromText "</td>")
+
+fromInt :: Int -> Builder
+fromInt = fromText . T.pack . show

File benchmarks/haskell/Benchmarks/Programs/Cut.hs

+-- | Cut into a file, selecting certain columns (e.g. columns 10 to 40)
+--
+-- Tested in this benchmark:
+--
+-- * Reading the file
+--
+-- * Splitting into lines
+--
+-- * Taking a number of characters from the lines
+--
+-- * Joining the lines
+--
+-- * Writing back to a handle
+--
+module Benchmarks.Programs.Cut
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bgroup, bench)
+import System.IO (Handle, hPutStr)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BLC
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Text.Lazy.IO as TL
+
+benchmark :: FilePath -> Handle -> Int -> Int -> IO Benchmark
+benchmark p sink from to = return $ bgroup "Cut"
+    [ bench' "String" string
+    , bench' "ByteString" byteString
+    , bench' "LazyByteString" lazyByteString
+    , bench' "Text" text
+    , bench' "LazyText" lazyText
+    , bench' "TextByteString" textByteString
+    , bench' "LazyTextByteString" lazyTextByteString
+    ]
+  where
+    bench' n s = bench n (s p sink from to)
+
+string :: FilePath -> Handle -> Int -> Int -> IO ()
+string fp sink from to = do
+    s <- readFile fp
+    hPutStr sink $ cut s
+  where
+    cut = unlines . map (take (to - from) . drop from) . lines
+
+byteString :: FilePath -> Handle -> Int -> Int -> IO ()
+byteString fp sink from to = do
+    bs <- B.readFile fp
+    B.hPutStr sink $ cut bs
+  where
+    cut = BC.unlines . map (B.take (to - from) . B.drop from) . BC.lines
+
+lazyByteString :: FilePath -> Handle -> Int -> Int -> IO ()
+lazyByteString fp sink from to = do
+    bs <- BL.readFile fp
+    BL.hPutStr sink $ cut bs
+  where
+    cut = BLC.unlines . map (BL.take (to' - from') . BL.drop from') . BLC.lines
+    from' = fromIntegral from
+    to' = fromIntegral to
+
+text :: FilePath -> Handle -> Int -> Int -> IO ()
+text fp sink from to = do
+    t <- T.readFile fp
+    T.hPutStr sink $ cut t
+  where
+    cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines
+
+lazyText :: FilePath -> Handle -> Int -> Int -> IO ()
+lazyText fp sink from to = do
+    t <- TL.readFile fp
+    TL.hPutStr sink $ cut t
+  where
+    cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines
+    from' = fromIntegral from
+    to' = fromIntegral to
+
+textByteString :: FilePath -> Handle -> Int -> Int -> IO ()
+textByteString fp sink from to = do
+    t <- T.decodeUtf8 `fmap` B.readFile fp
+    B.hPutStr sink $ T.encodeUtf8 $ cut t
+  where
+    cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines
+
+lazyTextByteString :: FilePath -> Handle -> Int -> Int -> IO ()
+lazyTextByteString fp sink from to = do
+    t <- TL.decodeUtf8 `fmap` BL.readFile fp
+    BL.hPutStr sink $ TL.encodeUtf8 $ cut t
+  where
+    cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines
+    from' = fromIntegral from
+    to' = fromIntegral to

File benchmarks/haskell/Benchmarks/Programs/Fold.hs

+-- | Benchmark which formats paragraph, like the @sort@ unix utility.
+--
+-- Tested in this benchmark:
+--
+-- * Reading the file
+--
+-- * Splitting into paragraphs
+--
+-- * Reformatting the paragraphs to a certain line width
+--
+-- * Concatenating the results using the text builder
+--
+-- * Writing back to a handle
+--
+{-# LANGUAGE OverloadedStrings #-}
+module Benchmarks.Programs.Fold
+    ( benchmark
+    ) where
+
+import Data.List (foldl')
+import Data.List (intersperse)
+import Data.Monoid (mempty, mappend, mconcat)
+import System.IO (Handle)
+import Criterion (Benchmark, bench)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy.Builder as TLB
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TL
+
+benchmark :: FilePath -> Handle -> IO Benchmark
+benchmark i o = return $
+    bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80
+
+-- | We represent a paragraph by a word list
+--
+type Paragraph = [T.Text]
+
+-- | Fold a text
+--
+fold :: Int -> T.Text -> TL.Text
+fold maxWidth = TLB.toLazyText . mconcat .
+    intersperse "\n\n" . map (foldParagraph maxWidth) . paragraphs
+
+-- | Fold a paragraph
+--
+foldParagraph :: Int -> Paragraph -> TLB.Builder
+foldParagraph _    []       = mempty
+foldParagraph max' (w : ws) = fst $ foldl' go (TLB.fromText w, T.length w) ws
+  where
+    go (builder, width) word
+        | width + len + 1 <= max' =
+            (builder `mappend` " " `mappend` word', width + len + 1)
+        | otherwise =
+            (builder `mappend` "\n" `mappend` word', len)
+      where
+        word' = TLB.fromText word
+        len = T.length word
+
+-- | Divide a text into paragraphs
+--
+paragraphs :: T.Text -> [Paragraph]
+paragraphs = splitParagraphs . map T.words . T.lines
+  where
+    splitParagraphs ls = case break null ls of
+        ([], []) -> []
+        (p,  []) -> [concat p]
+        (p,  lr) -> concat p : splitParagraphs (dropWhile null lr)

File benchmarks/haskell/Benchmarks/Programs/Sort.hs

+-- | This benchmark sorts the lines of a file, like the @sort@ unix utility.
+--
+-- Tested in this benchmark:
+--
+-- * Reading the file
+--
+-- * Splitting into lines
+--
+-- * Sorting the lines
+--
+-- * Joining the lines
+--
+-- * Writing back to a handle
+--
+{-# LANGUAGE OverloadedStrings #-}
+module Benchmarks.Programs.Sort
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bgroup, bench)
+import Data.Monoid (mconcat)
+import System.IO (Handle, hPutStr)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BLC
+import qualified Data.List as L
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TLB
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Text.Lazy.IO as TL
+
+benchmark :: FilePath -> Handle -> IO Benchmark
+benchmark i o = return $ bgroup "Sort"
+    [ bench "String" $ readFile i >>= hPutStr o . string
+    , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
+    , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString
+    , bench "Text" $ T.readFile i >>= T.hPutStr o . text
+    , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText
+    , bench "TextByteString" $ B.readFile i >>=
+        B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
+    , bench "LazyTextByteString" $ BL.readFile i >>=
+        BL.hPutStr o . TL.encodeUtf8 . lazyText .  TL.decodeUtf8
+    , bench "TextBuilder" $ B.readFile i >>=
+        BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8
+    ]
+
+string :: String -> String
+string = unlines . L.sort . lines
+
+byteString :: B.ByteString -> B.ByteString
+byteString = BC.unlines . L.sort . BC.lines
+
+lazyByteString :: BL.ByteString -> BL.ByteString
+lazyByteString = BLC.unlines . L.sort . BLC.lines
+
+text :: T.Text -> T.Text
+text = T.unlines . L.sort . T.lines
+
+lazyText :: TL.Text -> TL.Text
+lazyText = TL.unlines . L.sort . TL.lines
+
+-- | Text variant using a builder monoid for the final concatenation
+--
+textBuilder :: T.Text -> TL.Text
+textBuilder = TLB.toLazyText . mconcat . L.intersperse (TLB.singleton '\n') .
+    map TLB.fromText . L.sort . T.lines

File benchmarks/haskell/Benchmarks/Programs/StripTags.hs

+-- | Program to replace HTML tags by whitespace
+--
+-- This program was originally contributed by Petr Prokhorenkov.
+--
+-- Tested in this benchmark:
+--
+-- * Reading the file
+--
+-- * Replacing text between HTML tags (<>) with whitespace
+--
+-- * Writing back to a handle
+--
+{-# OPTIONS_GHC -fspec-constr-count=5 #-}
+module Benchmarks.Programs.StripTags
+    ( benchmark
+    ) where
+     
+import Criterion (Benchmark, bgroup, bench)
+import Data.List (mapAccumL)
+import System.IO (Handle, hPutStr)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.IO as T
+
+benchmark :: FilePath -> Handle -> IO Benchmark
+benchmark i o = return $ bgroup "StripTags"
+    [ bench "String" $ readFile i >>= hPutStr o . string
+    , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString
+    , bench "Text" $ T.readFile i >>= T.hPutStr o . text
+    , bench "TextByteString" $
+        B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8
+    ]
+
+string :: String -> String
+string = snd . mapAccumL step 0
+
+text :: T.Text -> T.Text
+text = snd . T.mapAccumL step 0
+
+byteString :: B.ByteString -> B.ByteString
+byteString = snd . BC.mapAccumL step 0
+
+step :: Int -> Char -> (Int, Char)
+step d c
+    | d > 0 || d' > 0 = (d', ' ')
+    | otherwise       = (d', c)
+  where
+    d' = d + depth c
+    depth '>' = 1
+    depth '<' = -1
+    depth _   = 0

File benchmarks/haskell/Benchmarks/Programs/Throughput.hs

+-- | This benchmark simply reads and writes a file using the various string
+-- libraries. The point of it is that we can make better estimations on how
+-- much time the other benchmarks spend doing IO.
+--
+-- Note that we expect ByteStrings to be a whole lot faster, since they do not
+-- do any actual encoding/decoding here, while String and Text do have UTF-8
+-- encoding/decoding.
+--
+-- Tested in this benchmark:
+--
+-- * Reading the file
+--
+-- * Replacing text between HTML tags (<>) with whitespace
+--
+-- * Writing back to a handle
+--
+module Benchmarks.Programs.Throughput
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bgroup, bench)
+import System.IO (Handle, hPutStr)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Text.Lazy.IO as TL
+
+benchmark :: FilePath -> Handle -> IO Benchmark
+benchmark fp sink = return $ bgroup "Throughput"
+    [ bench "String" $ readFile fp >>= hPutStr sink
+    , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink
+    , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink
+    , bench "Text" $ T.readFile fp >>= T.hPutStr sink
+    , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink
+    , bench "TextByteString" $
+        B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 .  T.decodeUtf8
+    , bench "LazyTextByteString" $
+        BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8
+    ]

File benchmarks/haskell/Benchmarks/Pure.hs

+-- | Benchmarks various pure functions from the Text library
+--
+-- Tested in this benchmark:
+--
+-- * Most pure functions defined the string types
+--
+{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Benchmarks.Pure
+    ( benchmark
+    ) where
+
+import Control.DeepSeq (NFData (..))
+import Control.Exception (evaluate)
+import Criterion (Benchmark, bgroup, bench, nf)
+import Data.Char (toLower, toUpper)
+import Data.Monoid (mappend, mempty)
+import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.ByteString.Lazy.Internal as BL
+import qualified Data.ByteString.UTF8 as UTF8
+import qualified Data.List as L
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
+import qualified Data.Text.Lazy.Encoding as TL
+
+benchmark :: FilePath -> IO Benchmark
+benchmark fp = do
+    -- Evaluate stuff before actually running the benchmark, we don't want to
+    -- count it here.
+
+    -- ByteString A
+    bsa     <- BS.readFile fp
+
+    -- Text A/B, LazyText A/B
+    ta      <- evaluate $ T.decodeUtf8 bsa
+    tb      <- evaluate $ T.toUpper ta
+    tla     <- evaluate $ TL.fromChunks (T.chunksOf 16376 ta)
+    tlb     <- evaluate $ TL.fromChunks (T.chunksOf 16376 tb)
+
+    -- ByteString B, LazyByteString A/B
+    bsb     <- evaluate $ T.encodeUtf8 tb
+    bla     <- evaluate $ BL.fromChunks (chunksOf 16376 bsa)
+    blb     <- evaluate $ BL.fromChunks (chunksOf 16376 bsb)
+
+    -- String A/B
+    sa      <- evaluate $ UTF8.toString bsa
+    sb      <- evaluate $ T.unpack tb
+
+    -- Lengths
+    bsa_len <- evaluate $ BS.length bsa
+    ta_len  <- evaluate $ T.length ta
+    bla_len <- evaluate $ BL.length bla
+    tla_len <- evaluate $ TL.length tla
+    sa_len  <- evaluate $ L.length sa
+
+    -- Lines
+    bsl     <- evaluate $ BS.lines bsa
+    bll     <- evaluate $ BL.lines bla
+    tl      <- evaluate $ T.lines ta
+    tll     <- evaluate $ TL.lines tla
+    sl      <- evaluate $ L.lines sa
+
+    return $ bgroup "Pure"
+        [ bgroup "append"
+            [ benchT   $ nf (T.append tb) ta
+            , benchTL  $ nf (TL.append tlb) tla
+            , benchBS  $ nf (BS.append bsb) bsa
+            , benchBSL $ nf (BL.append blb) bla
+            , benchS   $ nf ((++) sb) sa
+            ]
+        , bgroup "concat"
+            [ benchT   $ nf T.concat tl
+            , benchTL  $ nf TL.concat tll
+            , benchBS  $ nf BS.concat bsl
+            , benchBSL $ nf BL.concat bll
+            , benchS   $ nf L.concat sl
+            ]
+        , bgroup "cons"
+            [ benchT   $ nf (T.cons c) ta
+            , benchTL  $ nf (TL.cons c) tla
+            , benchBS  $ nf (BS.cons c) bsa
+            , benchBSL $ nf (BL.cons c) bla
+            , benchS   $ nf (c:) sa
+            ]
+        , bgroup "concatMap"
+            [ benchT   $ nf (T.concatMap (T.replicate 3 . T.singleton)) ta
+            , benchTL  $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla
+            , benchBS  $ nf (BS.concatMap (BS.replicate 3)) bsa
+            , benchBSL $ nf (BL.concatMap (BL.replicate 3)) bla
+            , benchS   $ nf (L.concatMap (L.replicate 3 . (:[]))) sa
+            ]
+        , bgroup "decode"
+            [ benchT   $ nf T.decodeUtf8 bsa
+            , benchTL  $ nf TL.decodeUtf8 bla
+            , benchBS  $ nf BS.unpack bsa
+            , benchBSL $ nf BL.unpack bla
+            , benchS   $ nf UTF8.toString bsa
+            ]
+        , bgroup "drop"
+            [ benchT   $ nf (T.drop (ta_len `div` 3)) ta
+            , benchTL  $ nf (TL.drop (tla_len `div` 3)) tla
+            , benchBS  $ nf (BS.drop (bsa_len `div` 3)) bsa
+            , benchBSL $ nf (BL.drop (bla_len `div` 3)) bla
+            , benchS   $ nf (L.drop (sa_len `div` 3)) sa
+            ]
+        , bgroup "encode"
+            [ benchT   $ nf T.encodeUtf8 ta
+            , benchTL  $ nf TL.encodeUtf8 tla
+            , benchBS  $ nf BS.pack sa
+            , benchBSL $ nf BL.pack sa
+            , benchS   $ nf UTF8.fromString sa
+            ]
+        , bgroup "filter"
+            [ benchT   $ nf (T.filter p0) ta
+            , benchTL  $ nf (TL.filter p0) tla
+            , benchBS  $ nf (BS.filter p0) bsa
+            , benchBSL $ nf (BL.filter p0) bla
+            , benchS   $ nf (L.filter p0) sa
+            ]
+        , bgroup "filter.filter"
+            [ benchT   $ nf (T.filter p1 . T.filter p0) ta
+            , benchTL  $ nf (TL.filter p1 . TL.filter p0) tla
+            , benchBS  $ nf (BS.filter p1 . BS.filter p0) bsa
+            , benchBSL $ nf (BL.filter p1 . BL.filter p0) bla
+            , benchS   $ nf (L.filter p1 . L.filter p0) sa
+            ]
+        , bgroup "foldl'"
+            [ benchT   $ nf (T.foldl' len 0) ta
+            , benchTL  $ nf (TL.foldl' len 0) tla
+            , benchBS  $ nf (BS.foldl' len 0) bsa
+            , benchBSL $ nf (BL.foldl' len 0) bla
+            , benchS   $ nf (L.foldl' len 0) sa
+            ]
+        , bgroup "foldr"
+            [ benchT   $ nf (L.length . T.foldr (:) []) ta
+            , benchTL  $ nf (L.length . TL.foldr (:) []) tla
+            , benchBS  $ nf (L.length . BS.foldr (:) []) bsa
+            , benchBSL $ nf (L.length . BL.foldr (:) []) bla
+            , benchS   $ nf (L.length . L.foldr (:) []) sa
+            ]
+        , bgroup "head"
+            [ benchT   $ nf T.head ta
+            , benchTL  $ nf TL.head tla
+            , benchBS  $ nf BS.head bsa
+            , benchBSL $ nf BL.head bla
+            , benchS   $ nf L.head sa
+            ]
+        , bgroup "init"
+            [ benchT   $ nf T.init ta
+            , benchTL  $ nf TL.init tla
+            , benchBS  $ nf BS.init bsa
+            , benchBSL $ nf BL.init bla
+            , benchS   $ nf L.init sa
+            ]
+        , bgroup "intercalate"
+            [ benchT   $ nf (T.intercalate tsw) tl
+            , benchTL  $ nf (TL.intercalate tlw) tll
+            , benchBS  $ nf (BS.intercalate bsw) bsl
+            , benchBSL $ nf (BL.intercalate blw) bll
+            , benchS   $ nf (L.intercalate lw) sl
+            ]
+        , bgroup "intersperse"
+            [ benchT   $ nf (T.intersperse c) ta
+            , benchTL  $ nf (TL.intersperse c) tla
+            , benchBS  $ nf (BS.intersperse c) bsa
+            , benchBSL $ nf (BL.intersperse c) bla
+            , benchS   $ nf (L.intersperse c) sa
+            ]
+        , bgroup "isInfixOf"
+            [ benchT   $ nf (T.isInfixOf tsw) ta
+            , benchTL  $ nf (TL.isInfixOf tlw) tla
+            , benchBS  $ nf (BS.isInfixOf bsw) bsa
+              -- no isInfixOf for lazy bytestrings
+            , benchS   $ nf (L.isInfixOf lw) sa
+            ]
+        , bgroup "last"
+            [ benchT   $ nf T.last ta
+            , benchTL  $ nf TL.last tla
+            , benchBS  $ nf BS.last bsa
+            , benchBSL $ nf BL.last bla
+            , benchS   $ nf L.last sa
+            ]
+        , bgroup "map"
+            [ benchT   $ nf (T.map f) ta
+            , benchTL  $ nf (TL.map f) tla
+            , benchBS  $ nf (BS.map f) bsa
+            , benchBSL $ nf (BL.map f) bla
+            , benchS   $ nf (L.map f) sa
+            ]
+        , bgroup "mapAccumL"
+            [ benchT   $ nf (T.mapAccumL g 0) ta
+            , benchTL  $ nf (TL.mapAccumL g 0) tla
+            , benchBS  $ nf (BS.mapAccumL g 0) bsa
+            , benchBSL $ nf (BL.mapAccumL g 0) bla
+            , benchS   $ nf (L.mapAccumL g 0) sa
+            ]
+        , bgroup "mapAccumR"
+            [ benchT   $ nf (T.mapAccumR g 0) ta
+            , benchTL  $ nf (TL.mapAccumR g 0) tla
+            , benchBS  $ nf (BS.mapAccumR g 0) bsa
+            , benchBSL $ nf (BL.mapAccumR g 0) bla
+            , benchS   $ nf (L.mapAccumR g 0) sa
+            ]
+        , bgroup "map.map"
+            [ benchT   $ nf (T.map f . T.map f) ta
+            , benchTL  $ nf (TL.map f . TL.map f) tla
+            , benchBS  $ nf (BS.map f . BS.map f) bsa
+            , benchBSL $ nf (BL.map f . BL.map f) bla
+            , benchS   $ nf (L.map f . L.map f) sa
+            ]
+        , bgroup "replicate char"
+            [ benchT   $ nf (T.replicate bsa_len) (T.singleton c)
+            , benchTL  $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
+            , benchBS  $ nf (BS.replicate bsa_len) c
+            , benchBSL $ nf (BL.replicate (fromIntegral bsa_len)) c
+            , benchS   $ nf (L.replicate bsa_len) c
+            ]
+        , bgroup "replicate string"
+            [ benchT   $ nf (T.replicate (bsa_len `div` T.length tsw)) tsw
+            , benchTL  $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
+            , benchS   $ nf (replicat (bsa_len `div` T.length tsw)) lw
+            ]
+        , bgroup "reverse"
+            [ benchT   $ nf T.reverse ta
+            , benchTL  $ nf TL.reverse tla
+            , benchBS  $ nf BS.reverse bsa
+            , benchBSL $ nf BL.reverse bla
+            , benchS   $ nf L.reverse sa
+            ]
+        , bgroup "take"
+            [ benchT   $ nf (T.take (ta_len `div` 3)) ta
+            , benchTL  $ nf (TL.take (tla_len `div` 3)) tla
+            , benchBS  $ nf (BS.take (bsa_len `div` 3)) bsa
+            , benchBSL $ nf (BL.take (bla_len `div` 3)) bla
+            , benchS   $ nf (L.take (sa_len `div` 3)) sa
+            ]
+        , bgroup "tail"
+            [ benchT   $ nf T.tail ta
+            , benchTL  $ nf TL.tail tla
+            , benchBS  $ nf BS.tail bsa
+            , benchBSL $ nf BL.tail bla
+            , benchS   $ nf L.tail sa
+            ]
+        , bgroup "toLower"
+            [ benchT   $ nf T.toLower ta
+            , benchTL  $ nf TL.toLower tla
+            , benchBS  $ nf (BS.map toLower) bsa
+            , benchBSL $ nf (BL.map toLower) bla
+            , benchS   $ nf (L.map toLower) sa
+            ]
+        , bgroup "toUpper"
+            [ benchT   $ nf T.toUpper ta
+            , benchTL  $ nf TL.toUpper tla
+            , benchBS  $ nf (BS.map toUpper) bsa
+            , benchBSL $ nf (BL.map toUpper) bla
+            , benchS   $ nf (L.map toUpper) sa
+            ]
+        , bgroup "words"
+            [ benchT   $ nf T.words ta
+            , benchTL  $ nf TL.words tla
+            , benchBS  $ nf BS.words bsa
+            , benchBSL $ nf BL.words bla
+            , benchS   $ nf L.words sa
+            ]
+        , bgroup "zipWith"
+            [ benchT   $ nf (T.zipWith min tb) ta
+            , benchTL  $ nf (TL.zipWith min tlb) tla
+            , benchBS  $ nf (BS.zipWith min bsb) bsa
+            , benchBSL $ nf (BL.zipWith min blb) bla
+            , benchS   $ nf (L.zipWith min sb) sa
+            ]
+        , bgroup "length"
+            [ bgroup "cons"
+                [ benchT   $ nf (T.length . T.cons c) ta
+                , benchTL  $ nf (TL.length . TL.cons c) tla
+                , benchBS  $ nf (BS.length . BS.cons c) bsa
+                , benchBSL $ nf (BL.length . BL.cons c) bla
+                , benchS   $ nf (L.length . (:) c) sa
+                ]
+            , bgroup "decode"
+                [ benchT   $ nf (T.length . T.decodeUtf8) bsa
+                , benchTL  $ nf (TL.length . TL.decodeUtf8) bla
+                , benchBS  $ nf (L.length . BS.unpack) bsa
+                , benchBSL $ nf (L.length . BL.unpack) bla
+                , bench "StringUTF8" $ nf (L.length . UTF8.toString) bsa
+                ]
+            , bgroup "drop"
+                [ benchT   $ nf (T.length . T.drop (ta_len `div` 3)) ta
+                , benchTL  $ nf (TL.length . TL.drop (tla_len `div` 3)) tla
+                , benchBS  $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa
+                , benchBSL $ nf (BL.length . BL.drop (bla_len `div` 3)) bla
+                , benchS   $ nf (L.length . L.drop (sa_len `div` 3)) sa
+                ]
+            , bgroup "filter"
+                [ benchT   $ nf (T.length . T.filter p0) ta
+                , benchTL  $ nf (TL.length . TL.filter p0) tla
+                , benchBS  $ nf (BS.length . BS.filter p0) bsa
+                , benchBSL $ nf (BL.length . BL.filter p0) bla
+                , benchS   $ nf (L.length . L.filter p0) sa
+                ]
+            , bgroup "filter.filter"
+                [ benchT   $ nf (T.length . T.filter p1 . T.filter p0) ta
+                , benchTL  $ nf (TL.length . TL.filter p1 . TL.filter p0) tla
+                , benchBS  $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa
+                , benchBSL $ nf (BL.length . BL.filter p1 . BL.filter p0) bla
+                , benchS   $ nf (L.length . L.filter p1 . L.filter p0) sa
+                ]
+            , bgroup "init"
+                [ benchT   $ nf (T.length . T.init) ta
+                , benchTL  $ nf (TL.length . TL.init) tla
+                , benchBS  $ nf (BS.length . BS.init) bsa
+                , benchBSL $ nf (BL.length . BL.init) bla
+                , benchS   $ nf (L.length . L.init) sa
+                ]
+            , bgroup "intercalate"
+                [ benchT   $ nf (T.length . T.intercalate tsw) tl
+                , benchTL  $ nf (TL.length . TL.intercalate tlw) tll
+                , benchBS  $ nf (BS.length . BS.intercalate bsw) bsl
+                , benchBSL $ nf (BL.length . BL.intercalate blw) bll
+                , benchS   $ nf (L.length . L.intercalate lw) sl
+                ]
+            , bgroup "intersperse"
+                [ benchT   $ nf (T.length . T.intersperse c) ta
+                , benchTL  $ nf (TL.length . TL.intersperse c) tla
+                , benchBS  $ nf (BS.length . BS.intersperse c) bsa
+                , benchBSL $ nf (BL.length . BL.intersperse c) bla
+                , benchS   $ nf (L.length . L.intersperse c) sa
+                ]
+            , bgroup "map"
+                [ benchT   $ nf (T.length . T.map f) ta
+                , benchTL  $ nf (TL.length . TL.map f) tla
+                , benchBS  $ nf (BS.length . BS.map f) bsa
+                , benchBSL $ nf (BL.length . BL.map f) bla
+                , benchS   $ nf (L.length . L.map f) sa
+                ]
+            , bgroup "map.map"
+                [ benchT   $ nf (T.length . T.map f . T.map f) ta
+                , benchTL  $ nf (TL.length . TL.map f . TL.map f) tla
+                , benchBS  $ nf (BS.length . BS.map f . BS.map f) bsa
+                , benchS   $ nf (L.length . L.map f . L.map f) sa
+                ]
+            , bgroup "replicate char"
+                [ benchT   $ nf (T.length . T.replicate bsa_len) (T.singleton c)
+                , benchTL  $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
+                , benchBS  $ nf (BS.length . BS.replicate bsa_len) c
+                , benchBSL $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c
+                , benchS   $ nf (L.length . L.replicate bsa_len) c
+                ]
+            , bgroup "replicate string"
+                [ benchT   $ nf (T.length . T.replicate (bsa_len `div` T.length tsw)) tsw
+                , benchTL  $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
+                , benchS   $ nf (L.length . replicat (bsa_len `div` T.length tsw)) lw
+                ]
+            , bgroup "take"
+                [ benchT   $ nf (T.length . T.take (ta_len `div` 3)) ta
+                , benchTL  $ nf (TL.length . TL.take (tla_len `div` 3)) tla
+                , benchBS  $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa
+                , benchBSL $ nf (BL.length . BL.take (bla_len `div` 3)) bla
+                , benchS   $ nf (L.length . L.take (sa_len `div` 3)) sa
+                ]
+            , bgroup "tail"
+                [ benchT   $ nf (T.length . T.tail) ta
+                , benchTL  $ nf (TL.length . TL.tail) tla
+                , benchBS  $ nf (BS.length . BS.tail) bsa
+                , benchBSL $ nf (BL.length . BL.tail) bla
+                , benchS   $ nf (L.length . L.tail) sa
+                ]
+            , bgroup "toLower"
+                [ benchT   $ nf (T.length . T.toLower) ta
+                , benchTL  $ nf (TL.length . TL.toLower) tla
+                , benchBS  $ nf (BS.length . BS.map toLower) bsa
+                , benchBSL $ nf (BL.length . BL.map toLower) bla
+                , benchS   $ nf (L.length . L.map toLower) sa
+                ]
+            , bgroup "toUpper"
+                [ benchT   $ nf (T.length . T.toUpper) ta
+                , benchTL  $ nf (TL.length . TL.toUpper) tla
+                , benchBS  $ nf (BS.length . BS.map toUpper) bsa
+                , benchBSL $ nf (BL.length . BL.map toUpper) bla
+                , benchS   $ nf (L.length . L.map toUpper) sa
+                ]
+            , bgroup "words"
+                [ benchT   $ nf (L.length . T.words) ta
+                , benchTL  $ nf (L.length . TL.words) tla
+                , benchBS  $ nf (L.length . BS.words) bsa
+                , benchBSL $ nf (L.length . BL.words) bla
+                , benchS   $ nf (L.length . L.words) sa
+                ]
+            , bgroup "zipWith"
+                [ benchT   $ nf (T.length . T.zipWith min tb) ta
+                , benchTL  $ nf (TL.length . TL.zipWith min tlb) tla
+                , benchBS  $ nf (L.length . BS.zipWith min bsb) bsa
+                , benchBSL $ nf (L.length . BL.zipWith min blb) bla
+                , benchS   $ nf (L.length . L.zipWith min sb) sa
+                ]
+              ]
+        , bgroup "Builder"
+            [ bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000
+            , bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a'
+            , bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000
+            ]
+        ]
+  where
+    benchS   = bench "String"
+    benchT   = bench "Text"
+    benchTL  = bench "LazyText"
+    benchBS  = bench "ByteString"
+    benchBSL = bench "LazyByteString"
+
+    c  = 'й'
+    p0 = (== c)
+    p1 = (/= 'д')
+    lw  = "право"
+    bsw  = UTF8.fromString lw
+    blw  = BL.fromChunks [bsw]
+    tsw  = T.pack lw
+    tlw  = TL.fromChunks [tsw]
+    f (C# c#) = C# (chr# (ord# c# +# 1#))
+    g (I# i#) (C# c#) = (I# (i# +# 1#), C# (chr# (ord# c# +# i#)))
+    len l _ = l + (1::Int)
+    replicat n = concat . L.replicate n
+    short = T.pack "short"
+
+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
+
+-- | Split a bytestring in chunks
+--
+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
+
+-- | Append a character n times
+--
+mappendNChar :: Char -> Int -> TB.Builder
+mappendNChar c n = go 0
+  where
+    go i
+      | i < n     = TB.singleton c `mappend` go (i+1)
+      | otherwise = mempty
+
+-- | Gives more opportunity for inlining and elimination of unnecesary
+-- bounds checks.
+--
+mappend8Char :: Char -> TB.Builder
+mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`
+                 TB.singleton c `mappend` TB.singleton c `mappend`
+                 TB.singleton c `mappend` TB.singleton c `mappend`
+                 TB.singleton c `mappend` TB.singleton c
+
+-- | Append a text N times
+--
+mappendNText :: T.Text -> Int -> TB.Builder
+mappendNText t n = go 0
+  where
+    go i
+      | i < n     = TB.fromText t `mappend` go (i+1)
+      | otherwise = mempty

File benchmarks/haskell/Benchmarks/ReadNumbers.hs

+-- | Read numbers from a file with a just a number on each line, find the
+-- minimum of those numbers. The file contains different kinds of numbers:
+--
+-- * Decimals
+--
+-- * Hexadecimals
+--
+-- * Floating point numbers
+--
+-- * Floating point numbers in scientific notation
+--
+-- The different benchmarks will only take into account the values they can
+-- parse.
+--
+-- Tested in this benchmark:
+--
+-- * Lexing/parsing of different numerical types
+--
+module Benchmarks.ReadNumbers
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bgroup, bench, whnf)
+import Data.List (foldl')
+import Numeric (readDec, readFloat, readHex)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.ByteString.Lex.Double as B
+import qualified Data.ByteString.Lex.Lazy.Double as BL
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TL
+import qualified Data.Text.Lazy.Read as TL
+import qualified Data.Text.Read as T
+
+benchmark :: FilePath -> IO Benchmark
+benchmark fp = do
+    -- Read all files into lines: string, text, lazy text, bytestring, lazy
+    -- bytestring
+    s <- lines `fmap` readFile fp
+    t <- T.lines `fmap` T.readFile fp
+    tl <- TL.lines `fmap` TL.readFile fp
+    b <- B.lines `fmap` B.readFile fp
+    bl <- BL.lines `fmap` BL.readFile fp
+    return $ bgroup "ReadNumbers"
+        [ bench "DecimalString"     $ whnf (int . string readDec) s
+        , bench "HexadecimalString" $ whnf (int . string readHex) s
+        , bench "DoubleString"      $ whnf (double . string readFloat) s
+
+        , bench "DecimalText"     $ whnf (int . text (T.signed T.decimal)) t
+        , bench "HexadecimalText" $ whnf (int . text (T.signed T.hexadecimal)) t
+        , bench "DoubleText"      $ whnf (double . text T.double) t
+        , bench "RationalText"    $ whnf (double . text T.rational) t
+
+        , bench "DecimalLazyText" $
+            whnf (int . text (TL.signed TL.decimal)) tl
+        , bench "HexadecimalLazyText" $
+            whnf (int . text (TL.signed TL.hexadecimal)) tl
+        , bench "DoubleLazyText" $
+            whnf (double . text TL.double) tl
+        , bench "RationalLazyText" $
+            whnf (double . text TL.rational) tl
+
+        , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b
+        , bench "DoubleByteString"  $ whnf (double . byteString B.readDouble) b
+
+        , bench "DecimalLazyByteString" $
+            whnf (int . byteString BL.readInt) bl
+        , bench "DoubleLazyByteString" $
+            whnf (double . byteString BL.readDouble) bl
+        ]
+  where
+    -- Used for fixing types
+    int :: Int -> Int
+    int = id
+    double :: Double -> Double
+    double = id
+
+string :: (Ord a, Num a) => (t -> [(a, t)]) -> [t] -> a
+string reader = foldl' go 1000000
+  where
+    go z t = case reader t of [(n, _)] -> min n z
+                              _        -> z
+
+text :: (Ord a, Num a) => (t -> Either String (a,t)) -> [t] -> a
+text reader = foldl' go 1000000
+  where
+    go z t = case reader t of Left _       -> z
+                              Right (n, _) -> min n z
+    
+byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a
+byteString reader = foldl' go 1000000
+  where
+    go z t = case reader t of Nothing     -> z
+                              Just (n, _) -> min n z

File benchmarks/haskell/Benchmarks/Replace.hs

+-- | Replace a string by another string
+--
+-- Tested in this benchmark:
+--
+-- * Search and replace of a pattern in a text
+--
+module Benchmarks.Replace
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bgroup, bench, nf)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Search as BL
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Text.Lazy.IO as TL
+
+benchmark :: FilePath -> String -> String -> IO Benchmark
+benchmark fp pat sub = do
+    tl <- TL.readFile fp
+    bl <- BL.readFile fp
+    return $ bgroup "Replace"
+        [ bench "LazyText"       $ nf (TL.length . TL.replace tpat tsub) tl
+        , bench "LazyByteString" $ nf (BL.length . BL.replace bpat bsub) bl
+        ]
+  where
+    tpat = TL.pack pat
+    tsub = TL.pack sub
+    bpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tpat
+    bsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tsub

File benchmarks/haskell/Benchmarks/Search.hs

+-- | Search for a pattern in a file, find the number of occurences
+--
+-- Tested in this benchmark:
+--
+-- * Searching all occurences of a pattern using library routines
+--
+module Benchmarks.Search
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bench, bgroup, whnf)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Search as BL
+import qualified Data.ByteString.Search as B
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TL
+
+benchmark :: FilePath -> T.Text -> IO Benchmark
+benchmark fp needleT = do
+    b  <- B.readFile fp
+    bl <- BL.readFile fp
+    t  <- T.readFile fp
+    tl <- TL.readFile fp
+    return $ bgroup "FileIndices"
+        [ bench "ByteString"     $ whnf (byteString needleB)     b
+        , bench "LazyByteString" $ whnf (lazyByteString needleB) bl
+        , bench "Text"           $ whnf (text needleT)           t
+        , bench "LazyText"       $ whnf (lazyText needleTL)      tl
+        ]
+  where
+    needleB = T.encodeUtf8 needleT
+    needleTL = TL.fromChunks [needleT]
+
+byteString :: B.ByteString -> B.ByteString -> Int
+byteString needle = length . B.indices needle
+
+lazyByteString :: B.ByteString -> BL.ByteString -> Int
+lazyByteString needle = length . BL.indices needle
+
+text :: T.Text -> T.Text -> Int
+text = T.count
+
+lazyText :: TL.Text -> TL.Text -> Int
+lazyText needle = fromIntegral . TL.count needle

File benchmarks/haskell/Benchmarks/Stream.hs

+-- | This module contains a number of benchmarks for the different streaming
+-- functions
+--
+-- Tested in this benchmark:
+--
+-- * Most streaming functions
+--
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Benchmarks.Stream
+    ( benchmark
+    ) where
+
+import Control.DeepSeq (NFData (..))
+import Criterion (Benchmark, bgroup, bench, nf)
+import Data.Text.Fusion.Internal (Step (..), Stream (..))
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Encoding.Error as E
+import qualified Data.Text.Encoding.Fusion as T
+import qualified Data.Text.Encoding.Fusion.Common as F
+import qualified Data.Text.Fusion as T
+import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Text.Lazy.Encoding.Fusion as TL
+import qualified Data.Text.Lazy.Fusion as TL
+import qualified Data.Text.Lazy.IO as TL
+
+instance NFData a => NFData (Stream a) where
+    -- Currently, this implementation does not force evaluation of the size hint
+    rnf (Stream next s0 _) = go s0
+      where
+        go !s = case next s of
+            Done       -> ()
+            Skip s'    -> go s'
+            Yield x s' -> rnf x `seq` go s'
+
+benchmark :: FilePath -> IO Benchmark
+benchmark fp = do
+    -- Different formats
+    t  <- T.readFile fp
+    let !utf8    = T.encodeUtf8 t
+        !utf16le = T.encodeUtf16LE t
+        !utf16be = T.encodeUtf16BE t
+        !utf32le = T.encodeUtf32LE t
+        !utf32be = T.encodeUtf32BE t
+
+    -- Once again for the lazy variants
+    tl <- TL.readFile fp
+    let !utf8L    = TL.encodeUtf8 tl
+        !utf16leL = TL.encodeUtf16LE tl
+        !utf16beL = TL.encodeUtf16BE tl
+        !utf32leL = TL.encodeUtf32LE tl
+        !utf32beL = TL.encodeUtf32BE tl
+
+    -- For the functions which operate on streams
+    let !s = T.stream t
+
+    return $ bgroup "Stream"
+
+        -- Fusion
+        [ bgroup "stream" $
+            [ bench "Text"     $ nf T.stream t
+            , bench "LazyText" $ nf TL.stream tl
+            ]
+
+        -- Encoding.Fusion
+        , bgroup "streamUtf8"
+            [ bench "Text"     $ nf (T.streamUtf8 E.lenientDecode) utf8
+            , bench "LazyText" $ nf (TL.streamUtf8 E.lenientDecode) utf8L
+            ]
+        , bgroup "streamUtf16LE"
+            [ bench "Text"     $ nf (T.streamUtf16LE E.lenientDecode) utf16le
+            , bench "LazyText" $ nf (TL.streamUtf16LE E.lenientDecode) utf16leL
+            ]
+        , bgroup "streamUtf16BE"
+            [ bench "Text"     $ nf (T.streamUtf16BE E.lenientDecode) utf16be
+            , bench "LazyText" $ nf (TL.streamUtf16BE E.lenientDecode) utf16beL
+            ]
+        , bgroup "streamUtf32LE"
+            [ bench "Text"     $ nf (T.streamUtf32LE E.lenientDecode) utf32le
+            , bench "LazyText" $ nf (TL.streamUtf32LE E.lenientDecode) utf32leL
+            ]
+        , bgroup "streamUtf32BE"
+            [ bench "Text"     $ nf (T.streamUtf32BE E.lenientDecode) utf32be
+            , bench "LazyText" $ nf (TL.streamUtf32BE E.lenientDecode) utf32beL
+            ]
+
+        -- Encoding.Fusion.Common
+        , bench "restreamUtf8"    $ nf F.restreamUtf8 s
+        , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s
+        , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s
+        , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s
+        , bench "restreamUtf32BE" $ nf F.restreamUtf32BE s
+        ]

File benchmarks/haskell/Benchmarks/WordFrequencies.hs

+-- | A word frequency count using the different string types
+--
+-- Tested in this benchmark:
+--
+-- * Splitting into words
+--
+-- * Converting to lowercase
+--
+-- * Comparing: Eq/Ord instances
+--
+module Benchmarks.WordFrequencies
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bench, bgroup, whnf)
+import Data.Char (toLower)
+import Data.List (foldl')
+import Data.Map (Map)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.Map as M
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+benchmark :: FilePath -> IO Benchmark
+benchmark fp = do
+    s <- readFile fp
+    b <- B.readFile fp
+    t <- T.readFile fp
+    return $ bgroup "WordFrequencies"
+        [ bench "String"     $ whnf (frequencies . words . map toLower)     s
+        , bench "ByteString" $ whnf (frequencies . B.words . B.map toLower) b
+        , bench "Text"       $ whnf (frequencies . T.words . T.toLower)     t
+        ]
+
+frequencies :: Ord a => [a] -> Map a Int
+frequencies = foldl' (\m k -> M.insertWith (+) k 1 m) M.empty

File benchmarks/python/.gitignore

+__pycache__
+*.pyc

File benchmarks/python/cut.py

+#!/usr/bin/env python
+
+import utils, sys, codecs
+
+def cut(filename, l, r):
+    content = open(filename, encoding='utf-8')
+    for line in content:
+        print(line[l:r])
+
+for f in sys.argv[1:]:
+    t = utils.benchmark(lambda: cut(f, 20, 40))
+    sys.stderr.write('{0}: {1}\n'.format(f, t))

File benchmarks/python/sort.py

+#!/usr/bin/env python
+
+import utils, sys, codecs
+
+def sort(filename):
+    content = open(filename, encoding='utf-8').read()
+    lines = content.splitlines()
+    lines.sort()
+    print('\n'.join(lines))
+
+for f in sys.argv[1:]:
+    t = utils.benchmark(lambda: sort(f))
+    sys.stderr.write('{0}: {1}\n'.format(f, t))

File benchmarks/python/strip_tags.py

+#!/usr/bin/env python
+
+import utils, sys
+
+def strip_tags(filename):
+    string = open(filename, encoding='utf-8').read()
+
+    d = 0
+    out = []
+
+    for c in string:
+        if c == '<': d += 1
+
+        if d > 0:
+            out += ' '
+        else:
+            out += c
+
+        if c == '>': d -= 1
+
+    print(''.join(out))
+
+for f in sys.argv[1:]:
+    t = utils.benchmark(lambda: strip_tags(f))
+    sys.stderr.write('{0}: {1}\n'.format(f, t))

File benchmarks/python/utils.py

+#!/usr/bin/env python
+
+import sys, time
+
+def benchmark_once(f):
+    start = time.time()
+    f()
+    end = time.time()
+    return end - start
+
+def benchmark(f):
+    runs = 100
+    total = 0.0
+    for i in range(runs):
+        result = benchmark_once(f)
+        sys.stderr.write('Run {0}: {1}\n'.format(i, result))
+        total += result
+    return total / runs

File benchmarks/ruby/cut.rb

+#!/usr/bin/env ruby
+
+require './utils.rb'
+
+def cut(filename, l, r)
+  File.open(filename, 'r:utf-8') do |file|
+    file.each_line do |line|
+      puts line[l, r - l]
+    end
+  end
+end
+
+ARGV.each do |f|
+  t = benchmark { cut(f, 20, 40) }
+  STDERR.puts "#{f}: #{t}"
+end

File benchmarks/ruby/fold.rb

+#!/usr/bin/env ruby
+
+require './utils.rb'
+
+def fold(filename, max_width)
+  File.open(filename, 'r:utf-8') do |file|
+    # Words in this paragraph
+    paragraph = []
+
+    file.each_line do |line|
+      # If we encounter an empty line, we reformat and dump the current
+      # paragraph
+      if line.strip.empty?
+        puts fold_paragraph(paragraph, max_width)
+        puts
+        paragraph = []
+      # Otherwise, we append the words found in the line to the paragraph
+      else
+        paragraph.concat line.split
+      end
+    end
+
+    # Last paragraph
+    puts fold_paragraph(paragraph, max_width) unless paragraph.empty?
+  end
+end
+
+# Fold a single paragraph to the desired width
+def fold_paragraph(paragraph, max_width)
+  # Gradually build our output
+  str, *rest = paragraph
+  width = str.length
+
+  rest.each do |word|
+    if width + word.length + 1 <= max_width
+      str << ' ' << word
+      width += word.length + 1
+    else
+      str << "\n" << word
+      width = word.length
+    end
+  end
+
+  str
+end
+
+ARGV.each do |f|
+  t = benchmark { fold(f, 80) }
+  STDERR.puts "#{f}: #{t}"
+end

File benchmarks/ruby/sort.rb

+#!/usr/bin/env ruby
+
+require './utils.rb'
+
+def sort(filename)
+  File.open(filename, 'r:utf-8') do |file|
+    content = file.read
+    puts content.lines.sort.join
+  end
+end
+
+ARGV.each do |f|
+  t = benchmark { sort(f) }
+  STDERR.puts "#{f}: #{t}"
+end

File benchmarks/ruby/strip_tags.rb

+#!/usr/bin/env ruby
+
+require './utils.rb'
+
+def strip_tags(filename)
+  File.open(filename, 'r:utf-8') do |file|
+    str = file.read
+
+    d = 0
+
+    str.each_char do |c|
+      d += 1 if c == '<'
+      putc(if d > 0 then ' ' else c end)
+      d -= 1 if c == '>'
+    end
+  end
+end
+
+ARGV.each do |f|
+  t = benchmark { strip_tags(f) }
+  STDERR.puts "#{f}: #{t}"
+end

File benchmarks/ruby/utils.rb

+require 'benchmark'
+
+def benchmark(&block)
+  runs = 100
+  total = 0
+
+  runs.times do |i|
+    result = Benchmark.measure(&block).total
+    $stderr.puts "Run #{i}: #{result}"
+    total += result
+  end
+
+  total / runs 
+end

File benchmarks/text-benchmarks.cabal

+name:                text-benchmarks
+version:             0.0.0.0
+synopsis:            Benchmarks for the text package
+description:         Benchmarks for the text package
+homepage:            https://bitbucket.org/bos/text
+license:             BSD3
+license-file:        ../LICENSE
+author:              Jasper Van der Jeugt <jaspervdj@gmail.com>,
+                     Bryan O'Sullivan <bos@serpentine.com>,
+                     Tom Harper <rtomharper@googlemail.com>,
+                     Duncan Coutts <duncan@haskell.org>
+maintainer:          jaspervdj@gmail.com
+category:            Text
+build-type:          Simple
+
+cabal-version:       >=1.2
+
+executable text-benchmarks
+  hs-source-dirs: haskell ..
+  c-sources:      ../cbits/cbits.c
+                  cbits/time_iconv.c
+  main-is:        Benchmarks.hs
+  ghc-options:    -Wall -O2
+  cpp-options:    -DHAVE_DEEPSEQ
+  build-depends:  base == 4.*,
+                  binary,
+                  blaze-builder,
+                  bytestring,
+                  bytestring-lexing,
+                  containers,
+                  criterion >= 0.6.0.1,
+                  deepseq,
+                  directory,
+                  filepath,
+                  ghc-prim,
+                  stringsearch,
+                  utf8-string