newtype Cont r a = Cont ((a -> r) -> r)

instance Functor (Cont r) where
    fmap :: (a -> b) -> Cont r a -> Cont r b
    fmap f (Cont c) = Cont $ \k -> c $ k . f

instance Applicative (Cont r) where
    pure :: a -> Cont r a
    pure a = Cont $ \k -> k a

    (<*>) :: Cont r (a -> b) -> Cont r a -> Cont r b
    Cont f <*> Cont v = Cont $ \k -> f (\f' -> v $ k . f')

instance Monad (Cont r) where
    (>>=) :: Cont r a -> (a -> Cont r b) -> Cont r b
    Cont x >>= f = Cont $ \k -> x (\a -> let Cont c = f a in c k)

runCont :: Cont r a -> (a -> r) -> r
runCont (Cont c) = c

evalCont :: Cont a a -> a
evalCont (Cont c) = c id

callCC :: ((a -> Cont r b) -> Cont r a) -> Cont r a
callCC f = Cont $ \k -> runCont (f (\x -> Cont $ \_ -> k x)) k

foldrCPS :: (a -> b -> Cont r b) -> b -> [a] -> Cont r b
foldrCPS f z list = case list of
    []     -> pure z
    (x:xs) -> foldrCPS f z xs >>= f x

addCPS :: Num a => a -> a -> Cont r a
addCPS a b = pure (a + b)

sumCPS :: [Int] -> Int
sumCPS = evalCont . foldrCPS addCPS 0

data Trampoline a = More (() -> Trampoline a) | Done a

runTrampoline :: Trampoline a -> a
runTrampoline t = case t of
    Done a -> a
    More k -> runTrampoline $ k ()

instance Functor Trampoline where
    fmap :: (a -> b) -> Trampoline a -> Trampoline b
    fmap f t = case t of
        Done a -> pure $ f a
        More k -> More . const $ f <$> k ()

instance Applicative Trampoline where
    pure :: a -> Trampoline a
    pure = Done

    (<*>) :: Trampoline (a -> b) -> Trampoline a -> Trampoline b
    l <*> r = case (l, r) of
        (Done f, Done x) -> pure $ f x
        (More k, Done x) -> More . const $ k () <*> pure x
        (Done f, More c) -> More . const $ f <$> c ()
        (More k, More c) -> More . const $ k () <*> c ()

instance Monad Trampoline where
    (>>=) :: Trampoline a -> (a -> Trampoline b) -> Trampoline b
    l >>= f = case l of
        Done a -> f a
        More k -> More . const $ k () >>= f

foldrT :: (a -> b -> Trampoline b) -> b -> [a] -> Trampoline b
foldrT f z list = case list of
    []     -> pure z
    (x:xs) -> More . const $ foldrT f z xs >>= f x

addT :: Int -> Int -> Trampoline Int
addT a b = pure (a + b)

sumT :: [Int] -> Int
sumT = runTrampoline . foldrT addT 0

fibT :: Int -> Trampoline Int
fibT n = case n of
    0 -> pure 0
    1 -> pure 1
    n -> More . const $ (+) <$> fibT (n - 2) <*> fibT (n - 1)

fib :: Int -> Int
fib n = case n of
    0 -> 0
    1 -> 1
    n -> fib(n - 1) + fib(n - 2)

main = do
    print $ fib 48