ContStreams.lhs

> {-# OPTIONS_GHC -fdicts-cheap -fbang-patterns #-}
> {-# LANGUAGE Rank2Types, ExistentialQuantification#-}
> module StreamCont where

> data Stream a = forall s. Stream (s -> Step a s) s
> data Step a s = Done
>               | Yield a s
>               | Skip s

> data Stream' a 
>   = forall s. Stream' 
>              !(forall ans.
>                  s 
>               -> (a -> s -> ans) -- yield continuation
>               -> (s -> ans)      -- skip continuation
>               -> ans -- answer for Done
>               -> ans)
>              !s

> stream :: [a] -> Stream a 
> stream xs_0 = Stream next xs_0
>   where 
>     {-# INLINE next #-}
>     next []      = Done
>     next (x:xs)  = Yield x xs
> {-# INLINE [0] stream #-}

> unstream :: Stream a -> [a]
> unstream (Stream next_0 s_0) = unfold s_0
>   where unfold !s = case next_0 s of
>           Done        ->      []
>           Skip s'     ->      unfold s'
>           Yield x s'  -> x :  unfold s'
> {-# INLINE [0] unstream #-}

> stream' :: [a] -> Stream' a
> stream' xs_0 = Stream' next xs_0
>   where 
>     {-# INLINE next #-}
>     next [] yield skip done     = done
>     next (x:xs) yield skip done = yield x xs
> {-# INLINE [0] stream' #-}

> unstream' :: Stream' a -> [a]
> unstream' (Stream' next_0 s_0) = unfold s_0
>   where 
>     unfold !s = 
>       next_0 s  (\a s'  -> a :  unfold s')
>                 (\s'    ->      unfold s')
>                                 []
> {-# INLINE [0] unstream' #-}

> test1 = unstream' (stream' [1,2,3])

> test2 = unstream' . stream' . unstream' . stream' $ [1,2,3,4,5]

-- > map_s' :: (a -> b) -> Stream' a -> Stream' b
-- > map_s' (Stream' next s_0) = 
-- >     Stream' (\s yield skip done -> ) s_0

> map_s :: (a -> b) -> Stream a -> Stream b
> map_s f (Stream next_0 s_0) = Stream next s_0
>   where 
>     {-# INLINE next #-}
>     next !s = case next_0 s of
>         Done        -> Done
>         Skip s'     -> Skip s'
>         Yield x s'  -> Yield (f x) s'
> {-# INLINE [0] map_s #-}

> map_s' :: (a -> b) -> Stream' a -> Stream' b
> map_s' f (Stream' next_0 s_0) = Stream' next s_0
>   where 
>     {-# INLINE next #-}
>     next !s yield skip done =
>         next_0 s  (\x s' -> yield (f x) s')
>                   skip 
>                   done
> {-# INLINE [0] map_s' #-}


> test3 = unstream' . map_s' succ . stream' $ ['a'..'i']
> test4 = unstream' . map_s' (*3) . map_s' (+7) . stream' $ [1..5]

> filter_s' :: (a -> Bool) -> Stream' a -> Stream' a
> filter_s' p (Stream' next_0 s_0) = (Stream' next s_0)
>   where
>     next s yield skip done =
>         next_0 s  (\x s' -> if p x then yield x s' else skip s')
>                   skip
>                   done

> return_s' :: a -> Stream' a
> return_s' x = Stream' next True
>   where next True yield _ _ = yield x False
>         next False _ _ done = done

> enumFromTo_s' :: (Ord a, Enum a) => a -> a -> Stream' a
> enumFromTo_s' l h = Stream' next l
>   where
>     next n yield _ done 
>       | n > h      = done
>       | otherwise  = yield n (succ n)

> foldr_s' :: (a -> b -> b) -> b -> Stream' a -> b
> foldr_s' f z (Stream' next_0 s_0) = go s_0
>   where
>     go !s = next_0 s  (\x s'  -> f x (go s'))
>                      (\s'    -> go s')
>                      z

> test5 = foldr_s' (+) 0 . stream' $ [1..10]
> test5' = foldr_s' (+) 0 (enumFromTo_s' 1 10)

> foldl_s :: (b -> a -> b) -> b -> Stream a -> b
> foldl_s f z_0 (Stream next s_0) = go z_0 s_0
>   where
>     go z !s = case next s of 
>         Done        -> z
>         Skip s'     -> go z s'
>         Yield x s'  -> go (f z x) s' 
> {-# INLINE [0] foldl_s #-}

> foldl_s' :: (b -> a -> b) -> b -> Stream' a -> b
> foldl_s' f z_0 (Stream' next_0 s_0) = go z_0 s_0
>   where
>     go z !s = next_0 s  (\x s'  -> go (f z x) s')
>                         (\s'    -> go z s')
>                         z
> {-# INLINE [0] foldl_s' #-}

> test6 = foldl_s' (+) 0 . stream' $ [1..10]

and so on ...

> append_s :: Stream a -> Stream a -> Stream a
> append_s (Stream next_a s_a0) (Stream next_b s_b0) = Stream next (Left s_a0)
>   where
>     {-# INLINE next #-}
>     next (Left s_a) = 
>         case next_a s_a of
>           Done          -> Skip (Right s_b0)
>           Skip s'_a     -> Skip (Left s'_a)
>           Yield x s'_a  -> Yield x (Left s'_a)
>     next (Right s_b) =
>         case next_b s_b of
>           Done          -> Done
>           Skip s'_b     -> Skip (Right s'_b)
>           Yield x s'_b  -> Yield x (Right s'_b)
> {-# INLINE [0] append_s #-}

> test7 = unstream $ append_s (stream [1..4]) (stream [8..10])

> append_s' :: Stream' a -> Stream' a -> Stream' a
> append_s' (Stream' next_a0 s_a0) (Stream' next_b0 s_b0) = 
>     Stream' next (Left s_a0)
>   where
>     {-# INLINE next #-}
>     next (Left s_a) yield skip done = 
>       next_a0 s_a  (\x s'_a  -> yield x (Left s'_a))
>                    (\s'_a    -> skip (Left s'_a))
>                    (skip (Right s_b0))
>     next (Right s_b) yield skip done =
>       next_b0 s_b  (\x s'_b  -> yield x (Right s'_b))
>                    (\s'_b    -> skip (Right s'_b))
>                    done
> {-# INLINE [0] append_s' #-}

> test8 :: [Int] -> [Int] -> Int
> test8 xs ys = foldl_s (+) 0 (append_s (stream xs) (stream ys))

> test8' :: [Int] -> [Int] -> Int
> test8' xs ys = foldl_s' (+) 0 (append_s' (stream' xs) (stream' ys))