{-# LANGUAGE ScopedTypeVariables #-}
-- call-by-name continuation passing style
type K r a = (a -> r) -> r
foldr'cbv :: (a -> b -> K r b) -> b -> [a] -> K r b
foldr'cbv f z [ ] k = k z
foldr'cbv f z (x:xs) k = foldr'cbv f z xs (\y -> f x y k)
foldl'cbv :: (b -> a -> K r b) -> b -> [a] -> K r b
foldl'cbv f z [ ] k = k z
foldl'cbv f z (x:xs) k = f z x (\z' -> foldl'cbv f z' xs k)
pure :: a -> K r a
pure a k = k a
-- call-by-name CPS transformed lists
-- If you try constructing [] lists in foldr'cbn('), you'll end up
-- calling continuations too eagerly, and hang on infinite lists.
data KList r a = Nil | Cons (K r a) (K r (KList r a))
foldr'cbn :: forall a r b. K r (K r a -> K r b -> K r b) -> K r b -> K r (KList r a) -> K r b
foldr'cbn kf kz kl k = kl aux
where
aux :: KList r a -> r
aux Nil = kz k
aux (Cons kx kxs) = kf (\f -> f kx (foldr'cbn kf kz kxs) k)
delayList :: [a] -> KList r a
delayList [] = Nil
delayList (x:xs) = Cons (pure x) (pure (delayList xs))
forceList :: KList [a] a -> [a]
forceList Nil = []
forceList (Cons kx kxs) = kx (\x -> kxs (\xs -> x : forceList xs))
-- [] analogues of the above
foldr'cbn' :: forall a r b. K r (K r a -> K r b -> K r b) -> K r b -> K r [a] -> K r b
foldr'cbn' kf kz kl k = kl aux
where
aux :: [a] -> r
aux [ ] = kz k
aux (x:xs) = kf (\f -> f (pure x) (foldr'cbn' kf kz (pure xs)) k)
foldl'cbn' :: forall a r b. K r (K r b -> K r a -> K r b) -> K r b -> K r [a] -> K r b
foldl'cbn' kf kz kl k = kl aux
where
aux :: [a] -> r
aux [ ] = kz k
aux (x:xs) = kf (\f -> foldl'cbn' kf (f kz (pure x)) (pure xs) k)
{-
foldr'cbn' (pure (\kx kxs -> pure (Cons kx kxs))) (pure Nil) (pure [1..]) forceList
==> [1,2,3,4,5,6,7,8,9,10 ..]
-}