(** A long script to test (non-nested) induction and case analysis **)

Require Import MetaCoq.Template.All.
Require Import destruct_lemma.
Require Import MetaCoq.Template.Pretty.
Require Import List String.
Import ListNotations MCMonadNotation.

(* Load destruct_lemma. *)
(* Require Import MetaCoq.Template.Pretty. *)

(* mutual inductive test *)

(* Inductive even : nat -> Prop := *)
(*   | even_O : even 0 *)
(*   | even_S : forall n, odd n -> even (S n) *)
(* with odd : nat -> Prop := *)
(*   odd_S : forall n, even n -> odd (S n). *)

(* Print even_ind. *)
(* Print odd_ind. *)

(* Goal forall n, even n -> exists k, n=2*k. *)
(* Proof. *)
(*   induction 1. *)
(*   - now exists 0. *)
(*   - destruct H. *)
(* Restart. *)
(*   induction n. *)
(*   - intros _. now exists 0. *)
(*   - destruct 1. *)
(*     + now exists 0. *)
(*     + destruct H. *)
(* Abort. *)

(* Print even_ind. *)
(* MetaCoq Run (create even true true). *)

Unset Strict Unquote Universe Mode.
MetaCoq Run (create nat true false).
MetaCoq Run (create nat true true).

Require Import de_bruijn_print.
(* MetaCoq TemplateCoq Pretty.v *)

Check fresh_name.
Print global_env_ext.
Print universes_decl.
Print ContextSet.t.
Search global_env_ext.
Print global_env.
Print tmPrint.
Print program.

MetaCoq Run (tmPrint <% nat %>).
(* MetaCoq Run (tmEval lazy (inductive_mind <% nat %>) >>= tmPrint). *)
MetaCoq Run (tmQuoteInductive "nat" >>= tmPrint).
MetaCoq Run (tmQuoteRec "nat" >>= tmPrint).
MetaCoq Run (p <- tmQuoteRec nat;;
               t <- tmEval lazy (p.2);;
               tmPrint t).

MetaCoq Run (tmPrint "A";;match true with true => tmPrint "B" | _ => tmPrint "C" end).

MetaCoq Run (p <- tmQuoteRec le;;
               t <- tmEval lazy (p.2);;
               tmPrint t).
(* MetaCoq Run (tmQuoteInductive <% nat %> >>= tmPrint). *)

MetaCoq Run (p <- tmQuoteRec nat;;
             n <- tmEval lazy (empty_ext( p.1));;
             tmPrint n).

(* Definition env := *)
(* ([InductiveDecl (* "Coq.Init.Datatypes.nat" *) *)
(*     {| *)
(*     ind_finite := Finite; *)
(*     ind_npars := 0; *)
(*     ind_params := []; *)
(*     ind_bodies := [{| *)
(*                    ind_name := "nat"; *)
(*                    ind_type := tSort (NEL.sing (Level.lSet, false)); *)
(*                    ind_kelim := [InProp; InSet; InType]; *)
(*                    ind_ctors := [("O", tRel 0, 0); ("S", tProd nAnon (tRel 0) (tRel 1), 1)]; *)
(*                    ind_projs := [] |}]; *)
(*     ind_universes := Monomorphic_ctx *)
(*                        ({| LevelSet.this := []; LevelSet.is_ok := LevelSet.Raw.empty_ok |}, *)
(*                        {| ConstraintSet.this := []; ConstraintSet.is_ok := ConstraintSet.Raw.empty_ok |}) |}], *)
(* Monomorphic_ctx *)
(*   ({| LevelSet.this := []; LevelSet.is_ok := LevelSet.Raw.empty_ok |}, *)
(*   {| ConstraintSet.this := []; ConstraintSet.is_ok := ConstraintSet.Raw.empty_ok |})) *)
(* . *)

(* Compute (fresh_name _ _ nAnon <% nat %>). *)
(* MetaCoq Quote Definition q := (fun n => S n). *)
(* MetaCoq Unquote Definition m := (tLambda nAnon <% nat %> <% nat %>). *)
(* MetaCoq Unquote Definition m2 := (tLambda nAnon <% nat %> (tApp <% S %> [tRel 0] )). *)
(* MetaCoq Unquote Definition m3 := (tLambda (nNamed "n") <% nat %> (tApp <% S %> [tRel 0] )). *)
(* (* Check Σ. *) *)
(* MetaCoq Unquote Definition m4 := (tLambda (fresh_name env [] nAnon <% nat %>) <% nat %> (tApp <% S %> [tRel 0] )). *)
(* MetaCoq Unquote Definition m5 := (tLambda (fresh_name env [] (nNamed "n") <% nat %>) <% nat %> (tApp <% S %> [tRel 0] )). *)
(* MetaCoq Unquote Definition m6 := (tLambda (fresh_name env [] nAnon <% bool %>) <% nat %> (tApp <% S %> [tRel 0] )). *)
(* MetaCoq Unquote Definition m7 := (tLambda (fresh_name env [] (nNamed "IH") <% nat %>) <% nat %> (tLambda (fresh_name env [] (nNamed "IH") <% nat %>) <% nat %> (tApp <% add %> [tRel 0;tRel 1] ))). *)
(* Definition m8 := (tLambda (fresh_name env [] (nNamed "IH") <% nat %>) <% nat %> (tLambda (fresh_name env [] (nNamed "IH") <% nat %>) <% nat %> (tApp <% add %> [tRel 0;tRel 1] ))). *)
(* Print m. *)
(* Print m2. *)
(* Print m3. *)
(* Print m4. *)
(* Print m5. *)
(* Print m6. *)
(* Print m7. *)
(* Print m8. *)
(* MetaCoq Run (tmEval lazy m8 >>= tmPrint). *)

Print term.

(* MetaCoq Quote Definition added := (fun (x:nat) => x+0). *)
(* Print added. *)

(* tLambda (nNamed "x") *)
(* (tInd {| *)
(*         inductive_mind := "nat"; *)
(*         inductive_ind := 0 *)
(*         |} *)
(*     []) *)
(* (tApp (tConst "add" []) *)
(*      [tRel 0; *)
(*      tConstruct {| *)
(*         inductive_mind := "nat"; *)
(*         inductive_ind := 0 *)
(*         |} *)
(*         0 *)
(*         [] *)
(*     ]) *)
(* tLambda (nNamed "x") (tInd {| inductive_mind := "Coq.Init.Datatypes.nat"; inductive_ind := 0 |} []) *)
(*   (tApp (tConst "Coq.Init.Nat.add" []) *)
(*      [tRel 0; tConstruct {| inductive_mind := "Coq.Init.Datatypes.nat"; inductive_ind := 0 |} 0 []]) *)

(** non Uniform test **)

Inductive G3 (f:nat->bool) (n:nat) : Prop :=
  G3I : (f n = false -> G3 f (S n)) -> G3 f n.

Scheme Induction for G3 Sort Type.
Print G3_rect_dep.

MetaCoq Quote Definition I_G3 :=
  (
fun (f : nat -> bool) (P : forall n : nat, G3 f n -> Type)
  (f0 : forall (n : nat) (g : f n = false -> G3 f (S n)),
        (forall e : f n = false, P (S n) (g e)) -> P n (G3I f n g)) =>
fix F (n : nat) (g : G3 f n) {struct g} : P n g :=
  match g as g0 return (P n g0) with
  | @G3I _ _ g0 => f0 n g0 (fun e : f n = false => F (S n) (g0 e))
  end
  ).
From MetaCoq.PCUIC Require Import TemplateToPCUIC.
MetaCoq Run (bruijn_print (trans I_G3)).

(*
λ (f : (nat) -> bool).
λ (P : ∀ (n : nat), ((G3 (R1) (R0))) -> LTop.2132).
λ (f0 : ∀ (n : nat), ∀ (g : ((eq (bool) ((R2 (R0))) (false))) -> (G3 (R3) ((S (R1))))), (∀ (e : (eq (bool) ((R3 (R1))) (false))), (R3 ((S (R2))) ((R1 (R0))))) -> (R3 (R2) ((G3I (R4) (R2) (R1))))).
(fix F : ∀ (n : nat), ∀ (g : (G3 (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (g : (G3 (R4) (R0))).
match (P:2) R0 return λ (g0 : (G3 (R5) (R1))). (R5 (R2) (R0)) with
 | (1) λ (g0 : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0) (λ (e : (eq (bool) ((R6 (R2))) (false))). (R4 ((S (R3))) ((R1 (R0))))))
end)
λ (f : (nat) -> bool).
λ (P : ∀ (n : nat), ((G3 (R1) (R0))) -> LTop.2446).
λ (f0 : ∀ (n : nat), ∀ (g : ((eq (bool) ((R2 (R0))) (false))) -> (G3 (R3) ((S (R1))))), (∀ (e : (eq (bool) ((R3 (R1))) (false))), (R3 ((S (R2))) ((R1 (R0))))) -> (R3 (R2) ((G3I (R4) (R2) (R1))))).
(fix F : ∀ (n : nat), ∀ (g : (G3 (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (g : (G3 (R4) (R0))).
match (P:2) R0 return λ (g0 : (G3 (R5) (R1))). (R5 (R2) (R0)) with
 | (1) λ (g0 : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0) (λ (e : (eq (bool) ((R6 (R2))) (false))). (R4 ((S (R3))) ((R1 (R0))))))
end)
*)

Print G3.
MetaCoq Run (create G3 true false).
(*
λ (f : (nat) -> bool).
λ (p : ∀ (n : nat), ∀ (inst : (G3 (R1) (R0))), LTop.1887).
λ (H_G3I : ∀ (n : nat), (((eq (bool) ((R2 (R0))) (false))) -> (G3 (R3) ((S (R1))))) -> ∀ (IH : ((eq (bool) ((R3 (R1))) (false))) -> (R3 ((S (R2))) ((R1 (R0))))), (R3 (R2) ((G3I (R4) (R2) (R1))))).
(fix f : ∀ (n : nat), ∀ (inst : (G3 (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (inst : (G3 (R4) (R0))).
match (P:2) R0 return λ (inst : (G3 (R5) (R1))). (R6 (R2) (R0)) with
 | (1) λ (_ : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0) (λ (_ : (eq (bool) ((R6 (R2))) (false))). (R4 ((S (R3))) ((R1 (R0))))))
end)
*)
(*
 | (1) λ (_ : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0) (λ (_ : (eq (bool) ((R6 (R2))) (false))). (R4 ((S (R3))) ((R1 (R0))))))
 | (1) λ (_ : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0) (λ (_ : (eq (bool) ((R7 (R2))) (false))). (R4 ((S (R3))) ((R1 (R0))))))
 | (1) λ (_ : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0) (λ (_ : (eq (bool) ((R2 (R0))) (false))). (R4 ((S (R1))) ((R1 (R0))))))
*)
(*
λ (f : (nat) -> bool).
λ (p : ∀ (n : nat), ∀ (inst : (G3 (R1) (R0))), LTop.230).
λ (H_G3I : ∀ (n : nat), (((eq (bool) ((R2 (R0))) (false))) -> (G3 (R3) ((S (R1))))) -> ∀ (IH : ((eq (bool) ((R3 (R1))) (false))) -> (R3 ((S (R2))) ((R1 (R0))))), (R3 (R2) ((G3I (R4) (R2) (R1))))).
(fix f : ∀ (n : nat), ∀ (inst : (G3 (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (inst : (G3 (R4) (R0))).
match (P:2) R0 return λ (inst : (G3 (R5) (R1))). (R5 (R2) (R0)) with
                                                                                !   !
 | (1) λ (_ : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0) (λ (_ : (eq (bool) ((R5 (R0))) (false))). (R3 ((S (R1))) ((R1 (R0))))))
                 !       !
end)
 *)

(* have *)
(*   λ (f : (nat) -> bool). *)
(* λ (p : ∀ (n : nat), ∀ (inst : ((G3 R1) R0)), Ldestruct_lemma.447). *)
(* λ (H_G3I : ∀ (n : nat), (((((eq bool) (R2 R0)) false)) -> ((G3 R3) (S R1))) -> (((((eq bool) (R3 R1)) false)) -> ((R3 R4) (R1 R0))) -> ((R3 R4) (((G3I R4) R2) R1))). *)
(*                                                                                **                   ** *)
(* (fix f : ∀ (n : nat), ∀ (inst : ((G3 R3) R0)), ((R3 R1) R0) := *)
(* λ (n : nat). λ (inst : ((G3 R4) R0)). *)
(* match (P:2) R0 return λ (inst : ((G3 R5) R1)). ((R5 R2) R0) with *)
(*  | (1) λ (_ : ((((eq bool) (R5 R1)) false)) -> ((G3 R6) (S R2))). (((R4 R2) R0) λ (_ : (((eq bool) (R6 R2)) false)). ((R4 R7) (R1 R0))) *)
(* end) *)

(*   have 2 *)
(*   λ (f : (nat) -> bool). *)
(* λ (p : ∀ (n : nat), ∀ (inst : ((G3 R1) R0)), Ldestruct_lemma.447). *)
(* λ (H_G3I : ∀ (n : nat), (((((eq bool) (R2 R0)) false)) -> ((G3 R3) (S R1))) -> (((((eq bool) (R3 R1)) false)) -> ((R3 (S R2)) (R1 R0))) -> ((R3 R2) (((G3I R4) R2) R1))). *)
(* (fix f : ∀ (n : nat), ∀ (inst : ((G3 R3) R0)), ((R3 R1) R0) := *)
(* λ (n : nat). λ (inst : ((G3 R4) R0)). *)
(* match (P:2) R0 return λ (inst : ((G3 R5) R1)). ((R5 R2) R0) with *)
(*  | (1) λ (_ : ((((eq bool) (R5 R1)) false)) -> ((G3 R6) (S R2))). (((R4 R2) R0) λ (_ : (((eq bool) (R6 R2)) false)). ((R4 (S R3)) (R1 R0))) *)
(* end) *)

(* want *)
(* λ (f : (nat) -> bool). *)
(* λ (P : ∀ (n : nat), (((G3 R1) R0)) -> LTop.409). *)
(* λ (f0 : ∀ (n : nat), ∀ (g : ((((eq bool) (R2 R0)) false)) -> ((G3 R3) (S R1))), (∀ (e : (((eq bool) (R3 R1)) false)), ((R3 (S R2)) (R1 R0))) -> ((R3 R2) (((G3I R4) R2) R1))). *)
(* (fix F : ∀ (n : nat), ∀ (g : ((G3 R3) R0)), ((R3 R1) R0) := *)
(* λ (n : nat). λ (g : ((G3 R4) R0)). *)
(* match (P:2) R0 return λ (g0 : ((G3 R5) R1)). ((R5 R2) R0) with *)
(*  | (1) λ (g0 : ((((eq bool) (R5 R1)) false)) -> ((G3 R6) (S R2))). (((R4 R2) R0) λ (e : (((eq bool) (R6 R2)) false)). ((R4 (S R3)) (R1 R0))) *)
(* end) *)

MetaCoq Run (create G3 true true).

MetaCoq Quote Definition E_G3 := (fun (f : nat -> bool) (p : forall n : nat, G3 f n -> Type)
  (HG3I : forall (n : nat) (h : f n = false -> G3 f (S n)),
        p n (G3I f n h)) =>
fix F (n : nat) (g : G3 f n) {struct g} : p n g :=
  match g as g0 return (p n g0) with
  | @G3I _ _ h => HG3I n h
  end).

(* MetaCoq Run (bruijn_print E_G3). *)
(*
λ (f : (nat) -> bool).
λ (p : ∀ (n : nat), ((G3 (R1) (R0))) -> LTop.481).
λ (HG3I : ∀ (n : nat), ∀ (h : ((eq (bool) ((R2 (R0))) (false))) -> (G3 (R3) ((S (R1))))), (R2 (R1) ((G3I (R3) (R1) (R0))))).
(fix F : ∀ (n : nat), ∀ (g : (G3 (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (g : (G3 (R4) (R0))).
match (P:2) R0 return λ (g0 : (G3 (R5) (R1))). (R5 (R2) (R0)) with
 | (1) λ (h : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0))
end)
 *)

MetaCoq Run (create G3 false false).
MetaCoq Run (create G3 false true).
Print G3_case_MC.
Print G3_case_MC.
(*
 | (1) λ (_ : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0))
 | (1) λ (_ : ((eq (bool) ((R6 (R1))) (false))) -> (G3 (R7) ((S (R2))))). (R4 (R2) (R0))
 | (1) λ (_ : ((eq (bool) ((R4 (R0))) (false))) -> (G3 (R5) ((S (R1))))). (R4 (R2) (R0))
 | (1) λ (_ : ((eq (bool) ((R1 (R0))) (false))) -> (G3 (R2) ((S (R1))))). (R4 (R2) (R0))
 | (1) λ (_ : ((eq (bool) ((R5 (R4))) (false))) -> (G3 (R6) ((S (R5))))). (R4 (R2) (R0))
 | (1) λ (_ : ((eq (bool) ((R5 (R4))) (false))) -> (G3 (R6) ((S (R5))))). (R4 (R2) (R0))
 | (1) λ (_ : ((eq (bool) ((R5 (R4))) (false))) -> (G3 (R6) ((S (R5))))). (R3 (R2) (R0))
 | (1) λ (_ : ((eq (bool) ((R5 (R4))) (false))) -> (G3 (R6) ((S (R5))))). (R3 (R1) (R0))
 *)
(*
λ (f : (nat) -> bool).
λ (p : ∀ (n : nat), ∀ (inst : (G3 (R1) (R0))), LTop.230).
λ (H_G3I : ∀ (n : nat), (((eq (bool) ((R2 (R0))) (false))) -> (G3 (R3) ((S (R1))))) -> (R2 (R1) ((G3I (R3) (R1) (R0))))).
(fix f : ∀ (n : nat), ∀ (inst : (G3 (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (inst : (G3 (R4) (R0))).
match (P:2) R0 return λ (inst : (G3 (R5) (R1))). (R5 (R2) (R0)) with
 | (1) λ (_ : ((eq (bool) ((R5 (R4))) (false))) -> (G3 (R6) ((S (R5))))). (R3 (R0))
                                 !                                !         !!
end)
*)
(*
λ (f : (nat) -> bool). λ (p : ∀ (n : nat), ∀ (inst : (G3 (R1) (R0))), LTop.905). λ (H_G3I : ∀ (n : nat), (((eq (bool) ((R2 (R0))) (false))) -> (G3 (R3) ((S (R1))))) -> (R2 (R1) ((G3I (R3) (R1) (R0))))).
(fix f : ∀ (n : nat), ∀ (inst : (G3 (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (inst : (G3 (R4) (R0))).
match (P:2) R0 return λ (inst : (G3 (R5) (R0))). (R1 (R1) (R0)) with
 | R42
end)
*)
(*
λ (f : (nat) -> bool).
λ (p : ∀ (n : nat), ∀ (inst : (G3 (R1) (R0))), LTop.230).
λ (H_G3I : ∀ (n : nat), (((eq (bool) ((R2 (R0))) (false))) -> (G3 (R3) ((S (R1))))) -> (R2 (R1) ((G3I (R3) (R1) (R0))))).
(fix f : ∀ (n : nat), ∀ (inst : (G3 (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (inst : (G3 (R4) (R0))).
R42
)
*)

Inductive G4 (f:nat->bool) (n:nat) : nat -> Prop :=
  G4I : (f n = false -> G4 f (S n) 1) -> G4 f n 0.
MetaCoq Quote Definition E_G4 := (fun (f : nat -> bool) (p : forall (n m : nat), G4 f n m -> Type)
  (HG4I : forall (n : nat) (h : f n = false -> G4 f (S n) 1),
        p n 0 (G4I f n h)) =>
fix F (n : nat) (m:nat) (g : G4 f n m) {struct g} : p n m g :=
  match g in G4 _ _ m0 return (p n m0 g) with
  | @G4I _ _ h => HG4I n h
  end).
(* MetaCoq Run (bruijn_print E_G4). *)
(*
λ (f : (nat) -> bool).
λ (p : ∀ (n : nat), ∀ (m : nat), ((G4 (R2) (R1) (R0))) -> LTop.2226).
λ (HG4I : ∀ (n : nat), ∀ (h : ((eq (bool) ((R2 (R0))) (false))) -> (G4 (R3) ((S (R1))) ((S (O))))), (R2 (R1) (O) ((G4I (R3) (R1) (R0))))).
(fix F : ∀ (n : nat), ∀ (m : nat), ∀ (g : (G4 (R4) (R1) (R0))), (R4 (R2) (R1) (R0)) :=
λ (n : nat). λ (m : nat). λ (g : (G4 (R5) (R1) (R0))).
match (P:2) R0 return λ (m0 : nat). λ (g : (G4 (R7) (R3) (R0))). (R7 (R4) (R1) (R0)) with
 | (1) λ (h : ((eq (bool) ((R6 (R2))) (false))) -> (G4 (R7) ((S (R3))) ((S (O))))). (R5 (R3) (R0))
end)
*)
MetaCoq Run (create G4 false false).
(*
λ (f : (nat) -> bool).
λ (p : ∀ (n : nat), (nat) -> ∀ (inst : (G4 (R2) (R1) (R0))), LTop.230).
λ (H_G4I : ∀ (n : nat), (((eq (bool) ((R2 (R0))) (false))) -> (G4 (R3) ((S (R1))) ((S (O))))) -> (R2 (R1) (O) ((G4I (R3) (R1) (R0))))).
(fix f : ∀ (n : nat), (nat) -> ∀ (inst : (G4 (R4) (R1) (R0))), (R4 (R2) (R1) (R0)) :=
λ (n : nat). λ (_ : nat). λ (inst : (G4 (R5) (R1) (R0))).
match (P:2) R0 return λ (_ : nat). λ (inst : (G4 (R7) (R3) (R0))). (R6 (R4) (R1) (R0)) with
                                                                     !
 | (1) λ (_ : ((eq (bool) ((R6 (R2))) (false))) -> (G4 (R7) ((S (R3))) ((S (O))))). (R5 (R3) (R0))
end)
 *)
MetaCoq Run (create G4 false true).

Scheme Induction for G4 Sort Type.
Print G4_rect_dep.
MetaCoq Quote Definition I_G4 := (
fun (f : nat -> bool) (P : forall n n0 : nat, G4 f n n0 -> Type)
  (f0 : forall (n : nat) (g : f n = false -> G4 f (S n) 1),
        (forall e : f n = false, P (S n) 1 (g e)) -> P n 0 (G4I f n g)) =>
fix F (n n0 : nat) (g : G4 f n n0) {struct g} : P n n0 g :=
  match g as g0 in (G4 _ _ n1) return (P n n1 g0) with
  | @G4I _ _ g0 => f0 n g0 (fun e : f n = false => F (S n) 1 (g0 e))
  end
                        ).
(* MetaCoq Run (bruijn_print I_G4). *)
(*
λ (f : (nat) -> bool).
λ (P : ∀ (n : nat), ∀ (n0 : nat), ((G4 (R2) (R1) (R0))) -> LTop.1150).
λ (f0 : ∀ (n : nat), ∀ (g : ((eq (bool) ((R2 (R0))) (false))) -> (G4 (R3) ((S (R1))) ((S (O))))), (∀ (e : (eq (bool) ((R3 (R1))) (false))), (R3 ((S (R2))) ((S (O))) ((R1 (R0))))) -> (R3 (R2) (O) ((G4I (R4) (R2) (R1))))).
(fix F : ∀ (n : nat), ∀ (n0 : nat), ∀ (g : (G4 (R4) (R1) (R0))), (R4 (R2) (R1) (R0)) :=
λ (n : nat). λ (n0 : nat). λ (g : (G4 (R5) (R1) (R0))).
match (P:2) R0 return λ (n1 : nat). λ (g0 : (G4 (R7) (R3) (R0))). (R7 (R4) (R1) (R0)) with
 | (1) λ (g0 : ((eq (bool) ((R6 (R2))) (false))) -> (G4 (R7) ((S (R3))) ((S (O))))). (R5 (R3) (R0) (λ (e : (eq (bool) ((R7 (R3))) (false))). (R5 ((S (R4))) ((S (O))) ((R1 (R0))))))
end)
*)

MetaCoq Run (create G4 true false).
(*
λ (f : (nat) -> bool).
λ (p : ∀ (n : nat), (nat) -> ∀ (inst : (G4 (R2) (R1) (R0))), LTop.709).
λ (H_G4I : ∀ (n : nat), (((eq (bool) ((R2 (R0))) (false))) -> (G4 (R3) ((S (R1))) ((S (O))))) -> ∀ (IH : ((eq (bool) ((R3 (R1))) (false))) -> (R3 ((S (R2))) ((S (O))) ((R1 (R0))))), (R3 (R2) (O) ((G4I (R4) (R2) (R1))))).
(fix f : ∀ (n : nat), (nat) -> ∀ (inst : (G4 (R4) (R1) (R0))), (R4 (R2) (R1) (R0)) :=
λ (n : nat). λ (_ : nat). λ (inst : (G4 (R5) (R1) (R0))).
match (P:2) R0 return λ (_ : nat). λ (inst : (G4 (R7) (R3) (R0))). (R7 (R4) (R1) (R0)) with
 | (1) λ (_ : ((eq (bool) ((R6 (R2))) (false))) -> (G4 (R7) ((S (R3))) ((S (O))))). (R5 (R3) (R0) (λ (_ : (eq (bool) ((R8 (R3))) (false))). (R5 ((S (R4))) ((S (O))) ((R1 (R0))))))
        !                         !
end)
*)
MetaCoq Run (create G4 true true).

Inductive G5 (f:nat->bool) (n:nat) (n2:nat) : nat -> Prop :=
  G5I : (f n = false -> G5 f (S n) (2+n2) 1) -> G5 f n n2 0.
MetaCoq Run (create G5 false true).
Print G5_case_MC.
Scheme Induction for G5 Sort Type.
Print G5_rect_dep.
MetaCoq Quote Definition I_G5 := (
fun (f : nat -> bool) (P : forall n n2 n0 : nat, G5 f n n2 n0 -> Type)
  (f0 : forall (n n2 : nat) (g : f n = false -> G5 f (S n) (2 + n2) 1),
        (forall e : f n = false, P (S n) (2 + n2) 1 (g e)) -> P n n2 0 (G5I f n n2 g)) =>
fix F (n n2 n0 : nat) (g : G5 f n n2 n0) {struct g} : P n n2 n0 g :=
  match g as g0 in (G5 _ _ _ n1) return (P n n2 n1 g0) with
  | @G5I _ _ _ g0 => f0 n n2 g0 (fun e : f n = false => F (S n) (2 + n2) 1 (g0 e))
  end
                        ).
(* MetaCoq Run (bruijn_print I_G5). *)
(*
λ (f : (nat) -> bool).
λ (P : ∀ (n : nat), ∀ (n2 : nat), ∀ (n0 : nat), ((G5 (R3) (R2) (R1) (R0))) -> LTop.6844).
λ (f0 : ∀ (n : nat), ∀ (n2 : nat), ∀ (g : ((eq (bool) ((R3 (R1))) (false))) -> (G5 (R4) ((S (R2))) ((Coq.Init.Nat.add ((S ((S (O))))) (R1))) ((S (O))))), (∀ (e : (eq (bool) ((R4 (R2))) (false))), (R4 ((S (R3))) ((Coq.Init.Nat.add ((S ((S (O))))) (R2))) ((S (O))) ((R1 (R0))))) -> (R4 (R3) (R2) (O) ((G5I (R5) (R3) (R2) (R1))))).
(fix F : ∀ (n : nat), ∀ (n2 : nat), ∀ (n0 : nat), ∀ (g : (G5 (R5) (R2) (R1) (R0))), (R5 (R3) (R2) (R1) (R0)) :=
λ (n : nat). λ (n2 : nat). λ (n0 : nat). λ (g : (G5 (R6) (R2) (R1) (R0))).
match (P:3) R0 return λ (n1 : nat). λ (g0 : (G5 (R8) (R4) (R3) (R0))). (R8 (R5) (R4) (R1) (R0)) with
 | (1) λ (g0 : ((eq (bool) ((R7 (R3))) (false))) -> (G5 (R8) ((S (R4))) ((Coq.Init.Nat.add ((S ((S (O))))) (R3))) ((S (O))))). (R6 (R4) (R3) (R0) (λ (e : (eq (bool) ((R8 (R4))) (false))). (R6 ((S (R5))) ((Coq.Init.Nat.add ((S ((S (O))))) (R4))) ((S (O))) ((R1 (R0))))))
end)
*)
MetaCoq Run (create G5 true false).
(*
λ (f : (nat) -> bool).
λ (p : ∀ (n : nat), ∀ (n2 : nat), (nat) -> ∀ (inst : (G5 (R3) (R2) (R1) (R0))), LTop.6376).
λ (H_G5I : ∀ (n : nat), ∀ (n2 : nat), (((eq (bool) ((R3 (R1))) (false))) -> (G5 (R4) ((S (R2))) ((Coq.Init.Nat.add ((S ((S (O))))) (R1))) ((S (O))))) -> ∀ (IH : ((eq (bool) ((R4 (R2))) (false))) -> (R4 ((S (R3))) ((Coq.Init.Nat.add ((S ((S (O))))) (R2))) ((S (O))) ((R1 (R0))))), (R4 (R3) (R2) (O) ((G5I (R5) (R3) (R2) (R1))))).
(fix f : ∀ (n : nat), ∀ (n2 : nat), (nat) -> ∀ (inst : (G5 (R5) (R2) (R1) (R0))), (R5 (R3) (R2) (R1) (R0)) :=
λ (n : nat). λ (n2 : nat). λ (_ : nat). λ (inst : (G5 (R6) (R2) (R1) (R0))).
match (P:3) R0 return λ (_ : nat). λ (inst : (G5 (R8) (R4) (R3) (R0))). (R8 (R5) (R4) (R1) (R0)) with
 | (1) λ (_ : ((eq (bool) ((R7 (R3))) (false))) -> (G5 (R8) ((S (R4))) ((Coq.Init.Nat.add ((S ((S (O))))) (R3))) ((S (O))))). (R6 (R4) (R3) (R0) (λ (_ : (eq (bool) ((R9 (R4))) (false))). (R6 ((S (R5))) ((Coq.Init.Nat.add ((S ((S (O))))) (R4))) ((S (O))) ((R1 (R0))))))
                                                   !
end)
*)
(* MetaCoq Run (create G5 true true). *)

Inductive indexIndTest : nat -> Type :=
  | Ct0 : indexIndTest 0 -> indexIndTest 1.
(* MetaCoq Run (create indexIndTest true). *)
(* Print indexIndTest_case_MC. *)
(* Print indexIndTest_ind. *)

MetaCoq Quote Definition EindexIndTest :=
  (fun (p:forall n, indexIndTest n -> Type)
    HCt0 =>
    (* (HCt0: forall (H:indexIndTest 0), p 0 H -> p 1 (Ct0 H)) => *)
    fix f (n:nat) (x:indexIndTest n) :=
    match x in indexIndTest m return p m x with
      Ct0 H => HCt0 H (f 0 H)
    end).

(* MetaCoq Run (bruijn_print EindexIndTest). *)
(*
λ (p : ∀ (n : nat), ((indexIndTest (R0))) -> LTop.415).
λ (HCt0 : ∀ (x : (indexIndTest (O))), ∀ (x0 : (R1 (O) (R0))), (R2 ((S (O))) ((Ct0 (R1))))).
(fix f : ∀ (n : nat), ∀ (x : (indexIndTest (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (x : (indexIndTest (R0))).
match R0 return λ (m : nat). λ (x : (indexIndTest (R0))). (R6 (R1) (R0)) with
 | λ (H : (indexIndTest (O))). (R4 (R0) ((R3 (O) (R0))))
end)
 *)
MetaCoq Run (create indexIndTest true true).
Print indexIndTest_ind_MC.
Print indexIndTest_ind_MC.

(*
λ (p : (nat) -> ∀ (inst : (indexIndTest (R0))), LTop.2303).
λ (H_Ct0 : ((indexIndTest (O))) -> ∀ (IH : (R1 (O) (R0))), (R2 ((S (O))) ((Ct0 (R1))))).
(fix f : (nat) -> ∀ (inst : (indexIndTest (R0))), (R3 (R1) (R0)) :=
λ (_ : nat). λ (inst : (indexIndTest (R0))).
match R0 return λ (_ : nat). λ (inst : (indexIndTest (R0))). (R6 (R1) (R0)) with
 | λ (_ : (indexIndTest (O))). (R4 (R0) ((R3 (O) (R0))))
end) *)

(** Tests **)
(** Complex with Universes **)

MetaCoq Run (create term false true).
Print term_case_MC.
Print TemplateMonad.
MetaCoq Run(tmPrint <% nat %>).
MetaCoq Run(tmQuote nat >>= tmPrint).
MetaCoq Run(tmQuoteRec nat >>= tmPrint).
MetaCoq Run(tmQuoteInductive "nat" >>= tmPrint).
MetaCoq Run(tmQuoteRec TemplateMonad >>= tmPrint).
MetaCoq Run(tmQuoteInductive "TemplateMonad" >>= tmPrint).
(* MetaCoq Run (create TemplateMonad true). *)

Print term_ind.
(* MetaCoq Quote Definition E_term := *)
(* (fun (P : term -> Prop) (f : forall n : nat, P (tRel n)) (f0 : forall id : ident, P (tVar id)) *)
(*   (f1 : forall (ev : nat) (args : list term), P (tEvar ev args)) (f2 : forall s : universe, P (tSort s)) *)
(*   (f3 : forall t : term, P t -> forall (kind : cast_kind) (v : term), P v -> P (tCast t kind v)) *)
(*   (f4 : forall (na : name) (ty : term), P ty -> forall body : term, P body -> P (tProd na ty body)) *)
(*   (f5 : forall (na : name) (ty : term), P ty -> forall body : term, P body -> P (tLambda na ty body)) *)
(*   (f6 : forall (na : name) (def : term), *)
(*         P def -> forall def_ty : term, P def_ty -> forall body : term, P body -> P (tLetIn na def def_ty body)) *)
(*   (f7 : forall f7 : term, P f7 -> forall args : list term, P (tApp f7 args)) *)
(*   (f8 : forall (c : kername) (u : universe_instance), P (tConst c u)) *)
(*   (f9 : forall (ind : inductive) (u : universe_instance), P (tInd ind u)) *)
(*   (f10 : forall (ind : inductive) (idx : nat) (u : universe_instance), P (tConstruct ind idx u)) *)
(*   (f11 : forall (ind_and_nbparams : inductive × nat) (type_info : term), *)
(*          P type_info -> *)
(*          forall discr : term, *)
(*          P discr -> forall branches : list (nat × term), P (tCase ind_and_nbparams type_info discr branches)) *)
(*   (f12 : forall (proj : projection) (t : term), P t -> P (tProj proj t)) *)
(*   (f13 : forall (mfix : mfixpoint term) (idx : nat), P (tFix mfix idx)) *)
(*   (f14 : forall (mfix : mfixpoint term) (idx : nat), P (tCoFix mfix idx)) => *)
(* fix F (t : term) : P t := *)
(*   match t as t0 return (P t0) with *)
(*   | tRel n => f n *)
(*   | tVar id => f0 id *)
(*   | tEvar ev args => f1 ev args *)
(*   | tSort s => f2 s *)
(*   | tCast t0 kind v => f3 t0 (F t0) kind v (F v) *)
(*   | tProd na ty body => f4 na ty (F ty) body (F body) *)
(*   | tLambda na ty body => f5 na ty (F ty) body (F body) *)
(*   | tLetIn na def def_ty body => f6 na def (F def) def_ty (F def_ty) body (F body) *)
(*   | tApp f15 args => f7 f15 (F f15) args *)
(*   | tConst c u => f8 c u *)
(*   | tInd ind u => f9 ind u *)
(*   | tConstruct ind idx u => f10 ind idx u *)
(*   | tCase ind_and_nbparams type_info discr branches => *)
(*       f11 ind_and_nbparams type_info (F type_info) discr (F discr) branches *)
(*   | tProj proj t0 => f12 proj t0 (F t0) *)
(*   | tFix mfix idx => f13 mfix idx *)
(*   | tCoFix mfix idx => f14 mfix idx *)
(*   end *)
(* ). *)
(* MetaCoq Run (bruijn_print E_term). *)
(*
λ (P : (term) -> Prop).
λ (f : ∀ (n : nat), (R1 ((tRel (R0))))).
λ (f0 : ∀ (id : MetaCoq.Template.BasicAst.ident), (R2 ((tVar (R0))))).
λ (f1 : ∀ (ev : nat), ∀ (args : (list (term))), (R4 ((tEvar (R1) (R0))))).
λ (f2 : ∀ (s : MetaCoq.Template.Universes.universe), (R4 ((tSort (R0))))).
λ (f3 : ∀ (t : term), ((R5 (R0))) -> ∀ (kind : cast_kind), ∀ (v : term), ((R8 (R0))) -> (R9 ((tCast (R4) (R2) (R1))))).
λ (f4 : ∀ (na : name), ∀ (ty : term), ((R7 (R0))) -> ∀ (body : term), ((R9 (R0))) -> (R10 ((tProd (R4) (R3) (R1))))).
λ (f5 : ∀ (na : name), ∀ (ty : term), ((R8 (R0))) -> ∀ (body : term), ((R10 (R0))) -> (R11 ((tLambda (R4) (R3) (R1))))).
λ (f6 : ∀ (na : name), ∀ (def : term), ((R9 (R0))) -> ∀ (def_ty : term), ((R11 (R0))) -> ∀ (body : term), ((R13 (R0))) -> (R14 ((tLetIn (R6) (R5) (R3) (R1))))).
λ (f7 : ∀ (f7 : term), ((R9 (R0))) -> ∀ (args : (list (term))), (R11 ((tApp (R2) (R0))))).
λ (f8 : ∀ (c : MetaCoq.Template.BasicAst.kername), ∀ (u : MetaCoq.Template.Universes.universe_instance), (R11 ((tConst (R1) (R0))))).
λ (f9 : ∀ (ind : inductive), ∀ (u : MetaCoq.Template.Universes.universe_instance), (R12 ((tInd (R1) (R0))))).
λ (f10 : ∀ (ind : inductive), ∀ (idx : nat), ∀ (u : MetaCoq.Template.Universes.universe_instance), (R14 ((tConstruct (R2) (R1) (R0))))).
λ (f11 : ∀ (ind_and_nbparams : (prod (inductive) (nat))), ∀ (type_info : term), ((R14 (R0))) -> ∀ (discr : term), ((R16 (R0))) -> ∀ (branches : (list ((prod (nat) (term))))), (R18 ((tCase (R5) (R4) (R2) (R0))))).
λ (f12 : ∀ (proj : MetaCoq.Template.BasicAst.projection), ∀ (t : term), ((R15 (R0))) -> (R16 ((tProj (R2) (R1))))).
λ (f13 : ∀ (mfix : (MetaCoq.Template.BasicAst.mfixpoint (term))), ∀ (idx : nat), (R16 ((tFix (R1) (R0))))). λ (f14 : ∀ (mfix : (MetaCoq.Template.BasicAst.mfixpoint (term))), ∀ (idx : nat), (R17 ((tCoFix (R1) (R0))))).
(fix F : ∀ (t : term), (R17 (R0)) :=
λ (t : term).
match R0 return λ (t0 : term). (R19 (R0)) with
 | λ (n : nat). (R18 (R0))
 | λ (id : MetaCoq.Template.BasicAst.ident). (R17 (R0))
 | λ (ev : nat). λ (args : (list (term))). (R17 (R1) (R0))
 | λ (s : MetaCoq.Template.Universes.universe). (R15 (R0))
 | λ (t0 : term). λ (kind : cast_kind). λ (v : term). (R16 (R2) ((R4 (R2))) (R1) (R0) ((R4 (R0))))
 | λ (na : name). λ (ty : term). λ (body : term). (R15 (R2) (R1) ((R4 (R1))) (R0) ((R4 (R0))))
 | λ (na : name). λ (ty : term). λ (body : term). (R14 (R2) (R1) ((R4 (R1))) (R0) ((R4 (R0))))
 | λ (na : name). λ (def : term). λ (def_ty : term). λ (body : term). (R14 (R3) (R2) ((R5 (R2))) (R1) ((R5 (R1))) (R0) ((R5 (R0))))
 | λ (f15 : term). λ (args : (list (term))). (R11 (R1) ((R3 (R1))) (R0))
 | λ (c : MetaCoq.Template.BasicAst.kername). λ (u : MetaCoq.Template.Universes.universe_instance). (R10 (R1) (R0))
 | λ (ind : inductive). λ (u : MetaCoq.Template.Universes.universe_instance). (R9 (R1) (R0))
 | λ (ind : inductive). λ (idx : nat). λ (u : MetaCoq.Template.Universes.universe_instance). (R9 (R2) (R1) (R0))
 | λ (ind_and_nbparams : (prod (inductive) (nat))). λ (type_info : term). λ (discr : term). λ (branches : (list ((prod (nat) (term))))). (R9 (R3) (R2) ((R5 (R2))) (R1) ((R5 (R1))) (R0))
 | λ (proj : MetaCoq.Template.BasicAst.projection). λ (t0 : term). (R6 (R1) (R0) ((R3 (R0))))
 | λ (mfix : (MetaCoq.Template.BasicAst.mfixpoint (term))). λ (idx : nat). (R5 (R1) (R0))
 | λ (mfix : (MetaCoq.Template.BasicAst.mfixpoint (term))). λ (idx : nat). (R4 (R1) (R0))
end)
*)
MetaCoq Run (create term true false).
(*
λ (p : ∀ (inst : term), LTop.2491).
λ (H_tRel : ∀ (n : nat), (R1 ((tRel (R0))))).
λ (H_tVar : ∀ (id : MetaCoq.Template.BasicAst.ident), (R2 ((tVar (R0))))).
λ (H_tEvar : ∀ (ev : nat), ∀ (args : (list (term))), ∀ (IH_args : (R4 (R5) (R0))), (R5 ((tEvar (R2) (R1))))).
λ (H_tSort : ∀ (s : MetaCoq.Template.Universes.universe), (R4 ((tSort (R0))))).
λ (H_tCast : ∀ (t : term), ∀ (kind : cast_kind), ∀ (v : term), ∀ (IH_t : (R7 (R2))), ∀ (IH_v : (R8 (R1))), (R9 ((tCast (R4) (R3) (R2))))).
λ (H_tProd : ∀ (na : name), ∀ (ty : term), ∀ (body : term), ∀ (IH_ty : (R8 (R1))), ∀ (IH_body : (R9 (R1))), (R10 ((tProd (R4) (R3) (R2))))).
λ (H_tLambda : ∀ (na : name), ∀ (ty : term), ∀ (body : term), ∀ (IH_ty : (R9 (R1))), ∀ (IH_body : (R10 (R1))), (R11 ((tLambda (R4) (R3) (R2))))).
λ (H_tLetIn : ∀ (na : name), ∀ (def : term), ∀ (def_ty : term), ∀ (body : term), ∀ (IH_def : (R11 (R2))), ∀ (IH_def_ty : (R12 (R2))), ∀ (IH_body : (R13 (R2))), (R14 ((tLetIn (R6) (R5) (R4) (R3))))).
λ (H_tApp : ∀ (f : term), ∀ (args : (list (term))), ∀ (IH_f : (R10 (R1))), ∀ (IH_args : (R11 (R12) (R1))), (R12 ((tApp (R3) (R2))))).
λ (H_tConst : ∀ (c : MetaCoq.Template.BasicAst.kername), ∀ (u : MetaCoq.Template.Universes.universe_instance), (R11 ((tConst (R1) (R0))))).
λ (H_tInd : ∀ (ind : inductive), ∀ (u : MetaCoq.Template.Universes.universe_instance), (R12 ((tInd (R1) (R0))))).
λ (H_tConstruct : ∀ (ind : inductive), ∀ (idx : nat), ∀ (u : MetaCoq.Template.Universes.universe_instance), (R14 ((tConstruct (R2) (R1) (R0))))).
λ (H_tCase : ∀ (ind_and_nbparams : (prod (inductive) (nat))), ∀ (type_info : term), ∀ (discr : term), ∀ (branches : (list ((prod (nat) (term))))), ∀ (IH_type_info : (R16 (R2))), ∀ (IH_discr : (R17 (R2))), ∀ (IH_branches : (R18 ((prod (nat) (R19))) (R2))), (R19 ((tCase (R6) (R5) (R4) (R3))))). λ (H_tProj : ∀ (proj : MetaCoq.Template.BasicAst.projection), ∀ (t : term), ∀ (IH_t : (R15 (R0))), (R16 ((tProj (R2) (R1))))). λ (H_tFix : ∀ (mfix : (MetaCoq.Template.BasicAst.mfixpoint (term))), ∀ (idx : nat), ∀ (IH_mfix : (R16 (R17) (R1))), (R17 ((tFix (R2) (R1))))). λ (H_tCoFix : ∀ (mfix : (MetaCoq.Template.BasicAst.mfixpoint (term))), ∀ (idx : nat), ∀ (IH_mfix : (R17 (R18) (R1))), (R18 ((tCoFix (R2) (R1))))).
(fix f : ∀ (inst : term), (R17 (R0)) :=
λ (inst : term).
match R0 return λ (inst : term). (R19 (R0)) with
 | λ (n : nat). (R18 (R0))
 | λ (id : MetaCoq.Template.BasicAst.ident). (R17 (R0))
 | λ (ev : nat). λ (args : (list (term))). (R17 (R1) (R0) ((R3 (R21) (R0))))
 | λ (s : MetaCoq.Template.Universes.universe). (R15 (R0))
 | λ (t : term). λ (kind : cast_kind). λ (v : term). (R16 (R2) (R1) (R0) ((R4 (R2))) ((R4 (R0))))
 | λ (na : name). λ (ty : term). λ (body : term). (R15 (R2) (R1) (R0) ((R4 (R1))) ((R4 (R0))))
 | λ (na : name). λ (ty : term). λ (body : term). (R14 (R2) (R1) (R0) ((R4 (R1))) ((R4 (R0))))
 | λ (na : name). λ (def : term). λ (def_ty : term). λ (body : term). (R14 (R3) (R2) (R1) (R0) ((R5 (R2))) ((R5 (R1))) ((R5 (R0))))
 | λ (f : term). λ (args : (list (term))). (R11 (R1) (R0) ((R3 (R1))) ((R3 (R21) (R0))))
 | λ (c : MetaCoq.Template.BasicAst.kername). λ (u : MetaCoq.Template.Universes.universe_instance). (R10 (R1) (R0))
 | λ (ind : inductive). λ (u : MetaCoq.Template.Universes.universe_instance). (R9 (R1) (R0))
 | λ (ind : inductive). λ (idx : nat). λ (u : MetaCoq.Template.Universes.universe_instance). (R9 (R2) (R1) (R0))
 | λ (ind_and_nbparams : (prod (inductive) (nat))). λ (type_info : term). λ (discr : term). λ (branches : (list ((prod (nat) (term))))). (R9 (R3) (R2) (R1) (R0) ((R5 (R2))) ((R5 (R1))) ((R5 ((prod (nat) (R23))) (R0))))
 | λ (proj : MetaCoq.Template.BasicAst.projection). λ (t : term). (R6 (R1) (R0) ((R3 (R0))))
 | λ (mfix : (MetaCoq.Template.BasicAst.mfixpoint (term))). λ (idx : nat). (R5 (R1) (R0) ((R3 (R21) (R1))))
 | λ (mfix : (MetaCoq.Template.BasicAst.mfixpoint (term))). λ (idx : nat). (R4 (R1) (R0) ((R3 (R21) (R1))))
end)
 *)

(* MetaCoq Run (create term true true). *)
(* Print term_ind_MC. *)

(* Inductive rtree A : Type := *)
(* | Leaf (a:A) *)
(* | Node (l:list (rtree A)). *)

(* MetaCoq Run (create rtree false true). *)
(* Print rtree_case_MC. *)
(* MetaCoq Run (create rtree true true). *)
(* Print rtree_ind_MC. *)
(* Print rtree_ind. *)

(* Inductive listᵗ (A : Type) (Aᵗ : A -> Type) : list A -> Type := *)
(*     nilᵗ : listᵗ A Aᵗ [] | consᵗ : forall H : A, Aᵗ H -> forall H0 : list A, listᵗ A Aᵗ H0 -> listᵗ A Aᵗ (H :: H0). *)

(* Inductive rtreeᵗ (A : Type) (Aᵗ : A -> Type) : rtree A -> Type := *)
(*     Leafᵗ : forall a : A, Aᵗ a -> rtreeᵗ A Aᵗ (Leaf A a) *)
(*   | Nodeᵗ : forall l : list (rtree A), listᵗ (rtree A) (rtreeᵗ A Aᵗ) l -> rtreeᵗ A Aᵗ (Node A l). *)

(* MetaCoq Run (create rtreeᵗ true true). *)
(* Print rtreeᵗ_ind_MC. *)

(* here are nested *)

(** dependent indices **)

Lemma eqIsEq X (a:X) : a=a.
Proof.
  exact(Logic.eq_refl).
Qed.

Inductive dep (X:Type) : nat -> forall (x:X), x=x -> Prop :=
| dep0 y : dep X 0 y (@Coq.Init.Logic.eq_refl _ y).

MetaCoq Quote Definition Edep :=
  (
    fun (X:Type) (p:forall n x h, dep X n x h -> Prop) =>
      fun Hdep0 =>
        fix f m x h (i:dep X m x h) :=
      match i in dep _ m' x' h' return p m' x' h' i with
        dep0 y => Hdep0 y
      end
  ).
(* MetaCoq Run (bruijn_print Edep). *)
(*
λ (X : LTop.658).
λ (p : ∀ (n : nat), ∀ (x : R1), ∀ (h : (eq (R2) (R0) (R0))), ((dep (R3) (R2) (R1) (R0))) -> Prop).
  λ (Hdep0 : ∀ (x : R1), (R1 (O) (R0) ((eq_refl (R2) (R0))) ((dep0 (R2) (R0))))).
  (fix f : ∀ (m : nat), ∀ (x : R3), ∀ (h : (eq (R4) (R0) (R0))), ∀ (i : (dep (R5) (R2) (R1) (R0))), (R5 (R3) (R2) (R1) (R0)) :=
       λ (m : nat). λ (x : R4). λ (h : (eq (R5) (R0) (R0))). λ (i : (dep (R6) (R2) (R1) (R0))).
       match R0 return λ (m' : nat). λ (x' : R8). λ (h' : (eq (R9) (R0) (R0))). λ (i : (dep (R01) (R2) (R1) (R0))). (R01 (R3) (R2) (R1) (R0)) with
       | λ (y : R7). (R6 (R0))
       end
  )
 *)
MetaCoq Run (create dep false false).
MetaCoq Run (create dep false true).
Print dep_case_MC.
MetaCoq Run (create dep true true).
Print dep_ind_MC.

(** indices **)

Inductive indTest (X:Type) : nat -> Prop :=
  | indC0 : indTest X 0.

Print indTest.
MetaCoq Run (create indTest false false).
MetaCoq Run (create indTest false true).
Print indTest_case_MC.
MetaCoq Run (create indTest true true).
Print indTest_ind_MC.

Print le_n.
Check le_n.
Check le_S.
MetaCoq Run (create Peano.le false true).
MetaCoq Quote Definition leElimType := (
forall (n : nat) (p : forall H : nat, n <= H -> Prop),
             p n (le_n n) ->
             (forall (m : nat) (H : n <= m), p (S m) (le_S n m H)) -> forall (H : nat) (inst : n <= H), p H inst
                                      ).
Print leElimType.

Print le_case_MC.
MetaCoq Run (create Peano.le true true).
Print le_ind_MC.

Inductive eqT (X:Type) (x:X) : X -> Prop := Qcon : eqT X x x.

MetaCoq Run (create eqT false false).
MetaCoq Run (create eqT false true).
Print eqT_case_MC.
MetaCoq Run (create eqT true true).
Print eqT_ind_MC.

Inductive double : nat -> nat -> Prop :=
| d0 : double 0 0
| dS x y : double x y -> double (S x) (S(S y)).

MetaCoq Run (create double false true).
Print double_case_MC.
MetaCoq Run (create double true true).
Print double_ind_MC.

Inductive addition : nat -> nat -> nat -> Prop :=
| add0 x : addition 0 x x
| addS x y z : addition x y z -> addition (S x) y (S z).

MetaCoq Run (create addition false true).
Print addition_case_MC.
MetaCoq Run (create addition true true).
Print addition_ind_MC.

Print Peano.le.
Print Peano.le_ind.
MetaCoq Quote Definition Ele :=
  (fun n (p:forall m, n<=m -> Prop) Hn Hs =>
    fix f m (x:n<=m) :=
    match x in (_ <= m2) return p m2 x with
    | le_n => Hn
    | le_S k H => Hs k H
    end).
Print Ele.
(* MetaCoq Run (bruijn_print Ele). *)
(*
λ (n : nat). λ (p : ∀ (m : nat), ((le (R1) (R0))) -> Prop).
   λ (Hn : (R0 (R1) ((le_n (R1))))).
   λ (Hs : ∀ (x : nat), ∀ (x0 : (le (R3) (R0))), (R3 ((S (R1))) ((le_S (R4) (R1) (R0))))).
   (fix f : ∀ (m : nat), ∀ (x : (le (R4) (R0))), (R4 (R1) (R0)) :=
        λ (m : nat). λ (x : (le (R5) (R0))).
        match R0 return λ (m2 : nat). λ (x : (le (R7) (R0))). (R7 (R1) (R0)) with
        | R4
        | λ (k : nat). λ (H : (le (R7) (R0))). (R5 (R1) (R0))
        end
   )
 *)

(** Parameter **)

MetaCoq Quote Definition qElist := (fun X (p:list X -> Prop) Hnil Hcons =>
              fix f xs :=
              match xs return p xs with
                | nil => Hnil
                | y::ys => Hcons y ys
              end
                           ).
Print qElist.
(* MetaCoq Run (bruijn_print qElist). *)
(*
λ (X : LTop.793). λ (p : ((list (R0))) -> Prop).
  λ (Hnil : (R0 ((nil (R1))))).
  λ (Hcons : ∀ (x : R2), ∀ (x0 : (list (R3))), (R3 ((cons (R4) (R1) (R0))))).
  (fix f : ∀ (xs : (list (R3))), (R3 (R0)) := λ (xs : (list (R4))).
       match R0 return λ (xs : (list (R5))). (R5 (R0)) with
             | R3
             | λ (y : R5). λ (ys : (list (R6))). (R4 (R1) (R0))
       end
  )
 *)

MetaCoq Run (create list false false).
MetaCoq Run (create list false true).
Print list_case_MC.
Print list_ind.
MetaCoq Quote Definition E_list :=
(fun (A : Type) (P : list A -> Prop) (f : P []) (f0 : forall (a : A) (l : list A), P l -> P (a :: l)) =>
fix F (l : list A) : P l := match l as l0 return (P l0) with
                            | [] => f
                            | y :: l0 => f0 y l0 (F l0)
                            end
).
(* MetaCoq Run (bruijn_print E_list). *)
(*
λ (A : LTop.1687).
λ (P : ((list (R0))) -> Prop).
λ (f : (R0 ((nil (R1))))).
λ (f0 : ∀ (a : R2), ∀ (l : (list (R3))), ((R3 (R0))) -> (R4 ((cons (R5) (R2) (R1))))).
(fix F : ∀ (l : (list (R3))), (R3 (R0)) :=
λ (l : (list (R4))).
match R0 return λ (l0 : (list (R5))). (R5 (R0)) with
 | R3
 | λ (y : R5). λ (l0 : (list (R6))). (R4 (R1) (R0) ((R3 (R0))))
end)
 *)
MetaCoq Run (create list true false).
(*
λ (A : LCoq.Init.Datatypes.44).
λ (p : ∀ (inst : (list (R0))), LTop.1260).
λ (H_nil : (R0 ((nil (R1))))).
λ (H_cons : (R2) -> ((list (R3))) -> (R3 ((cons (R4) (R1) (R0))))).
(fix f : ∀ (inst : (list (R3))), (R3 (R0)) :=
λ (inst : (list (R4))).
match R0 return λ (inst : (list (R5))). (R5 (R0)) with
 | R3
 | λ (_ : R5). λ (_ : (list (R6))). (R4 (R1) (R0) ((R3 (R0))))
end)
*)
MetaCoq Run (create list true true).
Print list_ind_MC.

Inductive mutParam (X:Type) (f:X->bool) : Type :=
  | mP : mutParam X f.

MetaCoq Run (create mutParam false true).
Print mutParam.
Print mutParam_case_MC.
MetaCoq Run (create mutParam true true).
Print mutParam_ind_MC.

MetaCoq Run (create and false true).
Print and_case_MC.
MetaCoq Run (create and true true).
Print and_ind_MC.
MetaCoq Run (create or false false).
MetaCoq Run (create or false true).
Print or_case_MC.
MetaCoq Run (create or true true).
Print or_ind_MC.
MetaCoq Run (create ex false true).
Print ex_case_MC.
Print ex.
Scheme Induction for ex Sort Prop.
Print ex_ind_dep.
Print ex_case_MC.
MetaCoq Run (create ex false false).
(*
λ (A : LCoq.Init.Logic.4).
λ (P : (R0) -> Prop).
λ (p : ∀ (inst : (ex (R1) (R0))), Prop).
λ (H_ex_intro : ∀ (x : R2), ((R2 (R0))) -> (R2 ((ex_intro (R4) (R3) (R1) (R0))))).
(fix f : ∀ (inst : (ex (R3) (R2))), (R2 (R0)) :=
λ (inst : (ex (R4) (R3))).
match R0 return λ (inst : (ex (R5) (R4))). (R4 (R0)) with
 | λ (x : R5). λ (_ : (R5 (R0))). (R4 (R1) (R0))
end)
*)
MetaCoq Run (create ex true false).
MetaCoq Run (create ex true true).
Print ex_ind_MC.

Inductive G (f:nat->bool) : nat -> Prop :=
  GI : forall n, (f n = false -> G f (S n)) -> G f n.

Print G_ind.
MetaCoq Quote Definition E_G := (fun (f : nat -> bool) (P : forall n, G f n -> Prop)
  (f0 : forall (n : nat) (h:f n = false -> G f (S n)), (forall (h2:f n = false), P (S n) (h h2)) -> P n (GI f n h)) =>
fix F (n : nat) (g : G f n) {struct g} : P n g :=
  match g in (G _ n0) return (P n0 g) with
  | @GI _ n0 g0 => f0 n0 g0 (fun e : f n0 = false => F (S n0) (g0 e))
  end).
(* MetaCoq Run(bruijn_print E_G). *)
(*
λ (f : (nat) -> bool).
λ (P : ∀ (n : nat), ((G (R1) (R0))) -> Prop).
λ (f0 : ∀ (n : nat), ∀ (h : ((eq (bool) ((R2 (R0))) (false))) -> (G (R3) ((S (R1))))), (∀ (h2 : (eq (bool) ((R3 (R1))) (false))), (R3 ((S (R2))) ((R1 (R0))))) -> (R3 (R2) ((GI (R4) (R2) (R1))))).
(fix F : ∀ (n : nat), ∀ (g : (G (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (g : (G (R4) (R0))).
match R0 return λ (n0 : nat). λ (g : (G (R6) (R0))). (R6 (R1) (R0)) with
 | λ (n0 : nat). λ (g0 : ((eq (bool) ((R6 (R0))) (false))) -> (G (R7) ((S (R1))))). (R5 (R1) (R0) (λ (e : (eq (bool) ((R7 (R1))) (false))). (R5 ((S (R2))) ((R1 (R0))))))
end) *)
MetaCoq Run (create G false false).
MetaCoq Run (create G false true).
Print G_case_MC.
(*
λ (f : (nat) -> bool).
λ (p : (nat) -> ∀ (inst : (G (R1) (R0))), Prop).
λ (H_GI : ∀ (n : nat), (((eq (bool) ((R2 (R0))) (false))) -> (G (R3) ((S (R1))))) -> (R2 (R1) ((GI (R3) (R1) (R0))))).
(fix f : (nat) -> ∀ (inst : (G (R3) (R0))), (R3 (R1) (R0)) :=
λ (_ : nat). λ (inst : (G (R4) (R0))).
match R0 return λ (_ : nat). λ (inst : (G (R6) (R0))). (R6 (R1) (R0)) with
 | λ (n : nat). λ (_ : ((eq (bool) ((R6 (R0))) (false))) -> (G (R7) ((S (R1))))). (R5 (R1) (R0))
end)
 *)

Print G.
MetaCoq Run (create G true false).
(*
λ (f : (nat) -> bool).
λ (p : (nat) -> ∀ (inst : (G (R1) (R0))), Prop).
λ (H_GI : ∀ (n : nat), (((eq (bool) ((R2 (R0))) (false))) -> (G (R3) ((S (R1))))) -> ∀ (IH : ((eq (bool) ((R3 (R1))) (false))) -> (R3 ((S (R2))) ((R1 (R0))))), (R3 (R2) ((GI (R4) (R2) (R1))))).
(fix f : (nat) -> ∀ (inst : (G (R3) (R0))), (R3 (R1) (R0)) :=
λ (_ : nat). λ (inst : (G (R4) (R0))).
match (P:1) R0 return λ (_ : nat). λ (inst : (G (R6) (R0))). (R6 (R1) (R0)) with
 | (2) λ (n : nat). λ (_ : ((eq (bool) ((R6 (R0))) (false))) -> (G (R7) ((S (R1))))). (R5 (R1) (R0) (λ (_ : (eq (bool) ((R6 (R1))) (false))). (R5 ((S (R2))) ((R1 (R0))))))
end)
*)

Print G.
MetaCoq Run (create G true true).
Print G_ind_MC.
Print G.
Print Acc.
MetaCoq Run (create Acc true false).
(* Print Acc_ind_MC. *) (* after move to test *)

(* Inductive G3 (f:nat->bool) (n:nat) : Prop := *)
(*   G3I : (f n = false -> G3 f (S n)) -> G3 f n. *)

(* Scheme Induction for G3 Sort Type. *)
(* Print G3_rect_dep. *)

(* Quote Definition E_G3 := (fun (f : nat -> bool) (p : forall n : nat, G3 f n -> Type) *)
(*   (HG3I : forall (n : nat) (h : f n = false -> G3 f (S n)), *)
(*         p n (G3I f n h)) => *)
(* fix F (n : nat) (g : G3 f n) {struct g} : p n g := *)
(*   match g as g0 return (p n g0) with *)
(*   | @G3I _ _ h => HG3I n h *)
(*   end). *)

(* MetaCoq Run (bruijn_print E_G3). *)

(*
λ (f : (nat) -> bool).
λ (p : ∀ (n : nat), ((G3 (R1) (R0))) -> LTop.654).
λ (HG3I : ∀ (n : nat), ∀ (h : ((eq (bool) ((R2 (R0))) (false))) -> (G3 (R3) ((S (R1))))), (R2 (R1) ((G3I (R3) (R1) (R0))))).
(fix F : ∀ (n : nat), ∀ (g : (G3 (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (g : (G3 (R4) (R0))).
match R0 return λ (g0 : (G3 (R5) (R1))). (R5 (R2) (R0)) with
 | λ (h : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0))
end)
 *)

(*
λ (f : (nat) -> bool).
λ (P : ∀ (n : nat), ((G3 (R1) (R0))) -> LTop.2540).
λ (f0 : ∀ (n : nat), ∀ (g : ((eq (bool) ((R2 (R0))) (false))) -> (G3 (R3) ((S (R1))))), (R2 (R1) ((G3I (R3) (R1) (R0))))).
(fix F : ∀ (n : nat), ∀ (g : (G3 (R3) (R0))), (R3 (R1) (R0)) :=
λ (n : nat). λ (g : (G3 (R4) (R0))).
match R0 return λ (g0 : (G3 (R5) (R1))). (R5 (R2) (R0)) with
 | λ (g0 : ((eq (bool) ((R5 (R1))) (false))) -> (G3 (R6) ((S (R2))))). (R4 (R2) (R0))
end)
 *)

MetaCoq Run (create G3 false false).
(*

 *)
(* MetaCoq Run (create G3 false true). *)
(* Print G3_case_MC. *)
(* MetaCoq Run (create G3 true true). *)
(* Print G3_ind_MC. *)

Print Acc.
MetaCoq Run (create Acc false true).
Print Acc_case_MC.
(* Print Acc_ind_MC. *) (* after move to test *)

(* Quote Definition E_Acc := *)
(*   fun (A:Type) (R:A->A->Prop) (p:forall (x:A), ) *)

(* MetaCoq Run (create Acc true true). *)
(* Print Acc_ind_MC. *)

Inductive G2 (f:nat->bool) : nat -> Prop :=
  G2I1 : forall n, (f n = false -> G2 f (S n)) -> (f n = true -> G2 f (S (S n))) -> G2 f n
| G2I2 : forall n, (f n = false -> G2 f (S n)) -> G2 f n.

MetaCoq Run (create G2 false true).
Print G2_case_MC.
MetaCoq Run (create G2 true true).
Print G2_ind_MC.

(** without params, indices **)

Inductive pfree : Type :=
  | p0 : pfree
  | p1 : pfree
  | p2 (n:nat) : pfree
  | p3 : pfree -> pfree
  | p4 (b:bool) (p:pfree) (n:nat) : pfree.

MetaCoq Run (create pfree false true).
Print pfree_case_MC.
MetaCoq Run (create pfree true true).
Print pfree_ind_MC.

MetaCoq Run (create bool false true).
Print bool_case_MC.
MetaCoq Run (create bool true true).
Print bool_ind_MC.

MetaCoq Run (create True false true).
Print True_case_MC.
MetaCoq Run (create True true true).
Print True_ind_MC.

MetaCoq Run (create False false true).
Print False_case_MC.
MetaCoq Run (create False true true).
Print False_ind_MC.

MetaCoq Run (create nat false false).
(* MetaCoq Run (create nat false true). *)
(* Print nat_case_MC. *) (* after move to test *)
Definition Enat :=
fun (p : nat -> Type) (H_O : p 0) (H_S : forall H : nat, p (S H)) =>
fix f (inst : nat) : p inst := match inst as inst0 return (p inst0) with
                               | 0 => H_O
                               | S x => H_S x
                               end.

(* MetaCoq Run (create nat true true). *)
(* Print nat_ind_MC. *) (* after move to test *)


Require Import Logic.GeneralLogic.Base.
Require Import Logic.MinimumLogic.Syntax.
Require Import Logic.MinimumLogic.ProofTheory.Minimum.
Require Import Logic.MinimumLogic.ProofTheory.RewriteClass.
Require Import Logic.MinimumLogic.ProofTheory.ProofTheoryPatterns.
Require Import Logic.PropositionalLogic.Syntax.
Require Import Logic.PropositionalLogic.ProofTheory.Intuitionistic.
Require Import Logic.PropositionalLogic.ProofTheory.RewriteClass.
Require Import Logic.PropositionalLogic.ProofTheory.ProofTheoryPatterns.
Require Import Logic.PropositionalLogic.ProofTheory.TheoryOfIteratedConnectives.

Require Logic.PropositionalLogic.DeepEmbedded.Deep.

Local Open Scope list_scope.

Ltac length_cont ls k :=
  match ls with
  | nil => k O
  | _ :: ?ls' => length_cont ls' ltac:(fun n => k (S n))
  end.
Ltac length ls := length_cont ls ltac:(fun l => l).

Definition rev (l: list nat): list nat :=
  (fix rev (l: list nat) (cont: list nat -> list nat): list nat :=
    match l with
    | nil => cont nil
    | a :: l0 => rev l0 (fun l => a :: cont l)
    end) l (fun l => l).

Ltac reverse_cont l k :=
  match l with
  | @nil ?T => k (@nil T)
  | @cons _ ?h ?t =>
    let k' l :=
        let t' := k l in
        constr:(cons h t')
    in reverse_cont t k'
  end.
Ltac reverse l := reverse_cont l ltac:(fun l => l).

Ltac pred n :=
  match n with
  | O => O
  | S ?m => m
  end.

Ltac search_expr' n i l l0 :=
  match l with
  | nil => let len := length l0 in constr:((S len, n :: l0))
  | n :: ?t => constr:((i, l0))
  | _ :: ?t => let pi := pred i in search_expr' n pi t l0
  end.
Ltac search_expr n l := let len := length l in search_expr' n len l l.

Section Temp.
  Context {L : Language}
          {minL : MinimumLanguage L}
          {andpL : AndLanguage L}
          (default: Base.expr)
          (tbl : list Base.expr).

  Fixpoint reflect (e : Deep.expr) : Base.expr :=
    match e with
    | Deep.varp n => List.nth (pred n) tbl default
    | Deep.andp e1 e2 => Syntax.andp (reflect e1) (reflect e2)
    | Deep.impp e1 e2 => Syntax.impp (reflect e1) (reflect e2)
    end.
End Temp.

Ltac shallowToDeep' se l0 :=
  match se with
  | Syntax.andp ?sp ?sq =>
    match shallowToDeep' sp l0 with
    | (?dp, ?l1) =>
      match shallowToDeep' sq l1 with
      | (?dq, ?l2) => constr:((Deep.andp dp dq, l2))
      end
    end
  | Syntax.impp ?sp ?sq =>
    match shallowToDeep' sp l0 with
    | (?dp, ?l1) =>
      match shallowToDeep' sq l1 with
      | (?dq, ?l2) => constr:((Deep.impp dp dq, l2))
      end
    end
  | ?sp => match search_expr sp l0 with
          | (?i, ?l1) => constr:((Deep.varp i, l1))
          end
  end.

Ltac shallowToDeep se :=
  match shallowToDeep' se constr:(@nil Base.expr) with
  | (?de, ?tbl) =>
    let tbl' := reverse tbl in
    assert (reflect se tbl' de = se) by reflexivity
  end.

Section Temp.
  Context (L : Base.Language)
          (minL : Syntax.MinimumLanguage L)
          (andL : Syntax.AndLanguage L).
  Context (P Q R : Base.expr).
  Goal False.
    let n := search_expr 1 (1 :: 2 :: 3 :: 4 :: nil) in pose n.
    let n := search_expr 5 (1 :: 2 :: 3 :: 4 :: nil) in pose n.
    shallowToDeep (Syntax.impp (Syntax.andp P Q) (Syntax.andp Q P)).
  Abort.
End Temp.

Section Temp.
  Context {L: Language}
          {minL: MinimumLanguage L}
          {andpL: AndLanguage L}
          {GammaP: Provable L}
          {minAX: MinimumAxiomatization L GammaP}
          {andpAX: AndAxiomatization L GammaP}.

  Theorem reify_sound :
    forall table (default: Base.expr) (e : Deep.expr),
      Deep.provable e -> provable (reflect default table e).
  Proof.
    induction 1.
    - apply (modus_ponens (reflect default table x) (reflect default table y)); assumption.
    - apply (axiom1 (reflect default table x) (reflect default table y)); assumption.
    - apply (axiom2 (reflect default table x) (reflect default table y)); assumption.
    - apply (andp_intros (reflect default table x) (reflect default table y)); assumption.
    - apply (andp_elim1 (reflect default table x) (reflect default table y)); assumption.
    - apply (andp_elim2 (reflect default table x) (reflect default table y)); assumption.
  Qed.
End Temp.

Module DSolver.
  Local Existing Instances Deep.L Deep.minL Deep.andpL Deep.truepL Deep.iffpL Deep.iter_andp_L Deep.iter_andp_DL Deep.GP Deep.minAX Deep.andpAX Deep.truepAX Deep.iffpAX Deep.iter_andp_AXL.

  Instance Adj : P.Adjointness _ _ andp impp.
  Proof.
    constructor. split; intros.
    - rewrite <- impp_uncurry. auto.
    - rewrite <- impp_curry. auto.
  Qed.

  Instance Comm : P.Commutativity _ _ andp.
  Proof.
    apply andp_Comm.
  Qed.

  Instance Mono : P.Monotonicity _ _ andp.
  Proof.
    apply andp_Mono.
  Qed.

  Instance Assoc : P.Associativity _ _ andp.
  Proof.
    apply andp_Assoc.
  Qed.

  Instance LUnit : P.LeftUnit _ _ truep andp.
  Proof.
    constructor; intros; rewrite truep_andp; apply provable_impp_refl.
  Qed.

  Instance RUnit : P.RightUnit _ _ truep andp.
  Proof.
    constructor; intros; rewrite andp_truep; apply provable_impp_refl.
  Qed.

  Fixpoint flatten_imp (e : expr) : list expr * expr :=
    match e with
    | Deep.impp p q => let (cxt, fq) := flatten_imp q in (p :: cxt, fq)
    | _ => (nil, e)
    end.

  Definition flatten_imp_inv (p : list Deep.expr * Deep.expr) :=
    let (ctx, r) := p in multi_imp ctx r.

  Lemma flatten_imp_sound :
    forall e, e = flatten_imp_inv (flatten_imp e).
  Proof.
    intros. induction e; auto.
    simpl.
    destruct (flatten_imp e2) as [ctx fq].
    simpl. rewrite IHe2. auto.
  Qed.

  Fixpoint flatten_and (e : expr) : list expr :=
    match e with
    | Deep.andp p q => (flatten_and p ++ flatten_and q)
    | s => s :: nil
    end.

  Lemma flatten_and_sound :
    forall e, provable (iffp e (iter_andp (flatten_and e))).
  Proof.
    intros.
    rewrite iter_andp_def_l.
    induction e; simpl flatten_and
        (*;
      [ change (flatten_and_inv _) with (fold_left andp (flatten_and e1 ++ flatten_and e2) truep)
      | change (flatten_and_inv _) with (andp truep (orp e1 e2))
      | change (flatten_and_inv _) with (andp truep (impp e1 e2))
      | change (flatten_and_inv _) with (andp truep falsep)
      | change (flatten_and_inv _) with (andp truep (Deep.varp n))
      ]*).
    {
      apply solve_iffp_intros.
      {
        rewrite <- P.assoc_prodp_fold_left.
        rewrite iffp_elim1 in IHe1.
        rewrite iffp_elim1 in IHe2.
        apply P.prodp_mono; auto.
      }
      {
        rewrite P.assoc_fold_left_app.
        rewrite iffp_elim2 in IHe1.
        rewrite iffp_elim2 in IHe2.
        apply P.prodp_mono; auto.
      }
    }
    all: apply solve_iffp_intros;
      cbv [fold_left];
      [rewrite <- P.left_unit2 | rewrite P.left_unit1];
      apply provable_impp_refl.
  Qed.

  Definition flatten (e : expr) : list expr * list expr :=
    let (ctx, r) := flatten_imp e in
    (List.flat_map flatten_and ctx, flatten_and r).

  Definition AllInContext (es1 es2 : list expr) : Prop :=
    Forall (fun e => In e es1) es2.

  Lemma multi_imp_weaken :
    forall x y xs, provable (impp x y) -> provable (impp x (multi_imp xs y)).
  Proof.
    induction xs; intros.
    - auto.
    - change (multi_imp _ _) with (impp a (multi_imp xs y)).
      rewrite <- aux_minimun_theorem01. auto.
  Qed.

  Lemma flatten_imp_inv_In : forall es r, In r es -> provable (flatten_imp_inv (es,r)).
  Proof.
    intros. induction es.
    - contradiction.
    - inversion H; subst.
      + change (flatten_imp_inv _) with (impp r (multi_imp es r)).
        apply multi_imp_weaken. apply provable_impp_refl.
      + change (flatten_imp_inv _) with (impp a (multi_imp es r)).
        apply aux_minimun_rule00. auto.
  Qed.

  Lemma multi_imp_andp_intros :
    forall es x y, provable (multi_imp es x) ->
              provable (multi_imp es y) ->
              provable (multi_imp es (andp x y)).
  Proof.
    intros es x y Hx Hy.
    pose proof provable_multi_imp_weaken es x (impp y (andp x y)) (andp_intros x y).
    pose proof modus_ponens _ _ H Hx.
    pose proof provable_multi_imp_modus_ponens es y (andp x y).
    pose proof modus_ponens _ _ H1 Hy.
    pose proof modus_ponens _ _ H2 H0.
    exact H3.
  Qed.

  Lemma flatten_inv_left_In :
    forall es r, In r (List.flat_map flatten_and es) -> provable (flatten_imp_inv (es, r)).
  Proof.
    intros.
    induction es; [contradiction|].
    simpl in H.
    apply in_app_or in H.
    destruct H.
    + clear IHes.
      apply flatten_imp_inv_In in H.
      change (flatten_imp_inv _) with (multi_imp (flatten_and a) r) in H.
      rewrite <- iter_andp_multi_imp in H.
      pose proof flatten_and_sound a.
      change (flatten_imp_inv _) with (impp a (multi_imp es r)).
      apply multi_imp_weaken.
      apply solve_iffp_elim1 in H0.
      eapply aux_minimun_rule02; eauto.
    + apply aux_minimun_rule00, IHes, H.
  Qed.

  Lemma flatten_inv_All :
    forall es r, AllInContext (List.flat_map flatten_and es) (flatten_and r) ->
            provable (flatten_imp_inv (es, r)).
  Proof.
    intros.
    assert (Forall (fun e => provable (flatten_imp_inv (es, e)))
                   (flatten_and r)).
    { unfold AllInContext in H. rewrite Forall_forall in *. intros e ?.
      specialize (H e H0). clear H0.
      apply flatten_inv_left_In, H.
    } clear H. rename H0 into H.
    induction r; try apply (Forall_inv H).
    simpl in H; apply Coqlib.Forall_app_iff in H; destruct H as [H1 H2].
    apply IHr1 in H1. apply IHr2 in H2.
    apply multi_imp_andp_intros; auto.
  Qed.

  Lemma flatten_sound :
    forall es rs e, (es, rs) = flatten e -> AllInContext es rs -> provable e.
  Proof.
    unfold flatten. intros.
    pose proof flatten_imp_sound e.
    rewrite H1. destruct (flatten_imp e) as [es' r].
    inversion H. clear H. subst. apply flatten_inv_All, H0.
  Qed.

  Definition all_in_context e :=
    let (es, rs) := flatten e in forallb (fun r => existsb (Deep.beq r) es) rs.

  Lemma all_in_AllIn :
    forall es rs e, (es, rs) = flatten e -> all_in_context e = true -> AllInContext es rs.
  Proof.
    intros. unfold all_in_context in H0.
    rewrite <- H in H0. clear H. rename H0 into H.
    rewrite forallb_forall in H.
    unfold AllInContext. rewrite Forall_forall.
    intros. apply H in H0. clear H.
    apply existsb_exists in H0. destruct H0 as [y [H1 H2]].
    apply Deep.beq_eq in H2. subst y. exact H1.
  Qed.

  Lemma all_in_provable :
    forall e, all_in_context e = true -> provable e.
  Proof.
    intros. remember (flatten e) as fe.
    destruct fe as [es rs].
    pose proof all_in_AllIn _ _ _ Heqfe H.
    eapply flatten_sound; eauto.
  Qed.
End DSolver.

Module SolverSound.
  Ltac ipSolver' L se :=
    match shallowToDeep' se constr:(@nil Base.expr) with
    | (?de, ?tbl) =>
      let tbl' := reverse tbl in
      let b := eval hnf in (DSolver.all_in_context de) in
      assert (DSolver.all_in_context de = b) by reflexivity;
      assert (@eq (@Base.expr L) (reflect se tbl' de) (se)) by reflexivity;
      apply (@reify_sound L _ _ _ _ _ tbl' se de);
      apply DSolver.all_in_provable;
      match goal with
      | [H : DSolver.all_in_context _ = true |- _] => apply H
      end
    end.

  Ltac ipSolver :=
    match goal with
    | [|- @Base.provable ?L ?GammaP ?e] => ipSolver' L e
    end.

  Section Temp.
    Context {L: Language}
            {minL: MinimumLanguage L}
            {andpL: AndLanguage L}
            {GammaP: Provable L}
            {minAX: MinimumAxiomatization L GammaP}
            {andpAX: AndAxiomatization L GammaP}.
    Parameter (P Q R : expr).
    Goal (provable (impp (andp P Q) (andp Q P))).
      ipSolver.
    Qed.
  End Temp.
End SolverSound.


Set Warnings "-notation-overridden,-parsing,-deprecated-hint-without-locality".
From Coq Require Import Bool.Bool.
From Coq Require Import Strings.String.
From Coq Require Import Arith.Arith.
From Coq Require Import Arith.EqNat. Import Nat.
From Coq Require Import Arith.PeanoNat.
From Coq Require Import Strings.String.
From Coq Require Import Logic.Eqdep_dec.
From Coq Require Import Logic.FunctionalExtensionality.
From Coq Require Import Lia.
From PFPL Require Import PartialMap_Set.
From PFPL Require Import Definitions.
From PFPL Require Import Lemmas_Vars.
From PFPL Require Import Lemmas_Rename.
From PFPL Require Import Lemmas_Same_Structure.
From PFPL Require Import Induction_Expr.
From PFPL Require Import Lemmas_AlphaEquiv.

Lemma alpha_equiv_renamed_1 : forall e e' x z,
  free_vars e z = false -> all_vars e' z = false ->
  alpha_equiv_rel e (rename e' x z) ->
  e' = (rename e' x z).
Proof.
  intros e e'.
  induction e, e' using expr_pair_ind; intros.
  - simpl. simpl in H1.
    destruct (x0 =? x').
    inversion H1. subst.
    simpl in H. unfold singletonSet in H.
    rewrite Nat.eqb_refl in H. discriminate.
    reflexivity.
  - simpl. simpl in H3.
    simpl in H1. unfold unionSet in H1.
    apply orb_false_iff in H1. destruct H1.
    unfold removeFromSet in H4.
    simpl in H2. unfold unionSet in H2.
    apply orb_false_iff in H2. destruct H2.
    unfold updateSet in H5.
    case_eq (x' =? z); intros X'Z.
    rewrite X'Z in H5. discriminate.
    case_eq (x0 =? x'); intros.
    + rewrite H6 in H3.
      apply Nat.eqb_eq in H6. subst.
      inversion H3. subst.
      assert (T :=
        H e'1 e'3
        (same_structure_refl e'1)
        (same_structure_refl e'3)
        x' z H1 H2 H8
      ).
      rewrite <- T. reflexivity.
    + rewrite H6 in H3. rewrite X'Z in H5.
      inversion H3. subst.
      assert (T :=
        H e'1 e'3
        (same_structure_refl e'1)
        (same_structure_refl e'3)
        x0 z H1 H2 H9
      ).
      rewrite <- T.
      remember (max (get_fresh_var e'2) (get_fresh_var (rename e'4 x0 z))) as newX.
      remember (max (S z) newX) as newX2.
      assert (T2 : (z =? newX2) = false).
      { apply Nat.eqb_neq. lia. }
      assert (T3 : alpha_equiv_rel (rename e'2 x newX2) (rename (rename e'4 x0 z) x' newX2)).
      {
        assert (T3 := max_id (S z)).
        apply H14.
        apply fresh_var_not_in_all_vars. lia.
        apply fresh_var_not_in_all_vars. lia.
      }
      assert (T4 := alpha_equiv_same_free_vars (rename e'2 x newX2) (rename (rename e'4 x0 z) x' newX2) T3).
      assert (T5 : free_vars e'4 x0 = false).
      {
        case_eq (free_vars e'4 x0); intros.
        assert (T5 := rename_the_free_var e'4 x0 z H7 H5).
        rewrite Nat.eqb_sym in X'Z.
        assert (T6 := rename_keeps_other_free_vars (rename e'4 x0 z) x' newX2 z X'Z).
        assert (T6 := T6 T2).
        rewrite <- T4 in T6.
        rewrite T5 in T6.
        case_eq (x =? z); intros XZ.
        apply Nat.eqb_eq in XZ. rewrite XZ in T6.
        assert (T7 := rename_removes_free_vars e'2 z newX2 T2).
        rewrite T7 in T6. discriminate.
        rewrite XZ in H4.
        rewrite Nat.eqb_sym in XZ.
        assert (T7 := rename_keeps_other_free_vars e'2 x newX2 z XZ T2).
        rewrite <- T6 in T7.
        rewrite H4 in T7. discriminate.
        reflexivity.
      }
      f_equal.
      apply rename_non_existant_free.
      assumption.
  - simpl. reflexivity.
  - simpl. reflexivity.
  - simpl. simpl in H3.
    inversion H3. subst.
    simpl in H1. unfold unionSet in H1.
    apply orb_false_iff in H1. destruct H1.
    simpl in H2. unfold unionSet in H2.
    apply orb_false_iff in H2. destruct H2.
    f_equal.
    apply (H e'1 e'3
      (same_structure_refl e'1)
      (same_structure_refl e'3)
      x z H1 H2 H7
    ).
    apply (H0 e'2 e'4
      (same_structure_refl e'2)
      (same_structure_refl e'4)
      x z H4 H5 H9
    ).
  - simpl. simpl in H3.
    inversion H3. subst.
    simpl in H1. unfold unionSet in H1.
    apply orb_false_iff in H1. destruct H1.
    simpl in H2. unfold unionSet in H2.
    apply orb_false_iff in H2. destruct H2.
    f_equal.
    apply (H e'1 e'3
      (same_structure_refl e'1)
      (same_structure_refl e'3)
      x z H1 H2 H7
    ).
    apply (H0 e'2 e'4
      (same_structure_refl e'2)
      (same_structure_refl e'4)
      x z H4 H5 H9
    ).
  - simpl. simpl in H3.
    inversion H3. subst.
    simpl in H1. unfold unionSet in H1.
    apply orb_false_iff in H1. destruct H1.
    simpl in H2. unfold unionSet in H2.
    apply orb_false_iff in H2. destruct H2.
    f_equal.
    apply (H e'1 e'3
      (same_structure_refl e'1)
      (same_structure_refl e'3)
      x z H1 H2 H7
    ).
    apply (H0 e'2 e'4
      (same_structure_refl e'2)
      (same_structure_refl e'4)
      x z H4 H5 H9
    ).
  - simpl. simpl in H2.
    inversion H2. subst.
    simpl in H0.
    simpl in H1.
    f_equal.
    apply (H e'1 e'2
      (same_structure_refl e'1)
      (same_structure_refl e'2)
      x z H0 H1 H5
    ).
  - destruct e'1.
    all: destruct e'2.
    all: simpl in H; try contradiction.
    all: simpl in H2.
    all: inversion H2; subst.
    all: destruct (x =? x0).
    all: inversion H2.
    all: destruct (x =? x1).
    all: inversion H2.
Qed.

Lemma complex : forall e e' x x' x'' z,
  all_vars e z = false ->
  all_vars e' z = false ->
  (x' =? z) = false ->
  (x'' =? x') = false ->
  (forall newX : nat,
    all_vars e newX = false ->
    all_vars (rename e' x'' z) newX = false ->
    alpha_equiv_rel (rename e x newX) (rename (rename e' x'' z) x' newX)
  ) ->
  free_vars e' x'' = false.
Proof.
  intros.
  case_eq (x'' =? z); intros X''Z.

  apply Nat.eqb_eq in X''Z. subst x''.
  apply not_in_expr_not_free; assumption.

  case_eq (x' =? z); intro X'Z.
  rewrite X'Z in H1. symmetry in H1.
  apply Nat.eqb_eq in X'Z. subst.
  discriminate.

  remember (max
    (max (get_fresh_var e) (get_fresh_var e'))
    (max (max (S x'') (S 0)) (max (S z) (S z)))
  ) as newX.
  assert (T := complex_max e e' x'' 0 z z newX HeqnewX).
  destruct T as [T' [_ [T'' [_ [T''' T'''']]]]].
  assert (T3 : free_vars (rename e x newX) z = false). {
    case_eq (x =? z); intros.
    apply Nat.eqb_eq in H4. rewrite H4.
    apply rename_removes_free_vars.
    assumption.
    rewrite Nat.eqb_sym in H4.
    assert (T3 := rename_keeps_other_free_vars e x newX z H4 T'').
    rewrite <- T3. apply not_in_expr_not_free. assumption.
  }
  assert (T4 : all_vars (rename e' x' newX) z = false). {
    rewrite Nat.eqb_sym in X'Z.
    assert (T4 := rename_keeps_other_vars e' x' newX z X'Z T'').
    rewrite H0 in T4. symmetry. assumption.
  }
  assert (T6 : all_vars (rename e' x'' newX) z = false). {
    case_eq (x'' =? z); intros.
    apply Nat.eqb_eq in H4. rewrite H4.
    assert (T6 := rename_non_existant e' z newX H0).
    rewrite <- T6. assumption.
    rewrite Nat.eqb_sym in H4.
    assert (T6 := rename_keeps_other_vars e' x'' newX z H4 T'').
    rewrite H0 in T6. symmetry. assumption.
  }
  assert (T8 : all_vars (rename e' x'' z) newX = false). {
    rewrite Nat.eqb_sym in T'.
    rewrite Nat.eqb_sym in T''.
    assert (T8 := rename_keeps_other_vars e' x'' z newX T' T'').
    rewrite <- T8.
    assumption.
  }
  assert (T9 := H3 newX T''' T8).
  assert (C : (rename (rename e' x'' z) x' newX) = (rename (rename e' x' newX) x'' z)).
  {
    apply rename_commu. assumption.
    assumption. rewrite Nat.eqb_sym.
    assumption. assumption.
  }
  assert (T10 := T9).
  rewrite C in T10.
  assert (T11 := alpha_equiv_renamed_1
    (rename e x newX)
    (rename e' x' newX)
    x'' z T3 T4 T10
  ).
  assert (T12 := rename_non_existant_free_2
    (rename e' x' newX)
    x'' z X''Z T11
  ).
  rewrite X'Z in H1. symmetry in H1.
  assert (T13 := rename_keeps_other_free_vars e' x' newX x'' H2 T').
  rewrite <- T13 in T12.
  assumption.
Qed.

Lemma alpha_equiv_renamed : forall e e' x x' z z',
  all_vars e z = false -> all_vars e' z = false ->
  all_vars e z' = false -> all_vars e' z' = false ->
  alpha_equiv_rel (rename e x z) (rename e' x' z) ->
  alpha_equiv_rel (rename e x z') (rename e' x' z').
Proof.
  intros e e'.
  induction e, e' using expr_pair_ind;
  intros y y' z z' C1 C2 C3 C4 A1; simpl in A1; simpl.
  - case_eq (y =? x); case_eq (y' =? x'); intros X X';
    rewrite X in A1; rewrite X' in A1.
    constructor.
    apply Nat.eqb_eq in X'. inversion A1. subst.
    simpl in C2. unfold singletonSet in C2.
    rewrite Nat.eqb_refl in C2. discriminate.
    apply Nat.eqb_eq in X. inversion A1. subst.
    simpl in C1. unfold singletonSet in C1.
    rewrite Nat.eqb_refl in C1. discriminate.
    assumption.
  - simpl in C1. unfold unionSet in C1.
    rewrite orb_false_iff in C1. destruct C1 as [C1 C1'].
    simpl in C2. unfold unionSet in C2.
    rewrite orb_false_iff in C2. destruct C2 as [C2 C2'].
    simpl in C3. unfold unionSet in C3.
    rewrite orb_false_iff in C3. destruct C3 as [C3 C3'].
    simpl in C4. unfold unionSet in C4.
    rewrite orb_false_iff in C4. destruct C4 as [C4 C4'].
    unfold updateSet in C1'.
    case_eq (x =? z); intro XZ; rewrite XZ in C1'. discriminate.
    unfold updateSet in C2'.
    case_eq (x' =? z); intro X'Z; rewrite X'Z in C2'. discriminate.
    unfold updateSet in C3'.
    case_eq (x =? z'); intro XZ'; rewrite XZ' in C3'. discriminate.
    unfold updateSet in C4'.
    case_eq (x' =? z'); intro X'Z'; rewrite X'Z' in C4'. discriminate.
    case_eq (y =? x); case_eq (y' =? x'); intros Y'X' YX;
    rewrite YX in A1; rewrite Y'X' in A1.
    + apply Nat.eqb_eq in YX. apply Nat.eqb_eq in Y'X'.
      inversion A1. subst. constructor.
      apply (H _ _ (same_structure_refl e'1) (same_structure_refl e'3) x x' z).
      all: assumption.
    + apply Nat.eqb_eq in YX.
      inversion A1. subst. constructor.
      apply (H _ _ (same_structure_refl e'1) (same_structure_refl e'3) x y' z).
      all: try assumption.
      intros.
      assert (T := complex e'2 e'4 x x' y' z C1' C2' X'Z Y'X' H8).
      rewrite <- (rename_non_existant_free e'4 y' z' T).
      rewrite <- (rename_non_existant_free e'4 y' z' T) in H2.
      rewrite <- (rename_non_existant_free e'4 y' z T) in H8.
      apply (H8 z0 H1 H2).
    + apply Nat.eqb_eq in Y'X'.
      inversion A1. subst. constructor.
      apply (H _ _ (same_structure_refl e'1) (same_structure_refl e'3) y x' z).
      all: try assumption.
      assert (H8' : (forall z0 : nat,
        all_vars e'4 z0 = false ->
        all_vars (rename e'2 y z) z0 = false ->
        alpha_equiv_rel (rename e'4 x' z0) (rename (rename e'2 y z) x z0))
      ). {
        intros. apply alpha_equiv_sym. apply H8; assumption.
      }
      intros.
      apply alpha_equiv_sym.
      assert (T := complex e'4 e'2 x' x y z C2' C1' XZ YX H8').
      rewrite <- (rename_non_existant_free e'2 y z' T).
      rewrite <- (rename_non_existant_free e'2 y z' T) in H1.
      rewrite <- (rename_non_existant_free e'2 y z T) in H8'.
      apply (H8' z0 H2 H1).
    + inversion A1. subst. constructor.
      apply (H _ _ (same_structure_refl e'1) (same_structure_refl e'3) y y' z).
      all: try assumption.
      intros.
      remember (max (max
        (max (get_fresh_var (rename e'2 y z)) (get_fresh_var (rename e'4 y' z)))
        (max (get_fresh_var (rename e'2 y z')) (get_fresh_var (rename e'4 y' z')))
      ) (max (max (S y) (S y')) (max (S z) (S z')))) as newX.
      assert (T1 := complex_max_2
        (rename e'2 y z) (rename e'4 y' z)
        (rename e'2 y z') (rename e'4 y' z')
        y y' z z' newX HeqnewX
      ).
      destruct T1 as [YnewX [Y'newX [ZnewX [Z'newX [T1 [T2 [T3 T4]]]]]]].
      clear HeqnewX.
      assert (T5 := H8 newX T1 T2).
      rewrite Nat.eqb_sym in XZ.
      rewrite (rename_commu e'2 y z x newX YX YnewX XZ ZnewX) in T5.
      rewrite Nat.eqb_sym in X'Z.
      rewrite (rename_commu e'4 y' z x' newX Y'X' Y'newX X'Z ZnewX) in T5.
      assert (T6 : all_vars (rename e'2 x newX) z = false). {
        assert (T6 := rename_keeps_other_vars e'2 x newX z XZ ZnewX).
        rewrite <- T6. assumption.
      }
      assert (T7 : all_vars (rename e'4 x' newX) z = false). {
        assert (T7 := rename_keeps_other_vars e'4 x' newX z X'Z ZnewX).
        rewrite <- T7. assumption.
      }
      assert (T8 : all_vars (rename e'2 x newX) z' = false). {
        rewrite Nat.eqb_sym in XZ'.
        assert (T8 := rename_keeps_other_vars e'2 x newX z' XZ' Z'newX).
        rewrite <- T8. assumption.
      }
      assert (T9 : all_vars (rename e'4 x' newX) z' = false). {
        rewrite Nat.eqb_sym in X'Z'.
        assert (T9 := rename_keeps_other_vars e'4 x' newX z' X'Z' Z'newX).
        rewrite <- T9. assumption.
      }
      assert (T10 := H0 (rename e'2 x newX) (rename e'4 x' newX)
        (rename_keeps_structure e'2 x newX)
        (rename_keeps_structure e'4 x' newX)
        y y' z z' T6 T7 T8 T9 T5
      ).
      rewrite Nat.eqb_sym in YX.
      rewrite Nat.eqb_sym in YnewX.
      rewrite Nat.eqb_sym in Z'newX.
      rewrite (rename_commu e'2 x newX y z' YX XZ' YnewX Z'newX) in T10.
      rewrite Nat.eqb_sym in Y'X'.
      rewrite Nat.eqb_sym in Y'newX.
      rewrite (rename_commu e'4 x' newX y' z' Y'X' X'Z' Y'newX Z'newX) in T10.
      apply (H0
        (rename e'2 y z')
        (rename e'4 y' z')
        (rename_keeps_structure e'2 y z')
        (rename_keeps_structure e'4 y' z')
        x x' newX z0 T3 T4 H1 H2 T10
      ).
  - assumption.
  - assumption.
  - simpl in C1. unfold unionSet in C1.
    rewrite orb_false_iff in C1. destruct C1 as [C1 C1'].
    simpl in C2. unfold unionSet in C2.
    rewrite orb_false_iff in C2. destruct C2 as [C2 C2'].
    simpl in C3. unfold unionSet in C3.
    rewrite orb_false_iff in C3. destruct C3 as [C3 C3'].
    simpl in C4. unfold unionSet in C4.
    rewrite orb_false_iff in C4. destruct C4 as [C4 C4'].
    inversion A1. subst.
    constructor.
    apply (H e'1 e'3 (same_structure_refl e'1) (same_structure_refl e'3) y y' z).
    all: try assumption.
    apply (H0 e'2 e'4 (same_structure_refl e'2) (same_structure_refl e'4) y y' z).
    all: assumption.
  - simpl in C1. unfold unionSet in C1.
    rewrite orb_false_iff in C1. destruct C1 as [C1 C1'].
    simpl in C2. unfold unionSet in C2.
    rewrite orb_false_iff in C2. destruct C2 as [C2 C2'].
    simpl in C3. unfold unionSet in C3.
    rewrite orb_false_iff in C3. destruct C3 as [C3 C3'].
    simpl in C4. unfold unionSet in C4.
    rewrite orb_false_iff in C4. destruct C4 as [C4 C4'].
    inversion A1. subst.
    constructor.
    apply (H e'1 e'3 (same_structure_refl e'1) (same_structure_refl e'3) y y' z).
    all: try assumption.
    apply (H0 e'2 e'4 (same_structure_refl e'2) (same_structure_refl e'4) y y' z).
    all: assumption.
  - simpl in C1. unfold unionSet in C1.
    rewrite orb_false_iff in C1. destruct C1 as [C1 C1'].
    simpl in C2. unfold unionSet in C2.
    rewrite orb_false_iff in C2. destruct C2 as [C2 C2'].
    simpl in C3. unfold unionSet in C3.
    rewrite orb_false_iff in C3. destruct C3 as [C3 C3'].
    simpl in C4. unfold unionSet in C4.
    rewrite orb_false_iff in C4. destruct C4 as [C4 C4'].
    inversion A1. subst.
    constructor.
    apply (H e'1 e'3 (same_structure_refl e'1) (same_structure_refl e'3) y y' z).
    all: try assumption.
    apply (H0 e'2 e'4 (same_structure_refl e'2) (same_structure_refl e'4) y y' z).
    all: assumption.
  - simpl in C1.
    simpl in C2.
    simpl in C3.
    simpl in C4.
    inversion A1. subst.
    constructor.
    apply (H e'1 e'2 (same_structure_refl e'1) (same_structure_refl e'2) y y' z).
    all: assumption.
  - assert (T := diff_constructor_not_alpha e'1 e'2 H
      (rename e'1 y z) (rename e'2 y' z)
      (rename_keeps_structure e'1 y z)
      (rename_keeps_structure e'2 y' z)
      A1
    ).
    contradiction.
Qed.

Lemma rename_keeps_alpha_equiv : forall e e' x z,
  all_vars e z = false -> all_vars e' z = false ->
  alpha_equiv_rel e e' ->
  alpha_equiv_rel (rename e x z) (rename e' x z).
Proof.
  intros.
  generalize dependent H0.
  generalize dependent H.
  generalize dependent z.
  generalize dependent x.
  induction H1; intros; simpl.
  - apply alpha_equiv_refl.
  - simpl in H2. unfold unionSet in H2.
    apply orb_false_iff in H2. destruct H2 as [H2 H2'].
    unfold updateSet in H2'. case_eq (x =? z); intro XZ.
    all: rewrite XZ in H2'. discriminate.
    simpl in H3. unfold unionSet in H3.
    apply orb_false_iff in H3. destruct H3 as [H3 H3'].
    unfold updateSet in H3'. case_eq (x' =? z); intro X'Z.
    all: rewrite X'Z in H3'. discriminate.
    case_eq (x0 =? x); intro X0X;
    case_eq (x0 =? x'); intro X0X'.
    + apply Nat.eqb_eq in X0X. apply Nat.eqb_eq in X0X'. subst.
      apply alpha_equiv_rel_let.
      apply IHalpha_equiv_rel; assumption.
      assumption.
    + apply Nat.eqb_eq in X0X. subst.
      apply alpha_equiv_rel_let.
      apply IHalpha_equiv_rel; assumption.
      intros.
      remember (max
        (max
          (max (get_fresh_var e2) (get_fresh_var e2'))
          (max (get_fresh_var e2) (get_fresh_var (rename e2' x z)))
        )
        (max (max (S x) (S x')) (max (S z) (S z0)))) as newX.
      assert (M := complex_max_2 e2 e2' e2 (rename e2' x z)
        x x' z z0 newX HeqnewX
      ).
      destruct M as [M1 [M2 [M3 [M4 [M5 [M6 [M7 M8]]]]]]].
      apply (alpha_equiv_renamed e2 (rename e2' x z)
        x x' newX z0 M5 M8 H4 H5
      ).
      rewrite Nat.eqb_sym in X'Z.
      rewrite (rename_commu _ _ _ _ _ X0X' M1 X'Z M3).
      rewrite (rename_twice e2 x newX z M1 M5).
      apply H0; try assumption.
      apply rename_does_not_add_new_var.
      rewrite Nat.eqb_sym. assumption. assumption.
      apply rename_does_not_add_new_var.
      rewrite Nat.eqb_sym. assumption. assumption.
    + apply Nat.eqb_eq in X0X'. subst.
      apply alpha_equiv_rel_let.
      apply IHalpha_equiv_rel; assumption.
      intros.
      remember (max
        (max
          (max (get_fresh_var e2) (get_fresh_var e2'))
          (max (get_fresh_var (rename e2 x' z)) (get_fresh_var e2'))
        )
        (max (max (S x) (S x')) (max (S z) (S z0)))) as newX.
      assert (M := complex_max_2 e2 e2' (rename e2 x' z) e2'
        x x' z z0 newX HeqnewX
      ).
      destruct M as [M1 [M2 [M3 [M4 [M5 [M6 [M7 M8]]]]]]].
      apply (alpha_equiv_renamed (rename e2 x' z) e2'
        x x' newX z0 M7 M8 H4 H5
      ).
      rewrite Nat.eqb_sym in XZ.
      rewrite (rename_commu _ _ _ _ _ X0X M2 XZ M3).
      rewrite (rename_twice e2' x' newX z M2 M6).
      apply H0; try assumption.
      apply rename_does_not_add_new_var.
      rewrite Nat.eqb_sym. assumption. assumption.
      apply rename_does_not_add_new_var.
      rewrite Nat.eqb_sym. assumption. assumption.
    + apply alpha_equiv_rel_let.
      apply IHalpha_equiv_rel; assumption.
      intros.
      remember (max
        (max
          (max (get_fresh_var e2) (get_fresh_var e2'))
          (max (get_fresh_var (rename e2 x0 z)) (get_fresh_var (rename e2' x0 z)))
        )
        (max (max (S x0) (S x')) (max (S z) (S z0)))) as newX.
      assert (M := complex_max_2 e2 e2' (rename e2 x0 z) (rename e2' x0 z)
        x0 x' z z0 newX HeqnewX
      ).
      destruct M as [M1 [M2 [M3 [M4 [M5 [M6 [M7 M8]]]]]]].
      apply (alpha_equiv_renamed (rename e2 x0 z) (rename e2' x0 z)
        x x' newX z0 M7 M8 H4 H5
      ).
      rewrite Nat.eqb_sym in XZ.
      rewrite (rename_commu e2 _ _ _ _ X0X M1 XZ M3).
      rewrite Nat.eqb_sym in X'Z.
      rewrite (rename_commu e2' _ _ _ _ X0X' M1 X'Z M3).
      apply H0; try assumption.
      apply rename_does_not_add_new_var.
      rewrite Nat.eqb_sym. assumption. assumption.
      apply rename_does_not_add_new_var.
      rewrite Nat.eqb_sym. assumption. assumption.
  - apply alpha_equiv_rel_num.
  - apply alpha_equiv_rel_str. assumption.
  - simpl in H. unfold unionSet in H.
    apply orb_false_iff in H. destruct H as [H H'].
    simpl in H0. unfold unionSet in H0.
    apply orb_false_iff in H0. destruct H0 as [H0 H0'].
    apply alpha_equiv_rel_plus; [apply IHalpha_equiv_rel1 | apply IHalpha_equiv_rel2].
    all: assumption.
  - simpl in H. unfold unionSet in H.
    apply orb_false_iff in H. destruct H as [H H'].
    simpl in H0. unfold unionSet in H0.
    apply orb_false_iff in H0. destruct H0 as [H0 H0'].
    apply alpha_equiv_rel_times; [apply IHalpha_equiv_rel1 | apply IHalpha_equiv_rel2].
    all: assumption.
  - simpl in H. unfold unionSet in H.
    apply orb_false_iff in H. destruct H as [H H'].
    simpl in H0. unfold unionSet in H0.
    apply orb_false_iff in H0. destruct H0 as [H0 H0'].
    apply alpha_equiv_rel_cat; [apply IHalpha_equiv_rel1 | apply IHalpha_equiv_rel2].
    all: assumption.
  - simpl in H. simpl in H0.
    apply alpha_equiv_rel_len. apply IHalpha_equiv_rel.
    all: assumption.
Qed.