module Data.Vector.Fusion.Stream.Monadic (
Stream(..), Step(..),
size, sized,
length, null,
empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++),
head, last, (!!), (!?),
slice, init, tail, take, drop,
map, mapM, mapM_, trans, unbox, concatMap, flatten,
indexed, indexedR, zipWithM_,
zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M,
zipWith, zipWith3, zipWith4, zipWith5, zipWith6,
zip, zip3, zip4, zip5, zip6,
filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,
elem, notElem, find, findM, findIndex, findIndexM,
foldl, foldlM, foldl1, foldl1M, foldM, fold1M,
foldl', foldlM', foldl1', foldl1M', foldM', fold1M',
foldr, foldrM, foldr1, foldr1M,
and, or, concatMapM,
unfoldr, unfoldrM,
unfoldrN, unfoldrNM,
iterateN, iterateNM,
prescanl, prescanlM, prescanl', prescanlM',
postscanl, postscanlM, postscanl', postscanlM',
scanl, scanlM, scanl', scanlM',
scanl1, scanl1M, scanl1', scanl1M',
enumFromStepN, enumFromTo, enumFromThenTo,
toList, fromList, fromListN, unsafeFromList
) where
import Data.Vector.Fusion.Stream.Size
import Data.Vector.Fusion.Util ( Box(..), delay_inline )
import Data.Char ( ord )
import GHC.Base ( unsafeChr )
import Control.Monad ( liftM )
import Prelude hiding ( length, null,
replicate, (++),
head, last, (!!),
init, tail, take, drop,
map, mapM, mapM_, concatMap,
zipWith, zipWith3, zip, zip3,
filter, takeWhile, dropWhile,
elem, notElem,
foldl, foldl1, foldr, foldr1,
and, or,
scanl, scanl1,
enumFromTo, enumFromThenTo )
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Word ( Word8, Word16, Word32, Word, Word64 )
#if __GLASGOW_HASKELL__ >= 700
import GHC.Exts ( SpecConstrAnnotation(..) )
#endif
#include "vector.h"
data SPEC = SPEC | SPEC2
#if __GLASGOW_HASKELL__ >= 700
#endif
emptyStream :: String
emptyStream = "empty stream"
#define EMPTY_STREAM (\s -> ERROR s emptyStream)
data Step s a = Yield a s
| Skip s
| Done
data Stream m a = forall s. Stream (s -> m (Step s a)) s Size
size :: Stream m a -> Size
size (Stream _ _ sz) = sz
sized :: Stream m a -> Size -> Stream m a
sized (Stream step s _) sz = Stream step s sz
length :: Monad m => Stream m a -> m Int
length s = foldl' (\n _ -> n+1) 0 s
null :: Monad m => Stream m a -> m Bool
null s = foldr (\_ _ -> False) True s
empty :: Monad m => Stream m a
empty = Stream (const (return Done)) () (Exact 0)
singleton :: Monad m => a -> Stream m a
singleton x = Stream (return . step) True (Exact 1)
where
step True = Yield x False
step False = Done
replicate :: Monad m => Int -> a -> Stream m a
replicate n x = replicateM n (return x)
replicateM :: Monad m => Int -> m a -> Stream m a
replicateM n p = Stream step n (Exact (delay_inline max n 0))
where
step i | i <= 0 = return Done
| otherwise = do { x <- p; return $ Yield x (i1) }
generate :: Monad m => Int -> (Int -> a) -> Stream m a
generate n f = generateM n (return . f)
generateM :: Monad m => Int -> (Int -> m a) -> Stream m a
generateM n f = n `seq` Stream step 0 (Exact (delay_inline max n 0))
where
step i | i < n = do
x <- f i
return $ Yield x (i+1)
| otherwise = return Done
cons :: Monad m => a -> Stream m a -> Stream m a
cons x s = singleton x ++ s
snoc :: Monad m => Stream m a -> a -> Stream m a
snoc s x = s ++ singleton x
infixr 5 ++
(++) :: Monad m => Stream m a -> Stream m a -> Stream m a
Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)
where
step (Left sa) = do
r <- stepa sa
case r of
Yield x sa' -> return $ Yield x (Left sa')
Skip sa' -> return $ Skip (Left sa')
Done -> return $ Skip (Right sb)
step (Right sb) = do
r <- stepb sb
case r of
Yield x sb' -> return $ Yield x (Right sb')
Skip sb' -> return $ Skip (Right sb')
Done -> return $ Done
head :: Monad m => Stream m a -> m a
head (Stream step s _) = head_loop SPEC s
where
head_loop !sPEC s
= do
r <- step s
case r of
Yield x _ -> return x
Skip s' -> head_loop SPEC s'
Done -> EMPTY_STREAM "head"
last :: Monad m => Stream m a -> m a
last (Stream step s _) = last_loop0 SPEC s
where
last_loop0 !sPEC s
= do
r <- step s
case r of
Yield x s' -> last_loop1 SPEC x s'
Skip s' -> last_loop0 SPEC s'
Done -> EMPTY_STREAM "last"
last_loop1 !sPEC x s
= do
r <- step s
case r of
Yield y s' -> last_loop1 SPEC y s'
Skip s' -> last_loop1 SPEC x s'
Done -> return x
infixl 9 !!
(!!) :: Monad m => Stream m a -> Int -> m a
Stream step s _ !! i | i < 0 = ERROR "!!" "negative index"
| otherwise = index_loop SPEC s i
where
index_loop !sPEC s i
= i `seq`
do
r <- step s
case r of
Yield x s' | i == 0 -> return x
| otherwise -> index_loop SPEC s' (i1)
Skip s' -> index_loop SPEC s' i
Done -> EMPTY_STREAM "!!"
infixl 9 !?
(!?) :: Monad m => Stream m a -> Int -> m (Maybe a)
Stream step s _ !? i = index_loop SPEC s i
where
index_loop !sPEC s i
= i `seq`
do
r <- step s
case r of
Yield x s' | i == 0 -> return (Just x)
| otherwise -> index_loop SPEC s' (i1)
Skip s' -> index_loop SPEC s' i
Done -> return Nothing
slice :: Monad m => Int
-> Int
-> Stream m a
-> Stream m a
slice i n s = take n (drop i s)
init :: Monad m => Stream m a -> Stream m a
init (Stream step s sz) = Stream step' (Nothing, s) (sz 1)
where
step' (Nothing, s) = liftM (\r ->
case r of
Yield x s' -> Skip (Just x, s')
Skip s' -> Skip (Nothing, s')
Done -> EMPTY_STREAM "init"
) (step s)
step' (Just x, s) = liftM (\r ->
case r of
Yield y s' -> Yield x (Just y, s')
Skip s' -> Skip (Just x, s')
Done -> Done
) (step s)
tail :: Monad m => Stream m a -> Stream m a
tail (Stream step s sz) = Stream step' (Left s) (sz 1)
where
step' (Left s) = liftM (\r ->
case r of
Yield x s' -> Skip (Right s')
Skip s' -> Skip (Left s')
Done -> EMPTY_STREAM "tail"
) (step s)
step' (Right s) = liftM (\r ->
case r of
Yield x s' -> Yield x (Right s')
Skip s' -> Skip (Right s')
Done -> Done
) (step s)
take :: Monad m => Int -> Stream m a -> Stream m a
take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)
where
step' (s, i) | i < n = liftM (\r ->
case r of
Yield x s' -> Yield x (s', i+1)
Skip s' -> Skip (s', i)
Done -> Done
) (step s)
step' (s, i) = return Done
drop :: Monad m => Int -> Stream m a -> Stream m a
drop n (Stream step s sz) = Stream step' (s, Just n) (sz Exact n)
where
step' (s, Just i) | i > 0 = liftM (\r ->
case r of
Yield x s' -> Skip (s', Just (i1))
Skip s' -> Skip (s', Just i)
Done -> Done
) (step s)
| otherwise = return $ Skip (s, Nothing)
step' (s, Nothing) = liftM (\r ->
case r of
Yield x s' -> Yield x (s', Nothing)
Skip s' -> Skip (s', Nothing)
Done -> Done
) (step s)
instance Monad m => Functor (Stream m) where
fmap = map
map :: Monad m => (a -> b) -> Stream m a -> Stream m b
map f = mapM (return . f)
mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b
mapM f (Stream step s n) = Stream step' s n
where
step' s = do
r <- step s
case r of
Yield x s' -> liftM (`Yield` s') (f x)
Skip s' -> return (Skip s')
Done -> return Done
consume :: Monad m => Stream m a -> m ()
consume (Stream step s _) = consume_loop SPEC s
where
consume_loop !sPEC s
= do
r <- step s
case r of
Yield _ s' -> consume_loop SPEC s'
Skip s' -> consume_loop SPEC s'
Done -> return ()
mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()
mapM_ m = consume . mapM m
trans :: (Monad m, Monad m') => (forall a. m a -> m' a)
-> Stream m a -> Stream m' a
trans f (Stream step s n) = Stream (f . step) s n
unbox :: Monad m => Stream m (Box a) -> Stream m a
unbox (Stream step s n) = Stream step' s n
where
step' s = do
r <- step s
case r of
Yield (Box x) s' -> return $ Yield x s'
Skip s' -> return $ Skip s'
Done -> return $ Done
indexed :: Monad m => Stream m a -> Stream m (Int,a)
indexed (Stream step s n) = Stream step' (s,0) n
where
step' (s,i) = i `seq`
do
r <- step s
case r of
Yield x s' -> return $ Yield (i,x) (s', i+1)
Skip s' -> return $ Skip (s', i)
Done -> return Done
indexedR :: Monad m => Int -> Stream m a -> Stream m (Int,a)
indexedR m (Stream step s n) = Stream step' (s,m) n
where
step' (s,i) = i `seq`
do
r <- step s
case r of
Yield x s' -> let i' = i1
in
return $ Yield (i',x) (s', i')
Skip s' -> return $ Skip (s', i)
Done -> return Done
zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
zipWithM f (Stream stepa sa na) (Stream stepb sb nb)
= Stream step (sa, sb, Nothing) (smaller na nb)
where
step (sa, sb, Nothing) = liftM (\r ->
case r of
Yield x sa' -> Skip (sa', sb, Just x)
Skip sa' -> Skip (sa', sb, Nothing)
Done -> Done
) (stepa sa)
step (sa, sb, Just x) = do
r <- stepb sb
case r of
Yield y sb' ->
do
z <- f x y
return $ Yield z (sa, sb', Nothing)
Skip sb' -> return $ Skip (sa, sb', Just x)
Done -> return $ Done
zipWithM_ :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> m ()
zipWithM_ f sa sb = consume (zipWithM f sa sb)
zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d
zipWith3M f (Stream stepa sa na) (Stream stepb sb nb) (Stream stepc sc nc)
= Stream step (sa, sb, sc, Nothing) (smaller na (smaller nb nc))
where
step (sa, sb, sc, Nothing) = do
r <- stepa sa
return $ case r of
Yield x sa' -> Skip (sa', sb, sc, Just (x, Nothing))
Skip sa' -> Skip (sa', sb, sc, Nothing)
Done -> Done
step (sa, sb, sc, Just (x, Nothing)) = do
r <- stepb sb
return $ case r of
Yield y sb' -> Skip (sa, sb', sc, Just (x, Just y))
Skip sb' -> Skip (sa, sb', sc, Just (x, Nothing))
Done -> Done
step (sa, sb, sc, Just (x, Just y)) = do
r <- stepc sc
case r of
Yield z sc' -> f x y z >>= (\res -> return $ Yield res (sa, sb, sc', Nothing))
Skip sc' -> return $ Skip (sa, sb, sc', Just (x, Just y))
Done -> return $ Done
zipWith4M :: Monad m => (a -> b -> c -> d -> m e)
-> Stream m a -> Stream m b -> Stream m c -> Stream m d
-> Stream m e
zipWith4M f sa sb sc sd
= zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd)
zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f)
-> Stream m a -> Stream m b -> Stream m c -> Stream m d
-> Stream m e -> Stream m f
zipWith5M f sa sb sc sd se
= zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se)
zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g)
-> Stream m a -> Stream m b -> Stream m c -> Stream m d
-> Stream m e -> Stream m f -> Stream m g
zipWith6M fn sa sb sc sd se sf
= zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc)
(zip3 sd se sf)
zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
zipWith f = zipWithM (\a b -> return (f a b))
zipWith3 :: Monad m => (a -> b -> c -> d)
-> Stream m a -> Stream m b -> Stream m c -> Stream m d
zipWith3 f = zipWith3M (\a b c -> return (f a b c))
zipWith4 :: Monad m => (a -> b -> c -> d -> e)
-> Stream m a -> Stream m b -> Stream m c -> Stream m d
-> Stream m e
zipWith4 f = zipWith4M (\a b c d -> return (f a b c d))
zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f)
-> Stream m a -> Stream m b -> Stream m c -> Stream m d
-> Stream m e -> Stream m f
zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e))
zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g)
-> Stream m a -> Stream m b -> Stream m c -> Stream m d
-> Stream m e -> Stream m f -> Stream m g
zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f))
zip :: Monad m => Stream m a -> Stream m b -> Stream m (a,b)
zip = zipWith (,)
zip3 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m (a,b,c)
zip3 = zipWith3 (,,)
zip4 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d
-> Stream m (a,b,c,d)
zip4 = zipWith4 (,,,)
zip5 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d
-> Stream m e -> Stream m (a,b,c,d,e)
zip5 = zipWith5 (,,,,)
zip6 :: Monad m => Stream m a -> Stream m b -> Stream m c -> Stream m d
-> Stream m e -> Stream m f -> Stream m (a,b,c,d,e,f)
zip6 = zipWith6 (,,,,,)
filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
filter f = filterM (return . f)
filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
filterM f (Stream step s n) = Stream step' s (toMax n)
where
step' s = do
r <- step s
case r of
Yield x s' -> do
b <- f x
return $ if b then Yield x s'
else Skip s'
Skip s' -> return $ Skip s'
Done -> return $ Done
takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
takeWhile f = takeWhileM (return . f)
takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
takeWhileM f (Stream step s n) = Stream step' s (toMax n)
where
step' s = do
r <- step s
case r of
Yield x s' -> do
b <- f x
return $ if b then Yield x s' else Done
Skip s' -> return $ Skip s'
Done -> return $ Done
dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a
dropWhile f = dropWhileM (return . f)
data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s
dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a
dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)
where
step' (DropWhile_Drop s)
= do
r <- step s
case r of
Yield x s' -> do
b <- f x
return $ if b then Skip (DropWhile_Drop s')
else Skip (DropWhile_Yield x s')
Skip s' -> return $ Skip (DropWhile_Drop s')
Done -> return $ Done
step' (DropWhile_Yield x s) = return $ Yield x (DropWhile_Next s)
step' (DropWhile_Next s)
= liftM (\r ->
case r of
Yield x s' -> Skip (DropWhile_Yield x s')
Skip s' -> Skip (DropWhile_Next s')
Done -> Done
) (step s)
infix 4 `elem`
elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
elem x (Stream step s _) = elem_loop SPEC s
where
elem_loop !sPEC s
= do
r <- step s
case r of
Yield y s' | x == y -> return True
| otherwise -> elem_loop SPEC s'
Skip s' -> elem_loop SPEC s'
Done -> return False
infix 4 `notElem`
notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool
notElem x s = liftM not (elem x s)
find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)
find f = findM (return . f)
findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)
findM f (Stream step s _) = find_loop SPEC s
where
find_loop !sPEC s
= do
r <- step s
case r of
Yield x s' -> do
b <- f x
if b then return $ Just x
else find_loop SPEC s'
Skip s' -> find_loop SPEC s'
Done -> return Nothing
findIndex :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe Int)
findIndex f = findIndexM (return . f)
findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int)
findIndexM f (Stream step s _) = findIndex_loop SPEC s 0
where
findIndex_loop !sPEC s i
= do
r <- step s
case r of
Yield x s' -> do
b <- f x
if b then return $ Just i
else findIndex_loop SPEC s' (i+1)
Skip s' -> findIndex_loop SPEC s' i
Done -> return Nothing
foldl :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
foldl f = foldlM (\a b -> return (f a b))
foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
foldlM m z (Stream step s _) = foldlM_loop SPEC z s
where
foldlM_loop !sPEC z s
= do
r <- step s
case r of
Yield x s' -> do { z' <- m z x; foldlM_loop SPEC z' s' }
Skip s' -> foldlM_loop SPEC z s'
Done -> return z
foldM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
foldM = foldlM
foldl1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
foldl1 f = foldl1M (\a b -> return (f a b))
foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
foldl1M f (Stream step s sz) = foldl1M_loop SPEC s
where
foldl1M_loop !sPEC s
= do
r <- step s
case r of
Yield x s' -> foldlM f x (Stream step s' (sz 1))
Skip s' -> foldl1M_loop SPEC s'
Done -> EMPTY_STREAM "foldl1M"
fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
fold1M = foldl1M
foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
foldl' f = foldlM' (\a b -> return (f a b))
foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
foldlM' m z (Stream step s _) = foldlM'_loop SPEC z s
where
foldlM'_loop !sPEC z s
= z `seq`
do
r <- step s
case r of
Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' }
Skip s' -> foldlM'_loop SPEC z s'
Done -> return z
foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
foldM' = foldlM'
foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a
foldl1' f = foldl1M' (\a b -> return (f a b))
foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
foldl1M' f (Stream step s sz) = foldl1M'_loop SPEC s
where
foldl1M'_loop !sPEC s
= do
r <- step s
case r of
Yield x s' -> foldlM' f x (Stream step s' (sz 1))
Skip s' -> foldl1M'_loop SPEC s'
Done -> EMPTY_STREAM "foldl1M'"
fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a
fold1M' = foldl1M'
foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b
foldr f = foldrM (\a b -> return (f a b))
foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b
foldrM f z (Stream step s _) = foldrM_loop SPEC s
where
foldrM_loop !sPEC s
= do
r <- step s
case r of
Yield x s' -> f x =<< foldrM_loop SPEC s'
Skip s' -> foldrM_loop SPEC s'
Done -> return z
foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m a
foldr1 f = foldr1M (\a b -> return (f a b))
foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a
foldr1M f (Stream step s _) = foldr1M_loop0 SPEC s
where
foldr1M_loop0 !sPEC s
= do
r <- step s
case r of
Yield x s' -> foldr1M_loop1 SPEC x s'
Skip s' -> foldr1M_loop0 SPEC s'
Done -> EMPTY_STREAM "foldr1M"
foldr1M_loop1 !sPEC x s
= do
r <- step s
case r of
Yield y s' -> f x =<< foldr1M_loop1 SPEC y s'
Skip s' -> foldr1M_loop1 SPEC x s'
Done -> return x
and :: Monad m => Stream m Bool -> m Bool
and (Stream step s _) = and_loop SPEC s
where
and_loop !sPEC s
= do
r <- step s
case r of
Yield False _ -> return False
Yield True s' -> and_loop SPEC s'
Skip s' -> and_loop SPEC s'
Done -> return True
or :: Monad m => Stream m Bool -> m Bool
or (Stream step s _) = or_loop SPEC s
where
or_loop !sPEC s
= do
r <- step s
case r of
Yield False s' -> or_loop SPEC s'
Yield True _ -> return True
Skip s' -> or_loop SPEC s'
Done -> return False
concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b
concatMap f = concatMapM (return . f)
concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b
concatMapM f (Stream step s _) = Stream concatMap_go (Left s) Unknown
where
concatMap_go (Left s) = do
r <- step s
case r of
Yield a s' -> do
b_stream <- f a
return $ Skip (Right (b_stream, s'))
Skip s' -> return $ Skip (Left s')
Done -> return Done
concatMap_go (Right (Stream inner_step inner_s sz, s)) = do
r <- inner_step inner_s
case r of
Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s' sz, s))
Skip inner_s' -> return $ Skip (Right (Stream inner_step inner_s' sz, s))
Done -> return $ Skip (Left s)
flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size
-> Stream m a -> Stream m b
flatten mk istep sz (Stream ostep t _) = Stream step (Left t) sz
where
step (Left t) = do
r <- ostep t
case r of
Yield a t' -> do
s <- mk a
s `seq` return (Skip (Right (s,t')))
Skip t' -> return $ Skip (Left t')
Done -> return $ Done
step (Right (s,t)) = do
r <- istep s
case r of
Yield x s' -> return $ Yield x (Right (s',t))
Skip s' -> return $ Skip (Right (s',t))
Done -> return $ Skip (Left t)
unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a
unfoldr f = unfoldrM (return . f)
unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a
unfoldrM f s = Stream step s Unknown
where
step s = liftM (\r ->
case r of
Just (x, s') -> Yield x s'
Nothing -> Done
) (f s)
unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a
unfoldrN n f = unfoldrNM n (return . f)
unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Stream m a
unfoldrNM n f s = Stream step (s,n) (Max (delay_inline max n 0))
where
step (s,n) | n <= 0 = return Done
| otherwise = liftM (\r ->
case r of
Just (x,s') -> Yield x (s',n1)
Nothing -> Done
) (f s)
iterateNM :: Monad m => Int -> (a -> m a) -> a -> Stream m a
iterateNM n f x0 = Stream step (x0,n) (Exact (delay_inline max n 0))
where
step (x,i) | i <= 0 = return Done
| i == n = return $ Yield x (x,i1)
| otherwise = do a <- f x
return $ Yield a (a,i1)
iterateN :: Monad m => Int -> (a -> a) -> a -> Stream m a
iterateN n f x0 = iterateNM n (return . f) x0
prescanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
prescanl f = prescanlM (\a b -> return (f a b))
prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
prescanlM f z (Stream step s sz) = Stream step' (s,z) sz
where
step' (s,x) = do
r <- step s
case r of
Yield y s' -> do
z <- f x y
return $ Yield x (s', z)
Skip s' -> return $ Skip (s', x)
Done -> return Done
prescanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
prescanl' f = prescanlM' (\a b -> return (f a b))
prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz
where
step' (s,x) = x `seq`
do
r <- step s
case r of
Yield y s' -> do
z <- f x y
return $ Yield x (s', z)
Skip s' -> return $ Skip (s', x)
Done -> return Done
postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
postscanl f = postscanlM (\a b -> return (f a b))
postscanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
postscanlM f z (Stream step s sz) = Stream step' (s,z) sz
where
step' (s,x) = do
r <- step s
case r of
Yield y s' -> do
z <- f x y
return $ Yield z (s',z)
Skip s' -> return $ Skip (s',x)
Done -> return Done
postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
postscanl' f = postscanlM' (\a b -> return (f a b))
postscanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
postscanlM' f z (Stream step s sz) = z `seq` Stream step' (s,z) sz
where
step' (s,x) = x `seq`
do
r <- step s
case r of
Yield y s' -> do
z <- f x y
z `seq` return (Yield z (s',z))
Skip s' -> return $ Skip (s',x)
Done -> return Done
scanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
scanl f = scanlM (\a b -> return (f a b))
scanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
scanlM f z s = z `cons` postscanlM f z s
scanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a
scanl' f = scanlM' (\a b -> return (f a b))
scanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a
scanlM' f z s = z `seq` (z `cons` postscanlM f z s)
scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a
scanl1 f = scanl1M (\x y -> return (f x y))
scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a
scanl1M f (Stream step s sz) = Stream step' (s, Nothing) sz
where
step' (s, Nothing) = do
r <- step s
case r of
Yield x s' -> return $ Yield x (s', Just x)
Skip s' -> return $ Skip (s', Nothing)
Done -> EMPTY_STREAM "scanl1M"
step' (s, Just x) = do
r <- step s
case r of
Yield y s' -> do
z <- f x y
return $ Yield z (s', Just z)
Skip s' -> return $ Skip (s', Just x)
Done -> return Done
scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a
scanl1' f = scanl1M' (\x y -> return (f x y))
scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a
scanl1M' f (Stream step s sz) = Stream step' (s, Nothing) sz
where
step' (s, Nothing) = do
r <- step s
case r of
Yield x s' -> x `seq` return (Yield x (s', Just x))
Skip s' -> return $ Skip (s', Nothing)
Done -> EMPTY_STREAM "scanl1M"
step' (s, Just x) = x `seq`
do
r <- step s
case r of
Yield y s' -> do
z <- f x y
z `seq` return (Yield z (s', Just z))
Skip s' -> return $ Skip (s', Just x)
Done -> return Done
enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a
enumFromStepN x y n = x `seq` y `seq` n `seq`
Stream step (x,n) (Exact (delay_inline max n 0))
where
step (x,n) | n > 0 = return $ Yield x (x+y,n1)
| otherwise = return $ Done
enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a
enumFromTo x y = fromList [x .. y]
enumFromTo_small :: (Integral a, Monad m) => a -> a -> Stream m a
enumFromTo_small x y = x `seq` y `seq` Stream step x (Exact n)
where
n = delay_inline max (fromIntegral y fromIntegral x + 1) 0
step x | x <= y = return $ Yield x (x+1)
| otherwise = return $ Done
#if WORD_SIZE_IN_BITS > 32
#endif
enumFromTo_int :: (Integral a, Monad m) => a -> a -> Stream m a
enumFromTo_int x y = x `seq` y `seq` Stream step x (Exact (len x y))
where
len x y | x > y = 0
| otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
(n > 0)
$ fromIntegral n
where
n = yx+1
step x | x <= y = return $ Yield x (x+1)
| otherwise = return $ Done
enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a
enumFromTo_big_word x y = x `seq` y `seq` Stream step x (Exact (len x y))
where
len x y | x > y = 0
| otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
(n < fromIntegral (maxBound :: Int))
$ fromIntegral (n+1)
where
n = yx
step x | x <= y = return $ Yield x (x+1)
| otherwise = return $ Done
enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a
enumFromTo_big_int x y = x `seq` y `seq` Stream step x (Exact (len x y))
where
len x y | x > y = 0
| otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
(n > 0 && n <= fromIntegral (maxBound :: Int))
$ fromIntegral n
where
n = yx+1
step x | x <= y = return $ Yield x (x+1)
| otherwise = return $ Done
#if WORD_SIZE_IN_BITS > 32
#endif
enumFromTo_char :: Monad m => Char -> Char -> Stream m Char
enumFromTo_char x y = x `seq` y `seq` Stream step xn (Exact n)
where
xn = ord x
yn = ord y
n = delay_inline max 0 (yn xn + 1)
step xn | xn <= yn = return $ Yield (unsafeChr xn) (xn+1)
| otherwise = return $ Done
enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Stream m a
enumFromTo_double n m = n `seq` m `seq` Stream step n (Max (len n m))
where
lim = m + 1/2
len x y | x > y = 0
| otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"
(n > 0)
$ fromIntegral n
where
n = truncate (yx)+2
step x | x <= lim = return $ Yield x (x+1)
| otherwise = return $ Done
enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Stream m a
enumFromThenTo x y z = fromList [x, y .. z]
toList :: Monad m => Stream m a -> m [a]
toList = foldr (:) []
fromList :: Monad m => [a] -> Stream m a
fromList xs = unsafeFromList Unknown xs
fromListN :: Monad m => Int -> [a] -> Stream m a
fromListN n xs = Stream step (xs,n) (Max (delay_inline max n 0))
where
step (xs,n) | n <= 0 = return Done
step (x:xs,n) = return (Yield x (xs,n1))
step ([],n) = return Done
unsafeFromList :: Monad m => Size -> [a] -> Stream m a
unsafeFromList sz xs = Stream step xs sz
where
step (x:xs) = return (Yield x xs)
step [] = return Done