(****************)
(* COMPUTATIONS *)
(****************)

(* This is a computation language intended to be interpreted into the
 * state monad. It has `get` and `put` operations, a way to combine
 * computations via `bind`, and a way to conclude with a literal value
 * via `return`. A neat thing about monads is that all of our
 * intuitions about `+` and expression languages from above can be
 * carried over. `bind` is actually associative (like `+`), `return`
 * is a unit for `bind` (just like `0` was for `+`). Most
 * importantly, we can compile this tree-structured thing into an
 * equivalent list-structured thing, and the ability to do so
 * crucially relies on associativity and unit laws.
 *)
Inductive computation_tree : Set :=
  | Bind_CT : computation_tree -> (nat -> computation_tree) -> computation_tree
  | Return_CT : nat -> computation_tree
  | Get_CT : computation_tree
  | Put_CT : nat -> computation_tree.(****************)
(* COMPUTATIONS *)
(****************)

(* This is a computation language intended to be interpreted into the
 * state monad. It has `get` and `put` operations, a way to combine
 * computations via `bind`, and a way to conclude with a literal value
 * via `return`. A neat thing about monads is that all of our
 * intuitions about `+` and expression languages from above can be
 * carried over. `bind` is actually associative (like `+`), `return`
 * is a unit for `bind` (just like `0` was for `+`). Most
 * importantly, we can compile this tree-structured thing into an
 * equivalent list-structured thing, and the ability to do so
 * crucially relies on associativity and unit laws.
 *)
Inductive computation_tree : Set :=
  | Bind_CT : computation_tree -> (nat -> computation_tree) -> computation_tree
  | Return_CT : nat -> computation_tree
  | Get_CT : computation_tree
  | Put_CT : nat -> computation_tree.(****************)
(* COMPUTATIONS *)
(****************)

(* This is a computation language intended to be interpreted into the
 * state monad. It has `get` and `put` operations, a way to combine
 * computations via `bind`, and a way to conclude with a literal value
 * via `return`. A neat thing about monads is that all of our
 * intuitions about `+` and expression languages from above can be
 * carried over. `bind` is actually associative (like `+`), `return`
 * is a unit for `bind` (just like `0` was for `+`). Most
 * importantly, we can compile this tree-structured thing into an
 * equivalent list-structured thing, and the ability to do so
 * crucially relies on associativity and unit laws.
 *)
Inductive computation_tree : Set :=
  | Bind_CT : computation_tree -> (nat -> computation_tree) -> computation_tree
  | Return_CT : nat -> computation_tree
  | Get_CT : computation_tree
  | Put_CT : nat -> computation_tree.(****************)
(* COMPUTATIONS *)
(****************)

(* This is a computation language intended to be interpreted into the
 * state monad. It has `get` and `put` operations, a way to combine
 * computations via `bind`, and a way to conclude with a literal value
 * via `return`. A neat thing about monads is that all of our
 * intuitions about `+` and expression languages from above can be
 * carried over. `bind` is actually associative (like `+`), `return`
 * is a unit for `bind` (just like `0` was for `+`). Most
 * importantly, we can compile this tree-structured thing into an
 * equivalent list-structured thing, and the ability to do so
 * crucially relies on associativity and unit laws.
 *)
Inductive computation_tree : Set :=
  | Bind_CT : computation_tree -> (nat -> computation_tree) -> computation_tree
  | Return_CT : nat -> computation_tree
  | Get_CT : computation_tree
  | Put_CT : nat -> computation_tree.(****************)
(* COMPUTATIONS *)
(****************)

(* This is a computation language intended to be interpreted into the
 * state monad. It has `get` and `put` operations, a way to combine
 * computations via `bind`, and a way to conclude with a literal value
 * via `return`. A neat thing about monads is that all of our
 * intuitions about `+` and expression languages from above can be
 * carried over. `bind` is actually associative (like `+`), `return`
 * is a unit for `bind` (just like `0` was for `+`). Most
 * importantly, we can compile this tree-structured thing into an
 * equivalent list-structured thing, and the ability to do so
 * crucially relies on associativity and unit laws.
 *)
Inductive computation_tree : Set :=
  | Bind_CT : computation_tree -> (nat -> computation_tree) -> computation_tree
  | Return_CT : nat -> computation_tree
  | Get_CT : computation_tree
  | Put_CT : nat -> computation_tree.(* This is an interpretation of computation trees in terms of
 * functions that manipulate a single cell of state
 *)
(*                                                                output state              *)
(*                                                                       ↓↓↓                *)
Fixpoint interp_computation_tree (e : computation_tree) (state : nat) : (nat * nat) :=
(*                                                                             ↑↑↑          *)
(*                                                                             return value *)

  match e with
  | Bind_CT e' f => 
    match interp_computation_tree e' state with
    | (state', n) => interp_computation_tree (f n) state'
    end
  | Return_CT n => (state, n)
  | Get_CT => (state, state)
  | Put_CT n => (n, n)
  end.(* This is our "first try" at list-ifying the computation tree. This
 * is just like a list that has two different types of "cons cells":
 * one for `get` and one for `put`. We can fold these together into a
 * single "cons cell" using a helper definition, so let's do that.
 *)
Inductive computation_list_first_try : Set :=
  | Get_CLFT : (nat -> computation_list_first_try) -> computation_list_first_try
  | Put_CLFT : nat -> (nat -> computation_list_first_try) -> computation_list_first_try
  | Done_CLFT : computation_list_first_try.(* This is our "first try" at list-ifying the computation tree. This
 * is just like a list that has two different types of "cons cells":
 * one for `get` and one for `put`. We can fold these together into a
 * single "cons cell" using a helper definition, so let's do that.
 *)
Inductive computation_list_first_try : Set :=
  | Get_CLFT : (nat -> computation_list_first_try) -> computation_list_first_try
  | Put_CLFT : nat -> (nat -> computation_list_first_try) -> computation_list_first_try
  | Done_CLFT : computation_list_first_try.(* This is our "first try" at list-ifying the computation tree. This
 * is just like a list that has two different types of "cons cells":
 * one for `get` and one for `put`. We can fold these together into a
 * single "cons cell" using a helper definition, so let's do that.
 *)
Inductive computation_list_first_try : Set :=
  | Get_CLFT : (nat -> computation_list_first_try) -> computation_list_first_try
  | Put_CLFT : nat -> (nat -> computation_list_first_try) -> computation_list_first_try
  | Done_CLFT : computation_list_first_try.(* This is our "first try" at list-ifying the computation tree. This
 * is just like a list that has two different types of "cons cells":
 * one for `get` and one for `put`. We can fold these together into a
 * single "cons cell" using a helper definition, so let's do that.
 *)
Inductive computation_list_first_try : Set :=
  | Get_CLFT : (nat -> computation_list_first_try) -> computation_list_first_try
  | Put_CLFT : nat -> (nat -> computation_list_first_try) -> computation_list_first_try
  | Done_CLFT : computation_list_first_try.(* This is the inductive type for "commands" in our language *)
Inductive computation_op : Set :=
  | Get_OP : computation_op
  | Put_OP : nat -> computation_op.(* This is the inductive type for "commands" in our language *)
Inductive computation_op : Set :=
  | Get_OP : computation_op
  | Put_OP : nat -> computation_op.(* This is the inductive type for "commands" in our language *)
Inductive computation_op : Set :=
  | Get_OP : computation_op
  | Put_OP : nat -> computation_op.(* This is the inductive type for computations in our language. It's
 * just a list, but where the cons cells allow for the tail of the
 * list to depend on a "return value". The tail of the list also holds
 * a final value.
 *)
Inductive computation_list : Set :=
  | Op_CL : computation_op -> (nat -> computation_list) -> computation_list
  | Done_CL : nat -> computation_list.(* This is the inductive type for computations in our language. It's
 * just a list, but where the cons cells allow for the tail of the
 * list to depend on a "return value". The tail of the list also holds
 * a final value.
 *)
Inductive computation_list : Set :=
  | Op_CL : computation_op -> (nat -> computation_list) -> computation_list
  | Done_CL : nat -> computation_list.(* This is the inductive type for computations in our language. It's
 * just a list, but where the cons cells allow for the tail of the
 * list to depend on a "return value". The tail of the list also holds
 * a final value.
 *)
Inductive computation_list : Set :=
  | Op_CL : computation_op -> (nat -> computation_list) -> computation_list
  | Done_CL : nat -> computation_list.(* This is an interpretation of these computation lists in terms of
 * the same state monad semantics
 *)
(*                                                                       state              *)
(*                                                                       ↓↓↓                *)
Fixpoint interp_computation_list (e : computation_list) (state : nat) : (nat * nat) :=
(*                                                                             ↑↑↑          *)
(*                                                                             return value *)
  match e with
  | Op_CL o f => 
      match o with
      | Get_OP => interp_computation_list (f state) state
      | Put_OP n => interp_computation_list (f n) n
      end
  | Done_CL n => (state, n)
  end.(* And finally, we have the compiler from computation trees to
 * computation lists.
 *)

(* Magically, we need an append operation for our computation lists
 * before defining our compiler for computation trees, just like we
 * needed an append operation on expression lists before defining our
 * compiler for expression trees.
 *)
Fixpoint append_computation_list (e : computation_list) (f : nat -> computation_list) : computation_list :=
  match e with
  | Op_CL o f1 => Op_CL o (fun x => append_computation_list (f1 x) f)
  | Done_CL n => f n
  end.(* And now we have the compiler from computation trees to computation
 * lists. We should be able to prove that the denotations of
 * computation trees and computation lists (via compilation) are
 * equal, and you'll notice that doing so relies on associativity and
 * unit laws for the denotation space (the state monad).
 *)
Fixpoint compile_computation_tree (e : computation_tree) : computation_list :=
  match e with
  | Bind_CT e f => append_computation_list (compile_computation_tree e) (fun n => compile_computation_tree (f n))
  | Return_CT n => Done_CL n
  | Get_CT => Op_CL Get_OP (fun n => Done_CL n)
  | Put_CT n => Op_CL (Put_OP n) (fun n' => Done_CL n')
  end.

(* Specifications: *)
Lemma interp_comp_list: forall l f st, interp_computation_list (append_computation_list l f) st = let (st',n') := interp_computation_list l st in interp_computation_list (f n') st'.
Theorem comp_tree_correct: forall e n, interp_computation_list(compile_computation_tree e) n = interp_computation_tree e n.
Lemma interp_comp_list: forall l f st, interp_computation_list (append_computation_list l f) st = let (st',n') := interp_computation_list l st in interp_computation_list (f n') st'.
Theorem comp_tree_correct: forall e n, interp_computation_list(compile_computation_tree e) n = interp_computation_tree e n.