Commits

tibbe committed 8677d83

Several performance improvements

* Ensure the bounds check gets inlined by making ensure non-recursive
so it can be inlined.

* Avoid creating an extra closure in the common case by inlining the
success continuation in ensure.

* Optimize lengths check on Text values by using an O(1) conservative
check before the exact O(n) check.

* Make sure functions that take a high-order predicate argument get
inlined to reduce the cost of calling that predicate.

Comments (0)

Files changed (2)

Data/Attoparsec/ByteString/Internal.hs

-{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE BangPatterns, CPP, Rank2Types, OverloadedStrings,
+    RecordWildCards #-}
 -- |
 -- Module      :  Data.Attoparsec.ByteString.Internal
 -- Copyright   :  Bryan O'Sullivan 2007-2011
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Unsafe as B
 
+#if defined(__GLASGOW_HASKELL__)
+import GHC.Exts (inline)
+#else
+inline :: a -> a
+inline x = x
+#endif
+
 type Parser = T.Parser B.ByteString
 type Result = IResult B.ByteString
 type Input = T.Input B.ByteString
 ensure :: Int -> Parser B.ByteString
 ensure !n = T.Parser $ \i0 a0 m0 kf ks ->
     if B.length (unI i0) >= n
-    then ks i0 a0 m0 (unI i0)
-    else T.runParser (demandInput >> ensure n) i0 a0 m0 kf ks
+    then inline ks i0 a0 m0 (unI i0)
+    else T.runParser (demandInput >> go n) i0 a0 m0 kf ks
+  where
+    go n' = T.Parser $ \i0 a0 m0 kf ks ->
+        if B.length (unI i0) >= n'
+        then ks i0 a0 m0 (unI i0)
+        else T.runParser (demandInput >> go n') i0 a0 m0 kf ks
+{-# INLINE ensure #-}
 
 -- | Ask for input.  If we receive any, pass it to a success
 -- continuation, otherwise to a failure continuation.
 satisfy :: (Word8 -> Bool) -> Parser Word8
 satisfy p = do
   s <- ensure 1
-  let w = B.unsafeHead s
+  let !w = B.unsafeHead s
   if p w
     then put (B.unsafeTail s) >> return w
     else fail "satisfy"
+{-# INLINE satisfy #-}
 
 -- | The parser @skip p@ succeeds for any byte for which the predicate
 -- @p@ returns 'True'.
 satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a
 satisfyWith f p = do
   s <- ensure 1
-  let c = f (B.unsafeHead s)
+  let c = f $! B.unsafeHead s
   if p c
-    then put (B.unsafeTail s) >> return c
+    then let !t = B.unsafeTail s
+         in put t >> return c
     else fail "satisfyWith"
+{-# INLINE satisfyWith #-}
 
 storable :: Storable a => Parser a
 storable = hack undefined
           then go (h:acc)
           else return (h:acc)
       else return (h:acc)
+{-# INLINE takeWhile #-}
 
 takeRest :: Parser [B.ByteString]
 takeRest = go []

Data/Attoparsec/Text/Internal.hs

-{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings, Rank2Types,
-    RecordWildCards, TypeSynonymInstances #-}
+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,
+    Rank2Types, RecordWildCards, TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -- |
 -- Module      :  Data.Attoparsec.Text.Internal
 import qualified Data.Attoparsec.Internal.Types as T
 import qualified Data.Attoparsec.Text.FastSet as Set
 import qualified Data.Text as T
+import qualified Data.Text.Internal as T
 import qualified Data.Text.Lazy as L
 
+#if defined(__GLASGOW_HASKELL__)
+import GHC.Exts (inline)
+#else
+inline :: a -> a
+inline x = x
+#endif
+
 type Parser = T.Parser Text
 type Result = IResult Text
 type Input = T.Input Text
 instance IsString (Parser Text) where
     fromString = string . T.pack
 
+lengthAtLeast :: T.Text -> Int -> Bool
+lengthAtLeast t@(T.Text _ _ l) n = l >= n * 4 || T.length t >= n
+{-# INLINE lengthAtLeast #-}
+
 -- | If at least @n@ characters of input are available, return the
 -- current input, otherwise fail.
 ensure :: Int -> Parser Text
 ensure !n = T.Parser $ \i0 a0 m0 kf ks ->
-    if T.length (unI i0) >= n
-    then ks i0 a0 m0 (unI i0)
-    else runParser (demandInput >> ensure n) i0 a0 m0 kf ks
+    if lengthAtLeast (unI i0) n
+    then inline ks i0 a0 m0 (unI i0)
+    else runParser (demandInput >> go n) i0 a0 m0 kf ks
+  where
+    go n' = T.Parser $ \i0 a0 m0 kf ks ->
+        if lengthAtLeast (unI i0) n'
+        then ks i0 a0 m0 (unI i0)
+        else runParser (demandInput >> go n') i0 a0 m0 kf ks
+{-# INLINE ensure #-}
 
 -- | Ask for input.  If we receive any, pass it to a success
 -- continuation, otherwise to a failure continuation.
 satisfy :: (Char -> Bool) -> Parser Char
 satisfy p = do
   s <- ensure 1
-  let w = unsafeHead s
+  let !w = unsafeHead s
   if p w
     then put (unsafeTail s) >> return w
     else fail "satisfy"
+{-# INLINE satisfy #-}
 
 -- | The parser @skip p@ succeeds for any character for which the
 -- predicate @p@ returns 'True'.
 satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a
 satisfyWith f p = do
   s <- ensure 1
-  let c = f (unsafeHead s)
+  let c = f $! unsafeHead s
   if p c
-    then put (unsafeTail s) >> return c
+    then let !t = unsafeTail s
+         in put t >> return c
     else fail "satisfyWith"
+{-# INLINE satisfyWith #-}
 
 -- | Consume @n@ characters of input, but succeed only if the
 -- predicate returns 'True'.