git.iko.soy/typeable/attoparsec
on 0.12.1.6 help sign in
120 lines 4.2 kB history raw
1{-# LANGUAGE BangPatterns, CPP #-}
3import Common ()
4import Control.Applicative (many)
5import Criterion.Main (bench, bgroup, defaultMain, nf)
6import Data.Bits
7import Data.Char (isAlpha)
8import Data.Word (Word32)
9import Data.Word (Word8)
10import Numbers (numbers)
11import Common (chunksOf)
12import Text.Parsec.Text ()
13import Text.Parsec.Text.Lazy ()
14import qualified Warp
15import qualified Aeson
16import qualified Genome
17import qualified Data.Attoparsec.ByteString as AB
18import qualified Data.Attoparsec.ByteString.Char8 as AC
19import qualified Data.Attoparsec.ByteString.Lazy as ABL
20import qualified Data.Attoparsec.Text as AT
21import qualified Data.Attoparsec.Text.Lazy as ATL
22import qualified Data.ByteString as B
23import qualified Data.ByteString.Char8 as BC
24import qualified Data.ByteString.Lazy as BL
25import qualified Data.Text as T
26import qualified Data.Text.Lazy as TL
27import qualified HeadersByteString
28import qualified HeadersText
29import qualified Links
30import qualified Text.Parsec as P
32main :: IO ()
33main = do
34 let s = take 1024 . cycle $ ['a'..'z'] ++ ['A'..'Z']
35 !b = BC.pack s
36 !bl = BL.fromChunks . map BC.pack . chunksOf 4 $ s
37 !t = T.pack s
38 !tl = TL.fromChunks . map T.pack . chunksOf 4 $ s
39 aeson <- Aeson.aeson
40 headersBS <- HeadersByteString.headers
41 headersT <- HeadersText.headers
42 defaultMain [
43 bgroup "many" [
44 bgroup "attoparsec" [
45 bench "B" $ nf (AB.parse (many (AC.satisfy AC.isAlpha_ascii))) b
46 , bench "BL" $ nf (ABL.parse (many (AC.satisfy AC.isAlpha_ascii))) bl
47 , bench "T" $ nf (AT.parse (many (AT.satisfy AC.isAlpha_ascii))) t
48 , bench "TL" $ nf (ATL.parse (many (AT.satisfy AC.isAlpha_ascii))) tl
49 ]
50 , bgroup "parsec" [
51 bench "S" $ nf (P.parse (many (P.satisfy AC.isAlpha_ascii)) "") s
52 , bench "B" $ nf (P.parse (many (P.satisfy AC.isAlpha_ascii)) "") b
53 , bench "BL" $ nf (P.parse (many (P.satisfy AC.isAlpha_ascii)) "") bl
54 , bench "T" $ nf (P.parse (many (P.satisfy AC.isAlpha_ascii)) "") t
55 , bench "TL" $ nf (P.parse (many (P.satisfy AC.isAlpha_ascii)) "") tl
56 ]
57 ]
58 , bgroup "comparison" [
59 bgroup "many-vs-takeWhile" [
60 bench "many" $ nf (AB.parse (many (AC.satisfy AC.isAlpha_ascii))) b
61 , bench "takeWhile" $ nf (AB.parse (AC.takeWhile AC.isAlpha_ascii)) b
62 ]
63 , bgroup "letter-vs-isAlpha" [
64 bench "letter" $ nf (AB.parse (many AC.letter_ascii)) b
65 , bench "isAlpha" $ nf (AB.parse (many (AC.satisfy AC.isAlpha_ascii))) b
66 ]
67 ]
68 , bgroup "takeWhile" [
69 bench "isAlpha" $ nf (ABL.parse (AC.takeWhile isAlpha)) bl
70 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl
71 , bench "isAlpha_iso8859_15" $
72 nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl
73 ]
74 , bgroup "takeWhile1" [
75 bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl
76 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile1 AC.isAlpha_ascii)) bl
77 ]
78 , bench "word32LE" $ nf (AB.parse word32LE) b
79 , bgroup "scan" [
80 bench "short" $ nf (AB.parse quotedString) (BC.pack "abcdefghijk\"")
81 , bench "long" $ nf (AB.parse quotedString) b
82 ]
83 , aeson
84 , Genome.genome
85 , headersBS
86 , headersT
87 , Links.links
88 , numbers
89 , Warp.benchmarks
90 ]
92-- Benchmarks bind and (potential) bounds-check merging.
93word32LE :: AB.Parser Word32
94word32LE = do
95 w1 <- AB.anyWord8
96 w2 <- AB.anyWord8
97 w3 <- AB.anyWord8
98 w4 <- AB.anyWord8
99 return $! (fromIntegral w1 :: Word32) +
100 fromIntegral w2 `unsafeShiftL` 8 +
101 fromIntegral w3 `unsafeShiftL` 16 +
102 fromIntegral w4 `unsafeShiftL` 32
104doubleQuote, backslash :: Word8
105doubleQuote = 34
106backslash = 92
107{-# INLINE backslash #-}
108{-# INLINE doubleQuote #-}
110-- | Parse a string without a leading quote.
111quotedString :: AB.Parser B.ByteString
112quotedString = AB.scan False $ \s c -> if s then Just False
113 else if c == doubleQuote
114 then Nothing
115 else Just (c == backslash)
117#if !MIN_VERSION_base(4,5,0)
118unsafeShiftL :: Bits a => a -> Int -> a
119unsafeShiftL = shiftL
120#endif