text 0.11.0.8 → 0.11.1.0

raw patch · 57 files changed

+2311/−1212 lines, 57 filesdep +arraydep +integerdep +integer-gmpdep ~basedep ~bytestring

Dependencies added: array, integer, integer-gmp

Dependency ranges changed: base, bytestring

Files

Data/Text/IO.hs +3/−3
Data/Text/Lazy/Builder.hs +46/−35
Data/Text/Lazy/Builder/Functions.hs +35/−0
Data/Text/Lazy/Builder/Int.hs +152/−0
Data/Text/Lazy/Builder/RealFloat.hs +239/−0
tests/Benchmarks.hs +0/−463
tests/Chartem.hs +153/−0
tests/Makefile +2/−7
tests/README.markdown +43/−0
tests/Regressions.hs +51/−0
tests/SearchBench.hs +115/−0
tests/benchmarks/Cut.hs +0/−60
tests/benchmarks/DecodeUtf8.hs +0/−107
tests/benchmarks/EncodeUtf8.hs +0/−55
tests/benchmarks/Equality.hs +0/−31
tests/benchmarks/FileIndices.hs +0/−25
tests/benchmarks/FileRead.hs +0/−57
tests/benchmarks/FoldLines.hs +0/−47
tests/benchmarks/HtmlCombinator.hs +0/−24
tests/benchmarks/Makefile +0/−18
tests/benchmarks/Replace.hs +0/−23
tests/benchmarks/ReplaceTags.hs +0/−91
tests/benchmarks/Setup.hs +2/−0
tests/benchmarks/fileread.py +0/−41
tests/benchmarks/fileread_c.c +0/−96
tests/benchmarks/python/case_map.py +7/−0
tests/benchmarks/python/file_read.py +7/−0
tests/benchmarks/python/sort.py +15/−0
tests/benchmarks/python/strip_brackets.py +22/−0
tests/benchmarks/python/utils.py +22/−0
tests/benchmarks/python/word_count.py +17/−0
tests/benchmarks/ruby/case_map.rb +8/−0
tests/benchmarks/ruby/file_read.rb +8/−0
tests/benchmarks/ruby/sort.rb +14/−0
tests/benchmarks/ruby/strip_brackets.rb +21/−0
tests/benchmarks/ruby/utils.rb +20/−0
tests/benchmarks/ruby/word_count.rb +16/−0
tests/benchmarks/src/Data/Text/Benchmarks.hs +58/−0
tests/benchmarks/src/Data/Text/Benchmarks/Builder.hs +44/−0
tests/benchmarks/src/Data/Text/Benchmarks/CaseMap.hs +15/−0
tests/benchmarks/src/Data/Text/Benchmarks/Cut.hs +86/−0
tests/benchmarks/src/Data/Text/Benchmarks/DecodeUtf8.hs +95/−0
tests/benchmarks/src/Data/Text/Benchmarks/EncodeUtf8.hs +33/−0
tests/benchmarks/src/Data/Text/Benchmarks/Equality.hs +30/−0
tests/benchmarks/src/Data/Text/Benchmarks/FileIndices.hs +28/−0
tests/benchmarks/src/Data/Text/Benchmarks/FileRead.hs +29/−0
tests/benchmarks/src/Data/Text/Benchmarks/FoldLines.hs +53/−0
tests/benchmarks/src/Data/Text/Benchmarks/HtmlCombinator.hs +36/−0
tests/benchmarks/src/Data/Text/Benchmarks/Ordering.hs +58/−0
tests/benchmarks/src/Data/Text/Benchmarks/Pure.hs +470/−0
tests/benchmarks/src/Data/Text/Benchmarks/ReadNumbers.hs +83/−0
tests/benchmarks/src/Data/Text/Benchmarks/Replace.hs +33/−0
tests/benchmarks/src/Data/Text/Benchmarks/Sort.hs +27/−0
tests/benchmarks/src/Data/Text/Benchmarks/StripBrackets.hs +33/−0
tests/benchmarks/src/Data/Text/Benchmarks/WordCount.hs +22/−0
tests/benchmarks/text-benchmarks.cabal +34/−0
text.cabal +26/−29

Data/Text/IO.hs view

@@ -46,7 +46,7 @@ import qualified Data.ByteString.Char8 as B import Data.Text.Encoding (decodeUtf8, encodeUtf8) #else-import Control.Exception (catch, throw)+import Control.Exception (catch, throwIO) import Control.Monad (liftM2, when) import Data.IORef (readIORef, writeIORef) import qualified Data.Text as T@@ -123,7 +123,7 @@               return $ if isEmptyBuffer buf                        then T.empty                        else T.singleton '\r'-          | otherwise = throw (augmentIOError e "hGetContents" h)+          | otherwise = throwIO (augmentIOError e "hGetContents" h)         readChunks = do           buf <- readIORef haCharBuffer           t <- readChunk hh buf `catch` catchError@@ -147,7 +147,7 @@       d <- catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->            if ioe_type e == InappropriateType            then return 16384 -- faster than the 2KB default-           else throw e+           else throwIO e       when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d     _ -> return () #endif

Data/Text/Lazy/Builder.hs view

@@ -82,14 +82,22 @@    {-# INLINE mempty #-}    mappend = append    {-# INLINE mappend #-}+   mconcat = foldr mappend mempty+   {-# INLINE mconcat #-}  instance String.IsString Builder where     fromString = fromString     {-# INLINE fromString #-}  instance Show Builder where-    show = L.unpack . toLazyText+    show = show . toLazyText +instance Eq Builder where+    a == b = toLazyText a == toLazyText b++instance Ord Builder where+    a <= b = toLazyText a <= toLazyText b+ ------------------------------------------------------------------------  -- | /O(1)./ The empty @Builder@, satisfying@@ -97,7 +105,7 @@ --  * @'toLazyText' 'empty' = 'L.empty'@ -- empty :: Builder-empty = Builder id+empty = Builder (\ k buf -> k buf) {-# INLINE empty #-}  -- | /O(1)./ A @Builder@ taking a single character, satisfying@@ -105,7 +113,17 @@ --  * @'toLazyText' ('singleton' c) = 'L.singleton' c@ -- singleton :: Char -> Builder-singleton c = putChar c+singleton c = writeAtMost 2 $ \ marr o ->+    if n < 0x10000+    then A.unsafeWrite marr o (fromIntegral n) >> return 1+    else do+        A.unsafeWrite marr o lo+        A.unsafeWrite marr (o+1) hi+        return 2+  where n = ord c+        m = n - 0x10000+        lo = fromIntegral $ (m `shiftR` 10) + 0xD800+        hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00 {-# INLINE singleton #-}  ------------------------------------------------------------------------@@ -229,20 +247,6 @@  ------------------------------------------------------------------------ -putChar :: Char -> Builder-putChar c-    | n < 0x10000 = writeN 1 $ \marr o -> A.unsafeWrite marr o (fromIntegral n)-    | otherwise   = writeN 2 $ \marr o -> do-          A.unsafeWrite marr o lo-          A.unsafeWrite marr (o+1) hi-  where n = ord c-        m = n - 0x10000-        lo = fromIntegral $ (m `shiftR` 10) + 0xD800-        hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00-{-# INLINE putChar #-}--------------------------------------------------------------------------- -- | Ensure that there are at least @n@ many elements available. ensureFree :: Int -> Builder ensureFree !n = withSize $ \ l ->@@ -251,18 +255,21 @@     else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize))) {-# INLINE [0] ensureFree #-} +writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder+writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)+{-# INLINE [0] writeAtMost #-}+ -- | Ensure that @n@ many elements are available, and then use @f@ to -- write some elements into the memory. writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder-writeN n f = ensureFree n `append'` withBuffer (writeNBuffer n f)-{-# INLINE [0] writeN #-}+writeN n f = writeAtMost n (\ p o -> f p o >> return n)+{-# INLINE writeN #-} -writeNBuffer :: Int -> (A.MArray s -> Int -> ST s ()) -> (Buffer s)-             -> ST s (Buffer s)-writeNBuffer n f (Buffer p o u l) = do-    f p (o+u)+writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)+writeBuffer f (Buffer p o u l) = do+    n <- f p (o+u)     return $! Buffer p o (u+n) (l-n)-{-# INLINE writeNBuffer #-}+{-# INLINE writeBuffer #-}  newBuffer :: Int -> ST s (Buffer s) newBuffer size = do@@ -275,27 +282,31 @@  -- This function makes GHC understand that 'writeN' and 'ensureFree' -- are *not* recursive in the precense of the rewrite rules below.--- This is not needed with GHC 6.14+.+-- This is not needed with GHC 7+. append' :: Builder -> Builder -> Builder append' (Builder f) (Builder g) = Builder (f . g) {-# INLINE append' #-}  {-# RULES -"append/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())-                           (g::forall s. A.MArray s -> Int -> ST s ()) ws.-        append (writeN a f) (append (writeN b g) ws) =-            append (writeN (a+b) (\marr o -> f marr o >> g marr (o+a))) ws+"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)+                           (g::forall s. A.MArray s -> Int -> ST s Int) ws.+    append (writeAtMost a f) (append (writeAtMost b g) ws) =+        append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n -> +                                    g marr (o+n) >>= \ m ->+                                    let s = n+m in s `seq` return s)) ws -"writeN/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())-                           (g::forall s. A.MArray s -> Int -> ST s ()).-        append (writeN a f) (writeN b g) =-            writeN (a+b) (\marr o -> f marr o >> g marr (o+a))+"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)+                           (g::forall s. A.MArray s -> Int -> ST s Int).+    append (writeAtMost a f) (writeAtMost b g) =+        writeAtMost (a+b) (\marr o -> f marr o >>= \ n -> +                            g marr (o+n) >>= \ m ->+                            let s = n+m in s `seq` return s)  "ensureFree/ensureFree" forall a b .-        append (ensureFree a) (ensureFree b) = ensureFree (max a b)+    append (ensureFree a) (ensureFree b) = ensureFree (max a b)  "flush/flush"-        append flush flush = flush+    append flush flush = flush   #-}

+ Data/Text/Lazy/Builder/Functions.hs view

@@ -0,0 +1,35 @@+{-# LANGUAGE MagicHash #-}++-- |+-- Module      : Data.Text.Lazy.Builder.Functions+-- Copyright   : (c) 2011 MailRank, Inc.+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- Useful functions and combinators.++module Data.Text.Lazy.Builder.Functions+    (+      (<>)+    , i2d+    ) where++import Data.Monoid (mappend)+import Data.Text.Lazy.Builder (Builder)+import GHC.Base++-- | Unsafe conversion for decimal digits.+{-# INLINE i2d #-}+i2d :: Int -> Char+i2d (I# i#) = C# (chr# (ord# '0'# +# i#))++-- | The normal 'mappend' function with right associativity instead of+-- left.+(<>) :: Builder -> Builder -> Builder+(<>) = mappend+{-# INLINE (<>) #-}++infixr 4 <>

+ Data/Text/Lazy/Builder/Int.hs view

@@ -0,0 +1,152 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}++-- Module:      Data.Text.Lazy.Builder.Int+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     BSD3+-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>+-- Stability:   experimental+-- Portability: portable+--+-- Efficiently write an integral value to a 'Builder'.++module Data.Text.Lazy.Builder.Int+    (+      decimal+    , hexadecimal+    ) where++import Data.Int (Int8, Int16, Int32, Int64)+import Data.Monoid (mempty)+import Data.Text.Lazy.Builder.Functions ((<>), i2d)+import Data.Text.Lazy.Builder+import Data.Word (Word, Word8, Word16, Word32, Word64)+import GHC.Base (quotInt, remInt)+import GHC.Num (quotRemInteger)+import GHC.Types (Int(..))++#ifdef  __GLASGOW_HASKELL__+# if __GLASGOW_HASKELL__ < 611+import GHC.Integer.Internals+# else+import GHC.Integer.GMP.Internals+# endif+#endif++#ifdef INTEGER_GMP+# define PAIR(a,b) (# a,b #)+#else+# define PAIR(a,b) (a,b)+#endif++decimal :: Integral a => a -> Builder+{-# SPECIALIZE decimal :: Int -> Builder #-}+{-# SPECIALIZE decimal :: Int8 -> Builder #-}+{-# SPECIALIZE decimal :: Int16 -> Builder #-}+{-# SPECIALIZE decimal :: Int32 -> Builder #-}+{-# SPECIALIZE decimal :: Int64 -> Builder #-}+{-# SPECIALIZE decimal :: Word -> Builder #-}+{-# SPECIALIZE decimal :: Word8 -> Builder #-}+{-# SPECIALIZE decimal :: Word16 -> Builder #-}+{-# SPECIALIZE decimal :: Word32 -> Builder #-}+{-# SPECIALIZE decimal :: Word64 -> Builder #-}+{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}+decimal i+    | i < 0     = singleton '-' <> go (-i)+    | otherwise = go i+  where+    go n | n < 10    = digit n+         | otherwise = go (n `quot` 10) <> digit (n `rem` 10)++hexadecimal :: Integral a => a -> Builder+{-# SPECIALIZE hexadecimal :: Int -> Builder #-}+{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Word -> Builder #-}+{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}+{-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-}+hexadecimal i+    | i < 0     = singleton '-' <> go (-i)+    | otherwise = go i+  where+    go n | n < 16    = hexDigit n+         | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)++digit :: Integral a => a -> Builder+digit n = singleton $! i2d (fromIntegral n)+{-# INLINE digit #-}++hexDigit :: Integral a => a -> Builder+hexDigit n+    | n <= 9    = singleton $! i2d (fromIntegral n)+    | otherwise = singleton $! toEnum (fromIntegral n + 87)+{-# INLINE hexDigit #-}++int :: Int -> Builder+int = decimal+{-# INLINE int #-}++data T = T !Integer !Int++integer :: Int -> Integer -> Builder+integer 10 (S# i#) = decimal (I# i#)+integer 16 (S# i#) = hexadecimal (I# i#)+integer base i+    | i < 0     = singleton '-' <> go (-i)+    | otherwise = go i+  where+    go n | n < maxInt = int (fromInteger n)+         | otherwise  = putH (splitf (maxInt * maxInt) n)++    splitf p n+      | p > n       = [n]+      | otherwise   = splith p (splitf (p*p) n)++    splith p (n:ns) = case n `quotRemInteger` p of+                        PAIR(q,r) | q > 0     -> q : r : splitb p ns+                                  | otherwise -> r : splitb p ns+    splith _ _      = error "splith: the impossible happened."++    splitb p (n:ns) = case n `quotRemInteger` p of+                        PAIR(q,r) -> q : r : splitb p ns+    splitb _ _      = []++    T maxInt10 maxDigits10 =+        until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)+      where mi = fromIntegral (maxBound :: Int)+    T maxInt16 maxDigits16 =+        until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)+      where mi = fromIntegral (maxBound :: Int)++    fstT (T a _) = a++    maxInt | base == 10 = maxInt10+           | otherwise  = maxInt16+    maxDigits | base == 10 = maxDigits10+              | otherwise  = maxDigits16++    putH (n:ns) = case n `quotRemInteger` maxInt of+                    PAIR(x,y)+                        | q > 0     -> int q <> pblock r <> putB ns+                        | otherwise -> int r <> putB ns+                        where q = fromInteger x+                              r = fromInteger y+    putH _ = error "putH: the impossible happened"++    putB (n:ns) = case n `quotRemInteger` maxInt of+                    PAIR(x,y) -> pblock q <> pblock r <> putB ns+                        where q = fromInteger x+                              r = fromInteger y+    putB _ = mempty++    pblock = loop maxDigits+      where+        loop !d !n+            | d == 1    = digit n+            | otherwise = loop (d-1) q <> digit r+            where q = n `quotInt` base+                  r = n `remInt` base

+ Data/Text/Lazy/Builder/RealFloat.hs view

@@ -0,0 +1,239 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module:    Data.Text.Lazy.Builder.RealFloat+-- Copyright: (c) The University of Glasgow 1994-2002+-- License:   see libraries/base/LICENSE+--+-- Write a floating point value to a 'Builder'.++module Data.Text.Lazy.Builder.RealFloat+    (+      FPFormat(..)+    , realFloat+    , formatRealFloat+    ) where++import Data.Array.Base (unsafeAt)+import Data.Array.IArray+import Data.Text.Lazy.Builder.Functions ((<>), i2d)+import Data.Text.Lazy.Builder.Int (decimal)+import Data.Text.Lazy.Builder.RealFloat.Functions (roundTo)+import Data.Text.Lazy.Builder+import qualified Data.Text as T++-- | Control the rendering of floating point numbers.+data FPFormat = Exponent+              -- ^ Scientific notation (e.g. @2.3e123@).+              | Fixed+              -- ^ Standard decimal notation.+              | Generic+              -- ^ Use decimal notation for values between @0.1@ and+              -- @9,999,999@, and scientific notation otherwise.+                deriving (Enum, Read, Show)++-- | Show a signed 'RealFloat' value to full precision,+-- using standard decimal notation for arguments whose absolute value lies+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.+realFloat :: (RealFloat a) => a -> Builder+{-# SPECIALIZE realFloat :: Float -> Builder #-}+{-# SPECIALIZE realFloat :: Double -> Builder #-}+realFloat x = formatRealFloat Generic Nothing x++formatRealFloat :: (RealFloat a) =>+                   FPFormat+                -> Maybe Int  -- ^ Number of decimal places to render.+                -> a+                -> Builder+{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}+{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}+formatRealFloat fmt decs x+   | isNaN x                   = "NaN"+   | isInfinite x              = if x < 0 then "-Infinity" else "Infinity"+   | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x))+   | otherwise                 = doFmt fmt (floatToDigits x)+ where+  doFmt format (is, e) =+    let ds = map i2d is in+    case format of+     Generic ->+      doFmt (if e < 0 || e > 7 then Exponent else Fixed)+            (is,e)+     Exponent ->+      case decs of+       Nothing ->+        let show_e' = decimal (e-1) in+        case ds of+          "0"     -> "0.0e0"+          [d]     -> singleton d <> ".0e" <> show_e'+          (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e'+          []      -> error "formatRealFloat/doFmt/Exponent: []"+       Just dec ->+        let dec' = max dec 1 in+        case is of+         [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"+         _ ->+          let+           (ei,is') = roundTo (dec'+1) is+           (d:ds') = map i2d (if ei > 0 then init is' else is')+          in+          singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)+     Fixed ->+      let+       mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}+      in+      case decs of+       Nothing+          | e <= 0    -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds+          | otherwise ->+             let+                f 0 s    rs  = mk0 (reverse s) <> singleton '.' <> mk0 rs+                f n s    ""  = f (n-1) ('0':s) ""+                f n s (r:rs) = f (n-1) (r:s) rs+             in+                f e "" ds+       Just dec ->+        let dec' = max dec 0 in+        if e >= 0 then+         let+          (ei,is') = roundTo (dec' + e) is+          (ls,rs)  = splitAt (e+ei) (map i2d is')+         in+         mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)+        else+         let+          (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)+          d:ds' = map i2d (if ei > 0 then is' else 0:is')+         in+         singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')+++-- Based on "Printing Floating-Point Numbers Quickly and Accurately"+-- by R.G. Burger and R.K. Dybvig in PLDI 96.+-- This version uses a much slower logarithm estimator. It should be improved.++-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,+-- and returns a list of digits and an exponent.+-- In particular, if @x>=0@, and+--+-- > floatToDigits base x = ([d1,d2,...,dn], e)+--+-- then+--+--      (1) @n >= 1@+--+--      (2) @x = 0.d1d2...dn * (base**e)@+--+--      (3) @0 <= di <= base-1@++floatToDigits :: (RealFloat a) => a -> ([Int], Int)+{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}+{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}+floatToDigits 0 = ([0], 0)+floatToDigits x =+ let+  (f0, e0) = decodeFloat x+  (minExp0, _) = floatRange x+  p = floatDigits x+  b = floatRadix x+  minExp = minExp0 - p -- the real minimum exponent+  -- Haskell requires that f be adjusted so denormalized numbers+  -- will have an impossibly low exponent.  Adjust for this.+  (f, e) =+   let n = minExp - e0 in+   if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)+  (r, s, mUp, mDn) =+   if e >= 0 then+    let be = expt b e in+    if f == expt b (p-1) then+      (f*be*b*2, 2*b, be*b, be)     -- according to Burger and Dybvig+    else+      (f*be*2, 2, be, be)+   else+    if e > minExp && f == expt b (p-1) then+      (f*b*2, expt b (-e+1)*2, b, 1)+    else+      (f*2, expt b (-e)*2, 1, 1)+  k :: Int+  k =+   let+    k0 :: Int+    k0 =+     if b == 2 then+        -- logBase 10 2 is very slightly larger than 8651/28738+        -- (about 5.3558e-10), so if log x >= 0, the approximation+        -- k1 is too small, hence we add one and need one fixup step less.+        -- If log x < 0, the approximation errs rather on the high side.+        -- That is usually more than compensated for by ignoring the+        -- fractional part of logBase 2 x, but when x is a power of 1/2+        -- or slightly larger and the exponent is a multiple of the+        -- denominator of the rational approximation to logBase 10 2,+        -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,+        -- we get a leading zero-digit we don't want.+        -- With the approximation 3/10, this happened for+        -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.+        -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x+        -- for IEEE-ish floating point types with exponent fields+        -- <= 17 bits and mantissae of several thousand bits, earlier+        -- convergents to logBase 10 2 would fail for long double.+        -- Using quot instead of div is a little faster and requires+        -- fewer fixup steps for negative lx.+        let lx = p - 1 + e0+            k1 = (lx * 8651) `quot` 28738+        in if lx >= 0 then k1 + 1 else k1+     else+        -- f :: Integer, log :: Float -> Float,+        --               ceiling :: Float -> Int+        ceiling ((log (fromInteger (f+1) :: Float) ++                 fromIntegral e * log (fromInteger b)) /+                   log 10)+--WAS:            fromInt e * log (fromInteger b))++    fixup n =+      if n >= 0 then+        if r + mUp <= expt 10 n * s then n else fixup (n+1)+      else+        if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)+   in+   fixup k0++  gen ds rn sN mUpN mDnN =+   let+    (dn, rn') = (rn * 10) `quotRem` sN+    mUpN' = mUpN * 10+    mDnN' = mDnN * 10+   in+   case (rn' < mDnN', rn' + mUpN' > sN) of+    (True,  False) -> dn : ds+    (False, True)  -> dn+1 : ds+    (True,  True)  -> if rn' * 2 < sN then dn : ds else dn+1 : ds+    (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'++  rds =+   if k >= 0 then+      gen [] r (s * expt 10 k) mUp mDn+   else+     let bk = expt 10 (-k) in+     gen [] (r * bk) s (mUp * bk) (mDn * bk)+ in+ (map fromIntegral (reverse rds), k)++-- Exponentiation with a cache for the most common numbers.+minExpt, maxExpt :: Int+minExpt = 0+maxExpt = 1100++expt :: Integer -> Int -> Integer+expt base n+    | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n+    | base == 10 && n <= maxExpt10              = expts10 `unsafeAt` n+    | otherwise                                 = base^n++expts :: Array Int Integer+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]++maxExpt10 :: Int+maxExpt10 = 324++expts10 :: Array Int Integer+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]

− tests/Benchmarks.hs

@@ -1,463 +0,0 @@-{-# LANGUAGE BangPatterns, 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 Data.Monoid (mappend, mempty)-import qualified Data.ByteString.UTF8 as UTF8-import qualified Data.Text as TS-import qualified Data.Text.IO as TS-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TB-import qualified Data.Text.Lazy.IO 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 Control.DeepSeq-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-  let dataFile = "text/test/russian.txt"-  bsa <- BS.readFile dataFile-  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 "encode" [-        bench "ts" $ nf TS.encodeUtf8 tsa-      , bench "tl" $ nf TL.encodeUtf8 tla-      , bench "bs" $ nf BS.pack la-      , bench "bl" $ nf BL.pack la-      , bench "l" $ nf UTF8.fromString 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 "mapAccumL" [-        bench "ts" $ nf (TS.mapAccumL g 0) tsa-      , bench "tl" $ nf (TL.mapAccumL g 0) tla-      , bench "bs" $ nf (BS.mapAccumL g 0) bsa-      , bench "bl" $ nf (BL.mapAccumL g 0) bla-      , bench "l" $ nf (L.mapAccumL g 0) la-      ],-      bgroup "mapAccumR" [-        bench "ts" $ nf (TS.mapAccumR g 0) tsa-      , bench "tl" $ nf (TL.mapAccumR g 0) tla-      , bench "bs" $ nf (BS.mapAccumR g 0) bsa-      , bench "bl" $ nf (BL.mapAccumR g 0) bla-      , bench "l" $ nf (L.mapAccumR g 0) 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 "readFile" [-        bench "ts" $ TS.readFile dataFile-      , bench "tl" $ nfIO (TL.readFile dataFile)-      , bench "bs" $ BS.readFile dataFile-      , bench "bl" $ nfIO (BL.length `fmap` BL.readFile dataFile)-      , bench "l" $ nfIO (length `fmap` readFile dataFile)-      ],-      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-        ]-      ],-      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-    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#))-    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 = TS.pack "short"--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--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--mappendNText :: TS.Text -> Int -> TB.Builder-mappendNText t n = go 0-  where-    go i-      | i < n     = TB.fromText t `mappend` go (i+1)-      | otherwise = mempty

+ tests/Chartem.hs view

@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}++import Data.Char+import Control.Monad (forM_)+import Data.Accessor ((^=))+import Data.Function+import Data.Maybe+import Data.List+import Debug.Trace+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)+import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Gtk (renderableToWindow)+import System.Environment (getArgs)+import Text.Printf+import qualified Data.ByteString as B+import qualified Data.Map as M+import qualified Data.Text as T++data Row = Row {+      rowName :: !Text+    , rowMean :: !Double+    , rowMeanLB :: !Double+    , rowMeanUB :: !Double+    , rowStdDev :: !Double+    , rowStdDevLB :: !Double+    , rowStdDevUB :: !Double+    } deriving (Show)++parseRow :: Text -> Row+parseRow = f . T.split ","+  where f [n,m,ml,mu,s,sl,su] = Row {+                                  rowName = n+                                , rowMean = r m+                                , rowMeanLB = r ml+                                , rowMeanUB = r mu+                                , rowStdDev = r s+                                , rowStdDevLB = r sl+                                , rowStdDevUB = r su+                                }+        r = read . T.unpack++readCSV :: FilePath -> IO [Row]+readCSV = fmap (map parseRow . tail . T.lines . decodeUtf8) . B.readFile++groupRows :: [Row] -> M.Map Text [Row]+groupRows = M.map (sortBy (compare `on` rowName)) . foldr f M.empty+    where f r m = let (p,s) = T.breakEnd "/" (rowName r)+                  in M.insertWith' (++) (T.init . T.tail $ p)+                     [r { rowName = T.init s}] m++main = do+  args <- getArgs+  groups <- mapM (fmap groupRows . readCSV) args+  let dd = M.unionsWith (++) . map (M.map (:[])) $ groups+  forM_ (M.toList dd) $ \(tdesc,rows) -> do+      let desc = T.unpack tdesc+      if False+       then renderableToWindow (renderMark desc rows) 400 160+       else renderableToPNGFile (renderMark desc rows) 400 160+                                (printf "time-%s.png" (map clean desc))+  where clean '/' = '-'+        clean c | isSpace c = '-'+                | otherwise = c++instance BarsPlotValue LogValue where+    barsReference = LogValue 1e-300+    barsAdd (LogValue a) (LogValue b) = LogValue (a * b)++renderMark :: String -> [[Row]] -> Renderable ()+renderMark desc rows+  | useLog    = toRenderable linLayout+  | otherwise = toRenderable logLayout+  where+    useLog = minimum (map minimum values) >= maximum (map maximum values) / 25+    values = transpose . map (map rowMean) $ rows+    keys   = map git (head rows)+        where git r = let n = T.unpack . rowName $ r+                      in maybe n id . flip lookup mappings $ n+    mappings = [("bl", "lazy BS"), ("bs", "strict BS"), ("l", "list"),+                ("tl", "lazy T"), ("ts", "strict T")]++    linLayout = layout1_title ^= "Timings for \"" ++ desc ++ "\""+              $ layout1_plots ^= [ Left (plotBars linBars) ]+              $ layout1_left_axis ^= linLeftAxis+              $ layout1_bottom_axis ^= bottomAxis+              $ defaultLayout1 :: Layout1 Double Double++    logLayout = layout1_title ^= "Timings for \"" ++ desc +++                "\" (log scale)"+              $ layout1_plots ^= [ Left (plotBars logBars) ]+              $ layout1_left_axis ^= logLeftAxis+              $ layout1_bottom_axis ^= bottomAxis+              $ defaultLayout1 :: Layout1 Double LogValue++    logLeftAxis = laxis_generate ^= autoScaledLogAxis logSecAxis+                $ laxis_reverse ^= False+                $ defaultLayoutAxis++    linLeftAxis = laxis_generate ^= autoScaledAxis linSecAxis+                $ defaultLayoutAxis++    bottomAxis = laxis_generate ^= autoScaledAxis typeAxis+               $ defaultLayoutAxis++    linBars = plot_bars_values ^= (zip [0.5,1.5..] values)+            $ defaultPlotBars++    logBars = plot_bars_values ^= (zip [0.5,1.5..] . map (map LogValue) $ values)+            $ defaultPlotBars++    typeAxis = la_labelf ^= (ix keys . floor)+             $ la_nLabels ^= length keys+             $ defaultLinearAxis++    ix (x:xs) n | n <= 0    = x+                | otherwise = ix xs (n-1)+    ix [] _                 = ""++    linSecAxis = la_labelf ^= secs+               $ defaultLinearAxis++    logSecAxis = loga_labelf ^= (secs . fromLV)+               $ defaultLogAxis++    fromLV (LogValue v) = v++-- | Try to render meaningful time-axis labels.+--+-- /FIXME/: Trouble is, we need to know the range of times for this to+-- work properly, so that we don't accidentally display consecutive+-- values that appear identical (e.g. \"43 ms, 43 ms\").+secs :: Double -> String+secs k+    | k < 0      = '-' : secs (-k)+    | k >= 1e9   = (k/1e9)  `with` "Gs"+    | k >= 1e6   = (k/1e6)  `with` "Ms"+    | k >= 1e4   = (k/1e3)  `with` "Ks"+    | k >= 1     = k        `with` "s"+    | k >= 1e-3  = (k*1e3)  `with` "ms"+    | k >= 1e-6  = (k*1e6)  `with` "µs"+    | k >= 1e-9  = (k*1e9)  `with` "ns"+    | k >= 1e-12 = (k*1e12) `with` "ps"+    | otherwise  = printf "%g s" k+     where with (t :: Double) (u :: String)+               | t >= 1e9  = printf "%.4g %s" t u+               | t >= 1e6  = printf "%.0f %s" t u+               | t >= 1e5  = printf "%.0f %s" t u+               | t >= 1e4  = printf "%.0f %s" t u+               | t >= 1e3  = printf "%.0f %s" t u+               | t >= 1e2  = printf "%.0f %s" t u+               | t >= 1e1  = printf "%.0f %s" t u+               | otherwise = printf "%.0f %s" t u

tests/Makefile view

@@ -23,7 +23,7 @@  cabal := $(shell which cabal 2>/dev/null) -all: bm qc coverage regressions+all: qc coverage regressions  lib: $(lib) @@ -78,11 +78,6 @@ regressions: Regressions.o TestUtils.o 	$(ghc) $(ghc-test-flags) -o $@ $^ $(lib) -Benchmarks.o: ghc-opt-flags = -O-bm Benchmarks.o: ghc-flags += -package utf8-string-bm: Benchmarks.o-	$(ghc) $(ghc-flags) -o $@ $^ $(lib)- SlowFunctions.o: ghc-opt-flags = -O2 SearchBench.o: ghc-opt-flags = -O %.o: %.hs@@ -98,4 +93,4 @@ 	curl -O http://projects.haskell.org/text/text-testdata.tar.bz2  clean:-	-rm -rf *.o *.hi *.tix bm qc qc-hpc stdio-hpc hpcdir .hpc coverage-html+	-rm -rf *.o *.hi *.tix qc qc-hpc stdio-hpc hpcdir .hpc coverage-html

+ tests/README.markdown view

@@ -0,0 +1,43 @@+Tests+=====++This directory contains the tests for the Text library. To run these tests, you+will need the test data from:++    http://projects.haskell.org/text/text-testdata.tar.bz2++You should extract that archive to the same directory as this README (some tests+rely on this).++There are two categories of tests: functional tests (including QuickCheck+properties), and benchmarks.++Functional tests+----------------++TODO++Benchmarks+----------++The benchmarks are located in the `benchmarks` subdirectory. An overview of+what's in that directory:++    python            Python implementations of some benchmarks+    ruby              Ruby implementations of some benchmarks+    src               Source files of the haskell benchmarks+    benchmarks.cabal  Cabal file which compiles all benchmarks+    Makefile          Has targets for common tasks++To compile the benchmarks, navigate to the `benchmarks` subdirectory and run+`cabal configure && cabal build`. Then, you can run the benchmarks using:++    ./dist/build/benchmarks/benchmarks++However, since there quite a lot of benchmarks, you usually don't want to run+them all. Instead, use the `-l` flag to get a list of benchmarks:++    ./dist/build/benchmarks/benchmarks++And run the ones you want to inspect. If you want to configure the benchmarks+further, the exact parameters can be changed in `src/Data/Text/Benchmarks.hs`.

+ tests/Regressions.hs view

@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}++-- Regression tests for specific bugs.++import Control.Exception (SomeException, handle)+import System.IO+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LE+import qualified Test.Framework as F+import qualified Test.Framework.Providers.HUnit as F+import Test.HUnit (assertFailure)+import TestUtils (withTempFile)++-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring+-- caused either a segfault or attempt to allocate a negative number+-- of bytes.+lazy_encode_crash = withTempFile $ \ _ h ->+   LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'++-- Reported by Pieter Laeremans: attempting to read an incorrectly+-- encoded file can result in a crash in the RTS (i.e. not merely an+-- exception).+hGetContents_crash = withTempFile $ \ path h -> do+  B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h+  h' <- openFile path ReadMode+  hSetEncoding h' utf8+  handle (\(_::SomeException) -> return ()) $+    T.hGetContents h' >> assertFailure "T.hGetContents should crash"++-- Reported by Ian Lynagh: attempting to allocate a sufficiently large+-- string (via either Array.new or Text.replicate) could result in an+-- integer overflow.+replicate_crash = handle (\(_::SomeException) -> return ()) $+                  T.replicate (2^power) "0123456789abcdef" `seq`+                  assertFailure "T.replicate should crash"+  where+    power | maxBound == (2147483647::Int) = 28+          | otherwise                     = 60 :: Int++tests :: F.Test+tests = F.testGroup "crashers" [+          F.testCase "hGetContents_crash" hGetContents_crash+        , F.testCase "lazy_encode_crash" lazy_encode_crash+        , F.testCase "replicate_crash" replicate_crash+        ]++main = F.defaultMain [tests]

+ tests/SearchBench.hs view

@@ -0,0 +1,115 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}++import Criterion.Main+import Data.Text.Encoding+import Data.Text.Search+import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T+import qualified SlowFunctions as Slow++main = defaultMain [+         bench "big/fast" $ (length . search indices)+       , bench "big/slow" $ (length . search Slow.indices)+       , bench "big/bytestring" $ (length . searchBS)+       , bench "dna/fast" $ (length . searchDNA indices)+       , bench "dna/slow" $ (length . searchDNA Slow.indices)+       , bench "dna/bytestring" $ (length . searchDNABS)+       ]++search f n = f needle' haystack+  where+    needle'  = T.drop (n `mod` 20) needle+    needle   = T.replicate 10 "abcdefghijklmnopqrstuvwxyz"+    haystack = T.replicate 100 $+               T.concat [ T.replicate 1000 "def"+                        , needle+                        , T.replicate 1000 "123"+                        ]+                        +searchDNA f n = f needle haystack+  where+    needle   = T.take 4 . T.drop (n `mod` (T.length dna - 4)) $ dna+    haystack = T.replicate 100 dna++replicateBS n = B.concat . replicate n++searchBS n = indicesBS needle' haystack+  where+    needle'  = B.drop (n `mod` 20) needle+    needle   = replicateBS 10 "abcdefghijklmnopqrstuvwxyz"+    haystack = replicateBS 100 $+               B.concat [ replicateBS 1000 "def"+                        , needle+                        , replicateBS 1000 "123"+                        ]+                        +searchDNABS n = indicesBS needle haystack+  where+    needle   = B.take 4 . B.drop (n `mod` (B.length bdna - 4)) $ bdna+    haystack = replicateBS 100 bdna++indicesBS :: B.ByteString -> B.ByteString -> [Int]+indicesBS pat+    | B.null pat = error "empty"+    | otherwise  = go 0+  where+    l  = B.length pat+    go !i src = case B.breakSubstring pat src of+                  (h,t) | B.null t -> []+                        | otherwise -> i' : go (i'+l) (B.drop l t)+                      where i' = i + B.length h++dna = decodeASCII bdna++bdna :: B.ByteString+bdna = "\+\CGTAACAAGGTTTCCGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGGGTT\+\AATCTGGAGGATCTGTTTACTTTGGTCACCCATGAGCATTTGCTGTTGAAGTGACCTAGAATTGCCATCG\+\AGCCTCCTTGGGAGCTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGCAGTTTTGCTCCAAGTCGTT\+\TGACACATAATTGGTGAAGGGGGTGGCATCCTTCCCTGACCCTCCCCCAACTATTTTTTTAACAACTCTC\+\AGCAACGGAGACTCAGTCTTCGGCAAATGCGATAAATGGTGTGAATTGCAGAATCCCGTGCACCATCGAG\+\TCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCTGCCTGGGCATTGCGAGTCATAT\+\CTCTCCCTTAACGAGGCTGTCCATACATACTGTTCAGCCGGTGCGGATGTGAGTTTGGCCCCTTGTTCTT\+\TGGTACGGGGGGTCTAAGAGCTGCATGGGCTTTTGATGGTCCTAAATACGGCAAGAGGTGGACGAACTAT\+\GCTACAACAAAATTGTTGTGCAGAGGCCCCGGGTTGTCGTATTAGATGGGCCACCGTAATCTGAAGACCC\+\TTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGGCCATTTGGTTGCGACCCCAGGTCAG\+\GTGAGCAACAGCTGTCGTAACAAGGTTTCCGTAGGGTGAACTGCGGAAGGATCATTGTTGAGATCACATA\+\ATAATTGATCGAGTTAATCTGGAGGATCTGTTTACTTGGGTCACCCATGGGCATTTGCTGTTGAAGTGAC\+\CTAGATTTGCCATCGAGCCTCCTTGGGAGCATCCTTGTTGGCGATATCTAAACCCTCAATTTTTCCCCCA\+\ATCAAATTACACAAAATTGGTGGAGGGGGTGGCATTCTTCCCTTACCCTCCCCCAAATATTTTTTTAACA\+\ACTCTCAGCAACGGATATCTCAGCTCTTGCATCGATGAAGAACCCACCGAAATGCGATAAATGGTGTGAA\+\TTGCAGAATCCCGTGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACG\+\CCTGCCTGGGCATTGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACATACTGTTCAGCCGGTGCG\+\GATGTGAGTTTGGCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGATGCATGGGCTTTTGATGGTCCTAA\+\ATACGGCAAGAGGTGGACGAACTATGCTACAACAAAATTGTTGTGCAAAGGCCCCGGGTTGTCGTATAAG\+\ATGGGCCACCGATATCTGAAGACCCTTTTGGACCCCATTGGAGCCCATCAACCCATGTCAGTTGATGGCC\+\ATTCGTAACAAGGTTTCCGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGA\+\GTTAATCTGGAGGATCTGTTTACTTGGGTCACCCATGGGCATTTGCTGTTGAAGTGACCTAGATTTGCCA\+\TCGAGCCTCCTTGGGAGCTTTCTTGTTGGCGATATCTAAACCCTTGCCCGGCAGAGTTTTGGGAATCCCG\+\TGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCTGCCTGGGCAT\+\TGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACACACCTGTTCAGCCGGTGCGGATGTGAGTTTG\+\GCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGCTGCATGGGCTTTTGATGGTCCTAAATACGGCAAGAG\+\GTGGACGAACTATGCTACAACAAAATTGTTGTGCAAAGGCCCCGGGTTGTCGTATTAGATGGGCCACCAT\+\AATCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGGCCATTTGGTTGC\+\GACCCAGTCAGGTGAGGGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGAG\+\TTAATCTGGAGGATCTGTTTACTTTGGTCACCCATGGGCATTTGCTGTTGAAGTGACCTAGATTTGCCAT\+\CGAGCCTCCTTGGGAGCTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGGAGTTTGGCGCCAAGTCA\+\TATGACACATAATTGGTGAAGGGGGTGGCATCCTGCCCTGACCCTCCCCAAATTATTTTTTTAACAACTC\+\TCAGCAACGGATATCTCGGCTCTTGCATCGATGAAGAACGCAGCGAAATGCGATAAATGGTGTGAATTGC\+\AGAATCCCGTGAACCATCGAGTCTTTGGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCT\+\GCCTGGGCATTGGGAATCATATCTCTCCCCTAACGAGGCTATCCAAACATACTGTTCATCCGGTGCGGAT\+\GTGAGTTTGGCCCCTTGTTCTTTGGTACCGGGGGTCTAAGAGCTGCATGGGCATTTGATGGTCCTCAAAA\+\CGGCAAGAGGTGGACGAACTATGCCACAACAAAATTGTTGTCCCAAGGCCCCGGGTTGTCGTATTAGATG\+\GGCCACCGTAACCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGACCA\+\TTTGTTGCGACCCCAGTCAGCTGAGCAACCCGCTGAGTGGAAGGTCATTGCCGATATCACATAATAATTG\+\ATCGAGTTAATCTGGAGGATCTGTTTACTTGGTCACCCATGAGCATTTGCTGTTGAAGTGACCTAGATTT\+\GCCATCGAGCCTCCTTGGGAGTTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGGAGTTGTGCGCCA\+\AGTCATATGACACATAATTGGTGAAGGGGGTGGCATCCTGCCCTGACCCTCCCCAAATTATTTTTTTAAC\+\AACTCTCAGCAACGGATATCTCGGCTCTTGCATCGATGAAGAACGCAGCGAAATGCGATAAATGGTGTGA\+\ATTGCAGAATCCCGTGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCAC\+\GCCTGCCTGGGCATTGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACATACTGTTCATCCGGTGC\+\GGATGTGAGTTTGGCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGCTGCATGGGCATTTGATGGTCCTC\+\AAAACGGCAAGAGGTGGACGAACTATGCTACAACCAAATTGTTGTCCCAAGGCCCCGGGTTGTCGTATTA\+\GATGGGCCACCGTAACCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATG\+\ACCATGTGTTGCGACCCCAGTCAGCTGAGCAACGCGCTGAGCGTAACAAGGTTTCCGTAGGTGGACCTCC\+\GGGAGGATCATTGTTGAGATCACATAATAATTGATCGAGGTAATCTGGAGGATCTGCATATTTTGGTCAC"

− tests/benchmarks/Cut.hs

@@ -1,60 +0,0 @@-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.Text.IO as T-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy.Encoding as TL-import qualified Data.Text.Lazy.IO as TL-import qualified Data.Text.Lazy as TL-import Data.Int (Int64)-import Numeric (readDec)-import System.Environment (getArgs)--bytestring file s e = do-  t <- B.readFile file-  B.putStr (cut t)-  where-    cut = B.unlines . map (B.take (e - s) . B.drop s) . B.lines--lazyBytestring file s e = do-  t <- BL.readFile file-  BL.putStr (cut (fromIntegral s) (fromIntegral e) t)-  where-    cut s e = BL.unlines . map (BL.take (e - s) . BL.drop s) . BL.lines--lazyText file s e = do-  t <- TL.readFile file-  TL.putStr (cut (fromIntegral s) (fromIntegral e) t)-  where-    cut s e = TL.unlines . map (TL.take (e - s) . TL.drop s) . TL.lines--text file s e = do-  t <- T.readFile file-  T.putStr (cut t)-  where-    cut = T.unlines . map (T.take (e - s) . T.drop s) . T.lines--textBS file s e = do-  bs <- B.readFile file-  T.putStr . cut . T.decodeUtf8 $ bs-  where-    cut = T.unlines . map (T.take (e - s) . T.drop s) . T.lines--lazyTextBS file s e = do-  t <- BL.readFile file-  TL.putStr (cut (fromIntegral s) (fromIntegral e) (TL.decodeUtf8 t))-  where-    cut s e = TL.unlines . map (TL.take (e - s) . TL.drop s) . TL.lines--main = do-  (name : ss : es : file : _) <- getArgs-  let [(s',"")] = readDec ss-      [(e,"")] = readDec es-      s = s' - 1-  case name of-    "bs" -> bytestring file s e-    "lbs" -> lazyBytestring file s e-    "ltext" -> lazyText file s e-    "text" -> text file s e-    "ltextBS" -> lazyTextBS file s e-    "textBS" -> textBS file s e

− tests/benchmarks/DecodeUtf8.hs

@@ -1,107 +0,0 @@-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Data.Text.Encoding 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-import qualified Codec.Binary.UTF8.Generic as U8-import Control.DeepSeq-import System.Environment-import System.IO--strict h = do-  bs <- B.hGetContents h-  rnf (T.decodeUtf8 bs) `seq` return ()--strict_len h = do-  bs <- B.hGetContents h-  print . T.length . T.decodeUtf8 $ bs--strict_init_len h = do-  bs <- B.hGetContents h-  print . T.length . T.init . T.decodeUtf8 $ bs--strict_io h = do-  hSetEncoding h utf8-  t <- T.hGetContents h-  rnf t `seq` return ()--strict_len_io h = do-  hSetEncoding h utf8-  t <- T.hGetContents h-  print (T.length t)--lazy h = do-  bs <- BL.hGetContents h-  rnf (TL.decodeUtf8 bs) `seq` return ()--lazy_len h = do-  bs <- BL.hGetContents h-  print . TL.length . TL.decodeUtf8 $ bs--lazy_init_len h = do-  bs <- BL.hGetContents h-  print . TL.length . TL.init . TL.decodeUtf8 $ bs--lazy_io h = do-  hSetEncoding h utf8-  t <- TL.hGetContents h-  rnf t `seq` return ()--lazy_len_io h = do-  hSetEncoding h utf8-  t <- TL.hGetContents h-  print (TL.length t)--string h = do-  hSetEncoding h utf8-  t <- hGetContents h-  rnf t `seq` return ()--string_len h = do-  hSetEncoding h utf8-  t <- hGetContents h-  print (length t)--lazy_string_utf8 h = do-  bs <- BL.hGetContents h-  let t = U8.toString bs-  rnf t `seq` return ()--lazy_string_utf8_len h = do-  bs <- BL.hGetContents h-  let t = U8.toString bs-  print (length t)--strict_string_utf8 h = do-  bs <- B.hGetContents h-  let t = U8.toString bs-  rnf t `seq` return ()--strict_string_utf8_len h = do-  bs <- B.hGetContents h-  let t = U8.toString bs-  print (length t)--main = do-  [kind,name] <- getArgs-  h <- openFile name ReadMode-  case kind of-    "strict" -> strict h-    "strict_len" -> strict_len h-    "strict_init_len" -> strict_init_len h-    "strict_io" -> strict_io h-    "strict_len_io" -> strict_len_io h-    "lazy" -> lazy h-    "lazy_len" -> lazy_len h-    "lazy_init_len" -> lazy_init_len h-    "lazy_io" -> lazy_io h-    "lazy_len_io" -> lazy_len_io h-    "string" -> string h-    "string_len" -> string_len h-    "lazy_string_utf8" -> lazy_string_utf8 h-    "lazy_string_utf8_len" -> lazy_string_utf8_len h-    "strict_string_utf8" -> strict_string_utf8 h-    "strict_string_utf8_len" -> strict_string_utf8_len h

− tests/benchmarks/EncodeUtf8.hs

@@ -1,55 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Data.Text.Encoding 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-import qualified Codec.Binary.UTF8.Generic as U8-import System.Environment-import System.IO--strict_bytestring k s = do-  let t = T.replicate k (T.pack s)-  B.putStr (T.encodeUtf8 t)--lazy_bytestring k s = do-  let t = TL.replicate (fromIntegral k) (TL.pack s)-  BL.putStr (TL.encodeUtf8 t)--strict_io k s = do-  let t = T.replicate k (T.pack s)-  hSetEncoding stdout utf8-  T.putStr t--lazy_io k s = do-  let t = TL.replicate (fromIntegral k) (TL.pack s)-  hSetEncoding stdout utf8-  TL.putStr t--string k s = do-  let t = concat $ replicate k s-  hSetEncoding stdout utf8-  putStr t--lazy_string_utf8 k s = do-  let t = concat $ replicate k s-  BL.putStr (U8.fromString t)--strict_string_utf8 k s = do-  let t = concat $ replicate k s-  B.putStr (U8.fromString t)--main = do-  [kind,str,kstr] <- getArgs-  let k = read kstr * 1000000-  case kind of-    "strict" -> strict_bytestring k str-    "lazy" -> lazy_bytestring k str-    "strict_io" -> strict_io k str-    "lazy_io" -> lazy_io k str-    "string" -> string k str-    "lazy_string_utf8" -> lazy_string_utf8 k str-    "strict_string_utf8" -> strict_string_utf8 k str

− tests/benchmarks/Equality.hs

@@ -1,31 +0,0 @@-import System.Environment-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--func :: (Eq a) => [a] -> IO ()-func ls =-  print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls--bytestring haystack = func =<< B.lines `fmap` B.readFile haystack--lazyBytestring haystack = func =<< BL.lines `fmap` BL.readFile haystack--text haystack = func =<< (T.lines . T.decodeUtf8) `fmap` B.readFile haystack--lazyText haystack = func =<<-                    (TL.lines . TL.decodeUtf8) `fmap` BL.readFile haystack--string haystack = func =<< lines `fmap` readFile haystack--main = do-  args <- getArgs-  case args of-    ["bs",h] -> bytestring h-    ["lazybs",h] -> lazyBytestring h-    ["text",h] -> text h-    ["lazytext",h] -> lazyText h-    ["string",h] -> string h

− tests/benchmarks/FileIndices.hs

@@ -1,25 +0,0 @@-{-# LANGUAGE BangPatterns #-}--import System.Environment (getArgs)-import qualified Data.Text.Lazy.IO as T-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.Encoding as T-import qualified Data.ByteString.Lazy.Char8 as B-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Search as B--text :: FilePath -> String -> IO ()-text file pat = T.readFile file >>= print . T.count (T.pack pat)--textBS :: FilePath -> String -> IO ()-textBS file pat = B.readFile file >>= print . T.count (T.pack pat) . T.decodeUtf8--bytestring :: FilePath -> String -> IO ()-bytestring file pat = B.readFile file >>= print . length . B.indices (BS.pack pat)--main = do-  (name : file : pat : _) <- getArgs-  case name of-    "bs" -> bytestring file pat-    "text" -> text file pat-    "textBS" -> textBS file pat

− tests/benchmarks/FileRead.hs

@@ -1,57 +0,0 @@-{-# LANGUAGE BangPatterns #-}--import System.Environment (getArgs)-import qualified Data.Text.IO as T-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy.IO as TL-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy.Char8 as BL-import System.IO--string :: Handle -> IO ()-string h = hGetContents h >>= print . length--ltext :: Handle -> IO ()-ltext h = do-  t <- {-# SCC "TL.hGetContents" #-} TL.hGetContents h-  print (TL.length t)--ltextBS :: Handle -> IO ()-ltextBS h = do-  bs <- {-# SCC "B.hGetContents" #-} BL.hGetContents h-  print . TL.length . TL.decodeUtf8 $ bs--text :: Handle -> IO ()-text h = do-  t <- {-# SCC "T.hGetContents" #-} T.hGetContents h-  print (T.length t)--textBS :: Handle -> IO ()-textBS h = do-  bs <- {-# SCC "B.hGetContents" #-} B.hGetContents h-  print . T.length . T.decodeUtf8 $ bs--lbytestring :: Handle -> IO ()-lbytestring h = do-  bs <- {-# SCC "BL.hGetContents" #-} BL.hGetContents h-  print (BL.length bs)--bytestring :: Handle -> IO ()-bytestring h = do-  bs <- {-# SCC "B.hGetContents" #-} B.hGetContents h-  print (B.length bs)--main = do-  (name : file : _) <- getArgs-  h <- openFile file ReadMode-  case name of-    "bs" -> bytestring h-    "lbs" -> lbytestring h-    "ltext" -> ltext h-    "ltextBS" -> ltextBS h-    "string" -> string h-    "text" -> text h-    "textBS" -> textBS h

− tests/benchmarks/FoldLines.hs

@@ -1,47 +0,0 @@-{-# LANGUAGE BangPatterns #-}--import System.Environment-import System.IO-import qualified Data.Text as T-import qualified Data.Text.IO as T-import qualified Data.ByteString as S---- Text-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 #-}--testT :: Handle -> IO Int-testT = foldLinesT (\n _ -> n + 1) 0----ByteString-foldLinesB :: (a -> S.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 <- S.hGetLine h-                let z' = f z l in go z'-{-# INLINE foldLinesB #-}--testB :: Handle -> IO Int-testB = foldLinesB (\n _ -> n + 1) 0--main = do-  (name : file : _) <- getArgs-  h <- openFile file ReadMode-  hSetBuffering h (BlockBuffering (Just 16384))-  case name of-    "bs" -> testB h-    "text" -> testT h

− tests/benchmarks/HtmlCombinator.hs

@@ -1,24 +0,0 @@-{-# LANGUAGE BangPatterns, OverloadedStrings #-}-import Data.Monoid (mappend, mconcat)-import Prelude hiding (putStr)-import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)-import Data.Text.Lazy.IO (putStr)--import qualified Data.Text as T--main :: IO ()-main = do-  putStr "Content-Type: text/html\n\n<table>"-  putStr . toLazyText $ mconcat (replicate 20000 makeRow) -  putStr "</table>"--makeRow :: Builder-makeRow = 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` (textInt i `mappend` fromText "</td>")--textInt :: Int -> Builder-textInt = fromText . T.pack . show

− tests/benchmarks/Makefile

@@ -1,18 +0,0 @@-CC := $(shell icu-config --cc)-CFLAGS := -g $(shell icu-config --cflags)-CPPFLAGS := $(shell icu-config --cppflags)-LDFLAGS := $(CFLAGS) $(shell icu-config --ldflags --ldflags-icuio)-ghc := ghc--all := FileRead FileRead_prof Replace Replace_prof fileread_c--all: $(all)--%: %.hs-	$(ghc) -O --make -o $@ $^--%_prof: %.hs-	$(ghc) -prof -auto-all -O --make -o $@ $^--clean:-	-rm -f *.hi *.o $(all)

− tests/benchmarks/Replace.hs

@@ -1,23 +0,0 @@-{-# LANGUAGE BangPatterns #-}-module Main (main) where--import System.Environment (getArgs)-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.IO as LT-import qualified Data.ByteString.Lazy.Search as LB-import qualified Data.ByteString.Lazy.Char8 as LB-import qualified Data.ByteString.Char8 as B--lazyText file pat sub =-  LT.readFile file >>= LT.putStr . LT.replace (LT.pack pat) (LT.pack sub)--lazyBS file pat sub =-  LB.readFile file >>= LB.putStr . LB.replace (B.pack pat) (LB.pack sub)--main = do-  (kind : file : pat : sub : _) <- getArgs-  case kind of-    "lazyText" -> lazyText file pat sub-    "lazyTextNull" -> LT.readFile file >>= LT.putStr-    "lazyBS" -> lazyBS file pat sub-    "lazyBSNull" -> LB.readFile file >>= LB.putStr

− tests/benchmarks/ReplaceTags.hs

@@ -1,91 +0,0 @@--- Contributed by Ken Friis Larsen and Morten Ib Nielsen.--{-# LANGUAGE BangPatterns #-}-module Main (main) where--import System.Environment (getArgs)-import qualified Char--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.ByteString.Lazy as BL-import qualified Data.Text.Lazy.Encoding as TLE---import qualified Data.ByteString.Char8 as BC-import qualified Data.ByteString as B-import qualified Data.Text.Encoding as TE--replaceTagsM file tag sub = -  BC.readFile file >>= BC.putStr . replaceTags tag sub . TE.encodeUtf8 . T.toLower . TE.decodeUtf8 -  where -    replaceTags tag replacement str = B.concat $ reverse $ replaceTags' [] (BC.pack $ '<' : tag) '>' (BC.pack replacement) str-    replaceTags' !res start end repl str =-      let (pre, post) = BC.breakSubstring start str-      in if BC.null post-           then  pre : res-           else replaceTags' (repl : pre : res) start end repl $ BC.drop 1 $-                BC.dropWhile (/= end) post--splitB sep str = seplen `seq` splitter str -  where -    splitter str = h : if B.null t then [] else splitter (B.drop seplen t)-      where (h,t) = B.breakSubstring sep str-    seplen = B.length sep-    -replaceTagsWrong file tagName sub = do-  content <- BC.readFile file-  let frags = map (BC.drop 1 . BC.dropWhile (/= '>')) -              $ splitB (BC.pack $ '<' : tagName) (BC.map Char.toLower content)-  BC.putStr $ BC.intercalate (BC.pack sub) frags- -replaceTagsK file tagName sub = do-  raw <- BC.readFile file -  let content = (TE.encodeUtf8 . T.toLower . TE.decodeUtf8) raw-  let frags = map (BC.drop 1 . BC.dropWhile (/= '>')) -              $ splitB (BC.pack $ '<' : tagName) content-  BC.putStr $ BC.intercalate (BC.pack sub) frags--replaceTagsO file tagName sub = do-  raw <- BC.readFile file -  let content = (TE.encodeUtf8 . T.toLower . TE.decodeUtf8) raw-  let frags = splitB (BC.pack $ '<' : tagName) content-  BC.putStr $ BC.intercalate (BC.pack sub) frags-  where -    splitB sep str = splitter str -      where -        splitter str = h : if BC.null t then [] else splitter (BC.drop 1 $ BC.dropWhile (/= '>') t)-          where (h,t) = B.breakSubstring sep str---    -replaceTagsT file tagName sub = do-  raw <- B.readFile file -  let content = TE.decodeUtf8 raw-  let frags = map (T.drop 1 . T.dropWhile (/= '>')) -              $ T.split (T.pack $ '<' : tagName) (T.toLower content)-  T.putStr $ T.intercalate (T.pack sub) frags-  -replaceTagsTL file tagName sub = do-  raw <- BL.readFile file -  let content = TLE.decodeUtf8 raw-  let frags = map (TL.drop 1 . TL.dropWhile (/= '>')) -              $ TL.split (TL.pack $ '<' : tagName) (TL.toLower content)-  TL.putStr $ TL.intercalate (TL.pack sub) frags---main = do-  (kind : file : tag : sub : _) <- getArgs-  case kind of-    "Text" -> replaceTagsT file tag sub-    "TextLazy" -> replaceTagsTL file tag sub-    "BytestringM" -> replaceTagsM file tag sub-    "BytestringK" -> replaceTagsK file tag sub-    "BytestringO" -> replaceTagsO file tag sub-    "TextNull" -> T.readFile file >>= T.putStr-    "ByteNull" -> B.readFile file >>= B.putStr-    "EncodeNull" -> B.readFile file >>= T.putStr . T.toLower . TE.decodeUtf8 -

+ tests/benchmarks/Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

− tests/benchmarks/fileread.py

@@ -1,41 +0,0 @@-#!/usr/bin/env python--import sys--def string(name):-    print len(open(name).read())--def lazystring(name):-    fp = open(name)-    n = 0-    d = True-    bs = 128 * 1024-    read = fp.read-    while d:-        d = len(read(bs))-        n += d-    print n--def lazytext(name):-    fp = open(name)-    n = 0-    d = True-    bs = 128 * 1024-    read = fp.read-    while d:-        s = read(bs)-        d = len(s.decode('utf-8', 'replace'))-        n += d-    print n--def text(name):-    print len(open(name).read().decode('utf-8', 'replace'))--if sys.argv[1] == 'bs':-    string(sys.argv[2])-if sys.argv[1] == 'lbs':-    lazystring(sys.argv[2])-elif sys.argv[1] == 'lazytext':-    lazytext(sys.argv[2])-elif sys.argv[1] == 'text':-    text(sys.argv[2])

− tests/benchmarks/fileread_c.c

@@ -1,96 +0,0 @@-#include <unicode/ustdio.h>-#include <stdio.h>-#include <stdlib.h>-#include <string.h>--void lazystring(const char *name)-{-    FILE *ufp = fopen(name, "r");-    const size_t bufsize = sizeof(char) * 32 * 1024;-    char *str = malloc(bufsize);-    long len = 0;-    int32_t n;--    do {-	n = fread(str, sizeof(char), bufsize, ufp);-	len += n;-    } while (n > 0);--    printf("%ld\n", len);-}--void lazytext(const char *name)-{-    UFILE *ufp = u_fopen(name, "r", NULL, "UTF-8");-    const size_t bufsize = sizeof(UChar) * 32 * 1024;-    UChar *str = malloc(bufsize);-    long len = 0;-    int32_t n;--    do {-	n = u_file_read(str, bufsize, ufp);-	len += n;-    } while (n > 0);--    printf("%ld\n", len);-}--void text(const char *name)-{-    UFILE *ufp = u_fopen(name, "r", NULL, "UTF-8");-    FILE *fp = u_fgetfile(ufp);-    UChar *str;-    long fsize;-    int32_t n;--    fseek(fp, 0, SEEK_END);-    fsize = ftell(fp);-    u_frewind(ufp);--    str = malloc(sizeof(*str) * fsize);--    n = u_file_read(str, fsize, ufp);--    printf("%d\n", n);-}--void string(const char *name)-{-    FILE *fp = fopen(name, "r");-    char *str;-    long fsize;-    int32_t n;--    fseek(fp, 0, SEEK_END);-    fsize = ftell(fp);-    fseek(fp, 0, SEEK_SET);--    str = malloc(sizeof(*str) * fsize);--    n = fread(str, sizeof(char), fsize, fp);--    printf("%d\n", n);-}--int main(int argc, char **argv)-{-    if (argc != 3) {-	fprintf(stderr, "Usage: %s handler filename\n", argv[0]);-	exit(1);-    }--    if (strcmp(argv[1], "lazystring") == 0)-	lazystring(argv[2]);-    else if (strcmp(argv[1], "lazytext") == 0)-	lazytext(argv[2]);-    else if (strcmp(argv[1], "string") == 0)-	string(argv[2]);-    else if (strcmp(argv[1], "text") == 0)-	text(argv[2]);-    else {-	fprintf(stderr, "no matching handler\n");-	return 1;-    }--    return 0;-}

+ tests/benchmarks/python/case_map.py view

@@ -0,0 +1,7 @@+#!/usr/bin/env python++import utils, sys++for f in sys.argv[1:]:+    t = utils.benchmark(lambda: utils.with_utf8_file(f, lambda c: c.upper()))+    sys.stderr.write('{0}: {1}\n'.format(f, t))

+ tests/benchmarks/python/file_read.py view

@@ -0,0 +1,7 @@+#!/usr/bin/env python++import utils, sys++for f in sys.argv[1:]:+    t = utils.benchmark(lambda: utils.with_utf8_file(f, lambda c: len(c)))+    sys.stderr.write('{0}: {1}\n'.format(f, t))

+ tests/benchmarks/python/sort.py view

@@ -0,0 +1,15 @@+#!/usr/bin/env python++import utils, sys++def sort(string):+    lines = string.splitlines()+    lines.sort()+    return '\n'.join(lines)++for f in sys.argv[1:]:+    t = utils.benchmark(lambda: sys.stdout.write(+                    				utils.with_utf8_file(f,sort).encode('utf-8'))+                    				)+    sys.stderr.write('{0}: {1}\n'.format(f, t))+

+ tests/benchmarks/python/strip_brackets.py view

@@ -0,0 +1,22 @@+#!/usr/bin/env python++import utils, sys++def strip_brackets(string):+    d = 0+    out = ''+    for c in string:+        if c == '{' or c == '[': d += 1++        if d > 0:+            out += ' '+        else:+            out += c++        if c == '}' or c == ']': d -= 1++    return out++for f in sys.argv[1:]:+    t = utils.benchmark(lambda: utils.with_utf8_file(f, strip_brackets))+    sys.stderr.write('{0}: {1}\n'.format(f, t))

+ tests/benchmarks/python/utils.py view

@@ -0,0 +1,22 @@+#!/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++def with_utf8_file(filename, f):+    contents = open(filename).read().decode('utf-8')+    return f(contents)

+ tests/benchmarks/python/word_count.py view

@@ -0,0 +1,17 @@+#!/usr/bin/env python++import utils, sys++def word_count(string):+    freqs = {}+    for w in string.split():+        w = w.lower()+        if freqs.get(w):+            freqs[w] += 1+        else:+            freqs[w] = 1+    return freqs++for f in sys.argv[1:]:+    t = utils.benchmark(lambda: utils.with_utf8_file(f, word_count))+    sys.stderr.write('{0}: {1}\n'.format(f, t))

+ tests/benchmarks/ruby/case_map.rb view

@@ -0,0 +1,8 @@+#!/usr/bin/env ruby++require './utils.rb'++ARGV.each do |f|+  t = benchmark { with_utf8_file(f) { |c| c.upcase } }+  STDERR.puts "#{f}: #{t}"+end

+ tests/benchmarks/ruby/file_read.rb view

@@ -0,0 +1,8 @@+#!/usr/bin/env ruby++require './utils.rb'++ARGV.each do |f|+  t = benchmark { with_utf8_file(f) { |c| c.size } }+  STDERR.puts "#{f}: #{t}"+end

+ tests/benchmarks/ruby/sort.rb view

@@ -0,0 +1,14 @@+#!/usr/bin/env ruby++require './utils.rb'++def sort(str)+  str.lines.sort.join+end++ARGV.each do |f|+  t = benchmark do+    with_utf8_file(f) { |c| puts sort(c) }+  end+  STDERR.puts "#{f}: #{t}"+end

+ tests/benchmarks/ruby/strip_brackets.rb view

@@ -0,0 +1,21 @@+#!/usr/bin/env ruby++require './utils.rb'++def strip_brackets(str)+  d = 0+  out = ''++  str.each_char do |c|+    d += 1 if c == '{' || c == '['+    out << if d > 0 then ' ' else c end+    d -= 1 if c == '}' || c == ']'+  end++  out+end++ARGV.each do |f|+  t = benchmark { with_utf8_file(f) { |c| strip_brackets(c) } }+  STDERR.puts "#{f}: #{t}"+end

+ tests/benchmarks/ruby/utils.rb view

@@ -0,0 +1,20 @@+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++def with_utf8_file(filename)+  File.open(filename, 'r:utf-8') do |file|+    yield file.read+  end+end

+ tests/benchmarks/ruby/word_count.rb view

@@ -0,0 +1,16 @@+#!/usr/bin/env ruby++require './utils.rb'++def word_count(str)+  freqs = Hash.new 0+  str.split.each do |w|+    freqs[w.downcase] += 1+  end+  freqs+end++ARGV.each do |f|+  t = benchmark { with_utf8_file(f) { |c| word_count(c) } }+  STDERR.puts "#{f}: #{t}"+end

+ tests/benchmarks/src/Data/Text/Benchmarks.hs view

@@ -0,0 +1,58 @@+-- | Main module to run the micro benchmarks+--+{-# LANGUAGE OverloadedStrings #-}+module Main+    ( main+    ) where++import Criterion.Main (Benchmark, defaultMain)+import System.FilePath ((</>))+import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)++import qualified Data.Text.Benchmarks.Builder as Builder+import qualified Data.Text.Benchmarks.CaseMap as CaseMap+import qualified Data.Text.Benchmarks.Cut as Cut+import qualified Data.Text.Benchmarks.DecodeUtf8 as DecodeUtf8+import qualified Data.Text.Benchmarks.EncodeUtf8 as EncodeUtf8+import qualified Data.Text.Benchmarks.Equality as Equality+import qualified Data.Text.Benchmarks.FileIndices as FileIndices+import qualified Data.Text.Benchmarks.FileRead as FileRead+import qualified Data.Text.Benchmarks.FoldLines as FoldLines+import qualified Data.Text.Benchmarks.HtmlCombinator as HtmlCombinator+import qualified Data.Text.Benchmarks.Ordering as Ordering+import qualified Data.Text.Benchmarks.Pure as Pure+import qualified Data.Text.Benchmarks.ReadNumbers as ReadNumbers+import qualified Data.Text.Benchmarks.Replace as Replace+import qualified Data.Text.Benchmarks.Sort as Sort+import qualified Data.Text.Benchmarks.StripBrackets as StripBrackets+import qualified Data.Text.Benchmarks.WordCount as WordCount++main :: IO ()+main = benchmarks >>= defaultMain++benchmarks :: IO [Benchmark]+benchmarks = do+    sink <- openFile "/dev/null" WriteMode+    hSetEncoding sink utf8+    sequence+        [ Builder.benchmark+        , CaseMap.benchmark (tf "russian.txt") sink+        , Cut.benchmark (tf "russian.txt") sink 30 60+        , DecodeUtf8.benchmark (tf "russian.txt")+        , EncodeUtf8.benchmark sink "επανάληψη 竺法蘭共譯"+        , Equality.benchmark (tf "japanese.txt")+        , FileIndices.benchmark (tf "russian.txt") "принимая"+        , FileRead.benchmark (tf "russian.txt")+        , FoldLines.benchmark (tf "russian.txt")+        , HtmlCombinator.benchmark sink+        , Ordering.benchmark (tf "russian.txt")+        , Pure.benchmark (tf "japanese.txt")+        , ReadNumbers.benchmark (tf "numbers.txt")+        , Replace.benchmark (tf "russian.txt") sink "принимая" "своем"+        , Sort.benchmark (tf "russian.txt") sink+        , StripBrackets.benchmark (tf "russian.txt") sink+        , WordCount.benchmark (tf "russian.txt")+        ]+  where+    -- Location of a test file+    tf = ("../text/test" </>)

+ tests/benchmarks/src/Data/Text/Benchmarks/Builder.hs view

@@ -0,0 +1,44 @@+-- | Testing the internal builder monoid+--+{-# LANGUAGE OverloadedStrings #-}+module Data.Text.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 #-}

+ tests/benchmarks/src/Data/Text/Benchmarks/CaseMap.hs view

@@ -0,0 +1,15 @@+-- | This benchmark converts a number of UTF-8 encoded files to uppercase+--+module Data.Text.Benchmarks.CaseMap+    ( benchmark+    ) where++import Criterion (Benchmark, bench)+import System.IO (Handle)+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++benchmark :: FilePath -> Handle -> IO Benchmark+benchmark fp sink = return $ bench "CaseMap" $+    B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.toUpper . T.decodeUtf8

+ tests/benchmarks/src/Data/Text/Benchmarks/Cut.hs view

@@ -0,0 +1,86 @@+-- | Cut into a file, selecting certain columns (e.g. lines 10 to 40)+--+module Data.Text.Benchmarks.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

+ tests/benchmarks/src/Data/Text/Benchmarks/DecodeUtf8.hs view

@@ -0,0 +1,95 @@+module Data.Text.Benchmarks.DecodeUtf8+    ( benchmark+    ) where++import Control.DeepSeq (rnf)+import Criterion (Benchmark, bgroup, bench)+import System.IO (IOMode (ReadMode), openFile, hGetContents, hSetEncoding, utf8)+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.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 -> IO Benchmark+benchmark fp = return $ bgroup "DecodeUtf8"+    [ bench "Strict" $ do+        bs <- B.readFile fp+        rnf (T.decodeUtf8 bs) `seq` return ()++    , bench "StrictLength" $ do+        bs <- B.readFile fp+        rnf (T.length $ T.decodeUtf8 bs) `seq` return ()++    , bench "StrictInitLength" $ do+        bs <- B.readFile fp+        rnf (T.length $ T.init $ T.decodeUtf8 bs) `seq` return ()++    , bench "StrictIO" $ do+        h <- openFile fp ReadMode+        hSetEncoding h utf8+        t <- T.hGetContents h+        rnf t `seq` return ()++    , bench "StrictLengthIO" $ do+        h <- openFile fp ReadMode+        hSetEncoding h utf8+        t <- T.hGetContents h+        rnf (T.length t) `seq` return ()++    , bench "Lazy" $ do+        bs <- BL.readFile fp+        rnf (TL.decodeUtf8 bs) `seq` return ()++    , bench "LazyLength" $ do+        bs <- BL.readFile fp+        rnf (TL.length $ TL.decodeUtf8 bs) `seq` return ()++    , bench "LazyInitLength" $ do+        bs <- BL.readFile fp+        rnf (TL.length $ TL.init $ TL.decodeUtf8 bs) `seq` return ()++    , bench "LazyIO" $ do+        h <- openFile fp ReadMode+        hSetEncoding h utf8+        t <- TL.hGetContents h+        rnf t `seq` return ()++    , bench "LazyLengthIO" $ do+        h <- openFile fp ReadMode+        hSetEncoding h utf8+        t <- TL.hGetContents h+        rnf (TL.length t) `seq` return ()++    , bench "String" $ do+        h <- openFile fp ReadMode+        hSetEncoding h utf8+        t <- hGetContents h+        rnf t `seq` return ()++    , bench "StringLength" $ do+        h <- openFile fp ReadMode+        hSetEncoding h utf8+        t <- hGetContents h+        rnf (length t) `seq` return ()++    , bench "LazyStringUtf8" $ do+        s <- U8.toString `fmap` BL.readFile fp+        rnf s `seq` return ()++    , bench "LazyStringUtf8Length" $ do+        s <- U8.toString `fmap` BL.readFile fp+        rnf (length s) `seq` return ()++    , bench "StrictStringUtf8" $ do+        s <- U8.toString `fmap` B.readFile fp+        rnf s `seq` return ()++    , bench "StrictStringUtf8Length" $ do+        s <- U8.toString `fmap` B.readFile fp+        rnf (length s) `seq` return ()+    ]

+ tests/benchmarks/src/Data/Text/Benchmarks/EncodeUtf8.hs view

@@ -0,0 +1,33 @@+module Data.Text.Benchmarks.EncodeUtf8+    ( 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 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 :: Handle -> String -> IO Benchmark+benchmark sink string = return $ bgroup "EncodeUtf8"+    [ bench "String" $ hPutStr sink $ concat $ replicate k string+    , bench "Text" $ T.hPutStr sink $ T.replicate k text+    , bench "TextLazy" $ TL.hPutStr sink $+        TL.replicate (fromIntegral k) lazyText+    , bench "TextByteString" $ B.hPutStr sink $+        T.encodeUtf8 $ T.replicate k text+    , bench "TextByteStringLazy" $ BL.hPutStr sink $+        TL.encodeUtf8 $ TL.replicate (fromIntegral k) lazyText+    ]+  where+    -- The string in different formats+    text = T.pack string+    lazyText = TL.pack string++    -- Amount+    k = 100000

+ tests/benchmarks/src/Data/Text/Benchmarks/Equality.hs view

@@ -0,0 +1,30 @@+-- | Compare a string with a copy of itself that is identical except+-- for the last character.+--+module Data.Text.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+  bl <- BL.readFile fp+  l <- readFile fp+  let t  = T.decodeUtf8 b+      tl = TL.decodeUtf8 bl+  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 bl `BL.snoc` '\xfffd') bl+    , bench "String" $ whnf (== init l ++ "\xfffd") l+    ]

+ tests/benchmarks/src/Data/Text/Benchmarks/FileIndices.hs view

@@ -0,0 +1,28 @@+-- | Search for a pattern in a file, find the number of occurences+--+module Data.Text.Benchmarks.FileIndices+    ( benchmark+    ) where++import Control.Exception (evaluate)+import Criterion (Benchmark, bench, bgroup)+import qualified Data.ByteString 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 -> TL.Text -> IO Benchmark+benchmark fp t = return $ bgroup "FileIndices"+    [ bench "LazyText"           $ TL.readFile fp >>= evaluate . text t+    , bench "LazyByteString"     $ BL.readFile fp >>= evaluate . byteString b+    ]+  where+    b = B.concat $ BL.toChunks $ TL.encodeUtf8 t++text :: TL.Text -> TL.Text -> Int+text needle = fromIntegral . TL.count needle++byteString :: B.ByteString -> BL.ByteString -> Int+byteString needle = length . BL.indices needle

+ tests/benchmarks/src/Data/Text/Benchmarks/FileRead.hs view

@@ -0,0 +1,29 @@+-- | Benchmarks simple file reading+--+module Data.Text.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+    ]

+ tests/benchmarks/src/Data/Text/Benchmarks/FoldLines.hs view

@@ -0,0 +1,53 @@+-- | Fold over the lines in a file+--+{-# LANGUAGE BangPatterns #-}+module Data.Text.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 "FoldLines"+    [ 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 #-}

+ tests/benchmarks/src/Data/Text/Benchmarks/HtmlCombinator.hs view

@@ -0,0 +1,36 @@+-- | Create a large HTML table and dump it to a handle+--+{-# LANGUAGE OverloadedStrings #-}+module Data.Text.Benchmarks.HtmlCombinator+    ( 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 "HtmlCombinator" $ 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

+ tests/benchmarks/src/Data/Text/Benchmarks/Ordering.hs view

@@ -0,0 +1,58 @@+-- | For every 1000th line of a file, check how many lines in the file are+-- lexicographically smaller+--+module Data.Text.Benchmarks.Ordering+    ( benchmark+    ) where++import Control.Exception (evaluate)+import Criterion (Benchmark, bgroup, bench)+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 = return $ bgroup "Ordering"+    [ bench "ByteString" $ B.readFile fp >>=+        evaluate . numSmaller . B.lines+    , bench "LazyByteString" $ BL.readFile fp >>=+        evaluate . numSmaller . BL.lines++    , bench "Text" $ B.readFile fp >>=+        evaluate . numSmaller . T.lines . T.decodeUtf8+    , bench "TextFusion" $ B.readFile fp >>=+        evaluate . numSmallerFusion . T.lines . T.decodeUtf8+    , bench "LazyText" $ BL.readFile fp >>=+        evaluate . numSmaller . TL.lines . TL.decodeUtf8++    , bench "String" $ readFile fp >>=+        evaluate . numSmaller . lines+    ]++-- | Take every Nth item from a list+--+every :: Int -> [a] -> [a]+every k = go k+  where+    go n (x : xs)+        | n < k     = go (n+1) xs+        | otherwise = x : go 1 xs+    go _ _          = []++-- | Benchmark logic+--+numSmaller :: (Ord a) => [a] -> Int+numSmaller ls = sum . map f $ every 1000 ls+  where+    f x = length . filter ((== GT) . compare x) $ ls++-- | Test a comparison that could be fused: compare (toLower a) (toLower b)+-- Currently, this funcion performs very badly!+--+numSmallerFusion :: [T.Text] -> Int+numSmallerFusion ls = sum . map f $ every 1000 ls+  where+    f x = length . filter ((== GT) . compare (T.toLower x) . T.toLower) $ ls

+ tests/benchmarks/src/Data/Text/Benchmarks/Pure.hs view

@@ -0,0 +1,470 @@+-- | Benchmarks various pure functions from the Text library+--+{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Text.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

+ tests/benchmarks/src/Data/Text/Benchmarks/ReadNumbers.hs view

@@ -0,0 +1,83 @@+-- | Read numbers from a file with a just a number on each line, find the+-- minimum of those numbers.+--+module Data.Text.Benchmarks.ReadNumbers+    ( benchmark+    ) where++import Control.Exception (evaluate)+import Criterion (Benchmark, bgroup, bench)+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.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Lazy.Read as TL+import qualified Data.Text.Read as T++benchmark :: FilePath -> IO Benchmark+benchmark fp = return $ bgroup "ReadNumbers"+    [ bench "DecimalString" $ readFile fp >>= evaluate .+        int . string readDec . lines+    , bench "HexadecimalString" $ readFile fp >>= evaluate .+        int . string readHex . lines+    , bench "DoubleString" $ readFile fp >>= evaluate .+        double . string readFloat . lines++    , bench "DecimalText" $ B.readFile fp >>= evaluate .+        int . text (T.signed T.decimal) . T.lines . T.decodeUtf8+    , bench "HexadecimalText" $ B.readFile fp >>= evaluate .+        int . text (T.signed T.hexadecimal) . T.lines . T.decodeUtf8+    , bench "DoubleText" $ B.readFile fp >>= evaluate .+        double . text T.double . T.lines . T.decodeUtf8+    , bench "RationalText" $ B.readFile fp >>= evaluate .+        double . text T.rational . T.lines . T.decodeUtf8++    , bench "DecimalLazyText" $ BL.readFile fp >>= evaluate .+        int . text (TL.signed TL.decimal) . TL.lines . TL.decodeUtf8+    , bench "HexadecimalLazyText" $ BL.readFile fp >>= evaluate .+        int . text (TL.signed TL.hexadecimal) . TL.lines . TL.decodeUtf8+    , bench "DoubleLazyText" $ BL.readFile fp >>= evaluate .+        double . text TL.double . TL.lines . TL.decodeUtf8+    , bench "RationalLazyText" $ BL.readFile fp >>= evaluate .+        double . text TL.rational . TL.lines . TL.decodeUtf8++    , bench "DecimalByteString" $ B.readFile fp >>= evaluate .+        int . byteString B.readInt . B.lines+    , bench "DoubleByteString" $ B.readFile fp >>= evaluate .+        double . byteString B.readDouble . B.lines++    , bench "DecimalLazyByteString" $ BL.readFile fp >>= evaluate .+        int . byteString BL.readInt . BL.lines+    , bench "DoubleLazyByteString" $ BL.readFile fp >>= evaluate .+        double . byteString BL.readDouble . BL.lines+    ]+  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

+ tests/benchmarks/src/Data/Text/Benchmarks/Replace.hs view

@@ -0,0 +1,33 @@+-- | Replace a string by another string in a file+--+module Data.Text.Benchmarks.Replace+    ( benchmark+    ) where++import Criterion (Benchmark, bgroup, bench)+import System.IO (Handle)+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 -> Handle -> String -> String -> IO Benchmark+benchmark fp sink pat sub = return $ bgroup "Replace"+    -- We have benchmarks for lazy text and lazy bytestrings. We also benchmark+    -- without the acual replacement, so we can get an idea of what time is+    -- spent on IO and computations.+    [ bench "LazyText" $ TL.readFile fp >>=+        TL.hPutStr sink . TL.replace tpat tsub+    , bench "LazyTextNull" $ TL.readFile fp >>= TL.hPutStr sink++    , bench "LazyByteString" $ BL.readFile fp >>=+        BL.hPutStr sink . BL.replace bpat bsub+    , bench "LazyByteStringNull" $ BL.readFile fp >>= BL.hPutStr sink+    ]+  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

+ tests/benchmarks/src/Data/Text/Benchmarks/Sort.hs view

@@ -0,0 +1,27 @@+-- | Implements the unix @sort@ program+--+{-# LANGUAGE OverloadedStrings #-}+module Data.Text.Benchmarks.Sort+    ( benchmark+    ) where++import Criterion (Benchmark, bench)+import Data.Monoid (mconcat)+import System.IO (Handle)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+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 TLB+import qualified Data.Text.Lazy.Encoding as TL++benchmark :: FilePath -> Handle -> IO Benchmark+benchmark fp sink = return $ bench "Sort" $ do+    t <- T.decodeUtf8 `fmap` B.readFile fp+    BL.hPutStr sink $ TL.encodeUtf8 $ sort t++sort :: T.Text -> TL.Text+sort = TLB.toLazyText . mconcat . L.intersperse (TLB.fromText "\n") .+    map TLB.fromText . L.sort . T.lines

+ tests/benchmarks/src/Data/Text/Benchmarks/StripBrackets.hs view

@@ -0,0 +1,33 @@+-- | Program to replace everything between brackets by spaces+--+-- This program was originally contributed by Petr Prokhorenkov.+--+module Data.Text.Benchmarks.StripBrackets+    ( benchmark+    ) where+     +import Criterion (Benchmark, bench)+import System.IO (Handle)+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++benchmark :: FilePath -> Handle -> IO Benchmark+benchmark fp sink = return $ bench "StripBrackets" $ do+    t <- T.decodeUtf8 `fmap` B.readFile fp+    B.hPutStr sink $ T.encodeUtf8 $ stripBrackets t++stripBrackets :: T.Text -> T.Text+stripBrackets = snd . T.mapAccumL f (0 :: Int)+  where+    f depth c =+        let depth' = depth + d' c+            c' | depth > 0 || depth' > 0 = ' '+               | otherwise = c+        in (depth', c')++    d' '{' = 1+    d' '[' = 1+    d' '}' = -1+    d' ']' = -1+    d' _   = 0

+ tests/benchmarks/src/Data/Text/Benchmarks/WordCount.hs view

@@ -0,0 +1,22 @@+-- | A word frequence count program+--+module Data.Text.Benchmarks.WordCount+    ( benchmark+    ) where++import Control.Exception (evaluate)+import Criterion (Benchmark, bench)+import Data.List (foldl')+import Data.Map (Map)+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 = return $ bench "WordCount" $ do+    t <- T.readFile fp+    evaluate $ M.size $ wordCount t++wordCount :: T.Text -> Map T.Text Int+wordCount =+    foldl' (\m k -> M.insertWith (+) k 1 m) M.empty . map T.toLower . T.words

+ tests/benchmarks/text-benchmarks.cabal view

@@ -0,0 +1,34 @@+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: src ../..+  main-is:        Data/Text/Benchmarks.hs+  ghc-options:    -Wall -O2+  cpp-options:    -DHAVE_DEEPSEQ+  build-depends:  base              >= 4   && < 5,+                  criterion         >= 0.5 && < 0.6,+                  bytestring        >= 0.9 && < 0.10,+                  deepseq           >= 1.1 && < 1.2,+                  filepath          >= 1.1 && < 1.3,+                  directory         >= 1.1 && < 1.2,+                  containers        >= 0.3 && < 0.5,+                  binary            >= 0.5 && < 0.6,+                  utf8-string       >= 0.3 && < 0.4,+                  blaze-builder     >= 0.3 && < 0.4,+                  bytestring-lexing >= 0.2 && < 0.3,+                  stringsearch      >= 0.3 && < 0.4

text.cabal view

@@ -1,7 +1,7 @@ name:           text-version:        0.11.0.8-homepage:       http://bitbucket.org/bos/text-bug-reports:    http://bitbucket.org/bos/text/issues+version:        0.11.1.0+homepage:       https://bitbucket.org/bos/text+bug-reports:    https://bitbucket.org/bos/text/issues synopsis:       An efficient packed Unicode text type. description:         .@@ -45,31 +45,16 @@     README.markdown     -- scripts/CaseFolding.txt     -- scripts/SpecialCasing.txt-    scripts/ApiCompare.hs-    scripts/Arsec.hs-    scripts/CaseFolding.hs-    scripts/CaseMapping.hs-    scripts/SpecialCasing.hs-    tests/Benchmarks.hs+    scripts/*.hs+    tests/*.hs     tests/Makefile-    tests/Properties.hs-    tests/QuickCheckUtils.hs-    tests/SlowFunctions.hs-    tests/StdioCoverage.hs-    tests/TestUtils.hs-    tests/benchmarks/Cut.hs-    tests/benchmarks/DecodeUtf8.hs-    tests/benchmarks/EncodeUtf8.hs-    tests/benchmarks/Equality.hs-    tests/benchmarks/FileIndices.hs-    tests/benchmarks/FileRead.hs-    tests/benchmarks/FoldLines.hs-    tests/benchmarks/HtmlCombinator.hs-    tests/benchmarks/Makefile-    tests/benchmarks/Replace.hs-    tests/benchmarks/ReplaceTags.hs-    tests/benchmarks/fileread.py-    tests/benchmarks/fileread_c.c+    tests/README.markdown+    tests/benchmarks/Setup.hs+    tests/benchmarks/python/*.py+    tests/benchmarks/ruby/*.rb+    tests/benchmarks/src/Data/Text/*.hs+    tests/benchmarks/src/Data/Text/Benchmarks/*.hs+    tests/benchmarks/text-benchmarks.cabal     tests/cover-stdio.sh  flag developer@@ -87,6 +72,8 @@     Data.Text.Internal     Data.Text.Lazy     Data.Text.Lazy.Builder+    Data.Text.Lazy.Builder.Int+    Data.Text.Lazy.Builder.RealFloat     Data.Text.Lazy.Encoding     Data.Text.Lazy.IO     Data.Text.Lazy.Internal@@ -104,6 +91,7 @@     Data.Text.Fusion.Internal     Data.Text.Fusion.Size     Data.Text.IO.Internal+    Data.Text.Lazy.Builder.Functions     Data.Text.Lazy.Encoding.Fusion     Data.Text.Lazy.Fusion     Data.Text.Lazy.Search@@ -114,6 +102,7 @@     Data.Text.Util    build-depends:+    array,     base       < 5,     bytestring >= 0.9 && < 1.0   if impl(ghc >= 6.10)@@ -132,10 +121,18 @@     ghc-options: -Werror     cpp-options: -DASSERTS +  if impl(ghc >= 6.11)+    cpp-options: -DINTEGER_GMP+    build-depends: integer-gmp >= 0.2 && < 0.3++  if impl(ghc >= 6.9) && impl(ghc < 6.11)+    cpp-options: -DINTEGER_GMP+    build-depends: integer >= 0.1 && < 0.2+ source-repository head   type:     mercurial-  location: http://bitbucket.org/bos/text+  location: https://bitbucket.org/bos/text  source-repository head   type:     git-  location: http://github.com/bos/text+  location: https://github.com/bos/text