-- Recursion from iteration
-- The Haskell code accompanying the article
-- undelimited.html#iter-recur

module IterRec where

import Control.Monad (liftM)
import CPSs

-- Definition of `iteration': tail-recursive loop
loop1 :: (a -> a) -> (a -> b)
loop1 g = \x -> loop1 g (g x)

-- Definition of `recursion': fix-point combinator
fix1 :: ((a->b) -> (a->b)) -> (a->b)
fix1 f  = \a -> f (fix1 f) a

-- Factorial in the open-recursion style
fact1 self n = 
    if n == 0 then 1 else n * self (n-1)

-- Example of using fix
fact1r = fix1 fact1 5
-- 120

-- loop via fix
loop1' :: (a -> a) -> (a -> b)
loop1' g = fix1 (. g)


-- Recasting loop and fix in monadic terms

loop2 :: Monad m => (a -> m a) -> (a -> m b)
loop2 g  = \x -> g x >>= loop2 g

-- This is the applicative fix-point combinator, NOT mfix
fix2 :: Monad m => ((a -> m b) -> (a -> m b)) -> (a -> m b)
fix2 f = \x -> f (fix2 f) x

-- Monadic version of fact1
fact2 :: Monad m => (Int -> m Int) -> (Int -> m Int)
fact2 self n = 
    if n == 0 then return 1 else liftM (n *) (self (n-1))

-- Example of using fix2, instantiating m to IO
fact2r = fix2 fact2 5 >>= print
-- 120

-- loop via fix
loop2' :: Monad m => (a -> m a) -> (a -> m b)
loop2' g = fix2 (\s -> (>>= s) . g)


-- fix via loop, the result of the derivation in the article
-- We could have used the Cont monad instead of CPS3. The latter is
-- more explicit though...
h' :: ((a -> CPS3 m w) -> (b -> CPS3 m w))
     -> ((b, K3 m w) -> CPS3 m (a, K3 m w))
h' f (x,k) = callCC3 (\k2 ->
  f (\x1 -> callCC3 (\k1 -> throw3 k2 (x1,k1))) x >>= (\v -> throw3 k v))

fix3 :: ((a -> CPS3 m b) -> (a -> CPS3 m b)) -> (a -> CPS3 m b)
fix3 f x = callCC3 (\k -> loop2 (h' f) (x,k))
 
fact3r = runCPS3 (fix3 fact2 5)
-- 120

-- Complex examples from Filinski's paper:

-- nested fix
nested = fix3 (\f n -> 
	       if n==0 then return 0 else fix3 (\f' n -> f n) (n-1)) 5

nestedr = runCPS3 nested
-- 0

-- fix-point of a higher-order function

-- Ordinary Ackermann function
ack m n = if m == 0 then n else ack (m-1) (n+1)

-- The same in the open-recursion and monadic styles
acks :: Monad m =>
	(Int -> m (Int -> m Int)) -> (Int -> m (Int -> m Int))
acks self m = return $ \n ->
   if m == 0 then return n else self (m-1) >>= ($ (n+1))

ack34 = fix3 acks 3 >>= ($ 4)

ack34r = runCPS3 ack34
-- 7