module Data.Stream (
#ifndef __HADDOCK__
Stream(Stream),
Step(..),
stream,
unstream,
L(L),
append,
append1,
cons,
snoc,
head,
last,
tail,
init,
null,
length,
map,
intersperse,
foldl,
foldl',
foldl1,
foldl1',
foldr,
foldr1,
concat,
concatMap,
and,
or,
any,
all,
sum,
product,
maximum,
minimum,
strictMaximum,
strictMinimum,
scanl,
scanl1,
iterate,
repeat,
replicate,
cycle,
unfoldr,
take,
drop,
splitAt,
takeWhile,
dropWhile,
isPrefixOf,
elem,
lookup,
find,
filter,
index,
findIndex,
elemIndex,
elemIndices,
findIndices,
zip,
zip3,
zip4,
zipWith,
zipWith3,
zipWith4,
unzip,
insertBy,
maximumBy,
minimumBy,
genericLength,
genericTake,
genericDrop,
genericIndex,
genericSplitAt,
enumFromToInt,
enumFromToChar,
enumDeltaInteger,
foldM,
foldM_,
return,
guard,
bind,
mapFilter,
declare
#endif
) where
#ifndef __HADDOCK__
#ifndef EXTERNAL_PACKAGE
import GHC.Err (error)
import GHC.Num (Num(..),Integer)
import GHC.Real (Integral(..))
import GHC.Base (Int, Char, Eq(..), Ord(..), Functor(..), Bool(..), (&&),
Ordering(..),
(||),(&&), ($),
seq, otherwise, ord, chr,
Monad((>>=), (>>)),
String, (++))
import qualified GHC.Base as Monad (Monad(return))
import Data.Tuple ()
#else
import Prelude (
error,
Num(..),
Integral(..),
Integer,
Int, Char, Eq(..), Ord(..), Functor(..), Ordering(..), Bool(..),
(&&), (||), ($),
seq, otherwise,
Monad((>>=)),
String, (++))
import qualified Prelude as Monad (Monad(return))
import Data.Char (ord,chr)
#endif
import qualified Data.Maybe (Maybe(..))
data Stream a = forall s. Unlifted s =>
Stream !(s -> Step a s)
!s
data Step a s = Yield a !s
| Skip !s
| Done
instance Functor Stream where fmap = map
class Unlifted a where
expose :: a -> b -> b
expose = seq
unlifted_dummy :: a
unlifted_dummy = error "unlifted_dummy"
data None = None
instance Unlifted None
data Switch = S1 | S2
instance Unlifted Switch
data (Unlifted a, Unlifted b) => a :!: b = !a :!: !b
instance (Unlifted a, Unlifted b) => Unlifted (a :!: b) where
expose (a :!: b) s = expose a (expose b s)
data Unlifted a => Maybe a = Nothing | Just !a
instance Unlifted a => Unlifted (Maybe a) where
expose (Just a) s = expose a s
expose Nothing s = s
data (Unlifted a, Unlifted b) => Either a b = Left !a | Right !b
instance (Unlifted a, Unlifted b) => Unlifted (Either a b) where
expose (Left a) s = expose a s
expose (Right b) s = expose b s
instance Unlifted (Stream a) where
expose (Stream next s0) s = seq next (seq s0 s)
data L a = L a
newtype S a = S a
instance Unlifted (L a) where
expose (L _) s = s
instance Unlifted (S a) where
expose (S a) s = seq a s
stream :: [a] -> Stream a
stream xs0 = Stream next (L xs0)
where
next (L []) = Done
next (L (x:xs)) = Yield x (L xs)
unstream :: Stream a -> [a]
unstream (Stream next s0) = unfold_unstream s0
where
unfold_unstream !s = case next s of
Done -> []
Skip s' -> expose s' $ unfold_unstream s'
Yield x s' -> expose s' $ x : unfold_unstream s'
append :: Stream a -> Stream a -> Stream a
append (Stream next0 s01) (Stream next1 s02) = Stream next (Left s01)
where
next (Left s1) = case next0 s1 of
Done -> Skip (Right s02)
Skip s1' -> Skip (Left s1')
Yield x s1' -> Yield x (Left s1')
next (Right s2) = case next1 s2 of
Done -> Done
Skip s2' -> Skip (Right s2')
Yield x s2' -> Yield x (Right s2')
append1 :: Stream a -> [a] -> [a]
append1 (Stream next s0) xs = loop_append1 s0
where
loop_append1 !s = case next s of
Done -> xs
Skip s' -> expose s' loop_append1 s'
Yield x s' -> expose s' $ x : loop_append1 s'
snoc :: Stream a -> a -> Stream a
snoc (Stream next0 xs0) w = Stream next (Just xs0)
where
next (Just xs) = case next0 xs of
Done -> Yield w Nothing
Skip xs' -> Skip (Just xs')
Yield x xs' -> Yield x (Just xs')
next Nothing = Done
cons :: a -> Stream a -> Stream a
cons w (Stream next0 s0) = Stream next (S2 :!: s0)
where
next (S2 :!: s) = Yield w (S1 :!: s)
next (S1 :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (S1 :!: s')
Yield x s' -> Yield x (S1 :!: s')
head :: Stream a -> a
head (Stream next s0) = loop_head s0
where
loop_head !s = case next s of
Yield x _ -> x
Skip s' -> expose s' $ loop_head s'
Done -> errorEmptyStream "head"
last :: Stream a -> a
last (Stream next s0) = loop0_last s0
where
loop0_last !s = case next s of
Done -> errorEmptyStream "last"
Skip s' -> expose s' $ loop0_last s'
Yield x s' -> expose s' $ loop_last x s'
loop_last x !s = case next s of
Done -> x
Skip s' -> expose s' $ loop_last x s'
Yield x' s' -> expose s' $ loop_last x' s'
tail :: Stream a -> Stream a
tail (Stream next0 s0) = Stream next (S1 :!: s0)
where
next (S1 :!: s) = case next0 s of
Done -> errorEmptyStream "tail"
Skip s' -> Skip (S1 :!: s')
Yield _ s' -> Skip (S2 :!: s')
next (S2 :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (S2 :!: s')
Yield x s' -> Yield x (S2 :!: s')
init :: Stream a -> Stream a
init (Stream next0 s0) = Stream next (Nothing :!: s0)
where
next (Nothing :!: s) = case next0 s of
Done -> errorEmptyStream "init"
Skip s' -> Skip (Nothing :!: s')
Yield x s' -> Skip (Just (L x) :!: s')
next (Just (L x) :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (Just (L x) :!: s')
Yield x' s' -> Yield x (Just (L x') :!: s')
null :: Stream a -> Bool
null (Stream next s0) = loop_null s0
where
loop_null !s = case next s of
Done -> True
Yield _ _ -> False
Skip s' -> expose s' $ loop_null s'
length :: Stream a -> Int
length (Stream next s0) = loop_length (0::Int) s0
where
loop_length !z !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_length z s'
Yield _ s' -> expose s' $ loop_length (z+1) s'
map :: (a -> b) -> Stream a -> Stream b
map f (Stream next0 s0) = Stream next s0
where
next !s = case next0 s of
Done -> Done
Skip s' -> Skip s'
Yield x s' -> Yield (f x) s'
intersperse :: a -> Stream a -> Stream a
intersperse sep (Stream next0 s0) = Stream next (s0 :!: Nothing :!: S1)
where
next (s :!: Nothing :!: S1) = case next0 s of
Done -> Done
Skip s' -> Skip (s' :!: Nothing :!: S1)
Yield x s' -> Skip (s' :!: Just (L x) :!: S1)
next (s :!: Just (L x) :!: S1) = Yield x (s :!: Nothing :!: S2)
next (s :!: Nothing :!: S2) = case next0 s of
Done -> Done
Skip s' -> Skip (s' :!: Nothing :!: S2)
Yield x s' -> Yield sep (s' :!: Just (L x) :!: S1)
foldl :: (b -> a -> b) -> b -> Stream a -> b
foldl f z0 (Stream next s0) = loop_foldl z0 s0
where
loop_foldl z !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_foldl z s'
Yield x s' -> expose s' $ loop_foldl (f z x) s'
foldl' :: (b -> a -> b) -> b -> Stream a -> b
foldl' f z0 (Stream next s0) = loop_foldl' z0 s0
where
loop_foldl' !z !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_foldl' z s'
Yield x s' -> expose s' $ loop_foldl' (f z x) s'
foldl1 :: (a -> a -> a) -> Stream a -> a
foldl1 f (Stream next s0) = loop0_foldl1 s0
where
loop0_foldl1 !s = case next s of
Skip s' -> expose s' $ loop0_foldl1 s'
Yield x s' -> expose s' $ loop_foldl1 x s'
Done -> errorEmptyStream "foldl1"
loop_foldl1 z !s = expose s $ case next s of
Done -> z
Skip s' -> expose s' $ loop_foldl1 z s'
Yield x s' -> expose s' $ loop_foldl1 (f z x) s'
foldl1' :: (a -> a -> a) -> Stream a -> a
foldl1' f (Stream next s0) = loop0_foldl1' s0
where
loop0_foldl1' !s = case next s of
Skip s' -> expose s' $ loop0_foldl1' s'
Yield x s' -> expose s' $ loop_foldl1' x s'
Done -> errorEmptyStream "foldl1"
loop_foldl1' !z !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_foldl1' z s'
Yield x s' -> expose s' $ loop_foldl1' (f z x) s'
foldr :: (a -> b -> b) -> b -> Stream a -> b
foldr f z (Stream next s0) = loop_foldr s0
where
loop_foldr !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_foldr s'
Yield x s' -> expose s' $ f x (loop_foldr s')
foldr1 :: (a -> a -> a) -> Stream a -> a
foldr1 f (Stream next s0) = loop0_foldr1 s0
where
loop0_foldr1 !s = case next s of
Done -> errorEmptyStream "foldr1"
Skip s' -> expose s' $ loop0_foldr1 s'
Yield x s' -> expose s' $ loop_foldr1 x s'
loop_foldr1 x !s = case next s of
Done -> x
Skip s' -> expose s' $ loop_foldr1 x s'
Yield x' s' -> expose s' $ f x (loop_foldr1 x' s')
concat :: Stream [a] -> [a]
concat (Stream next s0) = loop_concat_to s0
where
loop_concat_go [] !s = expose s $ loop_concat_to s
loop_concat_go (x:xs) !s = expose s $ x : loop_concat_go xs s
loop_concat_to !s = case next s of
Done -> []
Skip s' -> expose s' $ loop_concat_to s'
Yield xs s' -> expose s' $ loop_concat_go xs s'
concatMap :: (a -> Stream b) -> Stream a -> Stream b
concatMap f (Stream next0 s0) = Stream next (s0 :!: Nothing)
where
next (s :!: Nothing) = case next0 s of
Done -> Done
Skip s' -> Skip (s' :!: Nothing)
Yield x s' -> Skip (s' :!: Just (f x))
next (s :!: Just (Stream g t)) = case g t of
Done -> Skip (s :!: Nothing)
Skip t' -> Skip (s :!: Just (Stream g t'))
Yield x t' -> Yield x (s :!: Just (Stream g t'))
and :: Stream Bool -> Bool
and = foldr (&&) True
or :: Stream Bool -> Bool
or = foldr (||) False
any :: (a -> Bool) -> Stream a -> Bool
any p (Stream next s0) = loop_any s0
where
loop_any !s = case next s of
Done -> False
Skip s' -> expose s' $ loop_any s'
Yield x s' | p x -> True
| otherwise -> expose s' $ loop_any s'
all :: (a -> Bool) -> Stream a -> Bool
all p (Stream next s0) = loop_all s0
where
loop_all !s = case next s of
Done -> True
Skip s' -> expose s' $ loop_all s'
Yield x s' | p x -> expose s' $ loop_all s'
| otherwise -> False
sum :: Num a => Stream a -> a
sum (Stream next s0) = loop_sum 0 s0
where
loop_sum !a !s = case next s of
Done -> a
Skip s' -> expose s' $ loop_sum a s'
Yield x s' -> expose s' $ loop_sum (a + x) s'
product :: Num a => Stream a -> a
product (Stream next s0) = loop_product 1 s0
where
loop_product !a !s = case next s of
Done -> a
Skip s' -> expose s' $ loop_product a s'
Yield x s' -> expose s' $ loop_product (a * x) s'
maximum :: Ord a => Stream a -> a
maximum (Stream next s0) = loop0_maximum s0
where
loop0_maximum !s = case next s of
Done -> errorEmptyStream "maximum"
Skip s' -> expose s' $ loop0_maximum s'
Yield x s' -> expose s' $ loop_maximum x s'
loop_maximum z !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_maximum z s'
Yield x s' -> expose s' $ loop_maximum (max z x) s'
strictMaximum :: Ord a => Stream a -> a
strictMaximum (Stream next s0) = loop0_strictMaximum s0
where
loop0_strictMaximum !s = case next s of
Done -> errorEmptyStream "maximum"
Skip s' -> expose s' $ loop0_strictMaximum s'
Yield x s' -> expose s' $ loop_strictMaximum x s'
loop_strictMaximum !z !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_strictMaximum z s'
Yield x s' -> expose s' $ loop_strictMaximum (max z x) s'
minimum :: Ord a => Stream a -> a
minimum (Stream next s0) = loop0_minimum s0
where
loop0_minimum !s = case next s of
Done -> errorEmptyStream "minimum"
Skip s' -> expose s' $ loop0_minimum s'
Yield x s' -> expose s' $ loop_minimum x s'
loop_minimum z !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_minimum z s'
Yield x s' -> expose s' $ loop_minimum (min z x) s'
strictMinimum :: Ord a => Stream a -> a
strictMinimum (Stream next s0) = loop0_strictMinimum s0
where
loop0_strictMinimum !s = case next s of
Done -> errorEmptyStream "minimum"
Skip s' -> expose s' $ loop0_strictMinimum s'
Yield x s' -> expose s' $ loop_strictMinimum x s'
loop_strictMinimum !z !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_strictMinimum z s'
Yield x s' -> expose s' $ loop_strictMinimum (min z x) s'
scanl :: (b -> a -> b) -> b -> Stream a -> Stream b
scanl f z0 (Stream next0 s0) = Stream next (L z0 :!: s0)
where
next (L z :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (L z :!: s')
Yield x s' -> Yield z (L (f z x) :!: s')
scanl1 :: (a -> a -> a) -> Stream a -> Stream a
scanl1 f (Stream next0 s0) = Stream next (Nothing :!: s0)
where
next (Nothing :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (Nothing :!: s')
Yield x s' -> Skip (Just (L x) :!: s')
next (Just (L z) :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (Just (L z) :!: s')
Yield x s' -> Yield z (Just (L (f z x)) :!: s')
iterate :: (a -> a) -> a -> Stream a
iterate f x0 = Stream next (L x0)
where
next (L x) = Yield x (L (f x))
repeat :: a -> Stream a
repeat x = Stream next None
where
next _ = Yield x None
replicate :: Int -> a -> Stream a
replicate n x = Stream next (L n)
where
next (L !i) | i <= 0 = Done
| otherwise = Yield x (L (i1))
cycle :: Stream a -> Stream a
cycle (Stream next0 s0) = Stream next (s0 :!: S1)
where
next (s :!: S1) = case next0 s of
Done -> errorEmptyStream "cycle"
Skip s' -> Skip (s' :!: S1)
Yield x s' -> Yield x (s' :!: S2)
next (s :!: S2) = case next0 s of
Done -> Skip (s0 :!: S2)
Skip s' -> Skip (s' :!: S2)
Yield x s' -> Yield x (s' :!: S2)
unfoldr :: (b -> Data.Maybe.Maybe (a, b)) -> b -> Stream a
unfoldr f s0 = Stream next (L s0)
where
next (L s) = case f s of
Data.Maybe.Nothing -> Done
Data.Maybe.Just (w, s') -> Yield w (L s')
take :: Int -> Stream a -> Stream a
take n0 (Stream next0 s0) = Stream next (L n0 :!: s0)
where
next (L !n :!: s)
| n <= 0 = Done
| otherwise = case next0 s of
Done -> Done
Skip s' -> Skip (L n :!: s')
Yield x s' -> Yield x (L (n1) :!: s')
drop :: Int -> Stream a -> Stream a
drop n0 (Stream next0 s0) = Stream next (Just (L (max 0 n0)) :!: s0)
where
next (Just (L !n) :!: s)
| n == 0 = Skip (Nothing :!: s)
| otherwise = case next0 s of
Done -> Done
Skip s' -> Skip (Just (L n) :!: s')
Yield _ s' -> Skip (Just (L (n1)) :!: s')
next (Nothing :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (Nothing :!: s')
Yield x s' -> Yield x (Nothing :!: s')
splitAt :: Int -> Stream a -> ([a], [a])
splitAt n0 (Stream next s0)
| n0 < 0 = ([], expose s0 $ unstream (Stream next s0))
| otherwise = loop_splitAt n0 s0
where
loop_splitAt 0 !s = ([], expose s $ unstream (Stream next s))
loop_splitAt !n !s = case next s of
Done -> ([], [])
Skip s' -> expose s $ loop_splitAt n s'
Yield x s' -> (x:xs', xs'')
where
(xs', xs'') = expose s $ loop_splitAt (n1) s'
takeWhile :: (a -> Bool) -> Stream a -> Stream a
takeWhile p (Stream next0 s0) = Stream next s0
where
next !s = case next0 s of
Done -> Done
Skip s' -> Skip s'
Yield x s' | p x -> Yield x s'
| otherwise -> Done
dropWhile :: (a -> Bool) -> Stream a -> Stream a
dropWhile p (Stream next0 s0) = Stream next (S1 :!: s0)
where
next (S1 :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (S1 :!: s')
Yield x s' | p x -> Skip (S1 :!: s')
| otherwise -> Yield x (S2 :!: s')
next (S2 :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (S2 :!: s')
Yield x s' -> Yield x (S2 :!: s')
isPrefixOf :: Eq a => Stream a -> Stream a -> Bool
isPrefixOf (Stream stepa sa0) (Stream stepb sb0) = loop_isPrefixOf sa0 sb0 Nothing
where
loop_isPrefixOf !sa !sb Nothing = case stepa sa of
Done -> True
Skip sa' -> expose sa' $ loop_isPrefixOf sa' sb Nothing
Yield x sa' -> expose sa' $ loop_isPrefixOf sa' sb (Just (L x))
loop_isPrefixOf !sa !sb (Just (L x)) = case stepb sb of
Done -> False
Skip sb' -> expose sb' $ loop_isPrefixOf sa sb' (Just (L x))
Yield y sb' | x == y -> expose sb' $ loop_isPrefixOf sa sb' Nothing
| otherwise -> False
elem :: Eq a => a -> Stream a -> Bool
elem x (Stream next s0) = loop_elem s0
where
loop_elem !s = case next s of
Done -> False
Skip s' -> expose s' $ loop_elem s'
Yield y s'
| x == y -> True
| otherwise -> expose s' $ loop_elem s'
lookup :: Eq a => a -> Stream (a, b) -> Data.Maybe.Maybe b
lookup key (Stream next s0) = loop_lookup s0
where
loop_lookup !s = case next s of
Done -> Data.Maybe.Nothing
Skip s' -> expose s' $ loop_lookup s'
Yield (x, y) s' | key == x -> Data.Maybe.Just y
| otherwise -> expose s' $ loop_lookup s'
find :: (a -> Bool) -> Stream a -> Data.Maybe.Maybe a
find p (Stream next s0) = loop_find s0
where
loop_find !s = case next s of
Done -> Data.Maybe.Nothing
Skip s' -> expose s' $ loop_find s'
Yield x s' | p x -> Data.Maybe.Just x
| otherwise -> expose s' $ loop_find s'
filter :: (a -> Bool) -> Stream a -> Stream a
filter p (Stream next0 s0) = Stream next s0
where
next !s = case next0 s of
Done -> Done
Skip s' -> Skip s'
Yield x s' | p x -> Yield x s'
| otherwise -> Skip s'
index :: Stream a -> Int -> a
index (Stream next s0) n0
| n0 < 0 = error "Stream.(!!): negative index"
| otherwise = loop_index n0 s0
where
loop_index !n !s = case next s of
Done -> error "Stream.(!!): index too large"
Skip s' -> expose s' $ loop_index n s'
Yield x s' | n == 0 -> x
| otherwise -> expose s' $ loop_index (n1) s'
findIndex :: (a -> Bool) -> Stream a -> Data.Maybe.Maybe Int
findIndex p (Stream next s0) = loop_findIndex 0 s0
where
loop_findIndex !i !s = case next s of
Done -> Data.Maybe.Nothing
Skip s' -> expose s' $ loop_findIndex i s'
Yield x s' | p x -> Data.Maybe.Just i
| otherwise -> expose s' $ loop_findIndex (i+1) s'
elemIndex :: Eq a => a -> Stream a -> Data.Maybe.Maybe Int
elemIndex a (Stream next s0) = loop_elemIndex 0 s0
where
loop_elemIndex !i !s = case next s of
Done -> Data.Maybe.Nothing
Skip s' -> expose s' $ loop_elemIndex i s'
Yield x s' | a == x -> Data.Maybe.Just i
| otherwise -> expose s' $ loop_elemIndex (i+1) s'
elemIndices :: Eq a => a -> Stream a -> Stream Int
elemIndices a (Stream next0 s0) = Stream next (S 0 :!: s0)
where
next (S n :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (S n :!: s')
Yield x s' | x == a -> Yield n (S (n+1) :!: s')
| otherwise -> Skip (S (n+1) :!: s')
findIndices :: (a -> Bool) -> Stream a -> Stream Int
findIndices p (Stream next0 s0) = Stream next (S 0 :!: s0)
where
next (S n :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (S n :!: s')
Yield x s' | p x -> Yield n (S (n+1) :!: s')
| otherwise -> Skip (S (n+1) :!: s')
zip :: Stream a -> Stream b -> Stream (a, b)
zip = zipWith (,)
zip3 :: Stream a -> Stream b -> Stream c -> Stream (a, b, c)
zip3 = zipWith3 (,,)
zip4 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream (a, b, c, d)
zip4 = zipWith4 (,,,)
zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c
zipWith f (Stream next0 sa0) (Stream next1 sb0) = Stream next (sa0 :!: sb0 :!: Nothing)
where
next (sa :!: sb :!: Nothing) = case next0 sa of
Done -> Done
Skip sa' -> Skip (sa' :!: sb :!: Nothing)
Yield a sa' -> Skip (sa' :!: sb :!: Just (L a))
next (sa' :!: sb :!: Just (L a)) = case next1 sb of
Done -> Done
Skip sb' -> Skip (sa' :!: sb' :!: Just (L a))
Yield b sb' -> Yield (f a b) (sa' :!: sb' :!: Nothing)
zipWith3 :: (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d
zipWith3 f (Stream nexta sa0)
(Stream nextb sb0)
(Stream nextc sc0) = Stream next (sa0 :!: sb0 :!: sc0 :!: Nothing)
where
next (sa :!: sb :!: sc :!: Nothing) = case nexta sa of
Done -> Done
Skip sa' -> Skip (sa' :!: sb :!: sc :!: Nothing)
Yield a sa' -> Skip (sa' :!: sb :!: sc :!: Just (L a :!: Nothing))
next (sa' :!: sb :!: sc :!: Just (L a :!: Nothing)) = case nextb sb of
Done -> Done
Skip sb' -> Skip (sa' :!: sb' :!: sc :!: Just (L a :!: Nothing))
Yield b sb' -> Skip (sa' :!: sb' :!: sc :!: Just (L a :!: Just (L b)))
next (sa' :!: sb' :!: sc :!: Just (L a :!: Just (L b))) = case nextc sc of
Done -> Done
Skip sc' -> Skip (sa' :!: sb' :!: sc' :!: Just (L a :!: Just (L b)))
Yield c sc' -> Yield (f a b c) (sa' :!: sb' :!: sc' :!: Nothing)
zipWith4 :: (a -> b -> c -> d -> e) -> Stream a -> Stream b -> Stream c -> Stream d -> Stream e
zipWith4 f (Stream nexta sa0)
(Stream nextb sb0)
(Stream nextc sc0)
(Stream nextd sd0) = Stream next (sa0 :!: sb0 :!: sc0 :!: sd0 :!: Nothing)
where
next (sa :!: sb :!: sc :!: sd :!: Nothing) =
case nexta sa of
Done -> Done
Skip sa' -> Skip (sa' :!: sb :!: sc :!: sd :!: Nothing)
Yield a sa' -> Skip (sa' :!: sb :!: sc :!: sd :!: Just (L a :!: Nothing))
next (sa' :!: sb :!: sc :!: sd :!: Just (L a :!: Nothing)) =
case nextb sb of
Done -> Done
Skip sb' -> Skip (sa' :!: sb' :!: sc :!: sd :!: Just (L a :!: Nothing))
Yield b sb' -> Skip (sa' :!: sb' :!: sc :!: sd :!: Just (L a :!: Just (L b :!: Nothing)))
next (sa' :!: sb' :!: sc :!: sd :!: Just (L a :!: (Just (L b :!: Nothing)))) =
case nextc sc of
Done -> Done
Skip sc' -> Skip (sa' :!: sb' :!: sc' :!: sd :!: Just (L a :!: (Just (L b :!: Nothing))))
Yield c sc' -> Skip (sa' :!: sb' :!: sc' :!: sd :!: Just (L a :!: (Just (L b :!: Just (L c)))))
next (sa' :!: sb' :!: sc' :!: sd :!: Just (L a :!: (Just (L b :!: Just (L c))))) =
case nextd sd of
Done -> Done
Skip sd' -> Skip (sa' :!: sb' :!: sc' :!: sd' :!: Just (L a :!: (Just (L b :!: Just (L c)))))
Yield d sd' -> Yield (f a b c d) (sa' :!: sb' :!: sc' :!: sd' :!: Nothing)
unzip :: Stream (a, b) -> ([a], [b])
unzip = foldr (\(a,b) ~(as, bs) -> (a:as, b:bs)) ([], [])
insertBy :: (a -> a -> Ordering) -> a -> Stream a -> Stream a
insertBy cmp x (Stream next0 s0) = Stream next (S2 :!: s0)
where
next (S2 :!: s) = case next0 s of
Done -> Yield x (S1 :!: s)
Skip s' -> Skip (S2 :!: s')
Yield y s' | GT == cmp x y -> Yield y (S2 :!: s')
| otherwise -> Yield x (S1 :!: s)
next (S1 :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (S1 :!: s')
Yield y s' -> Yield y (S1 :!: s')
maximumBy :: (a -> a -> Ordering) -> Stream a -> a
maximumBy cmp (Stream next s0) = loop0_maximumBy s0
where
loop0_maximumBy !s = case next s of
Skip s' -> expose s' $ loop0_maximumBy s'
Yield x s' -> expose s' $ loop_maximumBy x s'
Done -> errorEmptyStream "maximumBy"
loop_maximumBy z !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_maximumBy z s'
Yield x s' -> expose s' $ loop_maximumBy (max' z x) s'
max' x y = case cmp x y of
GT -> x
_ -> y
minimumBy :: (a -> a -> Ordering) -> Stream a -> a
minimumBy cmp (Stream next s0) = loop0_minimumBy s0
where
loop0_minimumBy !s = case next s of
Skip s' -> expose s' $ loop0_minimumBy s'
Yield x s' -> expose s' $ loop_minimumBy x s'
Done -> errorEmptyStream "minimum"
loop_minimumBy z !s = case next s of
Done -> z
Skip s' -> expose s' $ loop_minimumBy z s'
Yield x s' -> expose s' $ loop_minimumBy (min' z x) s'
min' x y = case cmp x y of
GT -> y
_ -> x
genericLength :: Num i => Stream b -> i
genericLength (Stream next s0) = loop_genericLength s0
where
loop_genericLength !s = case next s of
Done -> 0
Skip s' -> expose s' $ loop_genericLength s'
Yield _ s' -> expose s' $ 1 + loop_genericLength s'
genericTake :: Integral i => i -> Stream a -> Stream a
genericTake n0 (Stream next0 s0) = Stream next (L n0 :!: s0)
where
next (L 0 :!: _) = Done
next (L n :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (L n :!: s')
Yield x s'
| n > 0 -> Yield x (L (n1) :!: s')
| otherwise -> error "List.genericTake: negative argument"
genericDrop :: Integral i => i -> Stream a -> Stream a
genericDrop n0 (Stream next0 s0) = Stream next (Just (L n0) :!: s0)
where
next (Just (L 0) :!: s) = Skip (Nothing :!: s)
next (Just (L n) :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (Just (L n) :!: s')
Yield _ s' | n > 0 -> Skip (Just (L (n1)) :!: s')
| otherwise -> error "List.genericDrop: negative argument"
next (Nothing :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (Nothing :!: s')
Yield x s' -> Yield x (Nothing :!: s')
genericIndex :: Integral a => Stream b -> a -> b
genericIndex (Stream next s0) i0 = loop_genericIndex i0 s0
where
loop_genericIndex i !s = case next s of
Done -> error "List.genericIndex: index too large."
Skip s' -> expose s' $ loop_genericIndex i s'
Yield x s' | i == 0 -> x
| i > 0 -> expose s' $ loop_genericIndex (i1) s'
| otherwise -> error "List.genericIndex: negative argument."
genericSplitAt :: Integral i => i -> Stream a -> ([a], [a])
genericSplitAt n0 (Stream next s0) = loop_genericSplitAt n0 s0
where
loop_genericSplitAt 0 !s = ([], expose s $ unstream (Stream next s))
loop_genericSplitAt n !s = case next s of
Done -> ([], [])
Skip s' -> expose s $ loop_genericSplitAt n s'
Yield x s'
| n > 0 -> (x:xs', xs'')
| otherwise -> error "List.genericSplitAt: negative argument"
where
(xs', xs'') = expose s $ loop_genericSplitAt (n1) s'
enumFromToInt :: Int -> Int -> Stream Int
enumFromToInt x y = Stream next (L x)
where
next (L !n)
| n > y = Done
| otherwise = Yield n (L (n+1))
enumDeltaInteger :: Integer -> Integer -> Stream Integer
enumDeltaInteger a d = Stream next (L a)
where
next (L !x) = Yield x (L (x+d))
enumFromToChar :: Char -> Char -> Stream Char
enumFromToChar x y = Stream next (L (ord x))
where
m = ord y
next (L !n)
| n > m = Done
| otherwise = Yield (chr n) (L (n+1))
foldM :: Monad m => (b -> a -> m b) -> b -> Stream a -> m b
foldM f z0 (Stream next s0) = loop_foldl z0 s0
where
loop_foldl z !s = case next s of
Done -> Monad.return z
Skip s' -> expose s' $ loop_foldl z s'
Yield x s' -> expose s' $ f z x >>= \z' -> loop_foldl z' s'
foldM_ :: Monad m => (b -> a -> m b) -> b -> Stream a -> m ()
foldM_ f z0 (Stream next s0) = loop_foldl z0 s0
where
loop_foldl z !s = case next s of
Done -> Monad.return ()
Skip s' -> expose s' $ loop_foldl z s'
Yield x s' -> expose s' $ f z x >>= \z' -> loop_foldl z' s'
return :: a -> Stream a
return e = Stream next S1
where
next S1 = Yield e S2
next S2 = Done
guard :: Bool -> Stream a -> Stream a
guard b (Stream next0 s0) = Stream next (S1 :!: s0)
where
next (S1 :!: s) = if b then Skip (S2 :!: s) else Done
next (S2 :!: s) = case next0 s of
Done -> Done
Skip s' -> Skip (S2 :!: s')
Yield x s' -> Yield x (S2 :!: s')
bind :: (a -> Bool) -> (a -> Stream b) -> Stream a -> Stream b
bind b f (Stream next0 s0) = Stream next (s0 :!: Nothing)
where
next (s :!: Nothing) = case next0 s of
Done -> Done
Skip s' -> Skip (s' :!: Nothing)
Yield x s'
| b x -> Skip (s' :!: Just (f x))
| otherwise -> Skip (s' :!: Nothing)
next (s :!: Just (Stream next1 s1)) = case next1 s1 of
Done -> Skip (s :!: Nothing)
Skip s1' -> Skip (s :!: Just (Stream next1 s1'))
Yield x s1' -> Yield x (s :!: Just (Stream next1 s1'))
mapFilter :: (a -> Bool) -> (a -> b) -> Stream a -> Stream b
mapFilter b f (Stream next0 s0) = Stream next s0
where
next s = case next0 s of
Done -> Done
Skip s' -> Skip s'
Yield x s'
| b x -> Yield (f x) s'
| otherwise -> Skip s'
declare :: (a -> Stream b) -> a -> Stream b
declare f bs = Stream next (f bs)
where
next (Stream next0 s) = case next0 s of
Done -> Done
Skip s' -> Skip (Stream next0 s')
Yield x s' -> Yield x (Stream next0 s')
errorEmptyStream :: String -> a
errorEmptyStream fun = moduleError fun "empty list"
moduleError :: String -> String -> a
moduleError fun msg = error ("List." ++ fun ++ ':':' ':msg)
#endif