#include "phases.h"
module Data.Vector.Stream (
Step(..), Stream(..),
size, sized,
length, null,
empty, singleton, cons, snoc, replicate, (++),
head, last, (!!),
extract, init, tail, take, drop,
map, zipWith,
filter, takeWhile, dropWhile,
elem, notElem, find, findIndex,
foldl, foldl1, foldl', foldl1', foldr, foldr1,
unfold,
toList, fromList,
mapM_, foldM
) where
import Data.Vector.Stream.Size
import Prelude hiding ( length, null,
replicate, (++),
head, last, (!!),
init, tail, take, drop,
map, zipWith,
filter, takeWhile, dropWhile,
elem, notElem,
foldl, foldl1, foldr, foldr1,
mapM_ )
data Step s a = Yield a s
| Skip s
| Done
data Stream a = forall s. Stream (s -> Step s a) s Size
size :: Stream a -> Size
size (Stream _ _ sz) = sz
sized :: Stream a -> Size -> Stream a
sized (Stream step s _) sz = Stream step s sz
unfold :: (s -> Maybe (a, s)) -> s -> Stream a
unfold f s = Stream step s Unknown
where
step s = case f s of
Just (x, s') -> Yield x s'
Nothing -> Done
toList :: Stream a -> [a]
toList s = foldr (:) [] s
fromList :: [a] -> Stream a
fromList xs = Stream step xs Unknown
where
step (x:xs) = Yield x xs
step [] = Done
length :: Stream a -> Int
length s = foldl' (\n _ -> n+1) 0 s
null :: Stream a -> Bool
null s = foldr (\_ _ -> False) True s
empty :: Stream a
empty = Stream (const Done) () (Exact 0)
singleton :: a -> Stream a
singleton x = Stream step True (Exact 1)
where
step True = Yield x False
step False = Done
replicate :: Int -> a -> Stream a
replicate n x = Stream step n (Exact (max n 0))
where
step i | i > 0 = Yield x (i1)
| otherwise = Done
cons :: a -> Stream a -> Stream a
cons x s = singleton x ++ s
snoc :: Stream a -> a -> Stream a
snoc s x = s ++ singleton x
infixr 5 ++
(++) :: Stream a -> Stream a -> Stream a
Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)
where
step (Left sa) = case stepa sa of
Yield x sa' -> Yield x (Left sa')
Skip sa' -> Skip (Left sa')
Done -> Skip (Right sb)
step (Right sb) = case stepb sb of
Yield x sb' -> Yield x (Right sb')
Skip sb' -> Skip (Right sb')
Done -> Done
head :: Stream a -> a
head (Stream step s _) = head_loop s
where
head_loop s = case step s of
Yield x _ -> x
Skip s' -> head_loop s'
Done -> error "Data.Vector.Stream.head: empty stream"
last :: Stream a -> a
last (Stream step s _) = last_loop0 s
where
last_loop0 s = case step s of
Yield x s' -> last_loop1 x s'
Skip s' -> last_loop0 s'
Done -> error "Data.Vector.Stream.last: empty stream"
last_loop1 x s = case step s of
Yield y s' -> last_loop1 y s'
Skip s' -> last_loop1 x s'
Done -> x
(!!) :: Stream a -> Int -> a
s !! i = head (drop i s)
extract :: Stream a -> Int
-> Int
-> Stream a
extract s i n = take n (drop i s)
init :: Stream a -> Stream a
init (Stream step s sz) = Stream step' (Nothing, s) (sz 1)
where
step' (Nothing, s) = case step s of
Yield x s' -> Skip (Just x, s')
Skip s' -> Skip (Nothing, s')
Done -> Done
step' (Just x, s) = case step s of
Yield y s' -> Yield x (Just y, s')
Skip s' -> Skip (Just x, s')
Done -> Done
tail :: Stream a -> Stream a
tail (Stream step s sz) = Stream step' (Left s) (sz 1)
where
step' (Left s) = case step s of
Yield x s' -> Skip (Right s')
Skip s' -> Skip (Left s')
Done -> Done
step' (Right s) = case step s of
Yield x s' -> Yield x (Right s')
Skip s' -> Skip (Right s')
Done -> Done
take :: Int -> Stream a -> Stream a
take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)
where
step' (s, i) | i < n = case step s of
Yield x s' -> Yield x (s', i+1)
Skip s' -> Skip (s', i)
Done -> Done
step' (s, i) = Done
data Drop s = Drop_Drop s Int | Drop_Keep s
drop :: Int -> Stream a -> Stream a
drop n (Stream step s sz) = Stream step' (Drop_Drop s 0) (sz Exact n)
where
step' (Drop_Drop s i) | i < n = case step s of
Yield x s' -> Skip (Drop_Drop s' (i+1))
Skip s' -> Skip (Drop_Drop s' i)
Done -> Done
| otherwise = Skip (Drop_Keep s)
step' (Drop_Keep s) = case step s of
Yield x s' -> Yield x (Drop_Keep s')
Skip s' -> Skip (Drop_Keep s')
Done -> Done
instance Functor Stream where
fmap = map
map :: (a -> b) -> Stream a -> Stream b
map f (Stream step s n) = Stream step' s n
where
step' s = case step s of
Yield x s' -> Yield (f x) s'
Skip s' -> Skip s'
Done -> Done
zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c
zipWith f (Stream stepa sa na) (Stream stepb sb nb)
= Stream step (sa, sb, Nothing) (smaller na nb)
where
step (sa, sb, Nothing) = case stepa sa of
Yield x sa' -> Skip (sa', sb, Just x)
Skip sa' -> Skip (sa', sb, Nothing)
Done -> Done
step (sa, sb, Just x) = case stepb sb of
Yield y sb' -> Yield (f x y) (sa, sb', Nothing)
Skip sb' -> Skip (sa, sb', Just x)
Done -> Done
filter :: (a -> Bool) -> Stream a -> Stream a
filter f (Stream step s n) = Stream step' s (toMax n)
where
step' s = case step s of
Yield x s' | f x -> Yield x s'
| otherwise -> Skip s'
Skip s' -> Skip s'
Done -> Done
takeWhile :: (a -> Bool) -> Stream a -> Stream a
takeWhile f (Stream step s n) = Stream step' s (toMax n)
where
step' s = case step s of
Yield x s' | f x -> Yield x s'
| otherwise -> Done
Skip s' -> Skip s'
Done -> Done
data DropWhile s a = DropWhile_Drop s | DropWhile_Yield a s | DropWhile_Next s
dropWhile :: (a -> Bool) -> Stream a -> Stream a
dropWhile f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n)
where
step' (DropWhile_Drop s)
= case step s of
Yield x s' | f x -> Skip (DropWhile_Drop s')
| otherwise -> Skip (DropWhile_Yield x s')
Skip s' -> Skip (DropWhile_Drop s')
Done -> Done
step' (DropWhile_Yield x s) = Yield x (DropWhile_Next s)
step' (DropWhile_Next s) = case step s of
Yield x s' -> Skip (DropWhile_Yield x s')
Skip s' -> Skip (DropWhile_Next s')
Done -> Done
infix 4 `elem`
elem :: Eq a => a -> Stream a -> Bool
elem x (Stream step s _) = elem_loop s
where
elem_loop s = case step s of
Yield y s' | x == y -> True
| otherwise -> elem_loop s'
Skip s' -> elem_loop s'
Done -> False
infix 4 `notElem`
notElem :: Eq a => a -> Stream a -> Bool
notElem x = not . elem x
find :: (a -> Bool) -> Stream a -> Maybe a
find f (Stream step s _) = find_loop s
where
find_loop s = case step s of
Yield x s' | f x -> Just x
| otherwise -> find_loop s'
Skip s' -> find_loop s'
Done -> Nothing
findIndex :: (a -> Bool) -> Stream a -> Maybe Int
findIndex f (Stream step s _) = findIndex_loop s 0
where
findIndex_loop s i = case step s of
Yield x s' | f x -> Just i
| otherwise -> findIndex_loop s' (i+1)
Skip s' -> findIndex_loop s' i
Done -> Nothing
foldl :: (a -> b -> a) -> a -> Stream b -> a
foldl f z (Stream step s _) = foldl_go z s
where
foldl_go z s = case step s of
Yield x s' -> foldl_go (f z x) s'
Skip s' -> foldl_go z s'
Done -> z
foldl1 :: (a -> a -> a) -> Stream a -> a
foldl1 f (Stream step s sz) = foldl1_loop s
where
foldl1_loop s = case step s of
Yield x s' -> foldl f x (Stream step s' (sz 1))
Skip s' -> foldl1_loop s'
Done -> error "Data.Vector.Stream.foldl1: empty stream"
foldl' :: (a -> b -> a) -> a -> Stream b -> a
foldl' f z (Stream step s _) = foldl_go z s
where
foldl_go z s = z `seq`
case step s of
Yield x s' -> foldl_go (f z x) s'
Skip s' -> foldl_go z s'
Done -> z
foldl1' :: (a -> a -> a) -> Stream a -> a
foldl1' f (Stream step s sz) = foldl1'_loop s
where
foldl1'_loop s = case step s of
Yield x s' -> foldl' f x (Stream step s' (sz 1))
Skip s' -> foldl1'_loop s'
Done -> error "Data.Vector.Stream.foldl1': empty stream"
foldr :: (a -> b -> b) -> b -> Stream a -> b
foldr f z (Stream step s _) = foldr_go s
where
foldr_go s = case step s of
Yield x s' -> f x (foldr_go s')
Skip s' -> foldr_go s'
Done -> z
foldr1 :: (a -> a -> a) -> Stream a -> a
foldr1 f (Stream step s sz) = foldr1_loop s
where
foldr1_loop s = case step s of
Yield x s' -> foldr f x (Stream step s' (sz 1))
Skip s' -> foldr1_loop s'
Done -> error "Data.Vector.Stream.foldr1: empty stream"
eq :: Eq a => Stream a -> Stream a -> Bool
eq (Stream step1 s1 _) (Stream step2 s2 _) = eq_loop0 s1 s2
where
eq_loop0 s1 s2 = case step1 s1 of
Yield x s1' -> eq_loop1 x s1' s2
Skip s1' -> eq_loop0 s1' s2
Done -> null (Stream step2 s2 Unknown)
eq_loop1 x s1 s2 = case step2 s2 of
Yield y s2' -> x == y && eq_loop0 s1 s2'
Skip s2' -> eq_loop1 x s1 s2'
Done -> False
cmp :: Ord a => Stream a -> Stream a -> Ordering
cmp (Stream step1 s1 _) (Stream step2 s2 _) = cmp_loop0 s1 s2
where
cmp_loop0 s1 s2 = case step1 s1 of
Yield x s1' -> cmp_loop1 x s1' s2
Skip s1' -> cmp_loop0 s1' s2
Done -> if null (Stream step2 s2 Unknown)
then EQ else LT
cmp_loop1 x s1 s2 = case step2 s2 of
Yield y s2' -> case x `compare` y of
EQ -> cmp_loop0 s1 s2'
c -> c
Skip s2' -> cmp_loop1 x s1 s2'
Done -> GT
instance Eq a => Eq (Stream a) where
(==) = eq
instance Ord a => Ord (Stream a) where
compare = cmp
mapM_ :: Monad m => (a -> m ()) -> Stream a -> m ()
mapM_ m (Stream step s _) = mapM_go s
where
mapM_go s = case step s of
Yield x s' -> do { m x; mapM_go s' }
Skip s' -> mapM_go s'
Done -> return ()
foldM :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a
foldM m z (Stream step s _) = foldM_go z s
where
foldM_go z s = case step s of
Yield x s' -> do { z' <- m z x; foldM_go z' s' }
Skip s' -> foldM_go z s'
Done -> return z