@@ -649,6 +649,81 @@ parseBreakD
649 return (b, str)
649 return (b, str)
650 PR.Error err -> throwM $ ParseError err
650 PR.Error err -> throwM $ ParseError err
652+{-# INLINE_NORMAL parseBreakK #-}
654+ forall m a b. (MonadIO m, MonadThrow m, Storable a)
656+ -> K.Stream m (Array.Array a)
657+ -> m (b, K.Stream m (Array.Array a))
658+parseBreakK (PRD.Parser pstep initial extract) stream = do
661+ PRD.IPartial s -> go s stream []
662+ PRD.IDone b -> return (b, stream)
663+ PRD.IError err -> throwM $ ParseError err
667+ -- "backBuf" contains last few items in the stream that we may have to
670+ -- XXX currently we are using a dumb list based approach for backtracking
671+ -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
672+ -- That will allow us more efficient random back and forth movement.
673+ go !pst st backBuf = do
674+ let stop = (, K.nil) <$> extract pst
675+ single a = yieldk a K.nil
676+ yieldk (Array contents start (Ptr end)) r =
677+ let fp = ForeignPtr end (arrayToFptrContents contents)
678+ in goArray pst backBuf r fp start
679+ in K.foldStream defState yieldk single stop st
681+ -- Use strictness on "cur" to keep it unboxed
682+ goArray !pst backBuf st fp@(ForeignPtr end _) !cur
683+ | cur == Ptr end = do
684+ liftIO $ touchForeignPtr fp
686+ goArray !pst backBuf st fp@(ForeignPtr end contents) !cur = do
687+ x <- liftIO $ peek cur
689+ let next = PTR_NEXT(cur,a)
692+ goArray s [] st fp next
693+ PR.Partial n s -> do
694+ assert (n <= Prelude.length (x:backBuf)) (return ())
695+ let src0 = Prelude.take n (x:backBuf)
696+ arr0 = A.fromListN n (Prelude.reverse src0)
697+ arr1 = Array (fptrToArrayContents contents) next (Ptr end)
699+ let !(Array cont1 start (Ptr end1)) = src
700+ fp1 = ForeignPtr end1 (arrayToFptrContents cont1)
701+ goArray s [] st fp1 start
703+ goArray s (x:backBuf) st fp next
704+ PR.Continue n s -> do
705+ assert (n <= Prelude.length (x:backBuf)) (return ())
706+ let (src0, buf1) = splitAt n (x:backBuf)
707+ arr0 = A.fromListN n (Prelude.reverse src0)
708+ arr1 = Array (fptrToArrayContents contents) next (Ptr end)
710+ let !(Array cont1 start (Ptr end1)) = src
711+ fp1 = ForeignPtr end1 (arrayToFptrContents cont1)
712+ goArray s buf1 st fp1 start
714+ let arr = Array (fptrToArrayContents contents) next (Ptr end)
715+ return (b, K.cons arr st)
717+ assert (n <= Prelude.length (x:backBuf)) (return ())
718+ let src0 = Prelude.take n (x:backBuf)
719+ -- XXX Use fromListRevN once implemented
720+ -- arr0 = A.fromListRevN n src0
721+ arr0 = A.fromListN n (Prelude.reverse src0)
722+ arr1 = Array (fptrToArrayContents contents) next (Ptr end)
723+ str = K.cons arr0 (K.cons arr1 st)
725+ PR.Error err -> throwM $ ParseError err
652-- | Parse an array stream using the supplied 'Parser'. Returns the parse
727-- | Parse an array stream using the supplied 'Parser'. Returns the parse
653-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.
728-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.
@@ -660,8 +735,12 @@ parseBreak ::
660 => PR.Parser m a b
735 => PR.Parser m a b
661 -> SerialT m (A.Array a)
736 -> SerialT m (A.Array a)
662 -> m (b, SerialT m (A.Array a))
737 -> m (b, SerialT m (A.Array a))
663parseBreak p s =
739parseBreak p s =
664 fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s)
740 fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s)
742+parseBreak p (SerialT s) =
743+ fmap (fmap SerialT) $ parseBreakK (PRD.fromParserK p) s
666-------------------------------------------------------------------------------
745-------------------------------------------------------------------------------
667-- Elimination - Running Array Folds and parsers
746-- Elimination - Running Array Folds and parsers