Main.hs

{-# LANGUAGE ExistentialQuantification #-}
module Main where

import GHC.Prim

import Criterion.Main
import GHC.Prim

main :: IO ()
main = defaultMain [b1, b2] where
  b1 = bench "Skip-less" $ whnf chain1 x
  b2 = bench "Skip" $ whnf chain2 x
  x = 100000000


--------------------------------------------------------------------------------

data Step1 s a = Done1 | Yield1 s a
data Stream1 a = forall s. Stream1 s (s -> Step1 s a)

enumFromTo1 :: (Ord a, Num a) => a -> a -> Stream1 a
enumFromTo1 start high = Stream1 start f where
  f i | i > high  = Done1
      | otherwise = Yield1 (i + 1) i

filter1 :: (a -> Bool) -> Stream1 a -> Stream1 a
filter1 predicate (Stream1 s0 next) = Stream1 s0 loop where
  loop s = case next s of
    Done1 -> Done1
    Yield1 s' x
      | predicate x -> Yield1 s' x
      | otherwise   -> loop s'

sum1 :: Num a => Stream1 a -> a
sum1 (Stream1 s0 next) = loop 0 s0 where
  loop total s = case next s of
    Done1 -> total
    Yield1 s' x -> loop (total + x) s'

chain1 :: Int -> Int
chain1 = sum1 . filter1 even . enumFromTo1 1

--------------------------------------------------------------------------------

data Step2 s a = Done2 | Skip2 s | Yield2 s a
data Stream2 a = forall s. Stream2 s (s -> Step2 s a)

enumFromTo2 :: (Ord a, Num a) => a -> a -> Stream2 a
enumFromTo2 start high = Stream2 start f where
  f i | i > high  = Done2
      | otherwise = Yield2 (i + 1) i

filter2 :: (a -> Bool) -> Stream2 a -> Stream2 a
filter2 predicate (Stream2 s0 next) = Stream2 s0 loop where
  loop s = case next s of
    Done2 -> Done2
    Skip2 s' -> Skip2 s'
    Yield2 s' x
      | predicate x -> Yield2 s' x
      | otherwise   -> Skip2 s'

sum2 :: Num a => Stream2 a -> a
sum2 (Stream2 s0 next) = loop 0 s0 where
  loop total s = case next s of
    Done2 -> total
    Skip2 s' -> loop total s'
    Yield2 s' x -> loop (total + x) s'

chain2 :: Int -> Int
chain2 = sum2 . filter2 even . enumFromTo2 1