More comments
[darcs-mirrors/vector.git] / Data / Vector / Fusion / Stream / Monadic.hs
1 {-# LANGUAGE ExistentialQuantification #-}
2
3 -- |
4 -- Module : Data.Vector.Fusion.Stream.Monadic
5 -- Copyright : (c) Roman Leshchinskiy 2008
6 -- License : BSD-style
7 --
8 -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
9 -- Stability : experimental
10 -- Portability : non-portable
11 --
12 -- Monadic streams
13 --
14
15 #include "phases.h"
16
17 module Data.Vector.Fusion.Stream.Monadic (
18 Stream(..), Step(..),
19
20 -- * Size hints
21 size, sized,
22
23 -- * Length
24 length, null,
25
26 -- * Construction
27 empty, singleton, cons, snoc, replicate, (++),
28
29 -- * Accessing elements
30 head, last, (!!),
31
32 -- * Substreams
33 extract, init, tail, take, drop,
34
35 -- * Mapping and zipping
36 map, mapM, mapM_, zipWith, zipWithM,
37
38 -- * Filtering
39 filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,
40
41 -- * Searching
42 elem, notElem, find, findM, findIndex, findIndexM,
43
44 -- * Folding
45 foldl, foldlM, foldM, foldl1, foldl1M,
46 foldl', foldlM', foldl1', foldl1M',
47 foldr, foldrM, foldr1, foldr1M,
48
49 -- * Unfolding
50 unfold, unfoldM,
51
52 -- * Scans
53 prescanl, prescanlM, prescanl', prescanlM',
54
55 -- * Conversions
56 toList, fromList
57 ) where
58
59 import Data.Vector.Fusion.Stream.Size
60
61 import Control.Monad ( liftM )
62 import Prelude hiding ( length, null,
63 replicate, (++),
64 head, last, (!!),
65 init, tail, take, drop,
66 map, mapM, mapM_, zipWith,
67 filter, takeWhile, dropWhile,
68 elem, notElem,
69 foldl, foldl1, foldr, foldr1 )
70 import qualified Prelude
71
72 -- | Result of taking a single step in a stream
73 data Step s a = Yield a s -- ^ a new element and a new seed
74 | Skip s -- ^ just a new seed
75 | Done -- ^ end of stream
76
77 -- | Monadic streams
78 data Stream m a = forall s. Stream (s -> m (Step s a)) s Size
79
80 -- | 'Size' hint of a 'Stream'
81 size :: Stream m a -> Size
82 {-# INLINE size #-}
83 size (Stream _ _ sz) = sz
84
85 -- | Attach a 'Size' hint to a 'Stream'
86 sized :: Stream m a -> Size -> Stream m a
87 {-# INLINE_STREAM sized #-}
88 sized (Stream step s _) sz = Stream step s sz
89
90 -- Length
91 -- ------
92
93 -- | Length of a 'Stream'
94 length :: Monad m => Stream m a -> m Int
95 {-# INLINE_STREAM length #-}
96 length s = foldl' (\n _ -> n+1) 0 s
97
98 -- | Check if a 'Stream' is empty
99 null :: Monad m => Stream m a -> m Bool
100 {-# INLINE_STREAM null #-}
101 null s = foldr (\_ _ -> False) True s
102
103
104 -- Construction
105 -- ------------
106
107 -- | Empty 'Stream'
108 empty :: Monad m => Stream m a
109 {-# INLINE_STREAM empty #-}
110 empty = Stream (const (return Done)) () (Exact 0)
111
112 -- | Singleton 'Stream'
113 singleton :: Monad m => a -> Stream m a
114 {-# INLINE_STREAM singleton #-}
115 singleton x = Stream (return . step) True (Exact 1)
116 where
117 {-# INLINE step #-}
118 step True = Yield x False
119 step False = Done
120
121 -- | Replicate a value to a given length
122 replicate :: Monad m => Int -> a -> Stream m a
123 {-# INLINE_STREAM replicate #-}
124 replicate n x = Stream (return . step) n (Exact (max n 0))
125 where
126 {-# INLINE step #-}
127 step i | i > 0 = Yield x (i-1)
128 | otherwise = Done
129
130 -- | Prepend an element
131 cons :: Monad m => a -> Stream m a -> Stream m a
132 {-# INLINE cons #-}
133 cons x s = singleton x ++ s
134
135 -- | Append an element
136 snoc :: Monad m => Stream m a -> a -> Stream m a
137 {-# INLINE snoc #-}
138 snoc s x = s ++ singleton x
139
140 infixr 5 ++
141 -- | Concatenate two 'Stream's
142 (++) :: Monad m => Stream m a -> Stream m a -> Stream m a
143 {-# INLINE_STREAM (++) #-}
144 Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)
145 where
146 step (Left sa) = do
147 r <- stepa sa
148 case r of
149 Yield x sa' -> return $ Yield x (Left sa')
150 Skip sa' -> return $ Skip (Left sa')
151 Done -> return $ Skip (Right sb)
152 step (Right sb) = do
153 r <- stepb sb
154 case r of
155 Yield x sb' -> return $ Yield x (Right sb')
156 Skip sb' -> return $ Skip (Right sb')
157 Done -> return $ Done
158
159 -- Accessing elements
160 -- ------------------
161
162 -- | First element of the 'Stream' or error if empty
163 head :: Monad m => Stream m a -> m a
164 {-# INLINE_STREAM head #-}
165 head (Stream step s _) = head_loop s
166 where
167 head_loop s = do
168 r <- step s
169 case r of
170 Yield x _ -> return x
171 Skip s' -> head_loop s'
172 Done -> errorEmptyStream "head"
173
174 -- | Last element of the 'Stream' or error if empty
175 last :: Monad m => Stream m a -> m a
176 {-# INLINE_STREAM last #-}
177 last (Stream step s _) = last_loop0 s
178 where
179 last_loop0 s = do
180 r <- step s
181 case r of
182 Yield x s' -> last_loop1 x s'
183 Skip s' -> last_loop0 s'
184 Done -> errorEmptyStream "last"
185
186 last_loop1 x s = do
187 r <- step s
188 case r of
189 Yield y s' -> last_loop1 y s'
190 Skip s' -> last_loop1 x s'
191 Done -> return x
192
193 -- | Element at the given position
194 (!!) :: Monad m => Stream m a -> Int -> m a
195 {-# INLINE (!!) #-}
196 s !! i = head (drop i s)
197
198 -- Substreams
199 -- ----------
200
201 -- | Extract a substream of the given length starting at the given position.
202 extract :: Monad m => Stream m a -> Int -- ^ starting index
203 -> Int -- ^ length
204 -> Stream m a
205 {-# INLINE extract #-}
206 extract s i n = take n (drop i s)
207
208 -- | All but the last element
209 init :: Monad m => Stream m a -> Stream m a
210 {-# INLINE_STREAM init #-}
211 init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)
212 where
213 {-# INLINE step' #-}
214 step' (Nothing, s) = liftM (\r ->
215 case r of
216 Yield x s' -> Skip (Just x, s')
217 Skip s' -> Skip (Nothing, s')
218 Done -> Done -- FIXME: should be an error
219 ) (step s)
220
221 step' (Just x, s) = liftM (\r ->
222 case r of
223 Yield y s' -> Yield x (Just y, s')
224 Skip s' -> Skip (Just x, s')
225 Done -> Done
226 ) (step s)
227
228 -- | All but the first element
229 tail :: Monad m => Stream m a -> Stream m a
230 {-# INLINE_STREAM tail #-}
231 tail (Stream step s sz) = Stream step' (Left s) (sz - 1)
232 where
233 {-# INLINE step' #-}
234 step' (Left s) = liftM (\r ->
235 case r of
236 Yield x s' -> Skip (Right s')
237 Skip s' -> Skip (Left s')
238 Done -> Done -- FIXME: should be error?
239 ) (step s)
240
241 step' (Right s) = liftM (\r ->
242 case r of
243 Yield x s' -> Yield x (Right s')
244 Skip s' -> Skip (Right s')
245 Done -> Done
246 ) (step s)
247
248 -- | The first @n@ elements
249 take :: Monad m => Int -> Stream m a -> Stream m a
250 {-# INLINE_STREAM take #-}
251 take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)
252 where
253 {-# INLINE step' #-}
254 step' (s, i) | i < n = liftM (\r ->
255 case r of
256 Yield x s' -> Yield x (s', i+1)
257 Skip s' -> Skip (s', i)
258 Done -> Done
259 ) (step s)
260 step' (s, i) = return Done
261
262 -- | All but the first @n@ elements
263 drop :: Monad m => Int -> Stream m a -> Stream m a
264 {-# INLINE_STREAM drop #-}
265 drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n)
266 where
267 {-# INLINE step' #-}
268 step' (s, Just i) | i > 0 = liftM (\r ->
269 case r of
270 Yield x s' -> Skip (s', Just (i-1))
271 Skip s' -> Skip (s', Just i)
272 Done -> Done
273 ) (step s)
274 | otherwise = return $ Skip (s, Nothing)
275
276 step' (s, Nothing) = liftM (\r ->
277 case r of
278 Yield x s' -> Yield x (s', Nothing)
279 Skip s' -> Skip (s', Nothing)
280 Done -> Done
281 ) (step s)
282
283
284 -- Mapping/zipping
285 -- ---------------
286
287 instance Monad m => Functor (Stream m) where
288 {-# INLINE fmap #-}
289 fmap = map
290
291 -- | Map a function over a 'Stream'
292 map :: Monad m => (a -> b) -> Stream m a -> Stream m b
293 {-# INLINE map #-}
294 map f = mapM (return . f)
295
296 -- | Map a monadic function over a 'Stream'
297 mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b
298 {-# INLINE_STREAM mapM #-}
299 mapM f (Stream step s n) = Stream step' s n
300 where
301 {-# INLINE step' #-}
302 step' s = do
303 r <- step s
304 case r of
305 Yield x s' -> liftM (`Yield` s') (f x)
306 Skip s' -> return (Skip s')
307 Done -> return Done
308
309 -- | Execute a monadic action for each element of the 'Stream'
310 mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()
311 {-# INLINE_STREAM mapM_ #-}
312 mapM_ m (Stream step s _) = mapM_go s
313 where
314 mapM_go s = do
315 r <- step s
316 case r of
317 Yield x s' -> do { m x; mapM_go s' }
318 Skip s' -> mapM_go s'
319 Done -> return ()
320
321 -- | Zip two 'Stream's with the given function
322 zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
323 {-# INLINE zipWith #-}
324 zipWith f = zipWithM (\a b -> return (f a b))
325
326 -- | Zip two 'Stream's with the given monadic function
327 zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
328 {-# INLINE_STREAM zipWithM #-}
329 zipWithM f (Stream stepa sa na) (Stream stepb sb nb)
330 = Stream step (sa, sb, Nothing) (smaller na nb)
331 where
332 {-# INLINE step #-}
333 step (sa, sb, Nothing) = liftM (\r ->
334 case r of
335 Yield x sa' -> Skip (sa', sb, Just x)
336 Skip sa' -> Skip (sa', sb, Nothing)
337 Done -> Done
338 ) (stepa sa)
339
340 step (sa, sb, Just x) = do
341 r <- stepb sb
342 case r of
343 Yield y sb' ->
344 do
345 z <- f x y
346 return $ Yield z (sa, sb', Nothing)
347 Skip sb' -> return $ Skip (sa, sb', Just x)
348 Done -> return $ Done
349
350 -- Filtering
351 -- ---------
352
353 -- | Drop elements which do not satisfy the predicate
354 filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
355 {-# INLINE filter #-}
356 filter f = filterM (return . f)
357
358 -- | Drop elements which do not satisfy the monadic predicate
359 filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
360 {-# INLINE_STREAM filterM #-}
361 filterM f (Stream step s n) = Stream step' s (toMax n)
362 where
363 {-# INLINE step' #-}
364 step' s = do
365 r <- step s
366 case r of
367 Yield x s' -> do
368 b <- f x
369 return $ if b then Yield x s'
370 else Skip s'
371 Skip s' -> return $ Skip s'
372 Done -> return $ Done
373
374 -- | Longest prefix of elements that satisfy the predicate
375 takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
376 {-# INLINE takeWhile #-}
377 takeWhile f = takeWhileM (return . f)
378
379 -- | Longest prefix of elements that satisfy the monadic predicate
380 takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
381 {-# INLINE_STREAM takeWhileM #-}
382 takeWhileM f (Stream step s n) = Stream step' s (toMax n)
383 where
384 {-# INLINE step' #-}
385 step' s = do
386 r <- step s
387 case r of
388 Yield x s' -> do
389 b <- f x
390 return $ if b then Yield x s' else Done
391 Skip s' -> return $ Skip s'
392 Done -> return $ Done
393
394 -- | Drop the longest prefix of elements that satisfy the predicate
395 dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
396 {-# INLINE dropWhile #-}
397 dropWhile f = dropWhileM (return . f)
398
399 data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s
400
401 -- | Drop the longest prefix of elements that satisfy the monadic predicate
402 dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
403 {-# INLINE_STREAM dropWhileM #-}
404 dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)
405 where
406 -- NOTE: we jump through hoops here to have only one Yield; local data
407 -- declarations would be nice!
408
409 {-# INLINE step' #-}
410 step' (DropWhile_Drop s)
411 = do
412 r <- step s
413 case r of
414 Yield x s' -> do
415 b <- f x
416 return $ if b then Skip (DropWhile_Drop s')
417 else Skip (DropWhile_Yield x s')
418 Skip s' -> return $ Skip (DropWhile_Drop s')
419 Done -> return $ Done
420
421 step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s)
422
423 step' (DropWhile_Next s)
424 = liftM (\r ->
425 case r of
426 Yield x s' -> Skip (DropWhile_Yield x s')
427 Skip s' -> Skip (DropWhile_Next s')
428 Done -> Done
429 ) (step s)
430
431 -- Searching
432 -- ---------
433
434 infix 4 `elem`
435 -- | Check whether the 'Stream' contains an element
436 elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
437 {-# INLINE_STREAM elem #-}
438 elem x (Stream step s _) = elem_loop s
439 where
440 elem_loop s = do
441 r <- step s
442 case r of
443 Yield y s' | x == y -> return True
444 | otherwise -> elem_loop s'
445 Skip s' -> elem_loop s'
446 Done -> return False
447
448 infix 4 `notElem`
449 -- | Inverse of `elem`
450 notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
451 {-# INLINE notElem #-}
452 notElem x s = liftM not (elem x s)
453
454 -- | Yield 'Just' the first element that satisfies the predicate or 'Nothing'
455 -- if no such element exists.
456 find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)
457 {-# INLINE find #-}
458 find f = findM (return . f)
459
460 -- | Yield 'Just' the first element that satisfies the monadic predicate or
461 -- 'Nothing' if no such element exists.
462 findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)
463 {-# INLINE_STREAM findM #-}
464 findM f (Stream step s _) = find_loop s
465 where
466 find_loop s = do
467 r <- step s
468 case r of
469 Yield x s' -> do
470 b <- f x
471 if b then return $ Just x
472 else find_loop s'
473 Skip s' -> find_loop s'
474 Done -> return Nothing
475
476 -- | Yield 'Just' the index of the first element that satisfies the predicate
477 -- or 'Nothing' if no such element exists.
478 findIndex :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe Int)
479 {-# INLINE_STREAM findIndex #-}
480 findIndex f = findIndexM (return . f)
481
482 -- | Yield 'Just' the index of the first element that satisfies the monadic
483 -- predicate or 'Nothing' if no such element exists.
484 findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int)
485 {-# INLINE_STREAM findIndexM #-}
486 findIndexM f (Stream step s _) = findIndex_loop s 0
487 where
488 findIndex_loop s i = do
489 r <- step s
490 case r of
491 Yield x s' -> do
492 b <- f x
493 if b then return $ Just i
494 else findIndex_loop s' (i+1)
495 Skip s' -> findIndex_loop s' i
496 Done -> return Nothing
497
498 -- Folding
499 -- -------
500
501 -- | Left fold
502 foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
503 {-# INLINE foldl #-}
504 foldl f = foldlM (\a b -> return (f a b))
505
506 -- | Left fold with a monadic operator
507 foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
508 {-# INLINE_STREAM foldlM #-}
509 foldlM m z (Stream step s _) = foldlM_go z s
510 where
511 foldlM_go z s = do
512 r <- step s
513 case r of
514 Yield x s' -> do { z' <- m z x; foldlM_go z' s' }
515 Skip s' -> foldlM_go z s'
516 Done -> return z
517
518 -- | Same as 'foldlM'
519 foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
520 {-# INLINE foldM #-}
521 foldM = foldlM
522
523 -- | Left fold over a non-empty 'Stream'
524 foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
525 {-# INLINE foldl1 #-}
526 foldl1 f = foldl1M (\a b -> return (f a b))
527
528 -- | Left fold over a non-empty 'Stream' with a monadic operator
529 foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
530 {-# INLINE_STREAM foldl1M #-}
531 foldl1M f (Stream step s sz) = foldl1M_go s
532 where
533 foldl1M_go s = do
534 r <- step s
535 case r of
536 Yield x s' -> foldlM f x (Stream step s' (sz - 1))
537 Skip s' -> foldl1M_go s'
538 Done -> errorEmptyStream "foldl1M"
539
540 -- | Left fold with a strict accumulator
541 foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
542 {-# INLINE foldl' #-}
543 foldl' f = foldlM' (\a b -> return (f a b))
544
545 -- | Left fold with a strict accumulator and a monadic operator
546 foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
547 {-# INLINE_STREAM foldlM' #-}
548 foldlM' m z (Stream step s _) = foldlM'_go z s
549 where
550 foldlM'_go z s = z `seq`
551 do
552 r <- step s
553 case r of
554 Yield x s' -> do { z' <- m z x; foldlM'_go z' s' }
555 Skip s' -> foldlM'_go z s'
556 Done -> return z
557
558 -- | Left fold over a non-empty 'Stream' with a strict accumulator
559 foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a
560 {-# INLINE foldl1' #-}
561 foldl1' f = foldl1M' (\a b -> return (f a b))
562
563 -- | Left fold over a non-empty 'Stream' with a strict accumulator and a
564 -- monadic operator
565 foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
566 {-# INLINE_STREAM foldl1M' #-}
567 foldl1M' f (Stream step s sz) = foldl1M'_go s
568 where
569 foldl1M'_go s = do
570 r <- step s
571 case r of
572 Yield x s' -> foldlM' f x (Stream step s' (sz - 1))
573 Skip s' -> foldl1M'_go s'
574 Done -> errorEmptyStream "foldl1M'"
575
576 -- | Right fold
577 foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b
578 {-# INLINE foldr #-}
579 foldr f = foldrM (\a b -> return (f a b))
580
581 -- | Right fold with a monadic operator
582 foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b
583 {-# INLINE_STREAM foldrM #-}
584 foldrM f z (Stream step s _) = foldrM_go s
585 where
586 foldrM_go s = do
587 r <- step s
588 case r of
589 Yield x s' -> f x =<< foldrM_go s'
590 Skip s' -> foldrM_go s'
591 Done -> return z
592
593 -- | Right fold over a non-empty stream
594 foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
595 {-# INLINE foldr1 #-}
596 foldr1 f = foldr1M (\a b -> return (f a b))
597
598 -- | Right fold over a non-empty stream with a monadic operator
599 foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
600 {-# INLINE_STREAM foldr1M #-}
601 foldr1M f (Stream step s _) = foldr1M_go0 s
602 where
603 foldr1M_go0 s = do
604 r <- step s
605 case r of
606 Yield x s' -> foldr1M_go1 x s'
607 Skip s' -> foldr1M_go0 s'
608 Done -> errorEmptyStream "foldr1M"
609
610 foldr1M_go1 x s = do
611 r <- step s
612 case r of
613 Yield y s' -> f x =<< foldr1M_go1 y s'
614 Skip s' -> foldr1M_go1 x s'
615 Done -> return x
616
617 -- Unfolding
618 -- ---------
619
620 -- | Unfold
621 unfold :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a
622 {-# INLINE_STREAM unfold #-}
623 unfold f = unfoldM (return . f)
624
625 -- | Unfold with a monadic function
626 unfoldM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a
627 {-# INLINE_STREAM unfoldM #-}
628 unfoldM f s = Stream step s Unknown
629 where
630 {-# INLINE step #-}
631 step s = liftM (\r ->
632 case r of
633 Just (x, s') -> Yield x s'
634 Nothing -> Done
635 ) (f s)
636
637 -- Scans
638 -- -----
639
640 -- | Prefix scan
641 prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
642 {-# INLINE prescanl #-}
643 prescanl f = prescanlM (\a b -> return (f a b))
644
645 -- | Prefix scan with a monadic operator
646 prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
647 {-# INLINE_STREAM prescanlM #-}
648 prescanlM f z (Stream step s sz) = Stream step' (s,z) sz
649 where
650 {-# INLINE step' #-}
651 step' (s,x) = do
652 r <- step s
653 case r of
654 Yield y s' -> do
655 z <- f x y
656 return $ Yield x (s', z)
657 Skip s' -> return $ Skip (s', x)
658 Done -> return Done
659
660 -- | Prefix scan with strict accumulator
661 prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
662 {-# INLINE prescanl' #-}
663 prescanl' f = prescanlM' (\a b -> return (f a b))
664
665 -- | Prefix scan with strict accumulator and a monadic operator
666 prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
667 {-# INLINE_STREAM prescanlM' #-}
668 prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz
669 where
670 {-# INLINE step' #-}
671 step' (s,x) = x `seq`
672 do
673 r <- step s
674 case r of
675 Yield y s' -> do
676 z <- f x y
677 return $ Yield x (s', z)
678 Skip s' -> return $ Skip (s', x)
679 Done -> return Done
680
681 -- Conversions
682 -- -----------
683
684 -- | Convert a 'Stream' to a list
685 toList :: Monad m => Stream m a -> m [a]
686 {-# INLINE toList #-}
687 toList = foldr (:) []
688
689 -- | Convert a list to a 'Stream'
690 fromList :: Monad m => [a] -> Stream m a
691 {-# INLINE_STREAM fromList #-}
692 fromList xs = Stream step xs Unknown
693 where
694 step (x:xs) = return (Yield x xs)
695 step [] = return Done
696
697
698 errorEmptyStream :: String -> a
699 errorEmptyStream s = error $ "Data.Vector.Fusion.Stream.Monadic."
700 Prelude.++ s Prelude.++ ": empty stream"
701