git.iko.soy/typeable/attoparsec
on master help sign in
Switch from backtracking by default to *not* backtracking.

This saves rather a lot of memory, and improves performance along the way.

commitd8469fb9ba478abdc8b6253fb39af611b443444d authorBryan O'Sullivan <bos@serpentine.com> dateTue 24 May 2011, 16:35 (15 years ago) parenta1be6a8
3 files changed+40−28
compare with master
unifiedsplit
Data/Attoparsec/Internal.hs+17−3 Data/Attoparsec/Internal/Types.hs+22−24 attoparsec.cabal+1−1
Data/Attoparsec/Internal.hs+17−3
@@ -69,6 +69,7 @@ import Control.Monad (when)
6969import Data.Attoparsec.Combinator
7070import Data.Attoparsec.FastSet (charClass, memberWord8)
7171import Data.Attoparsec.Internal.Types
72+import Data.Monoid (Monoid(..))
7273import Data.Word (Word8)
7374import Foreign.ForeignPtr (withForeignPtr)
7475import Foreign.Ptr (castPtr, minusPtr, plusPtr)
@@ -98,7 +99,7 @@ prompt :: Input -> Added -> More
9899prompt i0 a0 _m0 kf ks = Partial $ \s ->
99100 if B.null s
100101 then kf i0 a0 Complete
101− else ks (I (unI i0 +++ s)) (A (unA a0 +++ s)) Incomplete
102+ else ks (i0 `mappend` I s) (a0 `mappend` Added s) Incomplete
102103
103104-- | Immediately demand more input via a 'Partial' continuation
104105-- result.
@@ -140,6 +141,19 @@ try p = Parser $ \i0 a0 m0 kf ks ->
140141 noAdds i0 a0 m0 $ \i1 a1 m1 ->
141142 let kf' i2 a2 m2 = addS i0 a0 m0 i2 a2 m2 kf
142143 in runParser p i1 a1 m1 kf' ks
144+ where noAdds i0 _a0 m0 f = f i0 mempty m0
145+
146+addS :: Input -> Added -> More
147+ -> Input -> Added -> More
148+ -> (Input -> Added -> More -> r) -> r
149+addS i0 a0 m0 _i1 a1 m1 f =
150+ let !i = case a1 of
151+ Dropped -> i0
152+ Added s -> i0 `mappend` I s
153+ !a = a0 `mappend` a1
154+ !m = m0 `mappend` m1
155+ in f i a m
156+{-# INLINE addS #-}
143157
144158-- | The parser @satisfy p@ succeeds for any byte for which the
145159-- predicate @p@ returns 'True'. Returns the byte that is actually
@@ -441,12 +455,12 @@ successK i0 _a0 _m0 a = Done (unI i0) a
441455
442456-- | Run a parser.
443457parse :: Parser a -> B.ByteString -> Result a
444−parse m s = runParser m (I s) (A B.empty) Incomplete failK successK
458+parse m s = runParser m (I s) mempty Incomplete failK successK
445459{-# INLINE parse #-}
446460
447461-- | Run a parser that cannot be resupplied via a 'Partial' result.
448462parseOnly :: Parser a -> B.ByteString -> Either String a
449−parseOnly m s = case runParser m (I s) (A B.empty) Complete failK successK of
463+parseOnly m s = case runParser m (I s) mempty Complete failK successK of
450464 Fail _ _ err -> Left err
451465 Done _ a -> Right a
452466 _ -> error "parseOnly: impossible error!"
Data/Attoparsec/Internal/Types.hs+22−24
@@ -20,8 +20,6 @@ module Data.Attoparsec.Internal.Types
2020 , Input(..)
2121 , Added(..)
2222 , More(..)
23− , addS
24− , noAdds
2523 , (+++)
2624 ) where
2725
@@ -70,7 +68,21 @@ instance Functor Result where
7068 {-# INLINE fmap #-}
7169
7270newtype Input = I {unI :: B.ByteString}
73−newtype Added = A {unA :: B.ByteString}
71+ deriving (Show)
72+
73+instance Monoid Input where
74+ mempty = I B.empty
75+ mappend (I a) (I b) = I (a +++ b)
76+
77+data Added = Dropped
78+ | Added B.ByteString
79+ deriving (Show)
80+
81+instance Monoid Added where
82+ mempty = Dropped
83+ mappend a@Dropped _ = a
84+ mappend a Dropped = a
85+ mappend (Added a) (Added b) = Added (a +++ b)
7486
7587-- | The 'Parser' type is a monad.
7688newtype Parser a = Parser {
@@ -87,19 +99,11 @@ type Success a r = Input -> Added -> More -> a -> Result r
8799data More = Complete | Incomplete
88100 deriving (Eq, Show)
89101
90−addS :: Input -> Added -> More
91− -> Input -> Added -> More
92− -> (Input -> Added -> More -> r) -> r
93−addS i0 a0 m0 _i1 a1 m1 f =
94− let !i = I (unI i0 +++ unA a1)
95− a = A (unA a0 +++ unA a1)
96− !m = m0 <> m1
97− in f i a m
98− where
99− Complete <> _ = Complete
100− _ <> Complete = Complete
101− _ <> _ = Incomplete
102−{-# INLINE addS #-}
102+instance Monoid More where
103+ mempty = Incomplete
104+ mappend Complete _ = Complete
105+ mappend _ Complete = Complete
106+ mappend _ _ = Incomplete
103107
104108bindP :: Parser a -> (a -> Parser b) -> Parser b
105109bindP m g =
@@ -116,16 +120,10 @@ instance Monad Parser where
116120 (>>=) = bindP
117121 fail = failDesc
118122
119−noAdds :: Input -> Added -> More
120− -> (Input -> Added -> More -> r) -> r
121−noAdds i0 _a0 m0 f = f i0 (A B.empty) m0
122−{-# INLINE noAdds #-}
123−
124123plus :: Parser a -> Parser a -> Parser a
125124plus a b = Parser $ \i0 a0 m0 kf ks ->
126− let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $
127− \ i2 a2 m2 -> runParser b i2 a2 m2 kf ks
128− in noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks
125+ let kf' i1 a1 m1 _ _ = runParser b i1 a1 m1 kf ks
126+ in runParser a i0 a0 m0 kf' ks
129127{-# INLINE plus #-}
130128
131129instance MonadPlus Parser where
attoparsec.cabal+1−1
@@ -1,5 +1,5 @@
11name: attoparsec
2−version: 0.8.6.1
2+version: 0.9.0.0
33license: BSD3
44license-file: LICENSE
55category: Text, Parsing