@@ -21,7 +21,7 @@
2121
2222module Streamly.Internal.Data.Parser.ParserK.Type
2323 (
24− Driver (..)
24+ Step (..)
2525 , Parse (..)
2626 , Parser (..)
2727 , fromPure
@@ -38,39 +38,50 @@ import Control.Monad.Reader.Class (MonadReader, ask, local)
3838import Control.Monad.State.Class (MonadState, get, put)
3939import qualified Control.Monad.Fail as Fail
4040
41−
42−-- | The parse driver result. The driver may stop with a final result, pause
43−-- with a continuation to resume, or fail with an error.
41+-- | The intermediate result of running a parser step. The parser driver may
42+-- stop with a final result, pause with a continuation to resume, or fail with
43+-- an error.
44+--
45+-- See ParserD docs. This is the same as the ParserD Step except that it uses a
46+-- continuation in Partial and Continue constructors instead of a state in case
47+-- of ParserD.
4448--
4549-- /Pre-release/
4650--
47−data Driver m a r =
48− Stop !Int r
51+data Step m a r =
52+ Done !Int r
4953 -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.
5054 -- measure if that works any better.
51− | Partial !Int (Maybe a -> m (Driver m a r))
52− | Continue !Int (Maybe a -> m (Driver m a r))
53− | Failed String
54−
55−instance Functor m => Functor (Driver m a) where
56− fmap f (Stop n r) = Stop n (f r)
57− fmap f (Partial n yld) = Partial n (fmap (fmap f) . yld)
58− fmap f (Continue n yld) = Continue n (fmap (fmap f) . yld)
59− fmap _ (Failed e) = Failed e
55+ | Partial !Int (Maybe a -> m (Step m a r))
56+ | Continue !Int (Maybe a -> m (Step m a r))
57+ | Error String
58+
59+instance Functor m => Functor (Step m a) where
60+ fmap f (Done n r) = Done n (f r)
61+ fmap f (Partial n k) = Partial n (fmap (fmap f) . k)
62+ fmap f (Continue n k) = Continue n (fmap (fmap f) . k)
63+ fmap _ (Error e) = Error e
6064
61−-- The parser's result.
65+-- | The parser's result.
6266--
6367-- /Pre-release/
6468--
6569data Parse b =
66− Done !Int !b -- Done, no more input needed
67− | Error !String -- Failed
70+ Success !Int !b -- Success, no more input needed
71+ | Failure !String -- Error
6872
73+-- | Map a function over 'Success'.
6974instance Functor Parse where
70− fmap f (Done n b) = Done n (f b)
71− fmap _ (Error e) = Error e
72−
73−-- | A continuation passing style parser representation.
75+ fmap f (Success n b) = Success n (f b)
76+ fmap _ (Failure e) = Failure e
77+
78+-- | A continuation passing style parser representation. A continuation of
79+-- 'Step's, each step passes a state and a parse result to the next 'Step'. The
80+-- resulting 'Step' may carry a continuation that consumes input 'a' and
81+-- results in another 'Step'. Essentially, the continuation may either consume
82+-- input without a result or return a result with no further input to be
83+-- consumed.
84+--
7485newtype Parser m a b = MkParser
7586 { runParser :: forall r.
7687 -- The number of elements that were not used by the previous
@@ -88,9 +99,9 @@ newtype Parser m a b = MkParser
8899 -> (Int, Int)
89100 -- The first argument is the (nest level, used count) tuple as
90101 -- described above. The leftover element count is carried as part of
91− -- 'Done' constructor of 'Parse'.
92− -> ((Int, Int) -> Parse b -> m (Driver m a r))
93− -> m (Driver m a r)
102+ -- 'Success' constructor of 'Parse'.
103+ -> ((Int, Int) -> Parse b -> m (Step m a r))
104+ -> m (Step m a r)
94105 }
95106
96107-------------------------------------------------------------------------------
@@ -102,9 +113,9 @@ newtype Parser m a b = MkParser
102113--
103114instance Functor m => Functor (Parser m a) where
104115 {-# INLINE fmap #-}
105− fmap f parser = MkParser $ \lo st yieldk ->
106− let yld s res = yieldk s (fmap f res)
107− in runParser parser lo st yld
116+ fmap f parser = MkParser $ \n st k ->
117+ let k1 s res = k s (fmap f res)
118+ in runParser parser n st k1
108119
109120-------------------------------------------------------------------------------
110121-- Sequential applicative
@@ -118,7 +129,7 @@ instance Functor m => Functor (Parser m a) where
118129--
119130{-# INLINE fromPure #-}
120131fromPure :: b -> Parser m a b
121−fromPure b = MkParser $ \lo st yieldk -> yieldk st (Done lo b)
132+fromPure b = MkParser $ \n st k -> k st (Success n b)
122133
123134-- | See 'Streamly.Internal.Data.Parser.fromEffect'.
124135--
@@ -126,7 +137,7 @@ fromPure b = MkParser $ \lo st yieldk -> yieldk st (Done lo b)
126137--
127138{-# INLINE fromEffect #-}
128139fromEffect :: Monad m => m b -> Parser m a b
129−fromEffect eff = MkParser $ \lo st yieldk -> eff >>= \b -> yieldk st (Done lo b)
140+fromEffect eff = MkParser $ \n st k -> eff >>= \b -> k st (Success n b)
130141
131142-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.serialWith'. Note that
132143-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.serialWith'
@@ -140,22 +151,22 @@ instance Monad m => Applicative (Parser m a) where
140151 (<*>) = ap
141152
142153 {-# INLINE (*>) #-}
143− m1 *> m2 = MkParser $ \lo st yieldk ->
144− let yield1 s (Done n _) = runParser m2 n s yieldk
145− yield1 s (Error e) = yieldk s (Error e)
146− in runParser m1 lo st yield1
154+ p1 *> p2 = MkParser $ \n st k ->
155+ let k1 s (Success n1 _) = runParser p2 n1 s k
156+ k1 s (Failure e) = k s (Failure e)
157+ in runParser p1 n st k1
147158
148159 {-# INLINE (<*) #-}
149− m1 <* m2 = MkParser $ \lo st yieldk ->
150− let yield1 s (Done n b) =
151− let yield2 s1 (Done n1 _) = yieldk s1 (Done n1 b)
152− yield2 s1 (Error e) = yieldk s1 (Error e)
153− in runParser m2 n s yield2
154− yield1 s (Error e) = yieldk s (Error e)
155− in runParser m1 lo st yield1
160+ p1 <* p2 = MkParser $ \n st k ->
161+ let k1 s1 (Success n1 b) =
162+ let k2 s2 (Success n2 _) = k s2 (Success n2 b)
163+ k2 s2 (Failure e) = k s2 (Failure e)
164+ in runParser p2 n1 s1 k2
165+ k1 s1 (Failure e) = k s1 (Failure e)
166+ in runParser p1 n st k1
156167
157168 {-# INLINE liftA2 #-}
158− liftA2 f x = (<*>) (fmap f x)
169+ liftA2 f p = (<*>) (fmap f p)
159170
160171-------------------------------------------------------------------------------
161172-- Monad
@@ -170,7 +181,7 @@ instance Monad m => Applicative (Parser m a) where
170181--
171182{-# INLINE die #-}
172183die :: String -> Parser m a b
173−die err = MkParser (\_ st yieldk -> yieldk st (Error err))
184+die err = MkParser (\_ st k -> k st (Failure err))
174185
175186-- | Monad composition can be used for lookbehind parsers, we can make the
176187-- future parses depend on the previously parsed values.
@@ -219,10 +230,10 @@ instance Monad m => Monad (Parser m a) where
219230 return = pure
220231
221232 {-# INLINE (>>=) #-}
222− m >>= k = MkParser $ \lo st yieldk ->
223− let yield1 s (Done n b) = runParser (k b) n s yieldk
224− yield1 s (Error e) = yieldk s (Error e)
225− in runParser m lo st yield1
233+ p >>= f = MkParser $ \n st k ->
234+ let k1 s1 (Success n1 b) = runParser (f b) n1 s1 k
235+ k1 s1 (Failure e) = k s1 (Failure e)
236+ in runParser p n st k1
226237
227238 {-# INLINE (>>) #-}
228239 (>>) = (*>)
@@ -244,9 +255,7 @@ instance (MonadThrow m, MonadReader r m, MonadCatch m) =>
244255 ask = fromEffect ask
245256
246257 {-# INLINE local #-}
247− local f dp =
248− MkParser $ \lo st yieldk ->
249− local f $ runParser dp lo st yieldk
258+ local f p = MkParser $ \n st k -> local f $ runParser p n st k
250259
251260instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where
252261 {-# INLINE get #-}
@@ -281,11 +290,11 @@ instance Monad m => Alternative (Parser m a) where
281290 empty = die "empty"
282291
283292 {-# INLINE (<|>) #-}
284− m1 <|> m2 = MkParser $ \lo (level, _) yieldk ->
285− let yield1 (0, _) _ = error "0 nest level in Alternative"
286− yield1 (lvl, _) (Done n b) = yieldk (lvl - 1, 0) (Done n b)
287− yield1 (lvl, cnt) (Error _) = runParser m2 cnt (lvl - 1, 0) yieldk
288− in runParser m1 lo (level + 1, 0) yield1
293+ p1 <|> p2 = MkParser $ \n (level, _) k ->
294+ let k1 (0, _) _ = error "Bug: 0 nest level in Alternative"
295+ k1 (l1, n1) (Failure _) = runParser p2 n1 (l1 - 1, 0) k
296+ k1 (l1, _) success = k (l1 - 1, 0) success
297+ in runParser p1 n (level + 1, 0) k1
289298
290299 -- some and many are implemented here instead of using default definitions
291300 -- so that we can use INLINE on them. It gives 50% performance improvement.