git.iko.soy/typeable/attoparsec
on master help sign in
Back out 7de1dedc8889, the dread backtrack-ectomy
commitcfd1890a435a83c3eddeb6646068bec466e57f46 authorBryan O'Sullivan <bos@serpentine.com> dateFri 3 Jun 2011, 13:56 (15 years ago) parentd8469fb
2 files changed+27−39
compare with master
unifiedsplit
Data/Attoparsec/Internal.hs+3−17 Data/Attoparsec/Internal/Types.hs+24−22
Data/Attoparsec/Internal.hs+3−17
@@ -69,7 +69,6 @@ import Control.Monad (when)
6969import Data.Attoparsec.Combinator
7070import Data.Attoparsec.FastSet (charClass, memberWord8)
7171import Data.Attoparsec.Internal.Types
72−import Data.Monoid (Monoid(..))
7372import Data.Word (Word8)
7473import Foreign.ForeignPtr (withForeignPtr)
7574import Foreign.Ptr (castPtr, minusPtr, plusPtr)
@@ -99,7 +98,7 @@ prompt :: Input -> Added -> More
9998prompt i0 a0 _m0 kf ks = Partial $ \s ->
10099 if B.null s
101100 then kf i0 a0 Complete
102− else ks (i0 `mappend` I s) (a0 `mappend` Added s) Incomplete
101+ else ks (I (unI i0 +++ s)) (A (unA a0 +++ s)) Incomplete
103102
104103-- | Immediately demand more input via a 'Partial' continuation
105104-- result.
@@ -141,19 +140,6 @@ try p = Parser $ \i0 a0 m0 kf ks ->
141140 noAdds i0 a0 m0 $ \i1 a1 m1 ->
142141 let kf' i2 a2 m2 = addS i0 a0 m0 i2 a2 m2 kf
143142 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 #-}
157143
158144-- | The parser @satisfy p@ succeeds for any byte for which the
159145-- predicate @p@ returns 'True'. Returns the byte that is actually
@@ -455,12 +441,12 @@ successK i0 _a0 _m0 a = Done (unI i0) a
455441
456442-- | Run a parser.
457443parse :: Parser a -> B.ByteString -> Result a
458−parse m s = runParser m (I s) mempty Incomplete failK successK
444+parse m s = runParser m (I s) (A B.empty) Incomplete failK successK
459445{-# INLINE parse #-}
460446
461447-- | Run a parser that cannot be resupplied via a 'Partial' result.
462448parseOnly :: Parser a -> B.ByteString -> Either String a
463−parseOnly m s = case runParser m (I s) mempty Complete failK successK of
449+parseOnly m s = case runParser m (I s) (A B.empty) Complete failK successK of
464450 Fail _ _ err -> Left err
465451 Done _ a -> Right a
466452 _ -> error "parseOnly: impossible error!"
Data/Attoparsec/Internal/Types.hs+24−22
@@ -20,6 +20,8 @@ module Data.Attoparsec.Internal.Types
2020 , Input(..)
2121 , Added(..)
2222 , More(..)
23+ , addS
24+ , noAdds
2325 , (+++)
2426 ) where
2527
@@ -68,21 +70,7 @@ instance Functor Result where
6870 {-# INLINE fmap #-}
6971
7072newtype Input = I {unI :: 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)
73+newtype Added = A {unA :: B.ByteString}
8674
8775-- | The 'Parser' type is a monad.
8876newtype Parser a = Parser {
@@ -99,11 +87,19 @@ type Success a r = Input -> Added -> More -> a -> Result r
9987data More = Complete | Incomplete
10088 deriving (Eq, Show)
10189
102−instance Monoid More where
103− mempty = Incomplete
104− mappend Complete _ = Complete
105− mappend _ Complete = Complete
106− mappend _ _ = Incomplete
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 #-}
107103
108104bindP :: Parser a -> (a -> Parser b) -> Parser b
109105bindP m g =
@@ -120,10 +116,16 @@ instance Monad Parser where
120116 (>>=) = bindP
121117 fail = failDesc
122118
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+
123124plus :: Parser a -> Parser a -> Parser a
124125plus a b = Parser $ \i0 a0 m0 kf ks ->
125− let kf' i1 a1 m1 _ _ = runParser b i1 a1 m1 kf ks
126− in runParser a 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
127129{-# INLINE plus #-}
128130
129131instance MonadPlus Parser where