on master help sign in
Fix fusion issue in multi-stream folds

Fix fusion issue in isSubsequenceOf, isPrefixOf, stripPrefix, the

commitbc49c3d73107a06123ab0a3659747033210c9c58 authorHarendra Kumar <harendra@composewell.com> dateSat 16 Jul 2022, 15:50 (4 years ago) parentefa1957
1 file changed+41−34
core/src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs+41−34
core/src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs+41−34
@@ -83,6 +83,7 @@ import GHC.Types (SPEC(..))
8383import Streamly.Internal.Data.Parser (ParseError(..))
8484import Streamly.Internal.Data.SVar.Type (defState)
8585
86+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
8687import qualified Streamly.Internal.Data.Parser as PR
8788import qualified Streamly.Internal.Data.Parser.ParserD as PRD
8889import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Nesting
@@ -415,20 +416,20 @@ toListRev = foldl' (flip (:)) []
415416
416417{-# INLINE_NORMAL the #-}
417418the :: (Eq a, Monad m) => Stream m a -> m (Maybe a)
418−the (Stream step state) = go state
419+the (Stream step state) = go SPEC state
419420 where
420− go st = do
421+ go !_ st = do
421422 r <- step defState st
422423 case r of
423− Yield x s -> go' x s
424− Skip s -> go s
424+ Yield x s -> go' SPEC x s
425+ Skip s -> go SPEC s
425426 Stop -> return Nothing
426− go' n st = do
427+ go' !_ n st = do
427428 r <- step defState st
428429 case r of
429− Yield x s | x == n -> go' n s
430+ Yield x s | x == n -> go' SPEC n s
430431 | otherwise -> return Nothing
431− Skip s -> go' n s
432+ Skip s -> go' SPEC n s
432433 Stop -> return (Just n)
433434
434435------------------------------------------------------------------------------
@@ -446,65 +447,71 @@ mapM_ m = drain . mapM m
446447
447448{-# INLINE_NORMAL isPrefixOf #-}
448449isPrefixOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool
449−isPrefixOf (Stream stepa ta) (Stream stepb tb) = go (ta, tb, Nothing)
450− where
451− go (sa, sb, Nothing) = do
450+isPrefixOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb
451+
452+ where
453+
454+ go !_ Nothing' sa sb = do
452455 r <- stepa defState sa
453456 case r of
454− Yield x sa' -> go (sa', sb, Just x)
455− Skip sa' -> go (sa', sb, Nothing)
457+ Yield x sa' -> go SPEC (Just' x) sa' sb
458+ Skip sa' -> go SPEC Nothing' sa' sb
456459 Stop -> return True
457460
458− go (sa, sb, Just x) = do
461+ go !_ (Just' x) sa sb = do
459462 r <- stepb defState sb
460463 case r of
461464 Yield y sb' ->
462465 if x == y
463− then go (sa, sb', Nothing)
466+ then go SPEC Nothing' sa sb'
464467 else return False
465− Skip sb' -> go (sa, sb', Just x)
468+ Skip sb' -> go SPEC (Just' x) sa sb'
466469 Stop -> return False
467470
468471{-# INLINE_NORMAL isSubsequenceOf #-}
469472isSubsequenceOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool
470−isSubsequenceOf (Stream stepa ta) (Stream stepb tb) = go (ta, tb, Nothing)
471− where
472− go (sa, sb, Nothing) = do
473+isSubsequenceOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb
474+
475+ where
476+
477+ go !_ Nothing' sa sb = do
473478 r <- stepa defState sa
474479 case r of
475− Yield x sa' -> go (sa', sb, Just x)
476− Skip sa' -> go (sa', sb, Nothing)
477− Stop -> return True
480+ Yield x sa' -> go SPEC (Just' x) sa' sb
481+ Skip sa' -> go SPEC Nothing' sa' sb
482+ Stop -> return True
478483
479− go (sa, sb, Just x) = do
484+ go !_ (Just' x) sa sb = do
480485 r <- stepb defState sb
481486 case r of
482487 Yield y sb' ->
483488 if x == y
484− then go (sa, sb', Nothing)
485− else go (sa, sb', Just x)
486− Skip sb' -> go (sa, sb', Just x)
487− Stop -> return False
489+ then go SPEC Nothing' sa sb'
490+ else go SPEC (Just' x) sa sb'
491+ Skip sb' -> go SPEC (Just' x) sa sb'
492+ Stop -> return False
488493
489494{-# INLINE_NORMAL stripPrefix #-}
490495stripPrefix
491496 :: (Eq a, Monad m)
492497 => Stream m a -> Stream m a -> m (Maybe (Stream m a))
493−stripPrefix (Stream stepa ta) (Stream stepb tb) = go (ta, tb, Nothing)
494− where
495− go (sa, sb, Nothing) = do
498+stripPrefix (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb
499+
500+ where
501+
502+ go !_ Nothing' sa sb = do
496503 r <- stepa defState sa
497504 case r of
498− Yield x sa' -> go (sa', sb, Just x)
499− Skip sa' -> go (sa', sb, Nothing)
505+ Yield x sa' -> go SPEC (Just' x) sa' sb
506+ Skip sa' -> go SPEC Nothing' sa' sb
500507 Stop -> return $ Just (Stream stepb sb)
501508
502− go (sa, sb, Just x) = do
509+ go !_ (Just' x) sa sb = do
503510 r <- stepb defState sb
504511 case r of
505512 Yield y sb' ->
506513 if x == y
507− then go (sa, sb', Nothing)
514+ then go SPEC Nothing' sa sb'
508515 else return Nothing
509− Skip sb' -> go (sa, sb', Just x)
516+ Skip sb' -> go SPEC (Just' x) sa sb'
510517 Stop -> return Nothing