c935eed4d8a75efea439bc2bbc5276fd3b13302b
[darcs-mirrors/vector.git] / Data / Vector / Fusion / Stream / Monadic.hs
1 {-# LANGUAGE ExistentialQuantification, Rank2Types #-}
2
3 -- |
4 -- Module : Data.Vector.Fusion.Stream.Monadic
5 -- Copyright : (c) Roman Leshchinskiy 2008-2009
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 module Data.Vector.Fusion.Stream.Monadic (
16 Stream(..), Step(..),
17
18 -- * Size hints
19 size, sized,
20
21 -- * Length
22 length, null,
23
24 -- * Construction
25 empty, singleton, cons, snoc, replicate, generate, generateM, (++),
26
27 -- * Accessing elements
28 head, last, (!!),
29
30 -- * Substreams
31 slice, init, tail, take, drop,
32
33 -- * Mapping
34 map, mapM, mapM_, trans, unbox, concatMap,
35
36 -- * Zipping
37 indexed, indexedR,
38 zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M,
39 zipWith, zipWith3, zipWith4, zipWith5, zipWith6,
40 zip, zip3, zip4, zip5, zip6,
41
42 -- * Filtering
43 filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,
44
45 -- * Searching
46 elem, notElem, find, findM, findIndex, findIndexM,
47
48 -- * Folding
49 foldl, foldlM, foldl1, foldl1M, foldM, fold1M,
50 foldl', foldlM', foldl1', foldl1M', foldM', fold1M',
51 foldr, foldrM, foldr1, foldr1M,
52
53 -- * Specialised folds
54 and, or, concatMapM,
55
56 -- * Unfolding
57 unfoldr, unfoldrM,
58
59 -- * Scans
60 prescanl, prescanlM, prescanl', prescanlM',
61 postscanl, postscanlM, postscanl', postscanlM',
62 scanl, scanlM, scanl', scanlM',
63 scanl1, scanl1M, scanl1', scanl1M',
64
65 -- * Enumerations
66 enumFromStepN, enumFromTo, enumFromThenTo,
67
68 -- * Conversions
69 toList, fromList
70 ) where
71
72 import Data.Vector.Fusion.Stream.Size
73 import Data.Vector.Fusion.Util ( Box(..), delay_inline )
74
75 import Data.Char ( ord )
76 import GHC.Base ( unsafeChr )
77 import Control.Monad ( liftM )
78 import Prelude hiding ( length, null,
79 replicate, (++),
80 head, last, (!!),
81 init, tail, take, drop,
82 map, mapM, mapM_, concatMap,
83 zipWith, zipWith3, zip, zip3,
84 filter, takeWhile, dropWhile,
85 elem, notElem,
86 foldl, foldl1, foldr, foldr1,
87 and, or,
88 scanl, scanl1,
89 enumFromTo, enumFromThenTo )
90 import qualified Prelude
91
92 import Data.Int ( Int8, Int16, Int32, Int64 )
93 import Data.Word ( Word8, Word16, Word32, Word, Word64 )
94
95 #if __GLASGOW_HASKELL__ >= 613
96 import SpecConstr ( SpecConstrAnnotation(..) )
97 #endif
98
99 #include "vector.h"
100
101 data SPEC = SPEC | SPEC2
102 #if __GLASGOW_HASKELL__ >= 613
103 {-# ANN type SPEC ForceSpecConstr #-}
104 #endif
105
106
107 -- | Result of taking a single step in a stream
108 data Step s a = Yield a s -- ^ a new element and a new seed
109 | Skip s -- ^ just a new seed
110 | Done -- ^ end of stream
111
112 -- | Monadic streams
113 data Stream m a = forall s. Stream (s -> m (Step s a)) s Size
114
115 -- | 'Size' hint of a 'Stream'
116 size :: Stream m a -> Size
117 {-# INLINE size #-}
118 size (Stream _ _ sz) = sz
119
120 -- | Attach a 'Size' hint to a 'Stream'
121 sized :: Stream m a -> Size -> Stream m a
122 {-# INLINE_STREAM sized #-}
123 sized (Stream step s _) sz = Stream step s sz
124
125 -- Length
126 -- ------
127
128 -- | Length of a 'Stream'
129 length :: Monad m => Stream m a -> m Int
130 {-# INLINE_STREAM length #-}
131 length s = foldl' (\n _ -> n+1) 0 s
132
133 -- | Check if a 'Stream' is empty
134 null :: Monad m => Stream m a -> m Bool
135 {-# INLINE_STREAM null #-}
136 null s = foldr (\_ _ -> False) True s
137
138
139 -- Construction
140 -- ------------
141
142 -- | Empty 'Stream'
143 empty :: Monad m => Stream m a
144 {-# INLINE_STREAM empty #-}
145 empty = Stream (const (return Done)) () (Exact 0)
146
147 -- | Singleton 'Stream'
148 singleton :: Monad m => a -> Stream m a
149 {-# INLINE_STREAM singleton #-}
150 singleton x = Stream (return . step) True (Exact 1)
151 where
152 {-# INLINE_INNER step #-}
153 step True = Yield x False
154 step False = Done
155
156 -- | Replicate a value to a given length
157 replicate :: Monad m => Int -> a -> Stream m a
158 {-# INLINE_STREAM replicate #-}
159 -- NOTE: We delay inlining max here because GHC will create a join point for
160 -- the call to newArray# otherwise which is not really nice.
161 replicate n x = Stream (return . step) n (Exact (delay_inline max n 0))
162 where
163 {-# INLINE_INNER step #-}
164 step i | i > 0 = Yield x (i-1)
165 | otherwise = Done
166
167 generate :: Monad m => Int -> (Int -> a) -> Stream m a
168 {-# INLINE generate #-}
169 generate n f = generateM n (return . f)
170
171 -- | Generate a stream from its indices
172 generateM :: Monad m => Int -> (Int -> m a) -> Stream m a
173 {-# INLINE_STREAM generateM #-}
174 generateM n f = n `seq` Stream step 0 (Exact (delay_inline max n 0))
175 where
176 {-# INLINE_INNER step #-}
177 step i | i < n = do
178 x <- f i
179 return $ Yield x (i+1)
180 | otherwise = return Done
181
182 -- | Prepend an element
183 cons :: Monad m => a -> Stream m a -> Stream m a
184 {-# INLINE cons #-}
185 cons x s = singleton x ++ s
186
187 -- | Append an element
188 snoc :: Monad m => Stream m a -> a -> Stream m a
189 {-# INLINE snoc #-}
190 snoc s x = s ++ singleton x
191
192 infixr 5 ++
193 -- | Concatenate two 'Stream's
194 (++) :: Monad m => Stream m a -> Stream m a -> Stream m a
195 {-# INLINE_STREAM (++) #-}
196 Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)
197 where
198 {-# INLINE_INNER step #-}
199 step (Left sa) = do
200 r <- stepa sa
201 case r of
202 Yield x sa' -> return $ Yield x (Left sa')
203 Skip sa' -> return $ Skip (Left sa')
204 Done -> return $ Skip (Right sb)
205 step (Right sb) = do
206 r <- stepb sb
207 case r of
208 Yield x sb' -> return $ Yield x (Right sb')
209 Skip sb' -> return $ Skip (Right sb')
210 Done -> return $ Done
211
212 -- Accessing elements
213 -- ------------------
214
215 -- | First element of the 'Stream' or error if empty
216 head :: Monad m => Stream m a -> m a
217 {-# INLINE_STREAM head #-}
218 head (Stream step s _) = head_loop SPEC s
219 where
220 head_loop SPEC s
221 = do
222 r <- step s
223 case r of
224 Yield x _ -> return x
225 Skip s' -> head_loop SPEC s'
226 Done -> BOUNDS_ERROR(emptyStream) "head"
227
228
229
230 -- | Last element of the 'Stream' or error if empty
231 last :: Monad m => Stream m a -> m a
232 {-# INLINE_STREAM last #-}
233 last (Stream step s _) = last_loop0 SPEC s
234 where
235 last_loop0 SPEC s
236 = do
237 r <- step s
238 case r of
239 Yield x s' -> last_loop1 SPEC x s'
240 Skip s' -> last_loop0 SPEC s'
241 Done -> BOUNDS_ERROR(emptyStream) "last"
242
243 last_loop1 SPEC x s
244 = do
245 r <- step s
246 case r of
247 Yield y s' -> last_loop1 SPEC y s'
248 Skip s' -> last_loop1 SPEC x s'
249 Done -> return x
250
251 -- | Element at the given position
252 (!!) :: Monad m => Stream m a -> Int -> m a
253 {-# INLINE (!!) #-}
254 Stream step s _ !! i | i < 0 = BOUNDS_ERROR(error) "!!" "negative index"
255 | otherwise = index_loop SPEC s i
256 where
257 index_loop SPEC s i
258 = i `seq`
259 do
260 r <- step s
261 case r of
262 Yield x s' | i == 0 -> return x
263 | otherwise -> index_loop SPEC s' (i-1)
264 Skip s' -> index_loop SPEC s' i
265 Done -> BOUNDS_ERROR(emptyStream) "!!"
266
267 -- Substreams
268 -- ----------
269
270 -- | Extract a substream of the given length starting at the given position.
271 slice :: Monad m => Int -- ^ starting index
272 -> Int -- ^ length
273 -> Stream m a
274 -> Stream m a
275 {-# INLINE slice #-}
276 slice i n s = take n (drop i s)
277
278 -- | All but the last element
279 init :: Monad m => Stream m a -> Stream m a
280 {-# INLINE_STREAM init #-}
281 init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)
282 where
283 {-# INLINE_INNER step' #-}
284 step' (Nothing, s) = liftM (\r ->
285 case r of
286 Yield x s' -> Skip (Just x, s')
287 Skip s' -> Skip (Nothing, s')
288 Done -> BOUNDS_ERROR(emptyStream) "init"
289 ) (step s)
290
291 step' (Just x, s) = liftM (\r ->
292 case r of
293 Yield y s' -> Yield x (Just y, s')
294 Skip s' -> Skip (Just x, s')
295 Done -> Done
296 ) (step s)
297
298 -- | All but the first element
299 tail :: Monad m => Stream m a -> Stream m a
300 {-# INLINE_STREAM tail #-}
301 tail (Stream step s sz) = Stream step' (Left s) (sz - 1)
302 where
303 {-# INLINE_INNER step' #-}
304 step' (Left s) = liftM (\r ->
305 case r of
306 Yield x s' -> Skip (Right s')
307 Skip s' -> Skip (Left s')
308 Done -> BOUNDS_ERROR(emptyStream) "tail"
309 ) (step s)
310
311 step' (Right s) = liftM (\r ->
312 case r of
313 Yield x s' -> Yield x (Right s')
314 Skip s' -> Skip (Right s')
315 Done -> Done
316 ) (step s)
317
318 -- | The first @n@ elements
319 take :: Monad m => Int -> Stream m a -> Stream m a
320 {-# INLINE_STREAM take #-}
321 take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)
322 where
323 {-# INLINE_INNER step' #-}
324 step' (s, i) | i < n = liftM (\r ->
325 case r of
326 Yield x s' -> Yield x (s', i+1)
327 Skip s' -> Skip (s', i)
328 Done -> Done
329 ) (step s)
330 step' (s, i) = return Done
331
332 -- | All but the first @n@ elements
333 drop :: Monad m => Int -> Stream m a -> Stream m a
334 {-# INLINE_STREAM drop #-}
335 drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n)
336 where
337 {-# INLINE_INNER step' #-}
338 step' (s, Just i) | i > 0 = liftM (\r ->
339 case r of
340 Yield x s' -> Skip (s', Just (i-1))
341 Skip s' -> Skip (s', Just i)
342 Done -> Done
343 ) (step s)
344 | otherwise = return $ Skip (s, Nothing)
345
346 step' (s, Nothing) = liftM (\r ->
347 case r of
348 Yield x s' -> Yield x (s', Nothing)
349 Skip s' -> Skip (s', Nothing)
350 Done -> Done
351 ) (step s)
352
353
354 -- Mapping
355 -- -------
356
357 instance Monad m => Functor (Stream m) where
358 {-# INLINE fmap #-}
359 fmap = map
360
361 -- | Map a function over a 'Stream'
362 map :: Monad m => (a -> b) -> Stream m a -> Stream m b
363 {-# INLINE map #-}
364 map f = mapM (return . f)
365
366
367 -- | Map a monadic function over a 'Stream'
368 mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b
369 {-# INLINE_STREAM mapM #-}
370 mapM f (Stream step s n) = Stream step' s n
371 where
372 {-# INLINE_INNER step' #-}
373 step' s = do
374 r <- step s
375 case r of
376 Yield x s' -> liftM (`Yield` s') (f x)
377 Skip s' -> return (Skip s')
378 Done -> return Done
379
380 -- | Execute a monadic action for each element of the 'Stream'
381 mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()
382 {-# INLINE_STREAM mapM_ #-}
383 mapM_ m (Stream step s _) = mapM_loop SPEC s
384 where
385 mapM_loop SPEC s
386 = do
387 r <- step s
388 case r of
389 Yield x s' -> do { m x; mapM_loop SPEC s' }
390 Skip s' -> mapM_loop SPEC s'
391 Done -> return ()
392
393 -- | Transform a 'Stream' to use a different monad
394 trans :: (Monad m, Monad m') => (forall a. m a -> m' a)
395 -> Stream m a -> Stream m' a
396 {-# INLINE_STREAM trans #-}
397 trans f (Stream step s n) = Stream (f . step) s n
398
399 unbox :: Monad m => Stream m (Box a) -> Stream m a
400 {-# INLINE_STREAM unbox #-}
401 unbox (Stream step s n) = Stream step' s n
402 where
403 {-# INLINE_INNER step' #-}
404 step' s = do
405 r <- step s
406 case r of
407 Yield (Box x) s' -> return $ Yield x s'
408 Skip s' -> return $ Skip s'
409 Done -> return $ Done
410
411 -- Zipping
412 -- -------
413
414 -- | Pair each element in a 'Stream' with its index
415 indexed :: Monad m => Stream m a -> Stream m (Int,a)
416 {-# INLINE_STREAM indexed #-}
417 indexed (Stream step s n) = Stream step' (s,0) n
418 where
419 {-# INLINE_INNER step' #-}
420 step' (s,i) = i `seq`
421 do
422 r <- step s
423 case r of
424 Yield x s' -> return $ Yield (i,x) (s', i+1)
425 Skip s' -> return $ Skip (s', i)
426 Done -> return Done
427
428 -- | Pair each element in a 'Stream' with its index, starting from the right
429 -- and counting down
430 indexedR :: Monad m => Int -> Stream m a -> Stream m (Int,a)
431 {-# INLINE_STREAM indexedR #-}
432 indexedR m (Stream step s n) = Stream step' (s,m) n
433 where
434 {-# INLINE_INNER step' #-}
435 step' (s,i) = i `seq`
436 do
437 r <- step s
438 case r of
439 Yield x s' -> let i' = i-1
440 in
441 return $ Yield (i',x) (s', i')
442 Skip s' -> return $ Skip (s', i)
443 Done -> return Done
444
445 -- | Zip two 'Stream's with the given monadic function
446 zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
447 {-# INLINE_STREAM zipWithM #-}
448 zipWithM f (Stream stepa sa na) (Stream stepb sb nb)
449 = Stream step (sa, sb, Nothing) (smaller na nb)
450 where
451 {-# INLINE_INNER step #-}
452 step (sa, sb, Nothing) = liftM (\r ->
453 case r of
454 Yield x sa' -> Skip (sa', sb, Just x)
455 Skip sa' -> Skip (sa', sb, Nothing)
456 Done -> Done
457 ) (stepa sa)
458
459 step (sa, sb, Just x) = do
460 r <- stepb sb
461 case r of
462 Yield y sb' ->
463 do
464 z <- f x y
465 return $ Yield z (sa, sb', Nothing)
466 Skip sb' -> return $ Skip (sa, sb', Just x)
467 Done -> return $ Done
468
469 -- FIXME: This might expose an opportunity for inplace execution.
470 {-# RULES
471
472 "zipWithM xs xs [Vector.Stream]" forall f xs.
473 zipWithM f xs xs = mapM (\x -> f x x) xs
474
475 #-}
476
477 zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d
478 {-# INLINE_STREAM zipWith3M #-}
479 zipWith3M f (Stream stepa sa na) (Stream stepb sb nb) (Stream stepc sc nc)
480 = Stream step (sa, sb, sc, Nothing) (smaller na (smaller nb nc))
481 where
482 {-# INLINE_INNER step #-}
483 step (sa, sb, sc, Nothing) = do
484 r <- stepa sa
485 return $ case r of
486 Yield x sa' -> Skip (sa', sb, sc, Just (x, Nothing))
487 Skip sa' -> Skip (sa', sb, sc, Nothing)
488 Done -> Done
489
490 step (sa, sb, sc, Just (x, Nothing)) = do
491 r <- stepb sb
492 return $ case r of
493 Yield y sb' -> Skip (sa, sb', sc, Just (x, Just y))
494 Skip sb' -> Skip (sa, sb', sc, Just (x, Nothing))
495 Done -> Done
496
497 step (sa, sb, sc, Just (x, Just y)) = do
498 r <- stepc sc
499 case r of
500 Yield z sc' -> f x y z >>= (\res -> return $ Yield res (sa, sb, sc', Nothing))
501 Skip sc' -> return $ Skip (sa, sb, sc', Just (x, Just y))
502 Done -> return $ Done
503
504 zipWith4M :: Monad m => (a -> b -> c -> d -> m e)
505 -> Stream m a -> Stream m b -> Stream m c -> Stream m d
506 -> Stream m e
507 {-# INLINE zipWith4M #-}
508 zipWith4M f sa sb sc sd
509 = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd)
510
511 zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f)
512 -> Stream m a -> Stream m b -> Stream m c -> Stream m d
513 -> Stream m e -> Stream m f
514 {-# INLINE zipWith5M #-}
515 zipWith5M f sa sb sc sd se
516 = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se)
517
518 zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g)
519 -> Stream m a -> Stream m b -> Stream m c -> Stream m d
520 -> Stream m e -> Stream m f -> Stream m g
521 {-# INLINE zipWith6M #-}
522 zipWith6M fn sa sb sc sd se sf
523 = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc)
524 (zip3 sd se sf)
525
526 zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
527 {-# INLINE zipWith #-}
528 zipWith f = zipWithM (\a b -> return (f a b))
529
530 zipWith3 :: Monad m => (a -> b -> c -> d)
531 -> Stream m a -> Stream m b -> Stream m c -> Stream m d
532 {-# INLINE zipWith3 #-}
533 zipWith3 f = zipWith3M (\a b c -> return (f a b c))
534
535 zipWith4 :: Monad m => (a -> b -> c -> d -> e)
536 -> Stream m a -> Stream m b -> Stream m c -> Stream m d
537 -> Stream m e
538 {-# INLINE zipWith4 #-}
539 zipWith4 f = zipWith4M (\a b c d -> return (f a b c d))
540
541 zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f)
542 -> Stream m a -> Stream m b -> Stream m c -> Stream m d
543 -> Stream m e -> Stream m f
544 {-# INLINE zipWith5 #-}
545 zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e))
546
547 zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g)
548 -> Stream m a -> Stream m b -> Stream m c -> Stream m d
549 -> Stream m e -> Stream m f -> Stream m g
550 {-# INLINE zipWith6 #-}
551 zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f))
552
553 zip :: Monad m => Stream m a -> Stream m b -> Stream m (a,b)
554 {-# INLINE zip #-}
555 zip = zipWith (,)
556
557 zip3 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m (a,b,c)
558 {-# INLINE zip3 #-}
559 zip3 = zipWith3 (,,)
560
561 zip4 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d
562 -> Stream m (a,b,c,d)
563 {-# INLINE zip4 #-}
564 zip4 = zipWith4 (,,,)
565
566 zip5 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d
567 -> Stream m e -> Stream m (a,b,c,d,e)
568 {-# INLINE zip5 #-}
569 zip5 = zipWith5 (,,,,)
570
571 zip6 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d
572 -> Stream m e -> Stream m f -> Stream m (a,b,c,d,e,f)
573 {-# INLINE zip6 #-}
574 zip6 = zipWith6 (,,,,,)
575
576 -- Filtering
577 -- ---------
578
579 -- | Drop elements which do not satisfy the predicate
580 filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
581 {-# INLINE filter #-}
582 filter f = filterM (return . f)
583
584 -- | Drop elements which do not satisfy the monadic predicate
585 filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
586 {-# INLINE_STREAM filterM #-}
587 filterM f (Stream step s n) = Stream step' s (toMax n)
588 where
589 {-# INLINE_INNER step' #-}
590 step' s = do
591 r <- step s
592 case r of
593 Yield x s' -> do
594 b <- f x
595 return $ if b then Yield x s'
596 else Skip s'
597 Skip s' -> return $ Skip s'
598 Done -> return $ Done
599
600 -- | Longest prefix of elements that satisfy the predicate
601 takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
602 {-# INLINE takeWhile #-}
603 takeWhile f = takeWhileM (return . f)
604
605 -- | Longest prefix of elements that satisfy the monadic predicate
606 takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
607 {-# INLINE_STREAM takeWhileM #-}
608 takeWhileM f (Stream step s n) = Stream step' s (toMax n)
609 where
610 {-# INLINE_INNER step' #-}
611 step' s = do
612 r <- step s
613 case r of
614 Yield x s' -> do
615 b <- f x
616 return $ if b then Yield x s' else Done
617 Skip s' -> return $ Skip s'
618 Done -> return $ Done
619
620 -- | Drop the longest prefix of elements that satisfy the predicate
621 dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
622 {-# INLINE dropWhile #-}
623 dropWhile f = dropWhileM (return . f)
624
625 data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s
626
627 -- | Drop the longest prefix of elements that satisfy the monadic predicate
628 dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
629 {-# INLINE_STREAM dropWhileM #-}
630 dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)
631 where
632 -- NOTE: we jump through hoops here to have only one Yield; local data
633 -- declarations would be nice!
634
635 {-# INLINE_INNER step' #-}
636 step' (DropWhile_Drop s)
637 = do
638 r <- step s
639 case r of
640 Yield x s' -> do
641 b <- f x
642 return $ if b then Skip (DropWhile_Drop s')
643 else Skip (DropWhile_Yield x s')
644 Skip s' -> return $ Skip (DropWhile_Drop s')
645 Done -> return $ Done
646
647 step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s)
648
649 step' (DropWhile_Next s)
650 = liftM (\r ->
651 case r of
652 Yield x s' -> Skip (DropWhile_Yield x s')
653 Skip s' -> Skip (DropWhile_Next s')
654 Done -> Done
655 ) (step s)
656
657 -- Searching
658 -- ---------
659
660 infix 4 `elem`
661 -- | Check whether the 'Stream' contains an element
662 elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
663 {-# INLINE_STREAM elem #-}
664 elem x (Stream step s _) = elem_loop SPEC s
665 where
666 elem_loop SPEC s
667 = do
668 r <- step s
669 case r of
670 Yield y s' | x == y -> return True
671 | otherwise -> elem_loop SPEC s'
672 Skip s' -> elem_loop SPEC s'
673 Done -> return False
674
675 infix 4 `notElem`
676 -- | Inverse of `elem`
677 notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
678 {-# INLINE notElem #-}
679 notElem x s = liftM not (elem x s)
680
681 -- | Yield 'Just' the first element that satisfies the predicate or 'Nothing'
682 -- if no such element exists.
683 find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)
684 {-# INLINE find #-}
685 find f = findM (return . f)
686
687 -- | Yield 'Just' the first element that satisfies the monadic predicate or
688 -- 'Nothing' if no such element exists.
689 findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)
690 {-# INLINE_STREAM findM #-}
691 findM f (Stream step s _) = find_loop SPEC s
692 where
693 find_loop SPEC s
694 = do
695 r <- step s
696 case r of
697 Yield x s' -> do
698 b <- f x
699 if b then return $ Just x
700 else find_loop SPEC s'
701 Skip s' -> find_loop SPEC s'
702 Done -> return Nothing
703
704 -- | Yield 'Just' the index of the first element that satisfies the predicate
705 -- or 'Nothing' if no such element exists.
706 findIndex :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe Int)
707 {-# INLINE_STREAM findIndex #-}
708 findIndex f = findIndexM (return . f)
709
710 -- | Yield 'Just' the index of the first element that satisfies the monadic
711 -- predicate or 'Nothing' if no such element exists.
712 findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int)
713 {-# INLINE_STREAM findIndexM #-}
714 findIndexM f (Stream step s _) = findIndex_loop SPEC s 0
715 where
716 findIndex_loop SPEC s i
717 = do
718 r <- step s
719 case r of
720 Yield x s' -> do
721 b <- f x
722 if b then return $ Just i
723 else findIndex_loop SPEC s' (i+1)
724 Skip s' -> findIndex_loop SPEC s' i
725 Done -> return Nothing
726
727 -- Folding
728 -- -------
729
730 -- | Left fold
731 foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
732 {-# INLINE foldl #-}
733 foldl f = foldlM (\a b -> return (f a b))
734
735 -- | Left fold with a monadic operator
736 foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
737 {-# INLINE_STREAM foldlM #-}
738 foldlM m z (Stream step s _) = foldlM_loop SPEC z s
739 where
740 foldlM_loop SPEC z s
741 = do
742 r <- step s
743 case r of
744 Yield x s' -> do { z' <- m z x; foldlM_loop SPEC z' s' }
745 Skip s' -> foldlM_loop SPEC z s'
746 Done -> return z
747
748 -- | Same as 'foldlM'
749 foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
750 {-# INLINE foldM #-}
751 foldM = foldlM
752
753 -- | Left fold over a non-empty 'Stream'
754 foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
755 {-# INLINE foldl1 #-}
756 foldl1 f = foldl1M (\a b -> return (f a b))
757
758 -- | Left fold over a non-empty 'Stream' with a monadic operator
759 foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
760 {-# INLINE_STREAM foldl1M #-}
761 foldl1M f (Stream step s sz) = foldl1M_loop SPEC s
762 where
763 foldl1M_loop SPEC s
764 = do
765 r <- step s
766 case r of
767 Yield x s' -> foldlM f x (Stream step s' (sz - 1))
768 Skip s' -> foldl1M_loop SPEC s'
769 Done -> BOUNDS_ERROR(emptyStream) "foldl1M"
770
771 -- | Same as 'foldl1M'
772 fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
773 {-# INLINE fold1M #-}
774 fold1M = foldl1M
775
776 -- | Left fold with a strict accumulator
777 foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
778 {-# INLINE foldl' #-}
779 foldl' f = foldlM' (\a b -> return (f a b))
780
781 -- | Left fold with a strict accumulator and a monadic operator
782 foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
783 {-# INLINE_STREAM foldlM' #-}
784 foldlM' m z (Stream step s _) = foldlM'_loop SPEC z s
785 where
786 foldlM'_loop SPEC z s
787 = z `seq`
788 do
789 r <- step s
790 case r of
791 Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' }
792 Skip s' -> foldlM'_loop SPEC z s'
793 Done -> return z
794
795 -- | Same as 'foldlM''
796 foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
797 {-# INLINE foldM' #-}
798 foldM' = foldlM'
799
800 -- | Left fold over a non-empty 'Stream' with a strict accumulator
801 foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a
802 {-# INLINE foldl1' #-}
803 foldl1' f = foldl1M' (\a b -> return (f a b))
804
805 -- | Left fold over a non-empty 'Stream' with a strict accumulator and a
806 -- monadic operator
807 foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
808 {-# INLINE_STREAM foldl1M' #-}
809 foldl1M' f (Stream step s sz) = foldl1M'_loop SPEC s
810 where
811 foldl1M'_loop SPEC s
812 = do
813 r <- step s
814 case r of
815 Yield x s' -> foldlM' f x (Stream step s' (sz - 1))
816 Skip s' -> foldl1M'_loop SPEC s'
817 Done -> BOUNDS_ERROR(emptyStream) "foldl1M'"
818
819 -- | Same as 'foldl1M''
820 fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
821 {-# INLINE fold1M' #-}
822 fold1M' = foldl1M'
823
824 -- | Right fold
825 foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b
826 {-# INLINE foldr #-}
827 foldr f = foldrM (\a b -> return (f a b))
828
829 -- | Right fold with a monadic operator
830 foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b
831 {-# INLINE_STREAM foldrM #-}
832 foldrM f z (Stream step s _) = foldrM_loop SPEC s
833 where
834 foldrM_loop SPEC s
835 = do
836 r <- step s
837 case r of
838 Yield x s' -> f x =<< foldrM_loop SPEC s'
839 Skip s' -> foldrM_loop SPEC s'
840 Done -> return z
841
842 -- | Right fold over a non-empty stream
843 foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
844 {-# INLINE foldr1 #-}
845 foldr1 f = foldr1M (\a b -> return (f a b))
846
847 -- | Right fold over a non-empty stream with a monadic operator
848 foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
849 {-# INLINE_STREAM foldr1M #-}
850 foldr1M f (Stream step s _) = foldr1M_loop0 SPEC s
851 where
852 foldr1M_loop0 SPEC s
853 = do
854 r <- step s
855 case r of
856 Yield x s' -> foldr1M_loop1 SPEC x s'
857 Skip s' -> foldr1M_loop0 SPEC s'
858 Done -> BOUNDS_ERROR(emptyStream) "foldr1M"
859
860 foldr1M_loop1 SPEC x s
861 = do
862 r <- step s
863 case r of
864 Yield y s' -> f x =<< foldr1M_loop1 SPEC y s'
865 Skip s' -> foldr1M_loop1 SPEC x s'
866 Done -> return x
867
868 -- Specialised folds
869 -- -----------------
870
871 and :: Monad m => Stream m Bool -> m Bool
872 {-# INLINE_STREAM and #-}
873 and (Stream step s _) = and_loop SPEC s
874 where
875 and_loop SPEC s
876 = do
877 r <- step s
878 case r of
879 Yield False _ -> return False
880 Yield True s' -> and_loop SPEC s'
881 Skip s' -> and_loop SPEC s'
882 Done -> return True
883
884 or :: Monad m => Stream m Bool -> m Bool
885 {-# INLINE_STREAM or #-}
886 or (Stream step s _) = or_loop SPEC s
887 where
888 or_loop SPEC s
889 = do
890 r <- step s
891 case r of
892 Yield False s' -> or_loop SPEC s'
893 Yield True _ -> return True
894 Skip s' -> or_loop SPEC s'
895 Done -> return False
896
897 concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b
898 {-# INLINE concatMap #-}
899 concatMap f = concatMapM (return . f)
900
901 concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b
902 {-# INLINE_STREAM concatMapM #-}
903 concatMapM f (Stream step s _) = Stream concatMap_go (Left s) Unknown
904 where
905 concatMap_go (Left s) = do
906 r <- step s
907 case r of
908 Yield a s' -> do
909 b_stream <- f a
910 return $ Skip (Right (b_stream, s'))
911 Skip s' -> return $ Skip (Left s')
912 Done -> return Done
913 concatMap_go (Right (Stream inner_step inner_s sz, s)) = do
914 r <- inner_step inner_s
915 case r of
916 Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s' sz, s))
917 Skip inner_s' -> return $ Skip (Right (Stream inner_step inner_s' sz, s))
918 Done -> return $ Skip (Left s)
919
920 -- Unfolding
921 -- ---------
922
923 -- | Unfold
924 unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a
925 {-# INLINE_STREAM unfoldr #-}
926 unfoldr f = unfoldrM (return . f)
927
928 -- | Unfold with a monadic function
929 unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a
930 {-# INLINE_STREAM unfoldrM #-}
931 unfoldrM f s = Stream step s Unknown
932 where
933 {-# INLINE_INNER step #-}
934 step s = liftM (\r ->
935 case r of
936 Just (x, s') -> Yield x s'
937 Nothing -> Done
938 ) (f s)
939
940 -- Scans
941 -- -----
942
943 -- | Prefix scan
944 prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
945 {-# INLINE prescanl #-}
946 prescanl f = prescanlM (\a b -> return (f a b))
947
948 -- | Prefix scan with a monadic operator
949 prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
950 {-# INLINE_STREAM prescanlM #-}
951 prescanlM f z (Stream step s sz) = Stream step' (s,z) sz
952 where
953 {-# INLINE_INNER step' #-}
954 step' (s,x) = do
955 r <- step s
956 case r of
957 Yield y s' -> do
958 z <- f x y
959 return $ Yield x (s', z)
960 Skip s' -> return $ Skip (s', x)
961 Done -> return Done
962
963 -- | Prefix scan with strict accumulator
964 prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
965 {-# INLINE prescanl' #-}
966 prescanl' f = prescanlM' (\a b -> return (f a b))
967
968 -- | Prefix scan with strict accumulator and a monadic operator
969 prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
970 {-# INLINE_STREAM prescanlM' #-}
971 prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz
972 where
973 {-# INLINE_INNER step' #-}
974 step' (s,x) = x `seq`
975 do
976 r <- step s
977 case r of
978 Yield y s' -> do
979 z <- f x y
980 return $ Yield x (s', z)
981 Skip s' -> return $ Skip (s', x)
982 Done -> return Done
983
984 -- | Suffix scan
985 postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
986 {-# INLINE postscanl #-}
987 postscanl f = postscanlM (\a b -> return (f a b))
988
989 -- | Suffix scan with a monadic operator
990 postscanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
991 {-# INLINE_STREAM postscanlM #-}
992 postscanlM f z (Stream step s sz) = Stream step' (s,z) sz
993 where
994 {-# INLINE_INNER step' #-}
995 step' (s,x) = do
996 r <- step s
997 case r of
998 Yield y s' -> do
999 z <- f x y
1000 return $ Yield z (s',z)
1001 Skip s' -> return $ Skip (s',x)
1002 Done -> return Done
1003
1004 -- | Suffix scan with strict accumulator
1005 postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
1006 {-# INLINE postscanl' #-}
1007 postscanl' f = postscanlM' (\a b -> return (f a b))
1008
1009 -- | Suffix scan with strict acccumulator and a monadic operator
1010 postscanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
1011 {-# INLINE_STREAM postscanlM' #-}
1012 postscanlM' f z (Stream step s sz) = z `seq` Stream step' (s,z) sz
1013 where
1014 {-# INLINE_INNER step' #-}
1015 step' (s,x) = x `seq`
1016 do
1017 r <- step s
1018 case r of
1019 Yield y s' -> do
1020 z <- f x y
1021 z `seq` return (Yield z (s',z))
1022 Skip s' -> return $ Skip (s',x)
1023 Done -> return Done
1024
1025 -- | Haskell-style scan
1026 scanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
1027 {-# INLINE scanl #-}
1028 scanl f = scanlM (\a b -> return (f a b))
1029
1030 -- | Haskell-style scan with a monadic operator
1031 scanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
1032 {-# INLINE scanlM #-}
1033 scanlM f z s = z `cons` postscanlM f z s
1034
1035 -- | Haskell-style scan with strict accumulator
1036 scanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
1037 {-# INLINE scanl' #-}
1038 scanl' f = scanlM' (\a b -> return (f a b))
1039
1040 -- | Haskell-style scan with strict accumulator and a monadic operator
1041 scanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
1042 {-# INLINE scanlM' #-}
1043 scanlM' f z s = z `seq` (z `cons` postscanlM f z s)
1044
1045 -- | Scan over a non-empty 'Stream'
1046 scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a
1047 {-# INLINE scanl1 #-}
1048 scanl1 f = scanl1M (\x y -> return (f x y))
1049
1050 -- | Scan over a non-empty 'Stream' with a monadic operator
1051 scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a
1052 {-# INLINE_STREAM scanl1M #-}
1053 scanl1M f (Stream step s sz) = Stream step' (s, Nothing) sz
1054 where
1055 {-# INLINE_INNER step' #-}
1056 step' (s, Nothing) = do
1057 r <- step s
1058 case r of
1059 Yield x s' -> return $ Yield x (s', Just x)
1060 Skip s' -> return $ Skip (s', Nothing)
1061 Done -> BOUNDS_ERROR(emptyStream) "scanl1M"
1062
1063 step' (s, Just x) = do
1064 r <- step s
1065 case r of
1066 Yield y s' -> do
1067 z <- f x y
1068 return $ Yield z (s', Just z)
1069 Skip s' -> return $ Skip (s', Just x)
1070 Done -> return Done
1071
1072 -- | Scan over a non-empty 'Stream' with a strict accumulator
1073 scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a
1074 {-# INLINE scanl1' #-}
1075 scanl1' f = scanl1M' (\x y -> return (f x y))
1076
1077 -- | Scan over a non-empty 'Stream' with a strict accumulator and a monadic
1078 -- operator
1079 scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a
1080 {-# INLINE_STREAM scanl1M' #-}
1081 scanl1M' f (Stream step s sz) = Stream step' (s, Nothing) sz
1082 where
1083 {-# INLINE_INNER step' #-}
1084 step' (s, Nothing) = do
1085 r <- step s
1086 case r of
1087 Yield x s' -> x `seq` return (Yield x (s', Just x))
1088 Skip s' -> return $ Skip (s', Nothing)
1089 Done -> BOUNDS_ERROR(emptyStream) "scanl1M"
1090
1091 step' (s, Just x) = x `seq`
1092 do
1093 r <- step s
1094 case r of
1095 Yield y s' -> do
1096 z <- f x y
1097 z `seq` return (Yield z (s', Just z))
1098 Skip s' -> return $ Skip (s', Just x)
1099 Done -> return Done
1100
1101 -- Enumerations
1102 -- ------------
1103
1104 -- The Enum class is broken for this, there just doesn't seem to be a
1105 -- way to implement this generically. We have to specialise for as many types
1106 -- as we can but this doesn't help in polymorphic loops.
1107
1108 -- | Yield a 'Stream' of the given length containing the values @x@, @x+y@,
1109 -- @x+y+y@ etc.
1110 enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a
1111 {-# INLINE_STREAM enumFromStepN #-}
1112 enumFromStepN x y n = n `seq` Stream step (x,n) (Exact (delay_inline max n 0))
1113 where
1114 {-# INLINE_INNER step #-}
1115 step (x,n) | n > 0 = return $ Yield x (x+y,n-1)
1116 | otherwise = return $ Done
1117
1118 -- | Enumerate values
1119 --
1120 -- /WARNING:/ This operation can be very inefficient. If at all possible, use
1121 -- 'enumFromStepN' instead.
1122 enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a
1123 {-# INLINE_STREAM enumFromTo #-}
1124 enumFromTo x y = fromList [x .. y]
1125
1126 -- FIXME: Specialise enumFromTo for Float and Double. Also, try to do
1127 -- something about pairs?
1128
1129 -- NOTE: We use (x+1) instead of (succ x) below because the latter checks for
1130 -- overflow which can't happen here.
1131
1132 -- FIXME: add "too large" test for Int
1133 enumFromTo_small :: (Integral a, Monad m) => a -> a -> Stream m a
1134 {-# INLINE_STREAM enumFromTo_small #-}
1135 enumFromTo_small x y = Stream step x (Exact n)
1136 where
1137 n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0
1138
1139 {-# INLINE_INNER step #-}
1140 step x | x <= y = return $ Yield x (x+1)
1141 | otherwise = return $ Done
1142
1143 {-# RULES
1144
1145 "enumFromTo<Int8> [Stream]"
1146 enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Stream m Int8
1147
1148 "enumFromTo<Int16> [Stream]"
1149 enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Stream m Int16
1150
1151 "enumFromTo<Word8> [Stream]"
1152 enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Stream m Word8
1153
1154 "enumFromTo<Word16> [Stream]"
1155 enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Stream m Word16
1156
1157 #-}
1158
1159 #if WORD_SIZE_IN_BITS > 32
1160
1161 {-# RULES
1162
1163 "enumFromTo<Int32> [Stream]"
1164 enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Stream m Int32
1165
1166 "enumFromTo<Word32> [Stream]"
1167 enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Stream m Word32
1168
1169 #-}
1170
1171 #endif
1172
1173 -- NOTE: We could implement a generic "too large" test:
1174 --
1175 -- len x y | x > y = 0
1176 -- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n
1177 -- | otherwise = error
1178 -- where
1179 -- n = y-x+1
1180 --
1181 -- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for
1182 -- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744
1183 --
1184
1185 enumFromTo_int :: (Integral a, Monad m) => a -> a -> Stream m a
1186 {-# INLINE_STREAM enumFromTo_int #-}
1187 enumFromTo_int x y = Stream step x (Exact (len x y))
1188 where
1189 {-# INLINE [0] len #-}
1190 len x y | x > y = 0
1191 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
1192 (n > 0)
1193 $ fromIntegral n
1194 where
1195 n = y-x+1
1196
1197 {-# INLINE_INNER step #-}
1198 step x | x <= y = return $ Yield x (x+1)
1199 | otherwise = return $ Done
1200
1201 {-# RULES
1202
1203 "enumFromTo<Int> [Stream]"
1204 enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Stream m Int
1205
1206 #if WORD_SIZE_IN_BITS > 32
1207
1208 "enumFromTo<Int64> [Stream]"
1209 enumFromTo = enumFromTo_int :: Monad m => Int64 -> Int64 -> Stream m Int64
1210
1211 #else
1212
1213 "enumFromTo<Int32> [Stream]"
1214 enumFromTo = enumFromTo_int :: Monad m => Int32 -> Int32 -> Stream m Int32
1215
1216 #endif
1217
1218 #-}
1219
1220 enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a
1221 {-# INLINE_STREAM enumFromTo_big_word #-}
1222 enumFromTo_big_word x y = Stream step x (Exact (len x y))
1223 where
1224 {-# INLINE [0] len #-}
1225 len x y | x > y = 0
1226 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
1227 (n < fromIntegral (maxBound :: Int))
1228 $ fromIntegral (n+1)
1229 where
1230 n = y-x
1231
1232 {-# INLINE_INNER step #-}
1233 step x | x <= y = return $ Yield x (x+1)
1234 | otherwise = return $ Done
1235
1236 {-# RULES
1237
1238 "enumFromTo<Word> [Stream]"
1239 enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Stream m Word
1240
1241 "enumFromTo<Word64> [Stream]"
1242 enumFromTo = enumFromTo_big_word
1243 :: Monad m => Word64 -> Word64 -> Stream m Word64
1244
1245 #if WORD_SIZE_IN_BITS == 32
1246
1247 "enumFromTo<Word32> [Stream]"
1248 enumFromTo = enumFromTo_big_word
1249 :: Monad m => Word32 -> Word32 -> Stream m Word32
1250
1251 #endif
1252
1253 "enumFromTo<Integer> [Stream]"
1254 enumFromTo = enumFromTo_big_word
1255 :: Monad m => Integer -> Integer -> Stream m Integer
1256
1257 #-}
1258
1259 -- FIXME: the "too large" test is totally wrong
1260 enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a
1261 {-# INLINE_STREAM enumFromTo_big_int #-}
1262 enumFromTo_big_int x y = Stream step x (Exact (len x y))
1263 where
1264 {-# INLINE [0] len #-}
1265 len x y | x > y = 0
1266 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
1267 (n > 0 && n <= fromIntegral (maxBound :: Int))
1268 $ fromIntegral n
1269 where
1270 n = y-x+1
1271
1272 {-# INLINE_INNER step #-}
1273 step x | x <= y = return $ Yield x (x+1)
1274 | otherwise = return $ Done
1275
1276 #if WORD_SIZE_IN_BITS > 32
1277
1278 {-# RULES
1279
1280 "enumFromTo<Int64> [Stream]"
1281 enumFromTo = enumFromTo_big :: Monad m => Int64 -> Int64 -> Stream m Int64
1282
1283 #-}
1284
1285 #endif
1286
1287 enumFromTo_char :: Monad m => Char -> Char -> Stream m Char
1288 {-# INLINE_STREAM enumFromTo_char #-}
1289 enumFromTo_char x y = Stream step xn (Exact n)
1290 where
1291 xn = ord x
1292 yn = ord y
1293
1294 n = delay_inline max 0 (yn - xn + 1)
1295
1296 {-# INLINE_INNER step #-}
1297 step xn | xn <= yn = return $ Yield (unsafeChr xn) (xn+1)
1298 | otherwise = return $ Done
1299
1300 {-# RULES
1301
1302 "enumFromTo<Char> [Stream]"
1303 enumFromTo = enumFromTo_char
1304
1305 #-}
1306
1307 -- | Enumerate values with a given step.
1308 --
1309 -- /WARNING:/ This operation is very inefficient. If at all possible, use
1310 -- 'enumFromStepN' instead.
1311 enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Stream m a
1312 {-# INLINE_STREAM enumFromThenTo #-}
1313 enumFromThenTo x y z = fromList [x, y .. z]
1314
1315 -- FIXME: Specialise enumFromThenTo.
1316
1317 -- Conversions
1318 -- -----------
1319
1320 -- | Convert a 'Stream' to a list
1321 toList :: Monad m => Stream m a -> m [a]
1322 {-# INLINE toList #-}
1323 toList = foldr (:) []
1324
1325 -- | Convert a list to a 'Stream'
1326 fromList :: Monad m => [a] -> Stream m a
1327 {-# INLINE_STREAM fromList #-}
1328 fromList xs = Stream step xs Unknown
1329 where
1330 step (x:xs) = return (Yield x xs)
1331 step [] = return Done
1332