Require Import CpdtTactics Recdef.
Set Implicit Arguments.

(* The ackermann function is a simple example of a total function that
   is not primitive recursive. It's defined as follows:

Fixpoint ack m n : nat :=
  match m, n with
    | 0, n     => S n
    | S m, 0   => ack m 1
    | S m, S n => ack m (ack (S m) n)
  end.

  If you try to run this code you get an error:
    Error: Cannot guess decreasing argument of fix.

  In some recursive calls the first argument decreases and in others
  the second decreases. Coq isn't smart enough to figure out that this
  means the function terminates, so we have to convince it.

  Fortunately we can do a trick for this specific function to define
  it without resorting to well_founded recursion proofs 

 *)
(* Ex (Easy): Define the ackerman function using an inner fixpoint *)

(* 
  But where's the fun in that? We can't always do this sort of trick
  anyway, so let's consider why the function does terminate.

  First we uncurry the definition to make it a function of one argument.

  ack : nat * nat -> nat

  Then we need to come up with a relation on (nat * nat)'s that's
  well-founded. In other words, we need to come up with a notion of <
  on (nat * nat)'s such that any decreasing sequence of (nat * nat)'s
  must be finite.

  nats_le : (nat * nat) -> (nat * nat) -> Prop
p*)

(* Ex (medium): Come up with a definition for nats_le that captures the decreasing
       nature of recursive calls in the ackermann function 
  
  Note: your nats_le doesn't have to satisfy all of the properties of a total order.

*)

(* Now we need to prove our relation is well founded  *)
Print well_founded.
Print Acc.
(* We need to prove that every mn is accessible, i.e., forall mn, then every mn' less than mn is also accessible (We can only prove this if we eventually reach a base case with nothing less than mn). *)
Section Acc.
  Variable mn : nat * nat.

  Lemma nats_le_acc' : forall mn' : nat * nat, nats_le mn' mn -> Acc nats_le mn'.
    (* Ex (hard?): Prove this

       If you're having trouble with this, I suggest you Admit the
       proof and do the rest of the exercises before returning here.

     *)
  Admitted.

  Lemma nats_le_acc : Acc nats_le mn.
    constructor.
    apply nats_le_acc'.
  Defined.
End Acc.

Check nats_le_acc.
(* Now we have a well founded recursion principle *)
Theorem nats_le_wf : well_founded nats_le.
  unfold well_founded.
  apply nats_le_acc.
Defined.

(* Ex (medium): Now define the ackermann function using Fix and nats_le *)
Check Fix.

(* I'm going to skip the first general recursion monad because my Ltac fu is too weak, but that doesn't mean you have to! 
  
  Ex (challenge!!!!): Define the ackermann function using the first
  general recursion monad. You will probably need some major Ltac chops.
*)


(* Coinductive General Recursion Monad *)
(* We define the simplest possible (free?) coinductive monad *)
CoInductive comp (A : Type) : Type :=
| Ret : A -> comp A
| Bnd : forall B, comp B -> (B -> comp A) -> comp A.

(* And a proposition for running it *)
Inductive exec A : comp A -> A -> Prop :=
| ExecRet : forall x, exec (Ret x) x
| ExecBnd : forall B (c : comp B) (f : B -> comp A) x1 x2, exec (A := B) c x1
  -> exec (f x1) x2
  -> exec (Bnd c f) x2.
Hint Constructors exec.
(* And some nice monad notaation *)
Notation "x <- m1 ; m2" := (Bnd m1 (fun x => m2))
(right associativity, at level 70).

(** To execute this function, we go through the usual exercise of writing a function to catalyze evaluation of co-recursive calls. *)
Definition frob' A (c : comp A) :=
  match c with
    | Ret x => Ret x
    | Bnd _ c' f => Bnd c' f
  end.

Lemma exec_frob : forall A (c : comp A) x,
  exec (frob' c) x
  -> exec c x.
  destruct c; crush.
Qed.

(* Ex (Easy): Define the ackermann function using the coinductive nontermination monad and prove:
 * exec (monad_ack 0 1) 2
 * exec (monad_ack 2 8) 19
 * exec (monad_ack 3 4) 125 
 *)