From Coq Require Import Arith.Arith.
From Coq Require Import Bool.Bool.
From Coq Require Import Logic.FunctionalExtensionality.
From Coq Require Import Lists.List.
From Coq Require Import Strings.String.
Import ListNotations.
Set Default Goal Selector "!".

Theorem mul_0_r' : forall n : nat,
    n * 0 = 0.
Proof.
  apply nat_ind.
  - reflexivity.
  - simpl.
    intros.
    apply H.
Qed.

Inductive rgb : Type :=
| red
| green
| blue.

(* rgb_ind :
   forall P : rgb -> Prop,
          P red ->
          P green ->
          P blue ->
          forall color : rgb, P color
*)

Check rgb_ind.

Inductive booltree : Type :=
| bt_empty
| bt_leaf (b : bool)
| bt_branch (b : bool) (t1 t2 : booltree).

Definition base_case (P : booltree -> Prop) : Prop :=
  P bt_empty.

Definition leaf_case (P : booltree -> Prop) : Prop :=
  forall (b : bool), P (bt_leaf b).

Definition branch_case (P : booltree -> Prop) : Prop :=
  forall (b : bool) (t1 : booltree),
    P t1 -> forall (t2 : booltree),
    P t2 -> P (bt_branch b t1 t2).

Definition booltree_ind_type :=
  forall (P : booltree -> Prop),
    base_case P ->
    leaf_case P ->
    branch_case P ->
    forall (b : booltree), P b.

Theorem booltree_ind_type_correct : booltree_ind_type.
Proof.
  exact booltree_ind.
Qed.

Inductive Toy :=
| con1 (b : bool)
| con2 (n : nat) (t : Toy).

Theorem Toy_correct : exists f g,
  forall P : Toy -> Prop,
    (forall b : bool, P (f b)) ->
    (forall (n : nat) (t : Toy), P t -> P (g n t)) ->
    forall t : Toy, P t.
Proof.
  exists con1, con2.
  exact Toy_ind.
Qed.

Fixpoint build_proof
  (P : nat -> Prop)
  (evPO : P 0)
  (evPS : forall n : nat, P n -> P (S n))
  (n : nat) : P n :=
  match n with
  | 0 => evPO
  | S k => evPS k (build_proof P evPO evPS k)
  end.

Definition nat_ind2 :
  forall (P : nat -> Prop),
    P 0 ->
    P 1 ->
    (forall n : nat, P n -> P (S (S n))) ->
    forall n : nat, P n :=
  fun P P0 P1 PSS =>
    fix f (n : nat) := match n with
                       | 0 => P0
                       | 1 => P1
                       | S (S n') => PSS n' (f n')
                       end.

Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope.

Inductive t_tree (X : Type) : Type :=
| t_leaf
| t_branch : (t_tree X * X * t_tree X) -> t_tree X.

Arguments t_leaf {X}.
Arguments t_branch {X}.

Fixpoint reflect {X : Type} (t : t_tree X) : t_tree X :=
  match t with
  | t_leaf => t_leaf
  | t_branch (l, v, r) => t_branch (reflect r, v, reflect l)
  end.

Definition better_t_tree_ind_type : Prop :=
  forall (X: Type) (P : t_tree X -> Prop),
    P t_leaf ->
    (forall (l r : t_tree X) (v : X),
      P l -> P r -> P (t_branch (l, v, r))) ->
      forall (t : t_tree X), P t.

Definition better_t_tree_ind : better_t_tree_ind_type :=
  fun X P Pl Pb =>
    fix f t := match t with
               | t_leaf => Pl
               | t_branch (l, v, r) => Pb l r v (f l) (f r)
               end.

Theorem reflect_involution : forall (X : Type) (t : t_tree X),
    reflect (reflect t) = t.
Proof.
  intros X.
  apply better_t_tree_ind.
  - reflexivity.
  - intros l r v Hl Hr.
    simpl.
    rewrite Hl.
    rewrite Hr.
    reflexivity.
Qed.