Commit 3ef61934 authored by Bodigrim's avatar Bodigrim
Browse files

Merge text-multilang into text-benchmarks

parent e19405e7
......@@ -17,6 +17,7 @@ import qualified Benchmarks.Equality as Equality
import qualified Benchmarks.FileRead as FileRead
import qualified Benchmarks.FoldLines as FoldLines
import qualified Benchmarks.Mul as Mul
import qualified Benchmarks.Multilang as Multilang
import qualified Benchmarks.Pure as Pure
import qualified Benchmarks.ReadNumbers as ReadNumbers
import qualified Benchmarks.Replace as Replace
......@@ -48,6 +49,7 @@ main = do
, FileRead.benchmark (tf "russian.txt")
, FoldLines.benchmark (tf "russian.txt")
, env Mul.initEnv Mul.benchmark
, Multilang.benchmark
, env (Pure.initEnv (tf "tiny.txt")) (Pure.benchmark "tiny")
, env (Pure.initEnv (tf "ascii-small.txt")) (Pure.benchmark "ascii-small")
, env (Pure.initEnv (tf "ascii.txt")) (Pure.benchmark "ascii")
......
{-# LANGUAGE BangPatterns, OverloadedStrings, RankNTypes #-}
module Benchmarks.Multilang (benchmark) where
import qualified Data.ByteString as B
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8)
import Data.Text (Text)
import Test.Tasty.Bench (Benchmark, bgroup, bench, env, nf)
readYiwiki :: IO Text
readYiwiki = decodeUtf8 `fmap` B.readFile "benchmarks/text-test-data/yiwiki.xml"
benchmark :: Benchmark
benchmark = env readYiwiki $ \content -> bgroup "Multilang"
[ bench "find_first" $ nf (Text.isInfixOf "en:Benin") content
, bench "find_index" $ nf (Text.findIndex (=='c')) content
]
{-# LANGUAGE BangPatterns, OverloadedStrings, RankNTypes #-}
module Main (
main
) where
import Control.Monad (forM_)
import qualified Data.ByteString as B
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8)
import Data.Text (Text)
import System.IO (hFlush, stdout)
import Timer (timer)
type BM = Text -> ()
bm :: forall a. (Text -> a) -> BM
bm f t = f t `seq` ()
benchmarks :: [(String, Text.Text -> ())]
benchmarks = [
("find_first", bm $ Text.isInfixOf "en:Benin")
, ("find_index", bm $ Text.findIndex (=='c'))
]
main :: IO ()
main = do
!contents <- decodeUtf8 `fmap` B.readFile "benchmarks/text-test-data/yiwiki.xml"
forM_ benchmarks $ \(name, bmark) -> do
putStr $ name ++ " "
hFlush stdout
putStrLn =<< (timer 100 contents bmark)
{-# LANGUAGE BangPatterns #-}
module Timer (timer) where
import Control.Exception (evaluate)
import Data.Time.Clock.POSIX (getPOSIXTime)
import GHC.Float (FFFormat(..), formatRealFloat)
ickyRound :: Int -> Double -> String
ickyRound k = formatRealFloat FFFixed (Just k)
timer :: Int -> a -> (a -> b) -> IO String
timer count a0 f = do
let loop !k !fastest
| k <= 0 = return fastest
| otherwise = do
start <- getPOSIXTime
let inner a i
| i <= 0 = return ()
| otherwise = evaluate (f a) >> inner a (i-1)
inner a0 count
end <- getPOSIXTime
let elapsed = end - start
loop (k-1) (min fastest (elapsed / fromIntegral count))
t <- loop (3::Int) 1e300
let log10 x = log x / log 10
ft = realToFrac t
prec = round (log10 (fromIntegral count) - log10 ft)
return $! ickyRound prec ft
{-# NOINLINE timer #-}
......@@ -283,6 +283,7 @@ benchmark text-benchmarks
Benchmarks.FileRead
Benchmarks.FoldLines
Benchmarks.Mul
Benchmarks.Multilang
Benchmarks.Programs.BigTable
Benchmarks.Programs.Cut
Benchmarks.Programs.Fold
......@@ -299,17 +300,3 @@ benchmark text-benchmarks
default-language: Haskell2010
default-extensions: NondecreasingIndentation
other-extensions: DeriveGeneric
benchmark text-multilang
type: exitcode-stdio-1.0
hs-source-dirs: benchmarks/haskell
main-is: Multilang.hs
other-modules: Timer
ghc-options: -Wall -O2
build-depends: base == 4.*,
bytestring,
text,
time
default-language: Haskell2010
default-extensions: NondecreasingIndentation
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment