git.iko.soy/typeable/attoparsec
on master help sign in
Merge pull request #35 from tibbe/scan

Optimize scan for short strings

commit8a0065b6c14f5b83c888c6ce6f7acc562a0c0ebb authorBryan O'Sullivan <bos@serpentine.com> dateMon 19 Nov 2012, 20:20 (14 years ago) parent1b39dd7aa3ef16
2 files changed+40−7
compare with master
unifiedsplit
Data/Attoparsec/ByteString/Internal.hs+21−6 benchmarks/Benchmarks.hs+19−1
Data/Attoparsec/ByteString/Internal.hs+21−6
@@ -1,5 +1,5 @@
11{-# LANGUAGE BangPatterns, CPP, Rank2Types, OverloadedStrings,
2− RecordWildCards #-}
2+ RecordWildCards, MagicHash, UnboxedTuples #-}
33-- |
44-- Module : Data.Attoparsec.ByteString.Internal
55-- Copyright : Bryan O'Sullivan 2007-2011
@@ -76,7 +76,6 @@ import Foreign.ForeignPtr (withForeignPtr)
7676import Foreign.Ptr (castPtr, minusPtr, plusPtr)
7777import Foreign.Storable (Storable(peek, sizeOf))
7878import Prelude hiding (getChar, take, takeWhile)
79−import System.IO.Unsafe (unsafePerformIO)
8079import qualified Data.Attoparsec.Internal.Types as T
8180import qualified Data.ByteString as B8
8281import qualified Data.ByteString.Char8 as B
@@ -85,8 +84,12 @@ import qualified Data.ByteString.Lazy as L
8584import qualified Data.ByteString.Unsafe as B
8685
8786#if defined(__GLASGOW_HASKELL__)
87+import GHC.Base (realWorld#)
8888import GHC.Exts (inline)
89+import GHC.IO (IO(IO))
8990#else
91+import System.IO.Unsafe (unsafePerformIO)
92+
9093inline :: a -> a
9194inline x = x
9295#endif
@@ -345,7 +348,7 @@ scan s0 p = do
345348 chunks <- go [] s0
346349 case chunks of
347350 [x] -> return x
348− xs -> return . B.concat . reverse $ xs
351+ xs -> return $! B.concat $ reverse xs
349352 where
350353 go acc s1 = do
351354 let scanner (B.PS fp off len) =
@@ -362,9 +365,9 @@ scan s0 p = do
362365 done !i !s = return (T i s)
363366 inner start s1
364367 bs <- get
365− let T i s' = unsafePerformIO $ scanner bs
366− h = B.unsafeTake i bs
367− t = B.unsafeDrop i bs
368+ let T i s' = inlinePerformIO $ scanner bs
369+ !h = B.unsafeTake i bs
370+ !t = B.unsafeDrop i bs
368371 put t
369372 if B.null t
370373 then do
@@ -503,3 +506,15 @@ parseOnly m s = case T.runParser m (I s) (A B.empty) Complete failK successK of
503506 Done _ a -> Right a
504507 _ -> error "parseOnly: impossible error!"
505508{-# INLINE parseOnly #-}
509+
510+-- | Just like unsafePerformIO, but we inline it. Big performance gains as
511+-- it exposes lots of things to further inlining. /Very unsafe/. In
512+-- particular, you should do no memory allocation inside an
513+-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.
514+inlinePerformIO :: IO a -> a
515+#if defined(__GLASGOW_HASKELL__)
516+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
517+#else
518+inlinePerformIO = unsafePerformIO
519+#endif
520+{-# INLINE inlinePerformIO #-}
benchmarks/Benchmarks.hs+19−1
@@ -19,6 +19,7 @@ import qualified Data.ByteString.Char8 as BC
1919import qualified Data.ByteString.Lazy as BL
2020import qualified Data.Text as T
2121import qualified Data.Text.Lazy as TL
22+import Data.Word (Word8)
2223import qualified Text.Parsec as P
2324
2425instance NFData ByteString where
@@ -74,6 +75,10 @@ main = do
7475 , bench "isAlpha_iso8859_15" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl
7576 ]
7677 , bench "word32LE" $ nf (AB.parse word32LE) b
78+ , bgroup "scan" [
79+ bench "short" $ nf (AB.parse quotedString) (BC.pack "abcdefghijk\"")
80+ , bench "long" $ nf (AB.parse quotedString) b
81+ ]
7782 ]
7883
7984-- Benchmarks bind and (potential) bounds-check merging.
@@ -86,4 +91,17 @@ word32LE = do
8691 return $! (fromIntegral w1 :: Word32) +
8792 fromIntegral w2 `unsafeShiftL` 8 +
8893 fromIntegral w3 `unsafeShiftL` 16 +
89− fromIntegral w4 `unsafeShiftL` 32
94+ fromIntegral w4 `unsafeShiftL` 32
95+
96+doubleQuote, backslash :: Word8
97+doubleQuote = 34
98+backslash = 92
99+{-# INLINE backslash #-}
100+{-# INLINE doubleQuote #-}
101+
102+-- | Parse a string without a leading quote.
103+quotedString :: AB.Parser B.ByteString
104+quotedString = AB.scan False $ \s c -> if s then Just False
105+ else if c == doubleQuote
106+ then Nothing
107+ else Just (c == backslash)