@@ -649,6 +649,81 @@ parseBreakD
649649 return (b, str)
650650 PR.Error err -> throwM $ ParseError err
651651
652+{-# INLINE_NORMAL parseBreakK #-}
653+parseBreakK ::
654+ forall m a b. (MonadIO m, MonadThrow m, Storable a)
655+ => PRD.Parser m a b
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
659+ res <- initial
660+ case res of
661+ PRD.IPartial s -> go s stream []
662+ PRD.IDone b -> return (b, stream)
663+ PRD.IError err -> throwM $ ParseError err
664+
665+ where
666+
667+ -- "backBuf" contains last few items in the stream that we may have to
668+ -- backtrack to.
669+ --
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
680+
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
685+ go pst st backBuf
686+ goArray !pst backBuf st fp@(ForeignPtr end contents) !cur = do
687+ x <- liftIO $ peek cur
688+ pRes <- pstep pst x
689+ let next = PTR_NEXT(cur,a)
690+ case pRes of
691+ PR.Partial 0 s ->
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)
698+ src = arr0 <> arr1
699+ let !(Array cont1 start (Ptr end1)) = src
700+ fp1 = ForeignPtr end1 (arrayToFptrContents cont1)
701+ goArray s [] st fp1 start
702+ PR.Continue 0 s ->
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)
709+ src = arr0 <> arr1
710+ let !(Array cont1 start (Ptr end1)) = src
711+ fp1 = ForeignPtr end1 (arrayToFptrContents cont1)
712+ goArray s buf1 st fp1 start
713+ PR.Done 0 b -> do
714+ let arr = Array (fptrToArrayContents contents) next (Ptr end)
715+ return (b, K.cons arr st)
716+ PR.Done n b -> do
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)
724+ return (b, str)
725+ PR.Error err -> throwM $ ParseError err
726+
652727-- | Parse an array stream using the supplied 'Parser'. Returns the parse
653728-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.
654729--
@@ -660,8 +735,12 @@ parseBreak ::
660735 => PR.Parser m a b
661736 -> SerialT m (A.Array a)
662737 -> m (b, SerialT m (A.Array a))
738+{-
663739parseBreak p s =
664740 fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s)
741+-}
742+parseBreak p (SerialT s) =
743+ fmap (fmap SerialT) $ parseBreakK (PRD.fromParserK p) s
665744
666745-------------------------------------------------------------------------------
667746-- Elimination - Running Array Folds and parsers