Ticket #3767: Spec.hs

{-# LANGUAGE ExistentialQuantification #-}
module Foo where

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

{-
rep :: Int -> a -> Stream a
{-# INLINE rep #-}
rep n x = n `seq` Stream next n
  where
    next n | n > 0     = Yield x (n-1)
           | otherwise = Done

unstream :: Stream a -> [a]
{-# INLINE unstream #-}
unstream (Stream step s) = go s
  where
    go s = case step s of
             Yield x s' -> x : go s'
             Skip    s' -> go s'
             Done       -> []

plus :: Stream Int -> Int
{-# INLINE plus #-}
plus (Stream step s) = go 0 s
  where
    go n s = n `seq` case step s of
                       Yield x s' -> go (n+x) s'
                       Skip    s' -> go n s'
                       Done       -> n
-}


rep_even :: Int -> a -> Stream a
{-# INLINE rep_even #-}
rep_even n x = n `seq` Stream next n
  where
    next n | n > 0     = if even n then Yield x (n-1) else Skip (n-1)
           | otherwise = Done

plus_pos :: Stream Int -> Int
{-# INLINE plus_pos #-}
plus_pos (Stream step s) = go 0 s
  where
    go n s = n `seq` case step s of
                       Yield x s' -> go (n+max x 0) s'
                       Skip    s' -> go n s'
                       Done       -> n

app :: Stream a -> Stream a -> Stream a
{-# INLINE app #-}
app (Stream step1 s1) (Stream step2 s2) = Stream step (Left s1)
  where
    step (Left s1) = case step1 s1 of
                       Yield x s1' -> Yield x (Left s1')
                       Skip    s1' -> Skip    (Left s1')
                       Done        -> Skip    (Right s2)

    step (Right s2) = case step2 s2 of
                        Yield x s2' -> Yield x (Right s2')
                        Skip    s2' -> Skip    (Right s2')
                        Done        -> Done

foo :: Int -> Int -> Int
foo n x = plus_pos $ app (rep_even n x) (rep_even n x)