Fix Stream.!!
[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 Stream step s _ !! i | i < 0 = errorNegativeIndex "!!"
197 | otherwise = loop s i
198 where
199 loop s i = i `seq`
200 do
201 r <- step s
202 case r of
203 Yield x s' | i == 0 -> return x
204 | otherwise -> loop s' (i-1)
205 Skip s' -> loop s' i
206 Done -> errorIndexOutOfRange "!!"
207
208 -- Substreams
209 -- ----------
210
211 -- | Extract a substream of the given length starting at the given position.
212 extract :: Monad m => Stream m a -> Int -- ^ starting index
213 -> Int -- ^ length
214 -> Stream m a
215 {-# INLINE extract #-}
216 extract s i n = take n (drop i s)
217
218 -- | All but the last element
219 init :: Monad m => Stream m a -> Stream m a
220 {-# INLINE_STREAM init #-}
221 init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)
222 where
223 {-# INLINE step' #-}
224 step' (Nothing, s) = liftM (\r ->
225 case r of
226 Yield x s' -> Skip (Just x, s')
227 Skip s' -> Skip (Nothing, s')
228 Done -> Done -- FIXME: should be an error
229 ) (step s)
230
231 step' (Just x, s) = liftM (\r ->
232 case r of
233 Yield y s' -> Yield x (Just y, s')
234 Skip s' -> Skip (Just x, s')
235 Done -> Done
236 ) (step s)
237
238 -- | All but the first element
239 tail :: Monad m => Stream m a -> Stream m a
240 {-# INLINE_STREAM tail #-}
241 tail (Stream step s sz) = Stream step' (Left s) (sz - 1)
242 where
243 {-# INLINE step' #-}
244 step' (Left s) = liftM (\r ->
245 case r of
246 Yield x s' -> Skip (Right s')
247 Skip s' -> Skip (Left s')
248 Done -> Done -- FIXME: should be error?
249 ) (step s)
250
251 step' (Right s) = liftM (\r ->
252 case r of
253 Yield x s' -> Yield x (Right s')
254 Skip s' -> Skip (Right s')
255 Done -> Done
256 ) (step s)
257
258 -- | The first @n@ elements
259 take :: Monad m => Int -> Stream m a -> Stream m a
260 {-# INLINE_STREAM take #-}
261 take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)
262 where
263 {-# INLINE step' #-}
264 step' (s, i) | i < n = liftM (\r ->
265 case r of
266 Yield x s' -> Yield x (s', i+1)
267 Skip s' -> Skip (s', i)
268 Done -> Done
269 ) (step s)
270 step' (s, i) = return Done
271
272 -- | All but the first @n@ elements
273 drop :: Monad m => Int -> Stream m a -> Stream m a
274 {-# INLINE_STREAM drop #-}
275 drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n)
276 where
277 {-# INLINE step' #-}
278 step' (s, Just i) | i > 0 = liftM (\r ->
279 case r of
280 Yield x s' -> Skip (s', Just (i-1))
281 Skip s' -> Skip (s', Just i)
282 Done -> Done
283 ) (step s)
284 | otherwise = return $ Skip (s, Nothing)
285
286 step' (s, Nothing) = liftM (\r ->
287 case r of
288 Yield x s' -> Yield x (s', Nothing)
289 Skip s' -> Skip (s', Nothing)
290 Done -> Done
291 ) (step s)
292
293
294 -- Mapping/zipping
295 -- ---------------
296
297 instance Monad m => Functor (Stream m) where
298 {-# INLINE fmap #-}
299 fmap = map
300
301 -- | Map a function over a 'Stream'
302 map :: Monad m => (a -> b) -> Stream m a -> Stream m b
303 {-# INLINE map #-}
304 map f = mapM (return . f)
305
306 -- | Map a monadic function over a 'Stream'
307 mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b
308 {-# INLINE_STREAM mapM #-}
309 mapM f (Stream step s n) = Stream step' s n
310 where
311 {-# INLINE step' #-}
312 step' s = do
313 r <- step s
314 case r of
315 Yield x s' -> liftM (`Yield` s') (f x)
316 Skip s' -> return (Skip s')
317 Done -> return Done
318
319 -- | Execute a monadic action for each element of the 'Stream'
320 mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()
321 {-# INLINE_STREAM mapM_ #-}
322 mapM_ m (Stream step s _) = mapM_go s
323 where
324 mapM_go s = do
325 r <- step s
326 case r of
327 Yield x s' -> do { m x; mapM_go s' }
328 Skip s' -> mapM_go s'
329 Done -> return ()
330
331 -- | Zip two 'Stream's with the given function
332 zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
333 {-# INLINE zipWith #-}
334 zipWith f = zipWithM (\a b -> return (f a b))
335
336 -- | Zip two 'Stream's with the given monadic function
337 zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
338 {-# INLINE_STREAM zipWithM #-}
339 zipWithM f (Stream stepa sa na) (Stream stepb sb nb)
340 = Stream step (sa, sb, Nothing) (smaller na nb)
341 where
342 {-# INLINE step #-}
343 step (sa, sb, Nothing) = liftM (\r ->
344 case r of
345 Yield x sa' -> Skip (sa', sb, Just x)
346 Skip sa' -> Skip (sa', sb, Nothing)
347 Done -> Done
348 ) (stepa sa)
349
350 step (sa, sb, Just x) = do
351 r <- stepb sb
352 case r of
353 Yield y sb' ->
354 do
355 z <- f x y
356 return $ Yield z (sa, sb', Nothing)
357 Skip sb' -> return $ Skip (sa, sb', Just x)
358 Done -> return $ Done
359
360 -- Filtering
361 -- ---------
362
363 -- | Drop elements which do not satisfy the predicate
364 filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
365 {-# INLINE filter #-}
366 filter f = filterM (return . f)
367
368 -- | Drop elements which do not satisfy the monadic predicate
369 filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
370 {-# INLINE_STREAM filterM #-}
371 filterM f (Stream step s n) = Stream step' s (toMax n)
372 where
373 {-# INLINE step' #-}
374 step' s = do
375 r <- step s
376 case r of
377 Yield x s' -> do
378 b <- f x
379 return $ if b then Yield x s'
380 else Skip s'
381 Skip s' -> return $ Skip s'
382 Done -> return $ Done
383
384 -- | Longest prefix of elements that satisfy the predicate
385 takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
386 {-# INLINE takeWhile #-}
387 takeWhile f = takeWhileM (return . f)
388
389 -- | Longest prefix of elements that satisfy the monadic predicate
390 takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
391 {-# INLINE_STREAM takeWhileM #-}
392 takeWhileM f (Stream step s n) = Stream step' s (toMax n)
393 where
394 {-# INLINE step' #-}
395 step' s = do
396 r <- step s
397 case r of
398 Yield x s' -> do
399 b <- f x
400 return $ if b then Yield x s' else Done
401 Skip s' -> return $ Skip s'
402 Done -> return $ Done
403
404 -- | Drop the longest prefix of elements that satisfy the predicate
405 dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
406 {-# INLINE dropWhile #-}
407 dropWhile f = dropWhileM (return . f)
408
409 data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s
410
411 -- | Drop the longest prefix of elements that satisfy the monadic predicate
412 dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
413 {-# INLINE_STREAM dropWhileM #-}
414 dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)
415 where
416 -- NOTE: we jump through hoops here to have only one Yield; local data
417 -- declarations would be nice!
418
419 {-# INLINE step' #-}
420 step' (DropWhile_Drop s)
421 = do
422 r <- step s
423 case r of
424 Yield x s' -> do
425 b <- f x
426 return $ if b then Skip (DropWhile_Drop s')
427 else Skip (DropWhile_Yield x s')
428 Skip s' -> return $ Skip (DropWhile_Drop s')
429 Done -> return $ Done
430
431 step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s)
432
433 step' (DropWhile_Next s)
434 = liftM (\r ->
435 case r of
436 Yield x s' -> Skip (DropWhile_Yield x s')
437 Skip s' -> Skip (DropWhile_Next s')
438 Done -> Done
439 ) (step s)
440
441 -- Searching
442 -- ---------
443
444 infix 4 `elem`
445 -- | Check whether the 'Stream' contains an element
446 elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
447 {-# INLINE_STREAM elem #-}
448 elem x (Stream step s _) = elem_loop s
449 where
450 elem_loop s = do
451 r <- step s
452 case r of
453 Yield y s' | x == y -> return True
454 | otherwise -> elem_loop s'
455 Skip s' -> elem_loop s'
456 Done -> return False
457
458 infix 4 `notElem`
459 -- | Inverse of `elem`
460 notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
461 {-# INLINE notElem #-}
462 notElem x s = liftM not (elem x s)
463
464 -- | Yield 'Just' the first element that satisfies the predicate or 'Nothing'
465 -- if no such element exists.
466 find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)
467 {-# INLINE find #-}
468 find f = findM (return . f)
469
470 -- | Yield 'Just' the first element that satisfies the monadic predicate or
471 -- 'Nothing' if no such element exists.
472 findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)
473 {-# INLINE_STREAM findM #-}
474 findM f (Stream step s _) = find_loop s
475 where
476 find_loop s = do
477 r <- step s
478 case r of
479 Yield x s' -> do
480 b <- f x
481 if b then return $ Just x
482 else find_loop s'
483 Skip s' -> find_loop s'
484 Done -> return Nothing
485
486 -- | Yield 'Just' the index of the first element that satisfies the predicate
487 -- or 'Nothing' if no such element exists.
488 findIndex :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe Int)
489 {-# INLINE_STREAM findIndex #-}
490 findIndex f = findIndexM (return . f)
491
492 -- | Yield 'Just' the index of the first element that satisfies the monadic
493 -- predicate or 'Nothing' if no such element exists.
494 findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int)
495 {-# INLINE_STREAM findIndexM #-}
496 findIndexM f (Stream step s _) = findIndex_loop s 0
497 where
498 findIndex_loop s i = do
499 r <- step s
500 case r of
501 Yield x s' -> do
502 b <- f x
503 if b then return $ Just i
504 else findIndex_loop s' (i+1)
505 Skip s' -> findIndex_loop s' i
506 Done -> return Nothing
507
508 -- Folding
509 -- -------
510
511 -- | Left fold
512 foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
513 {-# INLINE foldl #-}
514 foldl f = foldlM (\a b -> return (f a b))
515
516 -- | Left fold with a monadic operator
517 foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
518 {-# INLINE_STREAM foldlM #-}
519 foldlM m z (Stream step s _) = foldlM_go z s
520 where
521 foldlM_go z s = do
522 r <- step s
523 case r of
524 Yield x s' -> do { z' <- m z x; foldlM_go z' s' }
525 Skip s' -> foldlM_go z s'
526 Done -> return z
527
528 -- | Same as 'foldlM'
529 foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
530 {-# INLINE foldM #-}
531 foldM = foldlM
532
533 -- | Left fold over a non-empty 'Stream'
534 foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
535 {-# INLINE foldl1 #-}
536 foldl1 f = foldl1M (\a b -> return (f a b))
537
538 -- | Left fold over a non-empty 'Stream' with a monadic operator
539 foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
540 {-# INLINE_STREAM foldl1M #-}
541 foldl1M f (Stream step s sz) = foldl1M_go s
542 where
543 foldl1M_go s = do
544 r <- step s
545 case r of
546 Yield x s' -> foldlM f x (Stream step s' (sz - 1))
547 Skip s' -> foldl1M_go s'
548 Done -> errorEmptyStream "foldl1M"
549
550 -- | Left fold with a strict accumulator
551 foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
552 {-# INLINE foldl' #-}
553 foldl' f = foldlM' (\a b -> return (f a b))
554
555 -- | Left fold with a strict accumulator and a monadic operator
556 foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
557 {-# INLINE_STREAM foldlM' #-}
558 foldlM' m z (Stream step s _) = foldlM'_go z s
559 where
560 foldlM'_go z s = z `seq`
561 do
562 r <- step s
563 case r of
564 Yield x s' -> do { z' <- m z x; foldlM'_go z' s' }
565 Skip s' -> foldlM'_go z s'
566 Done -> return z
567
568 -- | Left fold over a non-empty 'Stream' with a strict accumulator
569 foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a
570 {-# INLINE foldl1' #-}
571 foldl1' f = foldl1M' (\a b -> return (f a b))
572
573 -- | Left fold over a non-empty 'Stream' with a strict accumulator and a
574 -- monadic operator
575 foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
576 {-# INLINE_STREAM foldl1M' #-}
577 foldl1M' f (Stream step s sz) = foldl1M'_go s
578 where
579 foldl1M'_go s = do
580 r <- step s
581 case r of
582 Yield x s' -> foldlM' f x (Stream step s' (sz - 1))
583 Skip s' -> foldl1M'_go s'
584 Done -> errorEmptyStream "foldl1M'"
585
586 -- | Right fold
587 foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b
588 {-# INLINE foldr #-}
589 foldr f = foldrM (\a b -> return (f a b))
590
591 -- | Right fold with a monadic operator
592 foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b
593 {-# INLINE_STREAM foldrM #-}
594 foldrM f z (Stream step s _) = foldrM_go s
595 where
596 foldrM_go s = do
597 r <- step s
598 case r of
599 Yield x s' -> f x =<< foldrM_go s'
600 Skip s' -> foldrM_go s'
601 Done -> return z
602
603 -- | Right fold over a non-empty stream
604 foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
605 {-# INLINE foldr1 #-}
606 foldr1 f = foldr1M (\a b -> return (f a b))
607
608 -- | Right fold over a non-empty stream with a monadic operator
609 foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
610 {-# INLINE_STREAM foldr1M #-}
611 foldr1M f (Stream step s _) = foldr1M_go0 s
612 where
613 foldr1M_go0 s = do
614 r <- step s
615 case r of
616 Yield x s' -> foldr1M_go1 x s'
617 Skip s' -> foldr1M_go0 s'
618 Done -> errorEmptyStream "foldr1M"
619
620 foldr1M_go1 x s = do
621 r <- step s
622 case r of
623 Yield y s' -> f x =<< foldr1M_go1 y s'
624 Skip s' -> foldr1M_go1 x s'
625 Done -> return x
626
627 -- Unfolding
628 -- ---------
629
630 -- | Unfold
631 unfold :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a
632 {-# INLINE_STREAM unfold #-}
633 unfold f = unfoldM (return . f)
634
635 -- | Unfold with a monadic function
636 unfoldM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a
637 {-# INLINE_STREAM unfoldM #-}
638 unfoldM f s = Stream step s Unknown
639 where
640 {-# INLINE step #-}
641 step s = liftM (\r ->
642 case r of
643 Just (x, s') -> Yield x s'
644 Nothing -> Done
645 ) (f s)
646
647 -- Scans
648 -- -----
649
650 -- | Prefix scan
651 prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
652 {-# INLINE prescanl #-}
653 prescanl f = prescanlM (\a b -> return (f a b))
654
655 -- | Prefix scan with a monadic operator
656 prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
657 {-# INLINE_STREAM prescanlM #-}
658 prescanlM f z (Stream step s sz) = Stream step' (s,z) sz
659 where
660 {-# INLINE step' #-}
661 step' (s,x) = do
662 r <- step s
663 case r of
664 Yield y s' -> do
665 z <- f x y
666 return $ Yield x (s', z)
667 Skip s' -> return $ Skip (s', x)
668 Done -> return Done
669
670 -- | Prefix scan with strict accumulator
671 prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
672 {-# INLINE prescanl' #-}
673 prescanl' f = prescanlM' (\a b -> return (f a b))
674
675 -- | Prefix scan with strict accumulator and a monadic operator
676 prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
677 {-# INLINE_STREAM prescanlM' #-}
678 prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz
679 where
680 {-# INLINE step' #-}
681 step' (s,x) = x `seq`
682 do
683 r <- step s
684 case r of
685 Yield y s' -> do
686 z <- f x y
687 return $ Yield x (s', z)
688 Skip s' -> return $ Skip (s', x)
689 Done -> return Done
690
691 -- Conversions
692 -- -----------
693
694 -- | Convert a 'Stream' to a list
695 toList :: Monad m => Stream m a -> m [a]
696 {-# INLINE toList #-}
697 toList = foldr (:) []
698
699 -- | Convert a list to a 'Stream'
700 fromList :: Monad m => [a] -> Stream m a
701 {-# INLINE_STREAM fromList #-}
702 fromList xs = Stream step xs Unknown
703 where
704 step (x:xs) = return (Yield x xs)
705 step [] = return Done
706
707
708 streamError :: String -> String -> a
709 streamError fn msg = error $ "Data.Vector.Fusion.Stream.Monadic."
710 Prelude.++ fn Prelude.++ ": " Prelude.++ msg
711
712 errorEmptyStream :: String -> a
713 errorEmptyStream fn = streamError fn "empty stream"
714
715 errorNegativeIndex :: String -> a
716 errorNegativeIndex fn = streamError fn "negative index"
717
718 errorIndexOutOfRange :: String -> a
719 errorIndexOutOfRange fn = streamError fn "index out of range"
720