@@ -18,6 +18,7 @@ module Data.Attoparsec.Internal
1818 -- * Parser types
1919 Parser
2020 , Result(..)
21+ , S(input)
2122
2223 -- * Running parsers
2324 , parse
@@ -75,25 +76,20 @@ import qualified Data.ByteString.Char8 as B
7576import qualified Data.ByteString.Internal as B
7677import qualified Data.ByteString.Unsafe as B
7778
78−data Result r = Fail Input Added More [String] String
79+data Result r = Fail S [String] String
7980 | Partial (B.ByteString -> Result r)
80− | Done Input Added More r
81−
82−type Input = B.ByteString
83−type Added = B.ByteString
84−
85−type S a = Input -> Added -> More -> a
81+ | Done S r
8682
8783-- | The Parser monad is an Exception and State monad.
8884newtype Parser a = Parser {
8985 runParser :: forall r. S
90− (Failure r
91− -> Success a r
92− -> Result r)
86+ -> Failure r
87+ -> Success a r
88+ -> Result r
9389 }
9490
95−type Failure r = S ([String] -> String -> Result r)
96−type Success a r = S (a -> Result r)
91+type Failure r = S -> [String] -> String -> Result r
92+type Success a r = S -> a -> Result r
9793
9894data More = Complete | Incomplete
9995 deriving (Eq, Show)
@@ -108,18 +104,32 @@ instance Monoid More where
108104 mempty = Incomplete
109105 mappend = plusMore
110106
107+data S = S {
108+ input :: !B.ByteString
109+ , _added :: !B.ByteString
110+ , more :: !More
111+ } deriving (Show)
112+
111113instance Show r => Show (Result r) where
112− show (Fail _ _ _ stack msg) = "Fail " ++ show stack ++ " " ++ show msg
114+ show (Fail _ stack msg) = "Fail " ++ show stack ++ " " ++ show msg
113115 show (Partial _) = "Partial _"
114− show (Done bs _ _ r) = "Done " ++ show bs ++ " " ++ show r
116+ show (Done bs r) = "Done " ++ show bs ++ " " ++ show r
117+
118+addS :: S -> S -> S
119+addS (S s0 a0 c0) (S _s1 a1 c1) = S (s0 +++ a1) (a0 +++ a1) (mappend c0 c1)
120+{-# INLINE addS #-}
121+
122+instance Monoid S where
123+ mempty = S B.empty B.empty Incomplete
124+ mappend = addS
115125
116126bindP :: Parser a -> (a -> Parser b) -> Parser b
117127bindP m g =
118− Parser (\s0 a0 c0 kf ks -> runParser m s0 a0 c0 kf (\s1 a1 c1 a -> runParser (g a) s1 a1 c1 kf ks))
128+ Parser (\st0 kf ks -> runParser m st0 kf (\s a -> runParser (g a) s kf ks))
119129{-# INLINE bindP #-}
120130
121131returnP :: a -> Parser a
122−returnP a = Parser (\s0 a0 c0 _kf ks -> ks s0 a0 c0 a)
132+returnP a = Parser (\st0 _kf ks -> ks st0 a)
123133{-# INLINE returnP #-}
124134
125135instance Monad Parser where
@@ -127,10 +137,14 @@ instance Monad Parser where
127137 (>>=) = bindP
128138 fail = failDesc
129139
140+noAdds :: S -> S
141+noAdds (S s0 _a0 c0) = S s0 B.empty c0
142+{-# INLINE noAdds #-}
143+
130144plus :: Parser a -> Parser a -> Parser a
131−plus a b = Parser $ \s0 a0 c0 kf ks ->
132− let kf' s1 a1 c1 _ _ = runParser b (s0 +++ a1) (a0 +++ a1) (mappend c0 c1) kf ks
133− in runParser a s0 B.empty c0 kf' ks
145+plus a b = Parser $ \st0 kf ks ->
146+ let kf' st1 _ _ = runParser b (mappend st0 st1) kf ks
147+ in runParser a (noAdds st0) kf' ks
134148{-# INLINE plus #-}
135149
136150instance MonadPlus Parser where
@@ -138,7 +152,7 @@ instance MonadPlus Parser where
138152 mplus = plus
139153
140154fmapP :: (a -> b) -> Parser a -> Parser b
141−fmapP p m = Parser (\s0 a0 c0 f k -> runParser m s0 a0 c0 f (\s1 a1 c1 a -> k s1 a1 c1 (p a)))
155+fmapP p m = Parser (\st0 f k -> runParser m st0 f (\s a -> k s (p a)))
142156{-# INLINE fmapP #-}
143157
144158instance Functor Parser where
@@ -160,30 +174,31 @@ instance Alternative Parser where
160174 (<|>) = mplus
161175
162176failDesc :: String -> Parser a
163−failDesc err = Parser (\s0 a0 c0 kf _ks -> kf s0 a0 c0 [] msg)
177+failDesc err = Parser (\st0 kf _ks -> kf st0 [] msg)
164178 where msg = "Failed reading: " ++ err
165179{-# INLINE failDesc #-}
166180
167181ensure :: Int -> Parser ()
168−ensure n = Parser $ \s0 a0 c0 kf ks ->
182+ensure n = Parser $ \st0@(S s0 _a0 _c0) kf ks ->
169183 if B.length s0 >= n
170− then ks s0 a0 c0 ()
171− else runParser (requireInput >> ensure n) s0 a0 c0 kf ks
184+ then ks st0 ()
185+ else runParser (requireInput >> ensure n) st0 kf ks
172186
173187requireInput :: Parser ()
174−requireInput = Parser $ \s0 a0 c0 kf ks ->
188+requireInput = Parser $ \st0@(S s0 a0 c0) kf ks ->
175189 if c0 == Complete
176− then kf s0 a0 c0 ["requireInput"] "not enough bytes"
190+ then kf st0 ["requireInput"] "not enough bytes"
177191 else Partial $ \s ->
178192 if B.null s
179− then kf s0 a0 Complete ["requireInput"] "not enough bytes"
180− else ks (s0 +++ s) (a0 +++ s) Incomplete ()
193+ then kf (S s0 a0 Complete) ["requireInput"] "not enough bytes"
194+ else let st1 = S (s0 +++ s) (a0 +++ s) Incomplete
195+ in ks st1 ()
181196
182197get :: Parser B.ByteString
183−get = Parser $ \s0 a0 c0 _kf ks -> ks s0 a0 c0 s0
198+get = Parser (\st0 _kf ks -> ks st0 (input st0))
184199
185200put :: B.ByteString -> Parser ()
186−put s = Parser $ \_s0 a0 c0 _kf ks -> ks s a0 c0 ()
201+put s = Parser (\(S _s0 a0 c0) _kf ks -> ks (S s a0 c0) ())
187202
188203take :: Int -> Parser B.ByteString
189204take n = takeWith n (const True)
@@ -193,9 +208,8 @@ take n = takeWith n (const True)
193208{-# INLINE (+++) #-}
194209
195210try :: Parser a -> Parser a
196−try p = Parser $ \s0 a0 c0 kf ks ->
197− let kf' s1 a1 c1 = kf (s0 +++ a1) (a0 +++ a1) (mappend c0 c1)
198− in runParser p s0 B.empty c0 kf' ks
211+try p = Parser $ \st0 kf ks ->
212+ runParser p (noAdds st0) (kf . mappend st0) ks
199213
200214satisfy :: (Word8 -> Bool) -> Parser Word8
201215satisfy p = do
@@ -314,14 +328,14 @@ notWord8 c = satisfy (/= c) <?> "not " ++ show c
314328{-# INLINE notWord8 #-}
315329
316330endOfInput :: Parser ()
317−endOfInput = Parser $ \s0 a0 c0 kf ks ->
318− if B.null s0
319− then if c0 == Complete
320− then ks s0 a0 c0 ()
321− else let kf' s1 a1 c1 _ _ = ks (s0 +++ a1) (a0 +++ a1) (mappend c0 c1) ()
322− ks' s1 a1 c1 _ = kf (s0 +++ a1) (a0 +++ a1) (mappend c0 c1) [] "endOfInput"
323− in runParser requireInput s0 a0 c0 kf' ks'
324− else kf s0 a0 c0 [] "endOfInput"
331+endOfInput = Parser $ \st0@S{..} kf ks ->
332+ if B.null input
333+ then if more == Complete
334+ then ks st0 ()
335+ else let kf' st1 _ _ = ks (mappend st0 st1) ()
336+ ks' st1 _ = kf (mappend st0 st1) [] "endOfInput"
337+ in runParser requireInput st0 kf' ks'
338+ else kf st0 [] "endOfInput"
325339
326340endOfLine :: Parser ()
327341endOfLine = (word8 10 >> return ()) <|> (string (B.pack "\r\n") >> return ())
@@ -341,13 +355,13 @@ successK :: Success a a
341355successK state a = Done state a
342356
343357parse :: Parser a -> B.ByteString -> Result a
344−parse m s = runParser m s B.empty Incomplete failK successK
358+parse m s = runParser m (S s B.empty Incomplete) failK successK
345359{-# INLINE parse #-}
346360
347361feed :: Result r -> B.ByteString -> Result r
348−feed f@(Fail _ _ _ _ _) _ = f
362+feed f@(Fail _ _ _) _ = f
349363feed (Partial k) d = k d
350−feed (Done s a c r) d = Done (s +++ d) a c r
364+feed (Done (S s a c) r) d = Done (S (s +++ d) a c) r
351365
352366parseAll :: Parser a -> [B.ByteString] -> Result a
353367parseAll p ss = case ss of