d763144 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Rename some variables and constructors in ParserK

d763144Harendra Kumar4 years ago

core/src/Streamly/Internal/Data/Parser/ParserD/Type.hs+25−25

compare with master

unifiedsplit

@@ -462,15 +462,15 @@ parseDToK

462 -> (s -> m b)

463 -> Int

464 -> (Int, Int)

465− -> ((Int, Int) -> K.Parse b -> m (K.Driver m a r))

465+ -> ((Int, Int) -> K.Parse b -> m (K.Step m a r))

466− -> m (K.Driver m a r)

466+ -> m (K.Step m a r)

467

468parseDToK pstep initial extract leftover (0, _) cont = do

469 res <- initial

470 case res of

471 IPartial r -> return $ K.Continue leftover (parseCont (return r))

472− IDone b -> cont (0,0) (K.Done 0 b)

472+ IDone b -> cont (0,0) (K.Success 0 b)

473− IError err -> cont (0,0) (K.Error err)

473+ IError err -> cont (0,0) (K.Failure err)

474

475 where

476

@@ -478,8 +478,8 @@ parseDToK pstep initial extract leftover (0, _) cont = do

478 r <- pst

479 pRes <- pstep r x

480 case pRes of

481− Done n b -> cont (0,0) (K.Done n b)

481+ Done n b -> cont (0,0) (K.Success n b)

482− Error err -> cont (0,0) (K.Error err)

482+ Error err -> cont (0,0) (K.Failure err)

483 Partial n pst1 -> return $ K.Partial n (parseCont (return pst1))

484 Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))

485

@@ -487,15 +487,15 @@ parseDToK pstep initial extract leftover (0, _) cont = do

487 pst <- acc

488 r <- try $ extract pst

489 case r of

490− Left (e :: ParseError) -> cont (0,0) (K.Error (displayException e))

490+ Left (e :: ParseError) -> cont (0,0) (K.Failure (displayException e))

491− Right b -> cont (0,0) (K.Done 0 b)

491+ Right b -> cont (0,0) (K.Success 0 b)

492

493parseDToK pstep initial extract leftover (level, count) cont = do

494 res <- initial

495 case res of

496 IPartial r -> return $ K.Continue leftover (parseCont count (return r))

497− IDone b -> cont (level,count) (K.Done 0 b)

497+ IDone b -> cont (level,count) (K.Success 0 b)

498− IError err -> cont (level,count) (K.Error err)

498+ IError err -> cont (level,count) (K.Failure err)

499

500 where

501

@@ -506,9 +506,9 @@ parseDToK pstep initial extract leftover (level, count) cont = do

506 case pRes of

507 Done n b -> do

508 assert (n <= cnt1) (return ())

509− cont (level, cnt1 - n) (K.Done n b)

509+ cont (level, cnt1 - n) (K.Success n b)

510 Error err ->

511− cont (level, cnt1) (K.Error err)

511+ cont (level, cnt1) (K.Failure err)

512 Partial n pst1 -> do

513 assert (n <= cnt1) (return ())

514 return $ K.Partial n (parseCont (cnt1 - n) (return pst1))

@@ -520,8 +520,8 @@ parseDToK pstep initial extract leftover (level, count) cont = do

520 r <- try $ extract pst

521 let s = (level, cnt)

522 case r of

523− Left (e :: ParseError) -> cont s (K.Error (displayException e))

523+ Left (e :: ParseError) -> cont s (K.Failure (displayException e))

524− Right b -> cont s (K.Done 0 b)

524+ Right b -> cont s (K.Success 0 b)

525

526-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.

527--

@@ -538,24 +538,24 @@ toParserK (Parser step initial extract) =

538

539-- | A continuation to extract the result when a CPS parser is done.

540{-# INLINE parserDone #-}

541−parserDone :: Monad m => (Int, Int) -> K.Parse b -> m (K.Driver m a b)

541+parserDone :: Monad m => (Int, Int) -> K.Parse b -> m (K.Step m a b)

542−parserDone (0,_) (K.Done n b) = return $ K.Stop n b

542+parserDone (0,_) (K.Success n b) = return $ K.Done n b

543−parserDone st (K.Done _ _) =

543+parserDone st (K.Success _ _) =

544 error $ "Bug: fromParserK: inside alternative: " ++ show st

545−parserDone _ (K.Error e) = return $ K.Failed e

545+parserDone _ (K.Failure e) = return $ K.Error e

546

547-- | When there is no more input to feed, extract the result from the Parser.

548--

549-- /Pre-release/

550--

551−extractParse :: MonadThrow m => (Maybe a -> m (K.Driver m a b)) -> m b

551+extractParse :: MonadThrow m => (Maybe a -> m (K.Step m a b)) -> m b

552extractParse cont = do

553 r <- cont Nothing

554 case r of

555− K.Stop _ b -> return b

555+ K.Done _ b -> return b

556 K.Partial _ _ -> error "Bug: extractParse got Partial"

557 K.Continue _ cont1 -> extractParse cont1

558− K.Failed e -> throwM $ ParseError e

558+ K.Error e -> throwM $ ParseError e

559

560data FromParserK b c = FPKDone !Int !b | FPKCont c

561

@@ -575,8 +575,8 @@ fromParserK parser0 = Parser step initial extract

575 initial = do

576 r <- K.runParser parser0 0 (0,0) parserDone

577 return $ case r of

578− K.Stop n b -> IPartial $ FPKDone n b

578+ K.Done n b -> IPartial $ FPKDone n b

579− K.Failed e -> IError e

579+ K.Error e -> IError e

580 K.Partial _ cont -> IPartial $ FPKCont cont -- XXX can we get this?

581 K.Continue _ cont -> IPartial $ FPKCont cont

582

@@ -589,8 +589,8 @@ fromParserK parser0 = Parser step initial extract

589 step (FPKCont cont) a = do

590 r <- cont (Just a)

591 return $ case r of

592− K.Stop n b -> Done n b

592+ K.Done n b -> Done n b

593− K.Failed e -> Error e

593+ K.Error e -> Error e

594 K.Partial n cont1 -> Partial n (FPKCont cont1)

595 K.Continue n cont1 -> Continue n (FPKCont cont1)

596

core/src/Streamly/Internal/Data/Parser/ParserK/Type.hs+64−55

@@ -21,7 +21,7 @@

22module Streamly.Internal.Data.Parser.ParserK.Type

23 (

24− Driver (..)

24+ Step (..)

25 , Parse (..)

26 , Parser (..)

27 , fromPure

@@ -38,39 +38,50 @@ import Control.Monad.Reader.Class (MonadReader, ask, local)

38import Control.Monad.State.Class (MonadState, get, put)

39import qualified Control.Monad.Fail as Fail

41−

41+-- | The intermediate result of running a parser step. The parser driver may

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.

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.

44--

48--

45-- /Pre-release/

49-- /Pre-release/

46--

50--

47−data Driver m a r =

51+data Step m a r =

48− Stop !Int r

52+ Done !Int r

49 -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.

53 -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.

50 -- measure if that works any better.

54 -- measure if that works any better.

51− | Partial !Int (Maybe a -> m (Driver m a r))

55+ | Partial !Int (Maybe a -> m (Step m a r))

52− | Continue !Int (Maybe a -> m (Driver m a r))

56+ | Continue !Int (Maybe a -> m (Step m a r))

53− | Failed String

57+ | Error String

54−

58+

55−instance Functor m => Functor (Driver m a) where

59+instance Functor m => Functor (Step m a) where

56− fmap f (Stop n r) = Stop n (f r)

60+ fmap f (Done n r) = Done n (f r)

57− fmap f (Partial n yld) = Partial n (fmap (fmap f) . yld)

61+ fmap f (Partial n k) = Partial n (fmap (fmap f) . k)

58− fmap f (Continue n yld) = Continue n (fmap (fmap f) . yld)

62+ fmap f (Continue n k) = Continue n (fmap (fmap f) . k)

59− fmap _ (Failed e) = Failed e

63+ fmap _ (Error e) = Error e

61−-- The parser's result.

65+-- | The parser's result.

62--

66--

63-- /Pre-release/

67-- /Pre-release/

64--

68--

65data Parse b =

69data Parse b =

66− Done !Int !b -- Done, no more input needed

70+ Success !Int !b -- Success, no more input needed

67− | Error !String -- Failed

71+ | Failure !String -- Error

73+-- | Map a function over 'Success'.

69instance Functor Parse where

74instance Functor Parse where

70− fmap f (Done n b) = Done n (f b)

75+ fmap f (Success n b) = Success n (f b)

71− fmap _ (Error e) = Error e

76+ fmap _ (Failure e) = Failure e

72−

77+

73−-- | A continuation passing style parser representation.

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+--

74newtype Parser m a b = MkParser

85newtype Parser m a b = MkParser

75 { runParser :: forall r.

86 { runParser :: forall r.

76 -- The number of elements that were not used by the previous

87 -- The number of elements that were not used by the previous

@@ -88,9 +99,9 @@ newtype Parser m a b = MkParser

88 -> (Int, Int)

99 -> (Int, Int)

89 -- The first argument is the (nest level, used count) tuple as

100 -- The first argument is the (nest level, used count) tuple as

90 -- described above. The leftover element count is carried as part of

101 -- described above. The leftover element count is carried as part of

91− -- 'Done' constructor of 'Parse'.

102+ -- 'Success' constructor of 'Parse'.

92− -> ((Int, Int) -> Parse b -> m (Driver m a r))

103+ -> ((Int, Int) -> Parse b -> m (Step m a r))

93− -> m (Driver m a r)

104+ -> m (Step m a r)

94 }

105 }

106

96-------------------------------------------------------------------------------

107-------------------------------------------------------------------------------

@@ -102,9 +113,9 @@ newtype Parser m a b = MkParser

102--

113--

103instance Functor m => Functor (Parser m a) where

114instance Functor m => Functor (Parser m a) where

104 {-# INLINE fmap #-}

115 {-# INLINE fmap #-}

105− fmap f parser = MkParser $ \lo st yieldk ->

116+ fmap f parser = MkParser $ \n st k ->

106− let yld s res = yieldk s (fmap f res)

117+ let k1 s res = k s (fmap f res)

107− in runParser parser lo st yld

118+ in runParser parser n st k1

108

119

109-------------------------------------------------------------------------------

120-------------------------------------------------------------------------------

110-- Sequential applicative

121-- Sequential applicative

@@ -118,7 +129,7 @@ instance Functor m => Functor (Parser m a) where

118--

129--

119{-# INLINE fromPure #-}

130{-# INLINE fromPure #-}

120fromPure :: b -> Parser m a b

131fromPure :: 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)

122

133

123-- | See 'Streamly.Internal.Data.Parser.fromEffect'.

134-- | See 'Streamly.Internal.Data.Parser.fromEffect'.

124--

135--

@@ -126,7 +137,7 @@ fromPure b = MkParser $ \lo st yieldk -> yieldk st (Done lo b)

126--

137--

127{-# INLINE fromEffect #-}

138{-# INLINE fromEffect #-}

128fromEffect :: Monad m => m b -> Parser m a b

139fromEffect :: 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)

130

141

131-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.serialWith'. Note that

142-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.serialWith'. Note that

132-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.serialWith'

143-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.serialWith'

@@ -140,22 +151,22 @@ instance Monad m => Applicative (Parser m a) where

140 (<*>) = ap

151 (<*>) = ap

141

152

142 {-# INLINE (*>) #-}

153 {-# INLINE (*>) #-}

143− m1 *> m2 = MkParser $ \lo st yieldk ->

154+ p1 *> p2 = MkParser $ \n st k ->

144− let yield1 s (Done n _) = runParser m2 n s yieldk

155+ let k1 s (Success n1 _) = runParser p2 n1 s k

145− yield1 s (Error e) = yieldk s (Error e)

156+ k1 s (Failure e) = k s (Failure e)

146− in runParser m1 lo st yield1

157+ in runParser p1 n st k1

147

158

148 {-# INLINE (<*) #-}

159 {-# INLINE (<*) #-}

149− m1 <* m2 = MkParser $ \lo st yieldk ->

160+ p1 <* p2 = MkParser $ \n st k ->

150− let yield1 s (Done n b) =

161+ let k1 s1 (Success n1 b) =

151− let yield2 s1 (Done n1 _) = yieldk s1 (Done n1 b)

162+ let k2 s2 (Success n2 _) = k s2 (Success n2 b)

152− yield2 s1 (Error e) = yieldk s1 (Error e)

163+ k2 s2 (Failure e) = k s2 (Failure e)

153− in runParser m2 n s yield2

164+ in runParser p2 n1 s1 k2

154− yield1 s (Error e) = yieldk s (Error e)

165+ k1 s1 (Failure e) = k s1 (Failure e)

155− in runParser m1 lo st yield1

166+ in runParser p1 n st k1

156

167

157 {-# INLINE liftA2 #-}

168 {-# INLINE liftA2 #-}

158− liftA2 f x = (<*>) (fmap f x)

169+ liftA2 f p = (<*>) (fmap f p)

159

170

160-------------------------------------------------------------------------------

171-------------------------------------------------------------------------------

161-- Monad

172-- Monad

@@ -170,7 +181,7 @@ instance Monad m => Applicative (Parser m a) where

170--

181--

171{-# INLINE die #-}

182{-# INLINE die #-}

172die :: String -> Parser m a b

183die :: 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))

174

185

175-- | Monad composition can be used for lookbehind parsers, we can make the

186-- | Monad composition can be used for lookbehind parsers, we can make the

176-- future parses depend on the previously parsed values.

187-- future parses depend on the previously parsed values.

@@ -219,10 +230,10 @@ instance Monad m => Monad (Parser m a) where

219 return = pure

230 return = pure

220

231

221 {-# INLINE (>>=) #-}

232 {-# INLINE (>>=) #-}

222− m >>= k = MkParser $ \lo st yieldk ->

233+ p >>= f = MkParser $ \n st k ->

223− let yield1 s (Done n b) = runParser (k b) n s yieldk

234+ let k1 s1 (Success n1 b) = runParser (f b) n1 s1 k

224− yield1 s (Error e) = yieldk s (Error e)

235+ k1 s1 (Failure e) = k s1 (Failure e)

225− in runParser m lo st yield1

236+ in runParser p n st k1

226

237

227 {-# INLINE (>>) #-}

238 {-# INLINE (>>) #-}

228 (>>) = (*>)

239 (>>) = (*>)

@@ -244,9 +255,7 @@ instance (MonadThrow m, MonadReader r m, MonadCatch m) =>

244 ask = fromEffect ask

255 ask = fromEffect ask

245

256

246 {-# INLINE local #-}

257 {-# 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

250

259

251instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where

260instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where

252 {-# INLINE get #-}

261 {-# INLINE get #-}

@@ -281,11 +290,11 @@ instance Monad m => Alternative (Parser m a) where

281 empty = die "empty"

290 empty = die "empty"

282

291

283 {-# INLINE (<|>) #-}

292 {-# INLINE (<|>) #-}

284− m1 <|> m2 = MkParser $ \lo (level, _) yieldk ->

293+ p1 <|> p2 = MkParser $ \n (level, _) k ->

285− let yield1 (0, _) _ = error "0 nest level in Alternative"

294+ let k1 (0, _) _ = error "Bug: 0 nest level in Alternative"

286− yield1 (lvl, _) (Done n b) = yieldk (lvl - 1, 0) (Done n b)

295+ k1 (l1, n1) (Failure _) = runParser p2 n1 (l1 - 1, 0) k

287− yield1 (lvl, cnt) (Error _) = runParser m2 cnt (lvl - 1, 0) yieldk

296+ k1 (l1, _) success = k (l1 - 1, 0) success

288− in runParser m1 lo (level + 1, 0) yield1

297+ in runParser p1 n (level + 1, 0) k1

289

298

290 -- some and many are implemented here instead of using default definitions

299 -- some and many are implemented here instead of using default definitions

291 -- so that we can use INLINE on them. It gives 50% performance improvement.

300 -- so that we can use INLINE on them. It gives 50% performance improvement.