Honor INLINE on 0-arity bindings (#15578)
[ghc.git] / testsuite / tests / perf / should_run / T15578.hs
1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE Strict #-}
3 {-# LANGUAGE BangPatterns #-}
4 {-# LANGUAGE DeriveGeneric #-}
5
6 module Main where
7
8 import qualified Data.Set as Set
9 import qualified Data.Text as Text
10
11 import Data.Set (Set)
12 import Data.Text (Text)
13 import System.IO (BufferMode (NoBuffering), hSetBuffering, stdout)
14 import GHC.Generics (Generic)
15 import Control.DeepSeq (force, NFData)
16 import Control.Exception (evaluate)
17
18
19 --------------------------------
20 -- === Running benchmarks === --
21 --------------------------------
22
23 iters :: Int
24 iters = 100000000
25
26 src1 :: Text
27 src1 = Text.replicate iters "tttt"
28
29 data Grammar a
30 = Tokens !(Set a) !(a -> Bool)
31 | Many !(Grammar a)
32 | X !(Grammar a)
33
34 instance Ord a => Semigroup (Grammar a) where
35 Tokens s f <> Tokens s' g = Tokens (s <> s') $ \c -> f c || g c
36 {-# INLINE (<>) #-}
37
38 token :: Eq a => a -> Grammar a
39 token = \a -> Tokens (Set.singleton a) (a ==)
40 {-# INLINE token #-}
41
42 many :: Grammar a -> Grammar a
43 many = Many
44 {-# INLINE many #-}
45
46 data Result
47 = Success Text Text
48 | Fail
49 deriving (Show, Generic)
50
51 instance NFData Result
52
53 runTokenParser :: Grammar Char -> Text -> Result
54 runTokenParser = \grammar stream -> case grammar of
55 Tokens _ tst -> let
56 head = Text.head stream
57 in if tst head
58 then Success (Text.tail stream) (Text.singleton head)
59 else Fail
60 Many (Tokens _ tst) -> let
61 (!consumed, !rest) = Text.span tst stream
62 in Success rest consumed
63 X !grammar -> runTokenParser grammar stream
64
65 testGrammar1 :: Grammar Char
66 testGrammar1 = let
67 s1 = token 't'
68 in many s1
69 {-# INLINE testGrammar1 #-}
70
71 test3 :: Text -> Result
72 test3 src =
73 runTokenParser testGrammar1 src
74 {-# NOINLINE test3 #-}
75
76 main :: IO ()
77 main = do
78 srcx <- evaluate $ force src1
79 evaluate $ force $ test3 srcx
80 pure ()