git.iko.soy/streamly
on 0839d4f help sign in
streamly/src/Streamly/Streams/StreamD.hs
792 lines 24 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE ExistentialQuantification #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE RankNTypes #-}
10#include "inline.hs"
12-- |
13-- Module : Streamly.Streams.StreamD
14-- Copyright : (c) 2018 Harendra Kumar
15--
16-- License : BSD3
17-- Maintainer : harendra.kumar@gmail.com
18-- Stability : experimental
19-- Portability : GHC
20--
21-- Direct style re-implementation of CPS style stream in StreamK module. The
22-- symbol or suffix 'D' in this module denotes the "Direct" style. GHC is able
23-- to INLINE and fuse direct style better, providing better performance than
24-- CPS implementation.
25--
26-- @
27-- import qualified Streamly.Streams.StreamD as D
28-- @
30-- Some of functions in this file have been adapted from the vector
31-- library, https://hackage.haskell.org/package/vector.
33module Streamly.Streams.StreamD
34 (
35 -- * The stream type
36 Step (..)
37 , Stream (..)
39 -- * Construction
40 , nil
41 , cons
43 -- * Deconstruction
44 , uncons
46 -- * Generation
47 -- ** Unfolds
48 , unfoldr
49 , unfoldrM
51 -- ** Specialized Generation
52 -- | Generate a monadic stream from a seed.
53 , repeat
54 , enumFromStepN
56 -- ** Conversions
57 -- | Transform an input structure into a stream.
58 -- | Direct style stream does not support @fromFoldable@.
59 , yield
60 , yieldM
61 , fromList
62 , fromListM
63 , fromStreamK
64 , fromStreamD
66 -- * Elimination
67 -- ** General Folds
68 , foldr
69 , foldrM
70 , foldl'
71 , foldlM'
73 -- ** Specialized Folds
74 , runStream
75 , null
76 , head
77 , tail
78 , last
79 , elem
80 , notElem
81 , all
82 , any
83 , maximum
84 , minimum
86 -- ** Map and Fold
87 , mapM_
89 -- ** Conversions
90 -- | Transform a stream into another type.
91 , toList
92 , toStreamK
93 , toStreamD
95 -- * Transformation
96 -- ** By folding (scans)
97 , scanlM'
98 , scanl'
100 -- * Filtering
101 , filter
102 , filterM
103 , take
104 , takeWhile
105 , takeWhileM
106 , drop
107 , dropWhile
108 , dropWhileM
110 -- * Mapping
111 , map
112 , mapM
114 -- ** Map and Filter
115 , mapMaybe
116 , mapMaybeM
118 -- * Zipping
119 , zipWith
120 , zipWithM
122 -- * Comparisions
123 , eqBy
124 , cmpBy
125 )
126where
128import Data.Maybe (fromJust, isJust)
129import GHC.Types ( SPEC(..) )
130import Prelude
131 hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,
132 takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,
133 notElem, null, head, tail, zipWith)
135import Streamly.SVar (MonadAsync, State(..), defState, rstState)
137import qualified Data.Foldable as F
138import qualified Streamly.Streams.StreamK as K
140------------------------------------------------------------------------------
141-- The direct style stream type
142------------------------------------------------------------------------------
144-- | A stream is a succession of 'Step's. A 'Yield' produces a single value and
145-- the next state of the stream. 'Stop' indicates there are no more values in
146-- the stream.
147data Step s a = Yield a s | Skip s | Stop
149instance Functor (Step s) where
150 {-# INLINE fmap #-}
151 fmap f (Yield x s) = Yield (f x) s
152 fmap _ (Skip s) = Skip s
153 fmap _ Stop = Stop
155-- gst = global state
156-- | A stream consists of a step function that generates the next step given a
157-- current state, and the current state.
158data Stream m a = forall s. Stream (State K.Stream m a -> s -> m (Step s a)) s
160instance (Foldable m, Monad m) => Foldable (Stream m) where
161 {-# INLINE foldMap #-}
162 foldMap f = F.fold . toFoldable . map f
163 where
164 toFoldable :: (Monad m, Monoid a) => Stream m a -> m a
165 toFoldable = foldr mappend mempty
167instance (Traversable m, Monad m) => Traversable (Stream m) where
168 {-# INLINE traverse #-}
169 traverse f = sequenceA . fmap f
171 {-# INLINE sequenceA #-}
172 sequenceA = traverse id
174------------------------------------------------------------------------------
175-- Construction
176------------------------------------------------------------------------------
178-- | An empty 'Stream'.
179{-# INLINE_NORMAL nil #-}
180nil :: Monad m => Stream m a
181nil = Stream (\_ _ -> return Stop) ()
183-- | Can fuse but has O(n^2) complexity.
184{-# INLINE_NORMAL cons #-}
185cons :: Monad m => a -> Stream m a -> Stream m a
186cons x (Stream step state) = Stream step1 Nothing
187 where
188 {-# INLINE_LATE step1 #-}
189 step1 _ Nothing = return $ Yield x (Just state)
190 step1 gst (Just st) = do
191 r <- step (rstState gst) st
192 return $
193 case r of
194 Yield a s -> Yield a (Just s)
195 Skip s -> Skip (Just s)
196 Stop -> Stop
198-------------------------------------------------------------------------------
199-- Deconstruction
200-------------------------------------------------------------------------------
202-- Does not fuse, has the same performance as the StreamK version.
203{-# INLINE_NORMAL uncons #-}
204uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))
205uncons (Stream step state) = go state
206 where
207 go st = do
208 r <- step defState st
209 case r of
210 Yield x s -> return $ Just (x, Stream step s)
211 Skip s -> go s
212 Stop -> return Nothing
214------------------------------------------------------------------------------
215-- Generation by unfold
216------------------------------------------------------------------------------
218{-# INLINE_NORMAL unfoldrM #-}
219unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a
220unfoldrM next state = Stream step state
221 where
222 {-# INLINE_LATE step #-}
223 step _ st = do
224 r <- next st
225 return $ case r of
226 Just (x, s) -> Yield x s
227 Nothing -> Stop
229{-# INLINE_LATE unfoldr #-}
230unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a
231unfoldr f = unfoldrM (return . f)
233------------------------------------------------------------------------------
234-- Specialized Generation
235------------------------------------------------------------------------------
237repeat :: Monad m => a -> Stream m a
238repeat x = Stream (\_ _ -> return $ Yield x ()) ()
240{-# INLINE_NORMAL enumFromStepN #-}
241enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a
242enumFromStepN from stride n =
243 from `seq` stride `seq` n `seq` Stream step (from, n)
244 where
245 {-# INLINE_LATE step #-}
246 step _ (x, i) | i > 0 = return $ Yield x (x + stride, i - 1)
247 | otherwise = return Stop
249-------------------------------------------------------------------------------
250-- Generation by Conversion
251-------------------------------------------------------------------------------
253-- | Create a singleton 'Stream' from a pure value.
254{-# INLINE_NORMAL yield #-}
255yield :: Monad m => a -> Stream m a
256yield x = Stream (\_ s -> return $ step undefined s) True
257 where
258 {-# INLINE_LATE step #-}
259 step _ True = Yield x False
260 step _ False = Stop
262-- | Create a singleton 'Stream' from a monadic action.
263{-# INLINE_NORMAL yieldM #-}
264yieldM :: Monad m => m a -> Stream m a
265yieldM m = Stream step True
266 where
267 {-# INLINE_LATE step #-}
268 step _ True = m >>= \x -> return $ Yield x False
269 step _ False = return Stop
271-- XXX we need the MonadAsync constraint because of a rewrite rule.
272-- | Convert a list of monadic actions to a 'Stream'
273{-# INLINE_LATE fromListM #-}
274fromListM :: MonadAsync m => [m a] -> Stream m a
275fromListM = Stream step
276 where
277 {-# INLINE_LATE step #-}
278 step _ (m:ms) = m >>= \x -> return $ Yield x ms
279 step _ [] = return Stop
281-- | Convert a list of pure values to a 'Stream'
282{-# INLINE_LATE fromList #-}
283fromList :: Monad m => [a] -> Stream m a
284fromList = Stream step
285 where
286 {-# INLINE_LATE step #-}
287 step _ (x:xs) = return $ Yield x xs
288 step _ [] = return Stop
290-- XXX pass the state to streamD
291{-# INLINE_LATE fromStreamK #-}
292fromStreamK :: Monad m => K.Stream m a -> Stream m a
293fromStreamK = Stream step
294 where
295 step gst m1 =
296 let stop = return Stop
297 single a = return $ Yield a K.nil
298 yieldk a r = return $ Yield a r
299 in K.unStream m1 gst stop single yieldk
301{-# INLINE toStreamD #-}
302toStreamD :: (K.IsStream t, Monad m) => t m a -> Stream m a
303toStreamD = fromStreamK . K.toStream
305------------------------------------------------------------------------------
306-- Elimination by Folds
307------------------------------------------------------------------------------
309{-# INLINE_NORMAL foldrM #-}
310foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b
311foldrM f z (Stream step state) = go SPEC state
312 where
313 go !_ st = do
314 r <- step defState st
315 case r of
316 Yield x s -> go SPEC s >>= f x
317 Skip s -> go SPEC s
318 Stop -> return z
320{-# INLINE_NORMAL foldr #-}
321foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b
322foldr f = foldrM (\a b -> return (f a b))
324{-# INLINE_NORMAL foldlM' #-}
325foldlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> m b
326foldlM' fstep begin (Stream step state) = go SPEC begin state
327 where
328 go !_ acc st = acc `seq` do
329 r <- step defState st
330 case r of
331 Yield x s -> do
332 acc' <- fstep acc x
333 go SPEC acc' s
334 Skip s -> go SPEC acc s
335 Stop -> return acc
337{-# INLINE foldl' #-}
338foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b
339foldl' fstep = foldlM' (\b a -> return (fstep b a))
341------------------------------------------------------------------------------
342-- Specialized Folds
343------------------------------------------------------------------------------
345-- | Run a streaming composition, discard the results.
346{-# INLINE_LATE runStream #-}
347runStream :: Monad m => Stream m a -> m ()
348runStream (Stream step state) = go SPEC state
349 where
350 go !_ st = do
351 r <- step defState st
352 case r of
353 Yield _ s -> go SPEC s
354 Skip s -> go SPEC s
355 Stop -> return ()
357{-# INLINE_NORMAL null #-}
358null :: Monad m => Stream m a -> m Bool
359null (Stream step state) = go state
360 where
361 go st = do
362 r <- step defState st
363 case r of
364 Yield _ _ -> return False
365 Skip s -> go s
366 Stop -> return True
368-- XXX SPEC?
369{-# INLINE_NORMAL head #-}
370head :: Monad m => Stream m a -> m (Maybe a)
371head (Stream step state) = go state
372 where
373 go st = do
374 r <- step defState st
375 case r of
376 Yield x _ -> return (Just x)
377 Skip s -> go s
378 Stop -> return Nothing
380-- Does not fuse, has the same performance as the StreamK version.
381{-# INLINE_NORMAL tail #-}
382tail :: Monad m => Stream m a -> m (Maybe (Stream m a))
383tail (Stream step state) = go state
384 where
385 go st = do
386 r <- step defState st
387 case r of
388 Yield _ s -> return (Just $ Stream step s)
389 Skip s -> go s
390 Stop -> return Nothing
392-- XXX will it fuse? need custom impl?
393{-# INLINE_NORMAL last #-}
394last :: Monad m => Stream m a -> m (Maybe a)
395last = foldl' (\_ y -> Just y) Nothing
397{-# INLINE_NORMAL elem #-}
398elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
399elem e (Stream step state) = go state
400 where
401 go st = do
402 r <- step defState st
403 case r of
404 Yield x s
405 | x == e -> return True
406 | otherwise -> go s
407 Skip s -> go s
408 Stop -> return False
410{-# INLINE_NORMAL notElem #-}
411notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
412notElem e s = fmap not (elem e s)
414{-# INLINE_NORMAL all #-}
415all :: Monad m => (a -> Bool) -> Stream m a -> m Bool
416all p (Stream step state) = go state
417 where
418 go st = do
419 r <- step defState st
420 case r of
421 Yield x s
422 | p x -> go s
423 | otherwise -> return False
424 Skip s -> go s
425 Stop -> return True
427{-# INLINE_NORMAL any #-}
428any :: Monad m => (a -> Bool) -> Stream m a -> m Bool
429any p (Stream step state) = go state
430 where
431 go st = do
432 r <- step defState st
433 case r of
434 Yield x s
435 | p x -> return True
436 | otherwise -> go s
437 Skip s -> go s
438 Stop -> return False
440{-# INLINE_NORMAL maximum #-}
441maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)
442maximum (Stream step state) = go Nothing state
443 where
444 go Nothing st = do
445 r <- step defState st
446 case r of
447 Yield x s -> go (Just x) s
448 Skip s -> go Nothing s
449 Stop -> return Nothing
450 go (Just acc) st = do
451 r <- step defState st
452 case r of
453 Yield x s
454 | acc <= x -> go (Just x) s
455 | otherwise -> go (Just acc) s
456 Skip s -> go (Just acc) s
457 Stop -> return (Just acc)
459{-# INLINE_NORMAL minimum #-}
460minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)
461minimum (Stream step state) = go Nothing state
462 where
463 go Nothing st = do
464 r <- step defState st
465 case r of
466 Yield x s -> go (Just x) s
467 Skip s -> go Nothing s
468 Stop -> return Nothing
469 go (Just acc) st = do
470 r <- step defState st
471 case r of
472 Yield x s
473 | acc <= x -> go (Just acc) s
474 | otherwise -> go (Just x) s
475 Skip s -> go (Just acc) s
476 Stop -> return (Just acc)
478------------------------------------------------------------------------------
479-- Map and Fold
480------------------------------------------------------------------------------
482-- | Execute a monadic action for each element of the 'Stream'
483{-# INLINE_NORMAL mapM_ #-}
484mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()
485mapM_ m = runStream . mapM m
487------------------------------------------------------------------------------
488-- Converting folds
489------------------------------------------------------------------------------
491{-# INLINE toList #-}
492toList :: Monad m => Stream m a -> m [a]
493toList = foldr (:) []
495-- Convert a direct stream to and from CPS encoded stream
496{-# INLINE_LATE toStreamK #-}
497toStreamK :: Monad m => Stream m a -> K.Stream m a
498toStreamK (Stream step state) = go state
499 where
500 go st = K.Stream $ \gst stp sng yld -> do
501 r <- step gst st
502 case r of
503 Yield x s -> yld x (go s)
504 Skip s -> K.unStream (go s) gst stp sng yld
505 Stop -> stp
507#ifndef DISABLE_FUSION
508{-# RULES "fromStreamK/toStreamK fusion"
509 forall s. toStreamK (fromStreamK s) = s #-}
510{-# RULES "toStreamK/fromStreamK fusion"
511 forall s. fromStreamK (toStreamK s) = s #-}
512#endif
514{-# INLINE fromStreamD #-}
515fromStreamD :: (K.IsStream t, Monad m) => Stream m a -> t m a
516fromStreamD = K.fromStream . toStreamK
518------------------------------------------------------------------------------
519-- Transformation by Folding (Scans)
520------------------------------------------------------------------------------
522{-# INLINE_NORMAL postscanlM' #-}
523postscanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b
524postscanlM' fstep begin (Stream step state) =
525 begin `seq` Stream step' (state, begin)
526 where
527 {-# INLINE_LATE step' #-}
528 step' gst (st, acc) = acc `seq` do
529 r <- step (rstState gst) st
530 case r of
531 Yield x s -> do
532 y <- fstep acc x
533 y `seq` return (Yield y (s, y))
534 Skip s -> return $ Skip (s, acc)
535 Stop -> return Stop
537{-# INLINE_NORMAL scanlM' #-}
538scanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b
539scanlM' fstep begin s = begin `seq` (begin `cons` postscanlM' fstep begin s)
541{-# INLINE scanl' #-}
542scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b
543scanl' f = scanlM' (\a b -> return (f a b))
545-------------------------------------------------------------------------------
546-- Filtering
547-------------------------------------------------------------------------------
549{-# INLINE_NORMAL take #-}
550take :: Monad m => Int -> Stream m a -> Stream m a
551take n (Stream step state) = n `seq` Stream step' (state, 0)
552 where
553 {-# INLINE_LATE step' #-}
554 step' gst (st, i) | i < n = do
555 r <- step (rstState gst) st
556 return $ case r of
557 Yield x s -> Yield x (s, i + 1)
558 Skip s -> Skip (s, i)
559 Stop -> Stop
560 step' _ (_, _) = return Stop
562{-# INLINE_NORMAL takeWhileM #-}
563takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
564takeWhileM f (Stream step state) = Stream step' state
565 where
566 {-# INLINE_LATE step' #-}
567 step' gst st = do
568 r <- step (rstState gst) st
569 case r of
570 Yield x s -> do
571 b <- f x
572 return $ if b then Yield x s else Stop
573 Skip s -> return $ Skip s
574 Stop -> return Stop
576{-# INLINE takeWhile #-}
577takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
578takeWhile f = takeWhileM (return . f)
580{-# INLINE_NORMAL drop #-}
581drop :: Monad m => Int -> Stream m a -> Stream m a
582drop n (Stream step state) = Stream step' (state, Just n)
583 where
584 {-# INLINE_LATE step' #-}
585 step' gst (st, Just i)
586 | i > 0 = do
587 r <- step (rstState gst) st
588 return $
589 case r of
590 Yield _ s -> Skip (s, Just (i - 1))
591 Skip s -> Skip (s, Just i)
592 Stop -> Stop
593 | otherwise = return $ Skip (st, Nothing)
595 step' gst (st, Nothing) = do
596 r <- step (rstState gst) st
597 return $
598 case r of
599 Yield x s -> Yield x (s, Nothing)
600 Skip s -> Skip (s, Nothing)
601 Stop -> Stop
603data DropWhileState s a
604 = DropWhileDrop s
605 | DropWhileYield a s
606 | DropWhileNext s
608{-# INLINE_NORMAL dropWhileM #-}
609dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
610dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state)
611 where
612 {-# INLINE_LATE step' #-}
613 step' gst (DropWhileDrop st) = do
614 r <- step (rstState gst) st
615 case r of
616 Yield x s -> do
617 b <- f x
618 if b
619 then return $ Skip (DropWhileDrop s)
620 else return $ Skip (DropWhileYield x s)
621 Skip s -> return $ Skip (DropWhileDrop s)
622 Stop -> return Stop
624 step' gst (DropWhileNext st) = do
625 r <- step (rstState gst) st
626 case r of
627 Yield x s -> return $ Skip (DropWhileYield x s)
628 Skip s -> return $ Skip (DropWhileNext s)
629 Stop -> return Stop
631 step' _ (DropWhileYield x st) = return $ Yield x (DropWhileNext st)
633{-# INLINE dropWhile #-}
634dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
635dropWhile f = dropWhileM (return . f)
637{-# INLINE_NORMAL filterM #-}
638filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
639filterM f (Stream step state) = Stream step' state
640 where
641 {-# INLINE_LATE step' #-}
642 step' gst st = do
643 r <- step (rstState gst) st
644 case r of
645 Yield x s -> do
646 b <- f x
647 return $ if b
648 then Yield x s
649 else Skip s
650 Skip s -> return $ Skip s
651 Stop -> return Stop
653{-# INLINE filter #-}
654filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
655filter f = filterM (return . f)
657------------------------------------------------------------------------------
658-- Transformation by Mapping
659------------------------------------------------------------------------------
661-- | Map a monadic function over a 'Stream'
662{-# INLINE_NORMAL mapM #-}
663mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b
664mapM f (Stream step state) = Stream step' state
665 where
666 {-# INLINE_LATE step' #-}
667 step' gst st = do
668 r <- step (rstState gst) st
669 case r of
670 Yield x s -> f x >>= \a -> return $ Yield a s
671 Skip s -> return $ Skip s
672 Stop -> return Stop
674{-# INLINE map #-}
675map :: Monad m => (a -> b) -> Stream m a -> Stream m b
676map f = mapM (return . f)
678------------------------------------------------------------------------------
679-- Transformation by Map and Filter
680------------------------------------------------------------------------------
682-- XXX Will this always fuse properly?
683{-# INLINE_NORMAL mapMaybe #-}
684mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b
685mapMaybe f = fmap fromJust . filter isJust . map f
687{-# INLINE_NORMAL mapMaybeM #-}
688mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b
689mapMaybeM f = fmap fromJust . filter isJust . mapM f
691------------------------------------------------------------------------------
692-- Instances
693------------------------------------------------------------------------------
695{-# INLINE_NORMAL zipWithM #-}
696zipWithM :: Monad m
697 => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
698zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)
699 where
700 {-# INLINE_LATE step #-}
701 step gst (sa, sb, Nothing) = do
702 r <- stepa (rstState gst) sa
703 return $
704 case r of
705 Yield x sa' -> Skip (sa', sb, Just x)
706 Skip sa' -> Skip (sa', sb, Nothing)
707 Stop -> Stop
709 step gst (sa, sb, Just x) = do
710 r <- stepb (rstState gst) sb
711 case r of
712 Yield y sb' -> do
713 z <- f x y
714 return $ Yield z (sa, sb', Nothing)
715 Skip sb' -> return $ Skip (sa, sb', Just x)
716 Stop -> return Stop
718{-# RULES "zipWithM xs xs"
719 forall f xs. zipWithM f xs xs = mapM (\x -> f x x) xs #-}
721{-# INLINE zipWith #-}
722zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
723zipWith f = zipWithM (\a b -> return (f a b))
725------------------------------------------------------------------------------
726-- Comparisions
727------------------------------------------------------------------------------
729{-# INLINE_NORMAL eqBy #-}
730eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool
731eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2
732 where
733 eq_loop0 !_ s1 s2 = do
734 r <- step1 defState s1
735 case r of
736 Yield x s1' -> eq_loop1 SPEC x s1' s2
737 Skip s1' -> eq_loop0 SPEC s1' s2
738 Stop -> eq_null s2
740 eq_loop1 !_ x s1 s2 = do
741 r <- step2 defState s2
742 case r of
743 Yield y s2'
744 | eq x y -> eq_loop0 SPEC s1 s2'
745 | otherwise -> return False
746 Skip s2' -> eq_loop1 SPEC x s1 s2'
747 Stop -> return False
749 eq_null s2 = do
750 r <- step2 defState s2
751 case r of
752 Yield _ _ -> return False
753 Skip s2' -> eq_null s2'
754 Stop -> return True
756-- | Compare two streams lexicographically
757{-# INLINE_NORMAL cmpBy #-}
758cmpBy
759 :: Monad m
760 => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering
761cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2
762 where
763 cmp_loop0 !_ s1 s2 = do
764 r <- step1 defState s1
765 case r of
766 Yield x s1' -> cmp_loop1 SPEC x s1' s2
767 Skip s1' -> cmp_loop0 SPEC s1' s2
768 Stop -> cmp_null s2
770 cmp_loop1 !_ x s1 s2 = do
771 r <- step2 defState s2
772 case r of
773 Yield y s2' -> case x `cmp` y of
774 EQ -> cmp_loop0 SPEC s1 s2'
775 c -> return c
776 Skip s2' -> cmp_loop1 SPEC x s1 s2'
777 Stop -> return GT
779 cmp_null s2 = do
780 r <- step2 defState s2
781 case r of
782 Yield _ _ -> return LT
783 Skip s2' -> cmp_null s2'
784 Stop -> return EQ
786------------------------------------------------------------------------------
787-- Instances
788------------------------------------------------------------------------------
790instance Monad m => Functor (Stream m) where
791 {-# INLINE fmap #-}
792 fmap = map