4995dc1 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add singular generic version of continuation parsing

4995dc1Adithya Kumar3 years ago

core/src/Streamly/Internal/Data/Parser/ParserK/Type.hs+97

compare with master

unifiedsplit

@@ -28,6 +28,7 @@ module Streamly.Internal.Data.Parser.ParserK.Type

28 , ParseResult (..)

29 , ParserK (..)

30 , fromParser

31+ , fromParserSingular

31 -- , toParser

32 -- , toParser

32 , fromPure

33 , fromPure

33 , fromEffect

34 , fromEffect

@@ -503,6 +504,102 @@ fromParser :: (Monad m, Unbox a) => ParserD.Parser a m b -> ParserK (Array a) m

503fromParser (ParserD.Parser step initial extract) =

504fromParser (ParserD.Parser step initial extract) =

504 MkParser $ parseDToK step initial extract

505 MkParser $ parseDToK step initial extract

505

506

507+{-# INLINE parseDToKSingular #-}

508+parseDToKSingular

509+ :: forall m a s b r. (Monad m)

510+ => (s -> a -> m (ParserD.Step s b))

511+ -> m (ParserD.Initial s b)

512+ -> (s -> m (ParserD.Step s b))

513+ -> (ParseResult b -> Int -> Input a -> m (Step a m r))

514+ -> Int

515+ -> Int

516+ -> Input a

517+ -> m (Step a m r)

518+parseDToKSingular pstep initial extract cont !relPos !usedCount !input = do

519+ res <- initial

520+ case res of

521+ ParserD.IPartial pst -> do

522+ -- XXX can we come here with relPos 1?

523+ if relPos == 0

524+ then

525+ case input of

526+ Chunk arr -> parseContChunk usedCount pst arr

527+ None -> parseContNothing usedCount pst

528+ -- XXX Previous code was using Continue in this case

529+ else pure $ Partial relPos (parseCont usedCount pst)

530+ ParserD.IDone b -> cont (Success relPos b) usedCount input

531+ ParserD.IError err -> cont (Failure relPos err) usedCount input

532+

533+ where

534+

535+ -- XXX We can maintain an absolute position instead of relative that will

536+ -- help in reporting of error location in the stream.

537+ {-# NOINLINE parseContChunk #-}

538+ parseContChunk !count !state x = do

539+ go SPEC state

540+

541+ where

542+

543+ go !_ !pst = do

544+ pRes <- pstep pst x

545+ case pRes of

546+ ParserD.Done 0 b ->

547+ cont (Success 1 b) (count + 1) (Chunk x)

548+ ParserD.Done 1 b ->

549+ cont (Success 0 b) count (Chunk x)

550+ ParserD.Done n b ->

551+ cont (Success (1 - n) b) (count + 1 - n) (Chunk x)

552+ ParserD.Partial 0 pst1 ->

553+ pure $ Partial 1 (parseCont (count + 1) pst1)

554+ ParserD.Partial 1 pst1 ->

555+ -- XXX Since we got Partial, the driver should drop the

556+ -- buffer, we should call the driver here?

557+ go SPEC pst1

558+ ParserD.Partial n pst1 ->

559+ pure $ Partial (1 - n) (parseCont (count + 1 - n) pst1)

560+ ParserD.Continue 0 pst1 ->

561+ pure $ Continue 1 (parseCont (count + 1) pst1)

562+ ParserD.Continue 1 pst1 ->

563+ go SPEC pst1

564+ ParserD.Continue n pst1 ->

565+ pure $ Continue (1 - n) (parseCont (count + 1 - n) pst1)

566+ ParserD.Error err ->

567+ -- XXX fix undefined

568+ cont (Failure 0 err) count (Chunk x)

569+

570+ {-# NOINLINE parseContNothing #-}

571+ parseContNothing !count !pst = do

572+ r <- extract pst

573+ case r of

574+ -- IMPORTANT: the n here is from the byte stream parser, that means

575+ -- it is the backtrack element count and not the stream position

576+ -- index into the current input array.

577+ ParserD.Done n b ->

578+ assert (n >= 0)

579+ (cont (Success (- n) b) (count - n) None)

580+ ParserD.Continue n pst1 ->

581+ assert (n >= 0)

582+ (return $ Continue (- n) (parseCont (count - n) pst1))

583+ ParserD.Error err ->

584+ -- XXX It is called only when there is no input arr. So using 0

585+ -- as the position is correct?

586+ cont (Failure 0 err) count None

587+ ParserD.Partial _ _ -> error "Bug: parseDToK Partial unreachable"

588+

589+ -- XXX Maybe we can use two separate continuations instead of using

590+ -- Just/Nothing cases here. That may help in avoiding the parseContJust

591+ -- function call.

592+ {-# INLINE parseCont #-}

593+ parseCont !cnt !pst (Chunk arr) = parseContChunk cnt pst arr

594+ parseCont !cnt !pst None = parseContNothing cnt pst

595+

596+-- | Similar to "fromParser" but for singular elements.

597+--

598+{-# INLINE_LATE fromParserSingular #-}

599+fromParserSingular :: Monad m => ParserD.Parser a m b -> ParserK a m b

600+fromParserSingular (ParserD.Parser step initial extract) =

601+ MkParser $ parseDToKSingular step initial extract

602+

506{-

603{-

507-------------------------------------------------------------------------------

604-------------------------------------------------------------------------------

508-- Convert CPS style 'Parser' to direct style 'D.Parser'

605-- Convert CPS style 'Parser' to direct style 'D.Parser'

core/src/Streamly/Internal/Data/StreamK.hs+131

@@ -47,6 +47,8 @@ module Streamly.Internal.Data.StreamK

47 , parseD

48 , parseBreakChunks

49 , parseChunks

50+ , parseBreakSingular

51+ , parseSingular

51 -- ** Specialized Folds

53 -- ** Specialized Folds

52 , head

54 , head

@@ -1424,6 +1426,135 @@ parseChunks :: (Monad m, Unbox a) =>

1424 ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)

1426 ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)

1425parseChunks f = fmap fst . parseBreakChunks f

1427parseChunks f = fmap fst . parseBreakChunks f

1426

1428

1429+-------------------------------------------------------------------------------

1430+-- Parsing using ParserK.Generic

1431+-------------------------------------------------------------------------------

1432+

1433+{-# INLINE backTrackSingular #-}

1434+backTrackSingular :: Int -> [a] -> StreamK m a -> (StreamK m a, [a])

1435+backTrackSingular = go

1436+

1437+ where

1438+

1439+ go _ [] stream = (stream, [])

1440+ go n xs stream | n <= 0 = (stream, xs)

1441+ go n xs stream =

1442+ let (appendBuf, newBTBuf) = splitAt n xs

1443+ in (append (fromList (Prelude.reverse appendBuf)) stream, newBTBuf)

1444+

1445+

1446+-- | Similar to 'parseBreak' but works on singular elements.

1447+--

1448+{-# INLINE_NORMAL parseBreakSingular #-}

1449+parseBreakSingular

1450+ :: forall m a b. Monad m

1451+ => ParserK.ParserK a m b

1452+ -> StreamK m a

1453+ -> m (Either ParseError b, StreamK m a)

1454+parseBreakSingular parser input = do

1455+ let parserk = ParserK.runParser parser parserDone 0 0

1456+ in go [] parserk input

1457+

1458+ where

1459+

1460+ {-# INLINE goStop #-}

1461+ goStop

1462+ :: [a]

1463+ -> (ParserK.Input a -> m (ParserK.Step a m b))

1464+ -> m (Either ParseError b, StreamK m a)

1465+ goStop backBuf parserk = do

1466+ pRes <- parserk ParserK.None

1467+ case pRes of

1468+ -- If we stop in an alternative, it will try calling the next

1469+ -- parser, the next parser may call initial returning Partial and

1470+ -- then immediately we have to call extract on it.

1471+ ParserK.Partial 0 cont1 ->

1472+ go [] cont1 nil

1473+ ParserK.Partial n cont1 -> do

1474+ let n1 = negate n

1475+ assertM(n1 >= 0 && n1 <= length backBuf)

1476+ let (s1, backBuf1) = backTrackSingular n1 backBuf nil

1477+ in go backBuf1 cont1 s1

1478+ ParserK.Continue 0 cont1 ->

1479+ go backBuf cont1 nil

1480+ ParserK.Continue n cont1 -> do

1481+ let n1 = negate n

1482+ assertM(n1 >= 0 && n1 <= length backBuf)

1483+ let (s1, backBuf1) = backTrackSingular n1 backBuf nil

1484+ in go backBuf1 cont1 s1

1485+ ParserK.Done 0 b ->

1486+ return (Right b, nil)

1487+ ParserK.Done n b -> do

1488+ let n1 = negate n

1489+ assertM(n1 >= 0 && n1 <= length backBuf)

1490+ let (s1, _) = backTrackSingular n1 backBuf nil

1491+ in return (Right b, s1)

1492+ ParserK.Error _ err -> return (Left (ParseError err), nil)

1493+

1494+ seekErr n =

1495+ error $ "parseBreakSingular: Partial: forward seek not implemented n = "

1496+ ++ show n

1497+

1498+ yieldk

1499+ :: [a]

1500+ -> (ParserK.Input a -> m (ParserK.Step a m b))

1501+ -> a

1502+ -> StreamK m a

1503+ -> m (Either ParseError b, StreamK m a)

1504+ yieldk backBuf parserk arr stream = do

1505+ pRes <- parserk (ParserK.Chunk arr)

1506+ case pRes of

1507+ ParserK.Partial 1 cont1 -> go [] cont1 stream

1508+ ParserK.Partial 0 cont1 -> go [] cont1 (cons arr stream)

1509+ ParserK.Partial n _ | n > 1 -> seekErr n

1510+ ParserK.Partial n cont1 -> do

1511+ let n1 = negate n

1512+ bufLen = length backBuf

1513+ s = cons arr stream

1514+ assertM(n1 >= 0 && n1 <= bufLen)

1515+ let (s1, _) = backTrackSingular n1 backBuf s

1516+ go [] cont1 s1

1517+ ParserK.Continue 1 cont1 -> go (arr:backBuf) cont1 stream

1518+ ParserK.Continue 0 cont1 ->

1519+ go backBuf cont1 (cons arr stream)

1520+ ParserK.Continue n _ | n > 1 -> seekErr n

1521+ ParserK.Continue n cont1 -> do

1522+ let n1 = negate n

1523+ bufLen = length backBuf

1524+ s = cons arr stream

1525+ assertM(n1 >= 0 && n1 <= bufLen)

1526+ let (s1, backBuf1) = backTrackSingular n1 backBuf s

1527+ go backBuf1 cont1 s1

1528+ ParserK.Done 1 b -> pure (Right b, stream)

1529+ ParserK.Done 0 b -> pure (Right b, cons arr stream)

1530+ ParserK.Done n _ | n > 1 -> seekErr n

1531+ ParserK.Done n b -> do

1532+ let n1 = negate n

1533+ bufLen = length backBuf

1534+ s = cons arr stream

1535+ assertM(n1 >= 0 && n1 <= bufLen)

1536+ let (s1, _) = backTrackSingular n1 backBuf s

1537+ pure (Right b, s1)

1538+ ParserK.Error _ err -> return (Left (ParseError err), nil)

1539+

1540+ go

1541+ :: [a]

1542+ -> (ParserK.Input a -> m (ParserK.Step a m b))

1543+ -> StreamK m a

1544+ -> m (Either ParseError b, StreamK m a)

1545+ go backBuf parserk stream = do

1546+ let stop = goStop backBuf parserk

1547+ single a = yieldk backBuf parserk a nil

1548+ in foldStream

1549+ defState (yieldk backBuf parserk) single stop stream

1550+

1551+-- | Run a 'ParserK' over a 'StreamK'. Please use 'parseChunks' where possible,

1552+-- for better performance.

1553+{-# INLINE parseSingular #-}

1554+parseSingular :: Monad m =>

1555+ ParserK.ParserK a m b -> StreamK m a -> m (Either ParseError b)

1556+parseSingular f = fmap fst . parseBreakSingular f

1557+

1427-------------------------------------------------------------------------------

1558-------------------------------------------------------------------------------

1428-- Sorting

1559-- Sorting

1429-------------------------------------------------------------------------------

1560-------------------------------------------------------------------------------