diff options
| -rw-r--r-- | testsuite/tests/perf/should_run/T15578.hs | 80 | ||||
| -rw-r--r-- | testsuite/tests/perf/should_run/all.T | 9 |
2 files changed, 89 insertions, 0 deletions
diff --git a/testsuite/tests/perf/should_run/T15578.hs b/testsuite/tests/perf/should_run/T15578.hs new file mode 100644 index 0000000000..be056e222b --- /dev/null +++ b/testsuite/tests/perf/should_run/T15578.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric #-} + +module Main where + +import qualified Data.Set as Set +import qualified Data.Text as Text + +import Data.Set (Set) +import Data.Text (Text) +import System.IO (BufferMode (NoBuffering), hSetBuffering, stdout) +import GHC.Generics (Generic) +import Control.DeepSeq (force, NFData) +import Control.Exception (evaluate) + + +-------------------------------- +-- === Running benchmarks === -- +-------------------------------- + +iters :: Int +iters = 100000000 + +src1 :: Text +src1 = Text.replicate iters "tttt" + +data Grammar a + = Tokens !(Set a) !(a -> Bool) + | Many !(Grammar a) + | X !(Grammar a) + +instance Ord a => Semigroup (Grammar a) where + Tokens s f <> Tokens s' g = Tokens (s <> s') $ \c -> f c || g c + {-# INLINE (<>) #-} + +token :: Eq a => a -> Grammar a +token = \a -> Tokens (Set.singleton a) (a ==) +{-# INLINE token #-} + +many :: Grammar a -> Grammar a +many = Many +{-# INLINE many #-} + +data Result + = Success Text Text + | Fail + deriving (Show, Generic) + +instance NFData Result + +runTokenParser :: Grammar Char -> Text -> Result +runTokenParser = \grammar stream -> case grammar of + Tokens _ tst -> let + head = Text.head stream + in if tst head + then Success (Text.tail stream) (Text.singleton head) + else Fail + Many (Tokens _ tst) -> let + (!consumed, !rest) = Text.span tst stream + in Success rest consumed + X !grammar -> runTokenParser grammar stream + +testGrammar1 :: Grammar Char +testGrammar1 = let + s1 = token 't' + in many s1 +{-# INLINE testGrammar1 #-} + +test3 :: Text -> Result +test3 src = + runTokenParser testGrammar1 src +{-# NOINLINE test3 #-} + +main :: IO () +main = do + srcx <- evaluate $ force src1 + evaluate $ force $ test3 srcx + pure () diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 6a7bcf0040..1a85e7073d 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -604,3 +604,12 @@ test('T15426', only_ways(['normal'])], compile_and_run, ['-O2']) + +test('T15578', + [stats_num_field('bytes allocated', + [ (wordsize(64), 800041456, 5) ]), + # 2018-09-07 800041456 Improvements from #15578 + # initial 42400041456 + only_ways(['normal'])], + compile_and_run, + ['-O2']) |