Require Import Coq.Arith.Wf_nat.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Program.Equality.

Require Export Metalib.Metatheory.
Require Export Metalib.LibLNgen.

Require Export dqtt_ott.

(** NOTE: Auxiliary theorems are hidden in generated documentation.
    In general, there is a [_rec] version of every lemma involving
    [open] and [close]. *)

(* *********************************************************************** *)
(** * Induction principles for nonterminals *)

Scheme tm_ind' := Induction for tm Sort Prop.

Definition tm_mutind :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24 H25 =>
  tm_ind' H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24 H25.

Scheme tm_rec' := Induction for tm Sort Set.

Definition tm_mutrec :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24 H25 =>
  tm_rec' H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24 H25.

Fixpoint size_tm (a1 : tm) {struct a1} : nat :=
  match a1 with
    | a_TyUnit => 1
    | a_TmUnit => 1
    | a_letunitB a2 b1 B1 => 1 + (size_tm a2) + (size_tm b1) + (size_tm B1)
    | a_Pi q1 A1 B1 => 1 + (size_usage q1) + (size_tm A1) + (size_tm B1)
    | a_Lam q1 A1 a2 => 1 + (size_usage q1) + (size_tm A1) + (size_tm a2)
    | a_App a2 b1 => 1 + (size_tm a2) + (size_tm b1)
    | a_Box q1 A1 => 1 + (size_usage q1) + (size_tm A1)
    | a_LetBoxB a2 b1 B1 => 1 + (size_tm a2) + (size_tm b1) + (size_tm B1)
    | a_Type => 1
    | a_Var_f x1 => 1
    | a_Var_b n1 => 1
    | a_box q1 a2 => 1 + (size_usage q1) + (size_tm a2)
    | a_Let a2 b1 => 1 + (size_tm a2) + (size_tm b1)
    | a_Sum A1 A2 => 1 + (size_tm A1) + (size_tm A2)
    | a_Inj1 a2 => 1 + (size_tm a2)
    | a_Inj2 a2 => 1 + (size_tm a2)
    | a_Case q1 a2 b1 b2 B1 => 1 + (size_usage q1) + (size_tm a2) + (size_tm b1) + (size_tm b2) + (size_tm B1)
    | a_Sigma q1 A1 B1 => 1 + (size_usage q1) + (size_tm A1) + (size_tm B1)
    | a_Tensor a2 b1 => 1 + (size_tm a2) + (size_tm b1)
    | a_Spread a2 b1 B1 => 1 + (size_tm a2) + (size_tm b1) + (size_tm B1)
    | a_With A1 B1 => 1 + (size_tm A1) + (size_tm B1)
    | a_Pair a2 b1 => 1 + (size_tm a2) + (size_tm b1)
    | a_Prj1 a2 => 1 + (size_tm a2)
    | a_Prj2 a2 => 1 + (size_tm a2)
  end.

(* *********************************************************************** *)
(** * Degree *)

(** These define only an upper bound, not a strict upper bound. *)

Inductive degree_tm_wrt_tm : nat -> tm -> Prop :=
  | degree_wrt_tm_a_TyUnit : forall n1,
    degree_tm_wrt_tm n1 (a_TyUnit)
  | degree_wrt_tm_a_TmUnit : forall n1,
    degree_tm_wrt_tm n1 (a_TmUnit)
  | degree_wrt_tm_a_letunitB : forall n1 a1 b1 B1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm n1 b1 ->
    degree_tm_wrt_tm n1 B1 ->
    degree_tm_wrt_tm n1 (a_letunitB a1 b1 B1)
  | degree_wrt_tm_a_Pi : forall n1 q1 A1 B1,
    degree_tm_wrt_tm n1 A1 ->
    degree_tm_wrt_tm (S n1) B1 ->
    degree_tm_wrt_tm n1 (a_Pi q1 A1 B1)
  | degree_wrt_tm_a_Lam : forall n1 q1 A1 a1,
    degree_tm_wrt_tm n1 A1 ->
    degree_tm_wrt_tm (S n1) a1 ->
    degree_tm_wrt_tm n1 (a_Lam q1 A1 a1)
  | degree_wrt_tm_a_App : forall n1 a1 b1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm n1 b1 ->
    degree_tm_wrt_tm n1 (a_App a1 b1)
  | degree_wrt_tm_a_Box : forall n1 q1 A1,
    degree_tm_wrt_tm n1 A1 ->
    degree_tm_wrt_tm n1 (a_Box q1 A1)
  | degree_wrt_tm_a_LetBoxB : forall n1 a1 b1 B1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm (S n1) b1 ->
    degree_tm_wrt_tm n1 B1 ->
    degree_tm_wrt_tm n1 (a_LetBoxB a1 b1 B1)
  | degree_wrt_tm_a_Type : forall n1,
    degree_tm_wrt_tm n1 (a_Type)
  | degree_wrt_tm_a_Var_f : forall n1 x1,
    degree_tm_wrt_tm n1 (a_Var_f x1)
  | degree_wrt_tm_a_Var_b : forall n1 n2,
    lt n2 n1 ->
    degree_tm_wrt_tm n1 (a_Var_b n2)
  | degree_wrt_tm_a_box : forall n1 q1 a1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm n1 (a_box q1 a1)
  | degree_wrt_tm_a_Let : forall n1 a1 b1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm (S n1) b1 ->
    degree_tm_wrt_tm n1 (a_Let a1 b1)
  | degree_wrt_tm_a_Sum : forall n1 A1 A2,
    degree_tm_wrt_tm n1 A1 ->
    degree_tm_wrt_tm n1 A2 ->
    degree_tm_wrt_tm n1 (a_Sum A1 A2)
  | degree_wrt_tm_a_Inj1 : forall n1 a1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm n1 (a_Inj1 a1)
  | degree_wrt_tm_a_Inj2 : forall n1 a1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm n1 (a_Inj2 a1)
  | degree_wrt_tm_a_Case : forall n1 q1 a1 b1 b2 B1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm n1 b1 ->
    degree_tm_wrt_tm n1 b2 ->
    degree_tm_wrt_tm n1 B1 ->
    degree_tm_wrt_tm n1 (a_Case q1 a1 b1 b2 B1)
  | degree_wrt_tm_a_Sigma : forall n1 q1 A1 B1,
    degree_tm_wrt_tm n1 A1 ->
    degree_tm_wrt_tm (S n1) B1 ->
    degree_tm_wrt_tm n1 (a_Sigma q1 A1 B1)
  | degree_wrt_tm_a_Tensor : forall n1 a1 b1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm n1 b1 ->
    degree_tm_wrt_tm n1 (a_Tensor a1 b1)
  | degree_wrt_tm_a_Spread : forall n1 a1 b1 B1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm (S n1) b1 ->
    degree_tm_wrt_tm n1 B1 ->
    degree_tm_wrt_tm n1 (a_Spread a1 b1 B1)
  | degree_wrt_tm_a_With : forall n1 A1 B1,
    degree_tm_wrt_tm n1 A1 ->
    degree_tm_wrt_tm (S n1) B1 ->
    degree_tm_wrt_tm n1 (a_With A1 B1)
  | degree_wrt_tm_a_Pair : forall n1 a1 b1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm n1 b1 ->
    degree_tm_wrt_tm n1 (a_Pair a1 b1)
  | degree_wrt_tm_a_Prj1 : forall n1 a1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm n1 (a_Prj1 a1)
  | degree_wrt_tm_a_Prj2 : forall n1 a1,
    degree_tm_wrt_tm n1 a1 ->
    degree_tm_wrt_tm n1 (a_Prj2 a1).

Scheme degree_tm_wrt_tm_ind' := Induction for degree_tm_wrt_tm Sort Prop.

Definition degree_tm_wrt_tm_mutind :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24 H25 =>
  degree_tm_wrt_tm_ind' H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24 H25.

Hint Constructors degree_tm_wrt_tm : core lngen.

(* *********************************************************************** *)
(** * Local closure (version in [Set], induction principles) *)

Inductive lc_set_tm : tm -> Set :=
  | lc_set_a_TyUnit :
    lc_set_tm (a_TyUnit)
  | lc_set_a_TmUnit :
    lc_set_tm (a_TmUnit)
  | lc_set_a_letunitB : forall a1 b1 B1,
    lc_set_tm a1 ->
    lc_set_tm b1 ->
    lc_set_tm B1 ->
    lc_set_tm (a_letunitB a1 b1 B1)
  | lc_set_a_Pi : forall q1 A1 B1,
    lc_set_tm A1 ->
    (forall x1 : tmvar, lc_set_tm (open_tm_wrt_tm B1 (a_Var_f x1))) ->
    lc_set_tm (a_Pi q1 A1 B1)
  | lc_set_a_Lam : forall q1 A1 a1,
    lc_set_tm A1 ->
    (forall x1 : tmvar, lc_set_tm (open_tm_wrt_tm a1 (a_Var_f x1))) ->
    lc_set_tm (a_Lam q1 A1 a1)
  | lc_set_a_App : forall a1 b1,
    lc_set_tm a1 ->
    lc_set_tm b1 ->
    lc_set_tm (a_App a1 b1)
  | lc_set_a_Box : forall q1 A1,
    lc_set_tm A1 ->
    lc_set_tm (a_Box q1 A1)
  | lc_set_a_LetBoxB : forall a1 b1 B1,
    lc_set_tm a1 ->
    (forall x1 : tmvar, lc_set_tm (open_tm_wrt_tm b1 (a_Var_f x1))) ->
    lc_set_tm B1 ->
    lc_set_tm (a_LetBoxB a1 b1 B1)
  | lc_set_a_Type :
    lc_set_tm (a_Type)
  | lc_set_a_Var_f : forall x1,
    lc_set_tm (a_Var_f x1)
  | lc_set_a_box : forall q1 a1,
    lc_set_tm a1 ->
    lc_set_tm (a_box q1 a1)
  | lc_set_a_Let : forall a1 b1,
    lc_set_tm a1 ->
    (forall x1 : tmvar, lc_set_tm (open_tm_wrt_tm b1 (a_Var_f x1))) ->
    lc_set_tm (a_Let a1 b1)
  | lc_set_a_Sum : forall A1 A2,
    lc_set_tm A1 ->
    lc_set_tm A2 ->
    lc_set_tm (a_Sum A1 A2)
  | lc_set_a_Inj1 : forall a1,
    lc_set_tm a1 ->
    lc_set_tm (a_Inj1 a1)
  | lc_set_a_Inj2 : forall a1,
    lc_set_tm a1 ->
    lc_set_tm (a_Inj2 a1)
  | lc_set_a_Case : forall q1 a1 b1 b2 B1,
    lc_set_tm a1 ->
    lc_set_tm b1 ->
    lc_set_tm b2 ->
    lc_set_tm B1 ->
    lc_set_tm (a_Case q1 a1 b1 b2 B1)
  | lc_set_a_Sigma : forall q1 A1 B1,
    lc_set_tm A1 ->
    (forall x1 : tmvar, lc_set_tm (open_tm_wrt_tm B1 (a_Var_f x1))) ->
    lc_set_tm (a_Sigma q1 A1 B1)
  | lc_set_a_Tensor : forall a1 b1,
    lc_set_tm a1 ->
    lc_set_tm b1 ->
    lc_set_tm (a_Tensor a1 b1)
  | lc_set_a_Spread : forall a1 b1 B1,
    lc_set_tm a1 ->
    (forall x1 : tmvar, lc_set_tm (open_tm_wrt_tm b1 (a_Var_f x1))) ->
    lc_set_tm B1 ->
    lc_set_tm (a_Spread a1 b1 B1)
  | lc_set_a_With : forall A1 B1,
    lc_set_tm A1 ->
    (forall x1 : tmvar, lc_set_tm (open_tm_wrt_tm B1 (a_Var_f x1))) ->
    lc_set_tm (a_With A1 B1)
  | lc_set_a_Pair : forall a1 b1,
    lc_set_tm a1 ->
    lc_set_tm b1 ->
    lc_set_tm (a_Pair a1 b1)
  | lc_set_a_Prj1 : forall a1,
    lc_set_tm a1 ->
    lc_set_tm (a_Prj1 a1)
  | lc_set_a_Prj2 : forall a1,
    lc_set_tm a1 ->
    lc_set_tm (a_Prj2 a1).

Scheme lc_tm_ind' := Induction for lc_tm Sort Prop.

Definition lc_tm_mutind :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24 =>
  lc_tm_ind' H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24.

Scheme lc_set_tm_ind' := Induction for lc_set_tm Sort Prop.

Definition lc_set_tm_mutind :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24 =>
  lc_set_tm_ind' H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24.

Scheme lc_set_tm_rec' := Induction for lc_set_tm Sort Set.

Definition lc_set_tm_mutrec :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24 =>
  lc_set_tm_rec' H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 H18 H19 H20 H21 H22 H23 H24.

Hint Constructors lc_tm : core lngen.

Hint Constructors lc_set_tm : core lngen.

(* *********************************************************************** *)
(** * Body *)

Definition body_tm_wrt_tm a1 := forall x1, lc_tm (open_tm_wrt_tm a1 (a_Var_f x1)).

Hint Unfold body_tm_wrt_tm : core.

(* *********************************************************************** *)
(** * Tactic support *)

(** Additional hint declarations. *)

Hint Resolve @plus_le_compat : lngen.

(** Redefine some tactics. *)

Ltac default_case_split ::=
  first
    [ progress destruct_notin
    | progress destruct_sum
    | progress safe_f_equal
    ].

(* *********************************************************************** *)
(** * Theorems about [size] *)

Ltac default_auto ::= auto with arith lngen; tauto.
Ltac default_autorewrite ::= fail.

(* begin hide *)

Lemma size_usage_min_mutual :
(forall q1, 1 <= size_usage q1).
Proof. Admitted.

(* end hide *)

Lemma size_usage_min :
forall q1, 1 <= size_usage q1.
Proof. Admitted.

Hint Resolve size_usage_min : lngen.

(* begin hide *)

Lemma size_tm_min_mutual :
(forall a1, 1 <= size_tm a1).
Proof. Admitted.

(* end hide *)

Lemma size_tm_min :
forall a1, 1 <= size_tm a1.
Proof. Admitted.

Hint Resolve size_tm_min : lngen.

(* begin hide *)

Lemma size_tm_close_tm_wrt_tm_rec_mutual :
(forall a1 x1 n1,
  size_tm (close_tm_wrt_tm_rec n1 x1 a1) = size_tm a1).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma size_tm_close_tm_wrt_tm_rec :
forall a1 x1 n1,
  size_tm (close_tm_wrt_tm_rec n1 x1 a1) = size_tm a1.
Proof. Admitted.

Hint Resolve size_tm_close_tm_wrt_tm_rec : lngen.
Hint Rewrite size_tm_close_tm_wrt_tm_rec using solve [auto] : lngen.

(* end hide *)

Lemma size_tm_close_tm_wrt_tm :
forall a1 x1,
  size_tm (close_tm_wrt_tm x1 a1) = size_tm a1.
Proof. Admitted.

Hint Resolve size_tm_close_tm_wrt_tm : lngen.
Hint Rewrite size_tm_close_tm_wrt_tm using solve [auto] : lngen.

(* begin hide *)

Lemma size_tm_open_tm_wrt_tm_rec_mutual :
(forall a1 a2 n1,
  size_tm a1 <= size_tm (open_tm_wrt_tm_rec n1 a2 a1)).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma size_tm_open_tm_wrt_tm_rec :
forall a1 a2 n1,
  size_tm a1 <= size_tm (open_tm_wrt_tm_rec n1 a2 a1).
Proof. Admitted.

Hint Resolve size_tm_open_tm_wrt_tm_rec : lngen.

(* end hide *)

Lemma size_tm_open_tm_wrt_tm :
forall a1 a2,
  size_tm a1 <= size_tm (open_tm_wrt_tm a1 a2).
Proof. Admitted.

Hint Resolve size_tm_open_tm_wrt_tm : lngen.

(* begin hide *)

Lemma size_tm_open_tm_wrt_tm_rec_var_mutual :
(forall a1 x1 n1,
  size_tm (open_tm_wrt_tm_rec n1 (a_Var_f x1) a1) = size_tm a1).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma size_tm_open_tm_wrt_tm_rec_var :
forall a1 x1 n1,
  size_tm (open_tm_wrt_tm_rec n1 (a_Var_f x1) a1) = size_tm a1.
Proof. Admitted.

Hint Resolve size_tm_open_tm_wrt_tm_rec_var : lngen.
Hint Rewrite size_tm_open_tm_wrt_tm_rec_var using solve [auto] : lngen.

(* end hide *)

Lemma size_tm_open_tm_wrt_tm_var :
forall a1 x1,
  size_tm (open_tm_wrt_tm a1 (a_Var_f x1)) = size_tm a1.
Proof. Admitted.

Hint Resolve size_tm_open_tm_wrt_tm_var : lngen.
Hint Rewrite size_tm_open_tm_wrt_tm_var using solve [auto] : lngen.

(* *********************************************************************** *)
(** * Theorems about [degree] *)

Ltac default_auto ::= auto with lngen; tauto.
Ltac default_autorewrite ::= fail.

(* begin hide *)

Lemma degree_tm_wrt_tm_S_mutual :
(forall n1 a1,
  degree_tm_wrt_tm n1 a1 ->
  degree_tm_wrt_tm (S n1) a1).
Proof. Admitted.

(* end hide *)

Lemma degree_tm_wrt_tm_S :
forall n1 a1,
  degree_tm_wrt_tm n1 a1 ->
  degree_tm_wrt_tm (S n1) a1.
Proof. Admitted.

Hint Resolve degree_tm_wrt_tm_S : lngen.

Lemma degree_tm_wrt_tm_O :
forall n1 a1,
  degree_tm_wrt_tm O a1 ->
  degree_tm_wrt_tm n1 a1.
Proof. Admitted.

Hint Resolve degree_tm_wrt_tm_O : lngen.

(* begin hide *)

Lemma degree_tm_wrt_tm_close_tm_wrt_tm_rec_mutual :
(forall a1 x1 n1,
  degree_tm_wrt_tm n1 a1 ->
  degree_tm_wrt_tm (S n1) (close_tm_wrt_tm_rec n1 x1 a1)).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma degree_tm_wrt_tm_close_tm_wrt_tm_rec :
forall a1 x1 n1,
  degree_tm_wrt_tm n1 a1 ->
  degree_tm_wrt_tm (S n1) (close_tm_wrt_tm_rec n1 x1 a1).
Proof. Admitted.

Hint Resolve degree_tm_wrt_tm_close_tm_wrt_tm_rec : lngen.

(* end hide *)

Lemma degree_tm_wrt_tm_close_tm_wrt_tm :
forall a1 x1,
  degree_tm_wrt_tm 0 a1 ->
  degree_tm_wrt_tm 1 (close_tm_wrt_tm x1 a1).
Proof. Admitted.

Hint Resolve degree_tm_wrt_tm_close_tm_wrt_tm : lngen.

(* begin hide *)

Lemma degree_tm_wrt_tm_close_tm_wrt_tm_rec_inv_mutual :
(forall a1 x1 n1,
  degree_tm_wrt_tm (S n1) (close_tm_wrt_tm_rec n1 x1 a1) ->
  degree_tm_wrt_tm n1 a1).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma degree_tm_wrt_tm_close_tm_wrt_tm_rec_inv :
forall a1 x1 n1,
  degree_tm_wrt_tm (S n1) (close_tm_wrt_tm_rec n1 x1 a1) ->
  degree_tm_wrt_tm n1 a1.
Proof. Admitted.

Hint Immediate degree_tm_wrt_tm_close_tm_wrt_tm_rec_inv : lngen.

(* end hide *)

Lemma degree_tm_wrt_tm_close_tm_wrt_tm_inv :
forall a1 x1,
  degree_tm_wrt_tm 1 (close_tm_wrt_tm x1 a1) ->
  degree_tm_wrt_tm 0 a1.
Proof. Admitted.

Hint Immediate degree_tm_wrt_tm_close_tm_wrt_tm_inv : lngen.

(* begin hide *)

Lemma degree_tm_wrt_tm_open_tm_wrt_tm_rec_mutual :
(forall a1 a2 n1,
  degree_tm_wrt_tm (S n1) a1 ->
  degree_tm_wrt_tm n1 a2 ->
  degree_tm_wrt_tm n1 (open_tm_wrt_tm_rec n1 a2 a1)).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma degree_tm_wrt_tm_open_tm_wrt_tm_rec :
forall a1 a2 n1,
  degree_tm_wrt_tm (S n1) a1 ->
  degree_tm_wrt_tm n1 a2 ->
  degree_tm_wrt_tm n1 (open_tm_wrt_tm_rec n1 a2 a1).
Proof. Admitted.

Hint Resolve degree_tm_wrt_tm_open_tm_wrt_tm_rec : lngen.

(* end hide *)

Lemma degree_tm_wrt_tm_open_tm_wrt_tm :
forall a1 a2,
  degree_tm_wrt_tm 1 a1 ->
  degree_tm_wrt_tm 0 a2 ->
  degree_tm_wrt_tm 0 (open_tm_wrt_tm a1 a2).
Proof. Admitted.

Hint Resolve degree_tm_wrt_tm_open_tm_wrt_tm : lngen.

(* begin hide *)

Lemma degree_tm_wrt_tm_open_tm_wrt_tm_rec_inv_mutual :
(forall a1 a2 n1,
  degree_tm_wrt_tm n1 (open_tm_wrt_tm_rec n1 a2 a1) ->
  degree_tm_wrt_tm (S n1) a1).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma degree_tm_wrt_tm_open_tm_wrt_tm_rec_inv :
forall a1 a2 n1,
  degree_tm_wrt_tm n1 (open_tm_wrt_tm_rec n1 a2 a1) ->
  degree_tm_wrt_tm (S n1) a1.
Proof. Admitted.

Hint Immediate degree_tm_wrt_tm_open_tm_wrt_tm_rec_inv : lngen.

(* end hide *)

Lemma degree_tm_wrt_tm_open_tm_wrt_tm_inv :
forall a1 a2,
  degree_tm_wrt_tm 0 (open_tm_wrt_tm a1 a2) ->
  degree_tm_wrt_tm 1 a1.
Proof. Admitted.

Hint Immediate degree_tm_wrt_tm_open_tm_wrt_tm_inv : lngen.

(* *********************************************************************** *)
(** * Theorems about [open] and [close] *)

Ltac default_auto ::= auto with lngen brute_force; tauto.
Ltac default_autorewrite ::= fail.

(* begin hide *)

Lemma close_tm_wrt_tm_rec_inj_mutual :
(forall a1 a2 x1 n1,
  close_tm_wrt_tm_rec n1 x1 a1 = close_tm_wrt_tm_rec n1 x1 a2 ->
  a1 = a2).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma close_tm_wrt_tm_rec_inj :
forall a1 a2 x1 n1,
  close_tm_wrt_tm_rec n1 x1 a1 = close_tm_wrt_tm_rec n1 x1 a2 ->
  a1 = a2.
Proof. Admitted.

Hint Immediate close_tm_wrt_tm_rec_inj : lngen.

(* end hide *)

Lemma close_tm_wrt_tm_inj :
forall a1 a2 x1,
  close_tm_wrt_tm x1 a1 = close_tm_wrt_tm x1 a2 ->
  a1 = a2.
Proof. Admitted.

Hint Immediate close_tm_wrt_tm_inj : lngen.

(* begin hide *)

Lemma close_tm_wrt_tm_rec_open_tm_wrt_tm_rec_mutual :
(forall a1 x1 n1,
  x1 `notin` fv_tm_tm a1 ->
  close_tm_wrt_tm_rec n1 x1 (open_tm_wrt_tm_rec n1 (a_Var_f x1) a1) = a1).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma close_tm_wrt_tm_rec_open_tm_wrt_tm_rec :
forall a1 x1 n1,
  x1 `notin` fv_tm_tm a1 ->
  close_tm_wrt_tm_rec n1 x1 (open_tm_wrt_tm_rec n1 (a_Var_f x1) a1) = a1.
Proof. Admitted.

Hint Resolve close_tm_wrt_tm_rec_open_tm_wrt_tm_rec : lngen.
Hint Rewrite close_tm_wrt_tm_rec_open_tm_wrt_tm_rec using solve [auto] : lngen.

(* end hide *)

Lemma close_tm_wrt_tm_open_tm_wrt_tm :
forall a1 x1,
  x1 `notin` fv_tm_tm a1 ->
  close_tm_wrt_tm x1 (open_tm_wrt_tm a1 (a_Var_f x1)) = a1.
Proof. Admitted.

Hint Resolve close_tm_wrt_tm_open_tm_wrt_tm : lngen.
Hint Rewrite close_tm_wrt_tm_open_tm_wrt_tm using solve [auto] : lngen.

(* begin hide *)

Lemma open_tm_wrt_tm_rec_close_tm_wrt_tm_rec_mutual :
(forall a1 x1 n1,
  open_tm_wrt_tm_rec n1 (a_Var_f x1) (close_tm_wrt_tm_rec n1 x1 a1) = a1).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma open_tm_wrt_tm_rec_close_tm_wrt_tm_rec :
forall a1 x1 n1,
  open_tm_wrt_tm_rec n1 (a_Var_f x1) (close_tm_wrt_tm_rec n1 x1 a1) = a1.
Proof. Admitted.

Hint Resolve open_tm_wrt_tm_rec_close_tm_wrt_tm_rec : lngen.
Hint Rewrite open_tm_wrt_tm_rec_close_tm_wrt_tm_rec using solve [auto] : lngen.

(* end hide *)

Lemma open_tm_wrt_tm_close_tm_wrt_tm :
forall a1 x1,
  open_tm_wrt_tm (close_tm_wrt_tm x1 a1) (a_Var_f x1) = a1.
Proof. Admitted.

Hint Resolve open_tm_wrt_tm_close_tm_wrt_tm : lngen.
Hint Rewrite open_tm_wrt_tm_close_tm_wrt_tm using solve [auto] : lngen.

(* begin hide *)

Lemma open_tm_wrt_tm_rec_inj_mutual :
(forall a2 a1 x1 n1,
  x1 `notin` fv_tm_tm a2 ->
  x1 `notin` fv_tm_tm a1 ->
  open_tm_wrt_tm_rec n1 (a_Var_f x1) a2 = open_tm_wrt_tm_rec n1 (a_Var_f x1) a1 ->
  a2 = a1).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma open_tm_wrt_tm_rec_inj :
forall a2 a1 x1 n1,
  x1 `notin` fv_tm_tm a2 ->
  x1 `notin` fv_tm_tm a1 ->
  open_tm_wrt_tm_rec n1 (a_Var_f x1) a2 = open_tm_wrt_tm_rec n1 (a_Var_f x1) a1 ->
  a2 = a1.
Proof. Admitted.

Hint Immediate open_tm_wrt_tm_rec_inj : lngen.

(* end hide *)

Lemma open_tm_wrt_tm_inj :
forall a2 a1 x1,
  x1 `notin` fv_tm_tm a2 ->
  x1 `notin` fv_tm_tm a1 ->
  open_tm_wrt_tm a2 (a_Var_f x1) = open_tm_wrt_tm a1 (a_Var_f x1) ->
  a2 = a1.
Proof. Admitted.

Hint Immediate open_tm_wrt_tm_inj : lngen.

(* *********************************************************************** *)
(** * Theorems about [lc] *)

Ltac default_auto ::= auto with lngen brute_force; tauto.
Ltac default_autorewrite ::= autorewrite with lngen.

(* begin hide *)

Lemma degree_tm_wrt_tm_of_lc_tm_mutual :
(forall a1,
  lc_tm a1 ->
  degree_tm_wrt_tm 0 a1).
Proof. Admitted.

(* end hide *)

Lemma degree_tm_wrt_tm_of_lc_tm :
forall a1,
  lc_tm a1 ->
  degree_tm_wrt_tm 0 a1.
Proof. Admitted.

Hint Resolve degree_tm_wrt_tm_of_lc_tm : lngen.

(* begin hide *)

Lemma lc_tm_of_degree_size_mutual :
forall i1,
(forall a1,
  size_tm a1 = i1 ->
  degree_tm_wrt_tm 0 a1 ->
  lc_tm a1).
Proof. Admitted.

(* end hide *)

Lemma lc_tm_of_degree :
forall a1,
  degree_tm_wrt_tm 0 a1 ->
  lc_tm a1.
Proof. Admitted.

Hint Resolve lc_tm_of_degree : lngen.

Ltac usage_lc_exists_tac :=
  repeat (match goal with
            | H : _ |- _ =>
              fail 1
          end).

Ltac tm_lc_exists_tac :=
  repeat (match goal with
            | H : _ |- _ =>
              let J1 := fresh in pose proof H as J1; apply degree_tm_wrt_tm_of_lc_tm in J1; clear H
          end).

Lemma lc_a_Pi_exists :
forall x1 q1 A1 B1,
  lc_tm A1 ->
  lc_tm (open_tm_wrt_tm B1 (a_Var_f x1)) ->
  lc_tm (a_Pi q1 A1 B1).
Proof. Admitted.

Lemma lc_a_Lam_exists :
forall x1 q1 A1 a1,
  lc_tm A1 ->
  lc_tm (open_tm_wrt_tm a1 (a_Var_f x1)) ->
  lc_tm (a_Lam q1 A1 a1).
Proof. Admitted.

Lemma lc_a_LetBoxB_exists :
forall x1 a1 b1 B1,
  lc_tm a1 ->
  lc_tm (open_tm_wrt_tm b1 (a_Var_f x1)) ->
  lc_tm B1 ->
  lc_tm (a_LetBoxB a1 b1 B1).
Proof. Admitted.

Lemma lc_a_Let_exists :
forall x1 a1 b1,
  lc_tm a1 ->
  lc_tm (open_tm_wrt_tm b1 (a_Var_f x1)) ->
  lc_tm (a_Let a1 b1).
Proof. Admitted.

Lemma lc_a_Sigma_exists :
forall x1 q1 A1 B1,
  lc_tm A1 ->
  lc_tm (open_tm_wrt_tm B1 (a_Var_f x1)) ->
  lc_tm (a_Sigma q1 A1 B1).
Proof. Admitted.

Lemma lc_a_Spread_exists :
forall x1 a1 b1 B1,
  lc_tm a1 ->
  lc_tm (open_tm_wrt_tm b1 (a_Var_f x1)) ->
  lc_tm B1 ->
  lc_tm (a_Spread a1 b1 B1).
Proof. Admitted.

Lemma lc_a_With_exists :
forall x1 A1 B1,
  lc_tm A1 ->
  lc_tm (open_tm_wrt_tm B1 (a_Var_f x1)) ->
  lc_tm (a_With A1 B1).
Proof. Admitted.

Hint Extern 1 (lc_tm (a_Pi _ _ _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_a_Pi_exists x1) : core.

Hint Extern 1 (lc_tm (a_Lam _ _ _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_a_Lam_exists x1) : core.

Hint Extern 1 (lc_tm (a_LetBoxB _ _ _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_a_LetBoxB_exists x1) : core.

Hint Extern 1 (lc_tm (a_Let _ _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_a_Let_exists x1) : core.

Hint Extern 1 (lc_tm (a_Sigma _ _ _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_a_Sigma_exists x1) : core.

Hint Extern 1 (lc_tm (a_Spread _ _ _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_a_Spread_exists x1) : core.

Hint Extern 1 (lc_tm (a_With _ _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_a_With_exists x1) : core.

Lemma lc_body_tm_wrt_tm :
forall a1 a2,
  body_tm_wrt_tm a1 ->
  lc_tm a2 ->
  lc_tm (open_tm_wrt_tm a1 a2).
Proof. Admitted.

Hint Resolve lc_body_tm_wrt_tm : lngen.

Lemma lc_body_a_Pi_3 :
forall q1 A1 B1,
  lc_tm (a_Pi q1 A1 B1) ->
  body_tm_wrt_tm B1.
Proof. Admitted.

Hint Resolve lc_body_a_Pi_3 : lngen.

Lemma lc_body_a_Lam_3 :
forall q1 A1 a1,
  lc_tm (a_Lam q1 A1 a1) ->
  body_tm_wrt_tm a1.
Proof. Admitted.

Hint Resolve lc_body_a_Lam_3 : lngen.

Lemma lc_body_a_LetBoxB_2 :
forall a1 b1 B1,
  lc_tm (a_LetBoxB a1 b1 B1) ->
  body_tm_wrt_tm b1.
Proof. Admitted.

Hint Resolve lc_body_a_LetBoxB_2 : lngen.

Lemma lc_body_a_Let_2 :
forall a1 b1,
  lc_tm (a_Let a1 b1) ->
  body_tm_wrt_tm b1.
Proof. Admitted.

Hint Resolve lc_body_a_Let_2 : lngen.

Lemma lc_body_a_Sigma_3 :
forall q1 A1 B1,
  lc_tm (a_Sigma q1 A1 B1) ->
  body_tm_wrt_tm B1.
Proof. Admitted.

Hint Resolve lc_body_a_Sigma_3 : lngen.

Lemma lc_body_a_Spread_2 :
forall a1 b1 B1,
  lc_tm (a_Spread a1 b1 B1) ->
  body_tm_wrt_tm b1.
Proof. Admitted.

Hint Resolve lc_body_a_Spread_2 : lngen.

Lemma lc_body_a_With_2 :
forall A1 B1,
  lc_tm (a_With A1 B1) ->
  body_tm_wrt_tm B1.
Proof. Admitted.

Hint Resolve lc_body_a_With_2 : lngen.

(* begin hide *)

Lemma lc_tm_unique_mutual :
(forall a1 (proof2 proof3 : lc_tm a1), proof2 = proof3).
Proof. Admitted.

(* end hide *)

Lemma lc_tm_unique :
forall a1 (proof2 proof3 : lc_tm a1), proof2 = proof3.
Proof. Admitted.

Hint Resolve lc_tm_unique : lngen.

(* begin hide *)

Lemma lc_tm_of_lc_set_tm_mutual :
(forall a1, lc_set_tm a1 -> lc_tm a1).
Proof. Admitted.

(* end hide *)

Lemma lc_tm_of_lc_set_tm :
forall a1, lc_set_tm a1 -> lc_tm a1.
Proof. Admitted.

Hint Resolve lc_tm_of_lc_set_tm : lngen.

(* begin hide *)

Lemma lc_set_tm_of_lc_tm_size_mutual :
forall i1,
(forall a1,
  size_tm a1 = i1 ->
  lc_tm a1 ->
  lc_set_tm a1).
Proof. Admitted.

(* end hide *)

Lemma lc_set_tm_of_lc_tm :
forall a1,
  lc_tm a1 ->
  lc_set_tm a1.
Proof. Admitted.

Hint Resolve lc_set_tm_of_lc_tm : lngen.

(* *********************************************************************** *)
(** * More theorems about [open] and [close] *)

Ltac default_auto ::= auto with lngen; tauto.
Ltac default_autorewrite ::= fail.

(* begin hide *)

Lemma close_tm_wrt_tm_rec_degree_tm_wrt_tm_mutual :
(forall a1 x1 n1,
  degree_tm_wrt_tm n1 a1 ->
  x1 `notin` fv_tm_tm a1 ->
  close_tm_wrt_tm_rec n1 x1 a1 = a1).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma close_tm_wrt_tm_rec_degree_tm_wrt_tm :
forall a1 x1 n1,
  degree_tm_wrt_tm n1 a1 ->
  x1 `notin` fv_tm_tm a1 ->
  close_tm_wrt_tm_rec n1 x1 a1 = a1.
Proof. Admitted.

Hint Resolve close_tm_wrt_tm_rec_degree_tm_wrt_tm : lngen.
Hint Rewrite close_tm_wrt_tm_rec_degree_tm_wrt_tm using solve [auto] : lngen.

(* end hide *)

Lemma close_tm_wrt_tm_lc_tm :
forall a1 x1,
  lc_tm a1 ->
  x1 `notin` fv_tm_tm a1 ->
  close_tm_wrt_tm x1 a1 = a1.
Proof. Admitted.

Hint Resolve close_tm_wrt_tm_lc_tm : lngen.
Hint Rewrite close_tm_wrt_tm_lc_tm using solve [auto] : lngen.

(* begin hide *)

Lemma open_tm_wrt_tm_rec_degree_tm_wrt_tm_mutual :
(forall a2 a1 n1,
  degree_tm_wrt_tm n1 a2 ->
  open_tm_wrt_tm_rec n1 a1 a2 = a2).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma open_tm_wrt_tm_rec_degree_tm_wrt_tm :
forall a2 a1 n1,
  degree_tm_wrt_tm n1 a2 ->
  open_tm_wrt_tm_rec n1 a1 a2 = a2.
Proof. Admitted.

Hint Resolve open_tm_wrt_tm_rec_degree_tm_wrt_tm : lngen.
Hint Rewrite open_tm_wrt_tm_rec_degree_tm_wrt_tm using solve [auto] : lngen.

(* end hide *)

Lemma open_tm_wrt_tm_lc_tm :
forall a2 a1,
  lc_tm a2 ->
  open_tm_wrt_tm a2 a1 = a2.
Proof. Admitted.

Hint Resolve open_tm_wrt_tm_lc_tm : lngen.
Hint Rewrite open_tm_wrt_tm_lc_tm using solve [auto] : lngen.

(* *********************************************************************** *)
(** * Theorems about [fv] *)

Ltac default_auto ::= auto with set lngen; tauto.
Ltac default_autorewrite ::= autorewrite with lngen.

(* begin hide *)

Lemma fv_tm_tm_close_tm_wrt_tm_rec_mutual :
(forall a1 x1 n1,
  fv_tm_tm (close_tm_wrt_tm_rec n1 x1 a1) [=] remove x1 (fv_tm_tm a1)).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma fv_tm_tm_close_tm_wrt_tm_rec :
forall a1 x1 n1,
  fv_tm_tm (close_tm_wrt_tm_rec n1 x1 a1) [=] remove x1 (fv_tm_tm a1).
Proof. Admitted.

Hint Resolve fv_tm_tm_close_tm_wrt_tm_rec : lngen.
Hint Rewrite fv_tm_tm_close_tm_wrt_tm_rec using solve [auto] : lngen.

(* end hide *)

Lemma fv_tm_tm_close_tm_wrt_tm :
forall a1 x1,
  fv_tm_tm (close_tm_wrt_tm x1 a1) [=] remove x1 (fv_tm_tm a1).
Proof. Admitted.

Hint Resolve fv_tm_tm_close_tm_wrt_tm : lngen.
Hint Rewrite fv_tm_tm_close_tm_wrt_tm using solve [auto] : lngen.

(* begin hide *)

Lemma fv_tm_tm_open_tm_wrt_tm_rec_lower_mutual :
(forall a1 a2 n1,
  fv_tm_tm a1 [<=] fv_tm_tm (open_tm_wrt_tm_rec n1 a2 a1)).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma fv_tm_tm_open_tm_wrt_tm_rec_lower :
forall a1 a2 n1,
  fv_tm_tm a1 [<=] fv_tm_tm (open_tm_wrt_tm_rec n1 a2 a1).
Proof. Admitted.

Hint Resolve fv_tm_tm_open_tm_wrt_tm_rec_lower : lngen.

(* end hide *)

Lemma fv_tm_tm_open_tm_wrt_tm_lower :
forall a1 a2,
  fv_tm_tm a1 [<=] fv_tm_tm (open_tm_wrt_tm a1 a2).
Proof. Admitted.

Hint Resolve fv_tm_tm_open_tm_wrt_tm_lower : lngen.

(* begin hide *)

Lemma fv_tm_tm_open_tm_wrt_tm_rec_upper_mutual :
(forall a1 a2 n1,
  fv_tm_tm (open_tm_wrt_tm_rec n1 a2 a1) [<=] fv_tm_tm a2 `union` fv_tm_tm a1).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma fv_tm_tm_open_tm_wrt_tm_rec_upper :
forall a1 a2 n1,
  fv_tm_tm (open_tm_wrt_tm_rec n1 a2 a1) [<=] fv_tm_tm a2 `union` fv_tm_tm a1.
Proof. Admitted.

Hint Resolve fv_tm_tm_open_tm_wrt_tm_rec_upper : lngen.

(* end hide *)

Lemma fv_tm_tm_open_tm_wrt_tm_upper :
forall a1 a2,
  fv_tm_tm (open_tm_wrt_tm a1 a2) [<=] fv_tm_tm a2 `union` fv_tm_tm a1.
Proof. Admitted.

Hint Resolve fv_tm_tm_open_tm_wrt_tm_upper : lngen.

(* begin hide *)

Lemma fv_tm_tm_subst_tm_tm_fresh_mutual :
(forall a1 a2 x1,
  x1 `notin` fv_tm_tm a1 ->
  fv_tm_tm (subst_tm_tm a2 x1 a1) [=] fv_tm_tm a1).
Proof. Admitted.

(* end hide *)

Lemma fv_tm_tm_subst_tm_tm_fresh :
forall a1 a2 x1,
  x1 `notin` fv_tm_tm a1 ->
  fv_tm_tm (subst_tm_tm a2 x1 a1) [=] fv_tm_tm a1.
Proof. Admitted.

Hint Resolve fv_tm_tm_subst_tm_tm_fresh : lngen.
Hint Rewrite fv_tm_tm_subst_tm_tm_fresh using solve [auto] : lngen.

(* begin hide *)

Lemma fv_tm_tm_subst_tm_tm_lower_mutual :
(forall a1 a2 x1,
  remove x1 (fv_tm_tm a1) [<=] fv_tm_tm (subst_tm_tm a2 x1 a1)).
Proof. Admitted.

(* end hide *)

Lemma fv_tm_tm_subst_tm_tm_lower :
forall a1 a2 x1,
  remove x1 (fv_tm_tm a1) [<=] fv_tm_tm (subst_tm_tm a2 x1 a1).
Proof. Admitted.

Hint Resolve fv_tm_tm_subst_tm_tm_lower : lngen.

(* begin hide *)

Lemma fv_tm_tm_subst_tm_tm_notin_mutual :
(forall a1 a2 x1 x2,
  x2 `notin` fv_tm_tm a1 ->
  x2 `notin` fv_tm_tm a2 ->
  x2 `notin` fv_tm_tm (subst_tm_tm a2 x1 a1)).
Proof. Admitted.

(* end hide *)

Lemma fv_tm_tm_subst_tm_tm_notin :
forall a1 a2 x1 x2,
  x2 `notin` fv_tm_tm a1 ->
  x2 `notin` fv_tm_tm a2 ->
  x2 `notin` fv_tm_tm (subst_tm_tm a2 x1 a1).
Proof. Admitted.

Hint Resolve fv_tm_tm_subst_tm_tm_notin : lngen.

(* begin hide *)

Lemma fv_tm_tm_subst_tm_tm_upper_mutual :
(forall a1 a2 x1,
  fv_tm_tm (subst_tm_tm a2 x1 a1) [<=] fv_tm_tm a2 `union` remove x1 (fv_tm_tm a1)).
Proof. Admitted.

(* end hide *)

Lemma fv_tm_tm_subst_tm_tm_upper :
forall a1 a2 x1,
  fv_tm_tm (subst_tm_tm a2 x1 a1) [<=] fv_tm_tm a2 `union` remove x1 (fv_tm_tm a1).
Proof. Admitted.

Hint Resolve fv_tm_tm_subst_tm_tm_upper : lngen.

(* *********************************************************************** *)
(** * Theorems about [subst] *)

Ltac default_auto ::= auto with lngen brute_force; tauto.
Ltac default_autorewrite ::= autorewrite with lngen.

(* begin hide *)

Lemma subst_tm_tm_close_tm_wrt_tm_rec_mutual :
(forall a2 a1 x1 x2 n1,
  degree_tm_wrt_tm n1 a1 ->
  x1 <> x2 ->
  x2 `notin` fv_tm_tm a1 ->
  subst_tm_tm a1 x1 (close_tm_wrt_tm_rec n1 x2 a2) = close_tm_wrt_tm_rec n1 x2 (subst_tm_tm a1 x1 a2)).
Proof. Admitted.

(* end hide *)

Lemma subst_tm_tm_close_tm_wrt_tm_rec :
forall a2 a1 x1 x2 n1,
  degree_tm_wrt_tm n1 a1 ->
  x1 <> x2 ->
  x2 `notin` fv_tm_tm a1 ->
  subst_tm_tm a1 x1 (close_tm_wrt_tm_rec n1 x2 a2) = close_tm_wrt_tm_rec n1 x2 (subst_tm_tm a1 x1 a2).
Proof. Admitted.

Hint Resolve subst_tm_tm_close_tm_wrt_tm_rec : lngen.

Lemma subst_tm_tm_close_tm_wrt_tm :
forall a2 a1 x1 x2,
  lc_tm a1 ->  x1 <> x2 ->
  x2 `notin` fv_tm_tm a1 ->
  subst_tm_tm a1 x1 (close_tm_wrt_tm x2 a2) = close_tm_wrt_tm x2 (subst_tm_tm a1 x1 a2).
Proof. Admitted.

Hint Resolve subst_tm_tm_close_tm_wrt_tm : lngen.

(* begin hide *)

Lemma subst_tm_tm_degree_tm_wrt_tm_mutual :
(forall a1 a2 x1 n1,
  degree_tm_wrt_tm n1 a1 ->
  degree_tm_wrt_tm n1 a2 ->
  degree_tm_wrt_tm n1 (subst_tm_tm a2 x1 a1)).
Proof. Admitted.

(* end hide *)

Lemma subst_tm_tm_degree_tm_wrt_tm :
forall a1 a2 x1 n1,
  degree_tm_wrt_tm n1 a1 ->
  degree_tm_wrt_tm n1 a2 ->
  degree_tm_wrt_tm n1 (subst_tm_tm a2 x1 a1).
Proof. Admitted.

Hint Resolve subst_tm_tm_degree_tm_wrt_tm : lngen.

(* begin hide *)

Lemma subst_tm_tm_fresh_eq_mutual :
(forall a2 a1 x1,
  x1 `notin` fv_tm_tm a2 ->
  subst_tm_tm a1 x1 a2 = a2).
Proof. Admitted.

(* end hide *)

Lemma subst_tm_tm_fresh_eq :
forall a2 a1 x1,
  x1 `notin` fv_tm_tm a2 ->
  subst_tm_tm a1 x1 a2 = a2.
Proof. Admitted.

Hint Resolve subst_tm_tm_fresh_eq : lngen.
Hint Rewrite subst_tm_tm_fresh_eq using solve [auto] : lngen.

(* begin hide *)

Lemma subst_tm_tm_fresh_same_mutual :
(forall a2 a1 x1,
  x1 `notin` fv_tm_tm a1 ->
  x1 `notin` fv_tm_tm (subst_tm_tm a1 x1 a2)).
Proof. Admitted.

(* end hide *)

Lemma subst_tm_tm_fresh_same :
forall a2 a1 x1,
  x1 `notin` fv_tm_tm a1 ->
  x1 `notin` fv_tm_tm (subst_tm_tm a1 x1 a2).
Proof. Admitted.

Hint Resolve subst_tm_tm_fresh_same : lngen.

(* begin hide *)

Lemma subst_tm_tm_fresh_mutual :
(forall a2 a1 x1 x2,
  x1 `notin` fv_tm_tm a2 ->
  x1 `notin` fv_tm_tm a1 ->
  x1 `notin` fv_tm_tm (subst_tm_tm a1 x2 a2)).
Proof. Admitted.

(* end hide *)

Lemma subst_tm_tm_fresh :
forall a2 a1 x1 x2,
  x1 `notin` fv_tm_tm a2 ->
  x1 `notin` fv_tm_tm a1 ->
  x1 `notin` fv_tm_tm (subst_tm_tm a1 x2 a2).
Proof. Admitted.

Hint Resolve subst_tm_tm_fresh : lngen.

Lemma subst_tm_tm_lc_tm :
forall a1 a2 x1,
  lc_tm a1 ->
  lc_tm a2 ->
  lc_tm (subst_tm_tm a2 x1 a1).
Proof. Admitted.

Hint Resolve subst_tm_tm_lc_tm : lngen.

(* begin hide *)

Lemma subst_tm_tm_open_tm_wrt_tm_rec_mutual :
(forall a3 a1 a2 x1 n1,
  lc_tm a1 ->
  subst_tm_tm a1 x1 (open_tm_wrt_tm_rec n1 a2 a3) = open_tm_wrt_tm_rec n1 (subst_tm_tm a1 x1 a2) (subst_tm_tm a1 x1 a3)).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma subst_tm_tm_open_tm_wrt_tm_rec :
forall a3 a1 a2 x1 n1,
  lc_tm a1 ->
  subst_tm_tm a1 x1 (open_tm_wrt_tm_rec n1 a2 a3) = open_tm_wrt_tm_rec n1 (subst_tm_tm a1 x1 a2) (subst_tm_tm a1 x1 a3).
Proof. Admitted.

Hint Resolve subst_tm_tm_open_tm_wrt_tm_rec : lngen.

(* end hide *)

Lemma subst_tm_tm_open_tm_wrt_tm :
forall a3 a1 a2 x1,
  lc_tm a1 ->
  subst_tm_tm a1 x1 (open_tm_wrt_tm a3 a2) = open_tm_wrt_tm (subst_tm_tm a1 x1 a3) (subst_tm_tm a1 x1 a2).
Proof. Admitted.

Hint Resolve subst_tm_tm_open_tm_wrt_tm : lngen.

Lemma subst_tm_tm_open_tm_wrt_tm_var :
forall a2 a1 x1 x2,
  x1 <> x2 ->
  lc_tm a1 ->
  open_tm_wrt_tm (subst_tm_tm a1 x1 a2) (a_Var_f x2) = subst_tm_tm a1 x1 (open_tm_wrt_tm a2 (a_Var_f x2)).
Proof. Admitted.

Hint Resolve subst_tm_tm_open_tm_wrt_tm_var : lngen.

(* begin hide *)

Lemma subst_tm_tm_spec_rec_mutual :
(forall a1 a2 x1 n1,
  subst_tm_tm a2 x1 a1 = open_tm_wrt_tm_rec n1 a2 (close_tm_wrt_tm_rec n1 x1 a1)).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma subst_tm_tm_spec_rec :
forall a1 a2 x1 n1,
  subst_tm_tm a2 x1 a1 = open_tm_wrt_tm_rec n1 a2 (close_tm_wrt_tm_rec n1 x1 a1).
Proof. Admitted.

Hint Resolve subst_tm_tm_spec_rec : lngen.

(* end hide *)

Lemma subst_tm_tm_spec :
forall a1 a2 x1,
  subst_tm_tm a2 x1 a1 = open_tm_wrt_tm (close_tm_wrt_tm x1 a1) a2.
Proof. Admitted.

Hint Resolve subst_tm_tm_spec : lngen.

(* begin hide *)

Lemma subst_tm_tm_subst_tm_tm_mutual :
(forall a1 a2 a3 x2 x1,
  x2 `notin` fv_tm_tm a2 ->
  x2 <> x1 ->
  subst_tm_tm a2 x1 (subst_tm_tm a3 x2 a1) = subst_tm_tm (subst_tm_tm a2 x1 a3) x2 (subst_tm_tm a2 x1 a1)).
Proof. Admitted.

(* end hide *)

Lemma subst_tm_tm_subst_tm_tm :
forall a1 a2 a3 x2 x1,
  x2 `notin` fv_tm_tm a2 ->
  x2 <> x1 ->
  subst_tm_tm a2 x1 (subst_tm_tm a3 x2 a1) = subst_tm_tm (subst_tm_tm a2 x1 a3) x2 (subst_tm_tm a2 x1 a1).
Proof. Admitted.

Hint Resolve subst_tm_tm_subst_tm_tm : lngen.

(* begin hide *)

Lemma subst_tm_tm_close_tm_wrt_tm_rec_open_tm_wrt_tm_rec_mutual :
(forall a2 a1 x1 x2 n1,
  x2 `notin` fv_tm_tm a2 ->
  x2 `notin` fv_tm_tm a1 ->
  x2 <> x1 ->
  degree_tm_wrt_tm n1 a1 ->
  subst_tm_tm a1 x1 a2 = close_tm_wrt_tm_rec n1 x2 (subst_tm_tm a1 x1 (open_tm_wrt_tm_rec n1 (a_Var_f x2) a2))).
Proof. Admitted.

(* end hide *)

(* begin hide *)

Lemma subst_tm_tm_close_tm_wrt_tm_rec_open_tm_wrt_tm_rec :
forall a2 a1 x1 x2 n1,
  x2 `notin` fv_tm_tm a2 ->
  x2 `notin` fv_tm_tm a1 ->
  x2 <> x1 ->
  degree_tm_wrt_tm n1 a1 ->
  subst_tm_tm a1 x1 a2 = close_tm_wrt_tm_rec n1 x2 (subst_tm_tm a1 x1 (open_tm_wrt_tm_rec n1 (a_Var_f x2) a2)).
Proof. Admitted.

Hint Resolve subst_tm_tm_close_tm_wrt_tm_rec_open_tm_wrt_tm_rec : lngen.

(* end hide *)

Lemma subst_tm_tm_close_tm_wrt_tm_open_tm_wrt_tm :
forall a2 a1 x1 x2,
  x2 `notin` fv_tm_tm a2 ->
  x2 `notin` fv_tm_tm a1 ->
  x2 <> x1 ->
  lc_tm a1 ->
  subst_tm_tm a1 x1 a2 = close_tm_wrt_tm x2 (subst_tm_tm a1 x1 (open_tm_wrt_tm a2 (a_Var_f x2))).
Proof. Admitted.

Hint Resolve subst_tm_tm_close_tm_wrt_tm_open_tm_wrt_tm : lngen.

Lemma subst_tm_tm_a_Pi :
forall x2 q1 A1 B1 a1 x1,
  lc_tm a1 ->
  x2 `notin` fv_tm_tm a1 `union` fv_tm_tm B1 `union` singleton x1 ->
  subst_tm_tm a1 x1 (a_Pi q1 A1 B1) = a_Pi (q1) (subst_tm_tm a1 x1 A1) (close_tm_wrt_tm x2 (subst_tm_tm a1 x1 (open_tm_wrt_tm B1 (a_Var_f x2)))).
Proof. Admitted.

Hint Resolve subst_tm_tm_a_Pi : lngen.

Lemma subst_tm_tm_a_Lam :
forall x2 q1 A1 a2 a1 x1,
  lc_tm a1 ->
  x2 `notin` fv_tm_tm a1 `union` fv_tm_tm a2 `union` singleton x1 ->
  subst_tm_tm a1 x1 (a_Lam q1 A1 a2) = a_Lam (q1) (subst_tm_tm a1 x1 A1) (close_tm_wrt_tm x2 (subst_tm_tm a1 x1 (open_tm_wrt_tm a2 (a_Var_f x2)))).
Proof. Admitted.

Hint Resolve subst_tm_tm_a_Lam : lngen.

Lemma subst_tm_tm_a_LetBoxB :
forall x2 a2 b1 B1 a1 x1,
  lc_tm a1 ->
  x2 `notin` fv_tm_tm a1 `union` fv_tm_tm b1 `union` singleton x1 ->
  subst_tm_tm a1 x1 (a_LetBoxB a2 b1 B1) = a_LetBoxB (subst_tm_tm a1 x1 a2) (close_tm_wrt_tm x2 (subst_tm_tm a1 x1 (open_tm_wrt_tm b1 (a_Var_f x2)))) (subst_tm_tm a1 x1 B1).
Proof. Admitted.

Hint Resolve subst_tm_tm_a_LetBoxB : lngen.

Lemma subst_tm_tm_a_Let :
forall x2 a2 b1 a1 x1,
  lc_tm a1 ->
  x2 `notin` fv_tm_tm a1 `union` fv_tm_tm b1 `union` singleton x1 ->
  subst_tm_tm a1 x1 (a_Let a2 b1) = a_Let (subst_tm_tm a1 x1 a2) (close_tm_wrt_tm x2 (subst_tm_tm a1 x1 (open_tm_wrt_tm b1 (a_Var_f x2)))).
Proof. Admitted.

Hint Resolve subst_tm_tm_a_Let : lngen.

Lemma subst_tm_tm_a_Sigma :
forall x2 q1 A1 B1 a1 x1,
  lc_tm a1 ->
  x2 `notin` fv_tm_tm a1 `union` fv_tm_tm B1 `union` singleton x1 ->
  subst_tm_tm a1 x1 (a_Sigma q1 A1 B1) = a_Sigma (q1) (subst_tm_tm a1 x1 A1) (close_tm_wrt_tm x2 (subst_tm_tm a1 x1 (open_tm_wrt_tm B1 (a_Var_f x2)))).
Proof. Admitted.

Hint Resolve subst_tm_tm_a_Sigma : lngen.

Lemma subst_tm_tm_a_Spread :
forall x2 a2 b1 B1 a1 x1,
  lc_tm a1 ->
  x2 `notin` fv_tm_tm a1 `union` fv_tm_tm b1 `union` singleton x1 ->
  subst_tm_tm a1 x1 (a_Spread a2 b1 B1) = a_Spread (subst_tm_tm a1 x1 a2) (close_tm_wrt_tm x2 (subst_tm_tm a1 x1 (open_tm_wrt_tm b1 (a_Var_f x2)))) (subst_tm_tm a1 x1 B1).
Proof. Admitted.

Hint Resolve subst_tm_tm_a_Spread : lngen.

Lemma subst_tm_tm_a_With :
forall x2 A1 B1 a1 x1,
  lc_tm a1 ->
  x2 `notin` fv_tm_tm a1 `union` fv_tm_tm B1 `union` singleton x1 ->
  subst_tm_tm a1 x1 (a_With A1 B1) = a_With (subst_tm_tm a1 x1 A1) (close_tm_wrt_tm x2 (subst_tm_tm a1 x1 (open_tm_wrt_tm B1 (a_Var_f x2)))).
Proof. Admitted.

Hint Resolve subst_tm_tm_a_With : lngen.

(* begin hide *)

Lemma subst_tm_tm_intro_rec_mutual :
(forall a1 x1 a2 n1,
  x1 `notin` fv_tm_tm a1 ->
  open_tm_wrt_tm_rec n1 a2 a1 = subst_tm_tm a2 x1 (open_tm_wrt_tm_rec n1 (a_Var_f x1) a1)).
Proof. Admitted.

(* end hide *)

Lemma subst_tm_tm_intro_rec :
forall a1 x1 a2 n1,
  x1 `notin` fv_tm_tm a1 ->
  open_tm_wrt_tm_rec n1 a2 a1 = subst_tm_tm a2 x1 (open_tm_wrt_tm_rec n1 (a_Var_f x1) a1).
Proof. Admitted.

Hint Resolve subst_tm_tm_intro_rec : lngen.
Hint Rewrite subst_tm_tm_intro_rec using solve [auto] : lngen.

Lemma subst_tm_tm_intro :
forall x1 a1 a2,
  x1 `notin` fv_tm_tm a1 ->
  open_tm_wrt_tm a1 a2 = subst_tm_tm a2 x1 (open_tm_wrt_tm a1 (a_Var_f x1)).
Proof. Admitted.

Hint Resolve subst_tm_tm_intro : lngen.

(* *********************************************************************** *)
(** * "Restore" tactics *)

Ltac default_auto ::= auto; tauto.
Ltac default_autorewrite ::= fail.


Require Import SpecCert.Address.
Require Import SpecCert.Formalism.
Require Import SpecCert.Smm.Delta.Behavior.
Require Import SpecCert.Smm.Delta.Invariant.
Require Import SpecCert.Smm.Delta.Secure.Secure_def.
Require Import SpecCert.Smm.Software.
Require Import SpecCert.x86.

Lemma enable_interrupt_inv_is_secure:
  inv_is_secure EnableInterrupt.
Proof.
  trivial_inv_is_secure.
Qed.


Add LoadPath "src".
Require Import Maps.
Require Import Context.
Import Context.Context.
Require Import Coq.Lists.List.
Require Import Coq.ZArith.ZArith.

Module Smty.

Definition tyid := id.

(* Nominal Typing *)

Inductive ty : Set :=
    | TNat : ty
    | TChr : ty
    | TFun : ty -> ty -> ty
    | TBool : ty
    | TSum : ty -> ty -> ty
    | TNone : ty
    (*| TVar : tyid -> ty *)
    (*
        Everything as TVar would be substitue to
        Corresponding record type.
        So I will just erase it since
        it add complexity.
    *)
    | TRcd : tyid -> ty -> list (id* ty) -> ty.

Axiom nominal_eq :
    forall tid su0 su1 rcd0 rcd1,
        TRcd tid su0 rcd0 = TRcd tid su1 rcd1.

(* Scheme Equality for ty. is not working. *)
Theorem eq_ty_dec (T0 T1:ty) : {T0 = T1} + {T0 <> T1}.
generalize dependent T1.
induction T0; intro T1; induction T1;

try
(match goal with
| [|- {?X = ?X} + {_}] => left; auto; fail
| [|- {_} + {?X <> ?Y}] => right; intro; discriminate
end).
    destruct (IHT0_1 T1_1); destruct (IHT0_2 T1_2); subst; try tauto;
    right; intro K; injection K; subst; auto.
    destruct (IHT0_1 T1_1); destruct (IHT0_2 T1_2); subst; try tauto;
    right; intro K; injection K; subst; auto.
    destruct (eq_id_dec t t0);subst; eauto using nominal_eq.
    right; intro K; injection K; subst; auto.

Qed.

Definition eq_ty_dec_bool (T0 T1: ty) : bool :=
    if (eq_ty_dec T0 T1) then true else false.

Theorem eq_ty_dec_id:
    forall t (A: Set) (a b : A),
        (if eq_ty_dec t t then a else b) = a.
    intro t. destruct (eq_ty_dec t t); eauto.
    destruct (n eq_refl).
Qed.

Theorem eq_ty_dec_nid:
    forall t0 t1 (A: Set) (a b : A),
        t0 <> t1 ->
        (if eq_ty_dec t0 t1 then a else b) = b.

    intros t0 t1. destruct (eq_ty_dec t0 t1); subst; eauto; try discriminate.
    intros. destruct (H eq_refl).
Qed.

Theorem eq_ty_dec_bool_true:
    forall t ,
        eq_ty_dec_bool t t = true.
    unfold eq_ty_dec_bool. intro. eapply eq_ty_dec_id.
Qed.

Theorem eq_ty_dec_bool_false:
    forall t0 t1,
    t0 <> t1 ->
    eq_ty_dec_bool t0 t1 = false.

    intros t0 t1. eapply eq_ty_dec_nid.
Qed.

Theorem true_eq_ty_dec_bool:
    forall t0 t1,
        eq_ty_dec_bool t0 t1 = true ->
        t0 = t1.
    unfold eq_ty_dec_bool. intros.
    destruct (eq_ty_dec t0 t1); subst; auto; try discriminate.
Qed.

Theorem false_eq_ty_dec_bool:
    forall t0 t1,
        eq_ty_dec_bool t0 t1 = false ->
        t0 <> t1.
    unfold eq_ty_dec_bool. intros.
    destruct (eq_ty_dec t0 t1); subst; auto; try discriminate.
Qed.

Inductive tm : Set :=
    | tnone : tm
    | tif: tm -> tm -> tm -> tm
    | tvar : id -> tm
    | tint : Z -> tm
    | tsuc : tm -> tm
    | tdec : tm -> tm
    | tngt : tm -> tm -> tm
    | tnlt : tm -> tm -> tm
    | tneq : tm -> tm -> tm
    | tchr : nat -> tm
    | tceq : tm -> tm -> tm
    | tfun : id -> ty -> tm -> tm
    | tapp : tm -> tm -> tm
    | tlet : id -> ty -> tm -> tm -> tm
    (*
        it's acutally letrec.
    *)
    | ttrue : tm
    | tfalse : tm
    | tbeq : tm -> tm -> tm
    | tleft : tm -> ty -> tm
    | tright : ty -> tm -> tm
    | tcase : tm -> tm -> tm -> tm
        (*
            tcase (\ x -> x) (\ y -> y)
        *)
        (*
            type information is
            lexical scoped
        *)
    | tletrcd : id -> tyid -> ty -> list (id* ty) -> tm -> tm
        (*
            letRcd (contructorA TypeA ParentType ((a, Int) (b, Int))
            in ...
                 TypeA <: ParentType
            then constructorA :: Int -> Int -> TypeA
                 TypeA.a :: TypeA -> Int

            letRcd (i J (Nat Nat))
            then i :: Int -> Int -> J
        *)
    | tfield : ty -> id -> tm
        (*
            TypeA.a :: TypeA -> Int
        *)
    | tseq : tm -> tm -> tm.

Hint Constructors tm.

Inductive inheritable : ty -> Prop :=
| inh_n : inheritable TNone
| inh_r : forall c suty l,
            inheritable (TRcd c suty l).

Hint Constructors inheritable.

(* Structual Information will not be checked until
    type name elimination. *)

(*
    Inductive subrcd : (list (id * ty)) -> (list (id * ty)) -> Prop :=
    | srn: forall x, subrcd x []
    | srS: forall i t0 t1 rcd0 rcd1,
            subty t0 t1 ->
            subrcd rcd0 rcd1 ->
            subrcd ((i, t0): rcd0) ((i, t1): rcd1).
            *)

Inductive subty  : ty -> ty -> Prop :=
| stfun : forall x x' y y',
            subty x x' ->
            subty y' y ->
            subty (TFun x y) (TFun x' y')
| stsum : forall x x' y y',
            subty x x' ->
            subty y y' ->
            subty (TSum x y) (TSum x' y')
| strcds : forall tid suty rcd,
            inheritable suty ->
            subty (TRcd tid suty rcd) suty
| st_refl : forall t,
            subty t t
| st_trans : forall t0 t1 t2,
            subty t0 t1 ->
            subty t1 t2 ->
            subty t0 t2.

Hint Constructors subty.

End Smty.


Require Import Metalib.Metatheory.

Require Import Metalib.AssocList.

Require Import Lambdagc.Definitions.

Require Import Coq.Logic.Decidable.

Import LambdagcNotations.

Inductive stuck : program -> Prop :=
  | stuck_proj1_value : forall (H:heap) (x:var),
      (forall (x1 x2:var), ~ binds x (pair (var_f x1) (var_f x2)) H) ->
      stuck (H, proj1 (var_f x))
  | stuck_proj2_value : forall (H:heap) (x:var),
      (forall (x1 x2:var), ~ binds x (pair (var_f x1) (var_f x2)) H) ->
      stuck (H, proj2 (var_f x))
  | stuck_app : forall (H:heap) (x y:var),
      (forall (e1:exp), ~ binds x (abs e1) H) \/ (forall (e2:exp), ~ binds y e2 H) ->
      stuck (H, app (var_f x) (var_f y))
  | stuck_proj1 : forall (H:heap) (e:exp),
    stuck (H, e) ->
    stuck (H, proj1 e)
  | stuck_proj2 : forall (H:heap) (e:exp),
    stuck (H, e) ->
    stuck (H, proj2 e)
  | stuck_app1 : forall (H:heap) (e1 e2:exp),
    stuck (H, e1) ->
    stuck (H, app e1 e2)
  | stuck_app2 : forall (H:heap) (x1:var) (e2:exp),
    stuck (H, e2) ->
    stuck (H, app (var_f x1) e2)
  | stuck_pair1 : forall (H:heap) (e1 e2:exp),
    stuck (H, e1) ->
    stuck (H, pair e1 e2)
  | stuck_pair2 : forall (H:heap) (x1:var) (e2:exp),
    stuck (H, e2) ->
    stuck (H, pair (var_f x1) e2).

(* Theorem not_stuck_can_progress : forall (H:heap) (e:exp),
  ~(stuck (H,e)) /\ ~(is_answer (H,e)) /\ lc_exp e <->
  exists p', step (H,e) p'.
Proof.
    split.
    - intros hyp. destruct hyp. destruct H1.
      induction e.
      + inversion H2.
      + exfalso. apply H1. simpl. auto.
      + exists ([(fresh (dom_list H), num n)] ++ H, var_f (fresh (dom_list H))).
        apply step_alloc. simpl. auto.
      + exists ([(fresh (dom_list H), abs e)] ++ H, var_f (fresh (dom_list H))).
        apply step_alloc. simpl. auto.
      + inversion H2. destruct e1 eqn:Ee1.
        * inversion H5.
        * destruct e2 eqn:Ee2.
          -- inversion H6.
          -- unfold not in H0. Admitted.
             (* assert((exists e1, get x H = Some (abs e1)) /\ (exists e2, get x0 H = Some e2)).
             { split.  } Admitted. *) *)

Ltac solve_by_inverts n :=
  match goal with | H : ?T |- _ =>
  match type of T with Prop =>
    solve [
      inversion H;
      match n with S (S (?n')) => subst; solve_by_inverts (S n') end ]
  end end.

Theorem stuck_cannot_progress : forall (H:heap) (e:exp),
  lc_exp e ->
  stuck (H,e) \/ is_answer (H,e) ->
  ~(exists p', step (H,e) p').
Proof.
  unfold not. intros H e H_lc H_st C.
  destruct C as [(H', e') H_p'].
  destruct H_st as [H_st | H_ans].
  - generalize dependent H'. generalize dependent e'.
    induction H_st; subst; intros; inversion H_p'; subst; try (solve_by_inverts 2).
    + apply (H1 x1 x2). assumption.
    + apply (H1 x1 x2). assumption.
    + destruct H1.
      -- apply (H1 e1). assumption.
      -- apply (H1 e2). assumption.
    + apply (IHH_st e'0 H'). assumption.
    + apply (IHH_st e'0 H'). assumption.
    + apply (IHH_st e1' H'). assumption.
    + apply (IHH_st e2' H'). assumption.
    + apply (IHH_st e1' H'). assumption.
    + apply (IHH_st e2' H'). assumption.
  - inversion H_ans; subst. inversion H_p'; subst.
    inversion H7.
Qed.

Theorem not_stuck_implies_progress : forall (H:heap) (e:exp),
  lc_exp e ->
  (~(stuck (H, e)) /\ ~(is_answer (H, e))) ->
  (exists p', step (H,e) p').
Proof.
  unfold not. intros H e H_lc H_st.
  destruct H_st as [H_st H_ans].
  assert (forall (x:var) (E:heap), decidable (exists a, binds x a E)).
  { apply binds_lookup_dec. }
  induction e.
  - inversion H_lc.
  - exfalso. apply H_ans. apply answer_var_f.
  - pick fresh x for (dom H). exists ([(x, num n)] ++ H, var_f x).
    apply step_alloc. auto. apply lc_num. apply heap_num.
  - pick fresh x for (dom H). exists ([(x, abs e)] ++ H, var_f x).
    apply step_alloc. auto. apply H_lc. apply heap_abs.
  - Admitted.

  (* destruct e1; try (inversion H_lc; destruct IHe1; [ assumption | intros; apply H_st; apply stuck_app1; assumption | intros; inversion H4 |
                      destruct x as [H' e1']; exists (H', app e1' e2); apply step_app1; assumption; assumption]; fail).
    + destruct e2; try(destruct IHe2; [ inversion H_lc; assumption |  intros; apply H_st; apply stuck_app2; assumption | intros; inversion H0 |
                       destruct x0 as [H' e2']; exists ((H', app (var_f x) (e2'))); apply step_app2; apply H0]; fail).
      * destruct (get x H) eqn:E_getx.
        -- destruct e eqn:Ee;
           try (exfalso; apply H_st; apply stuck_app; left; unfold not; intros; rewrite H0 in E_getx; inversion E_getx; fail).
           destruct (get x0 H) eqn:E_getx0.
           ++ pick fresh y for (dom H). exists ([(y, e1)] ++ H, open e0 (var_f y)).
              apply step_app. auto. assumption. assumption.
           ++ exfalso. apply H_st. apply stuck_app. right. unfold not. intros. rewrite H0 in E_getx0. inversion E_getx0.
        -- exfalso. apply H_st. apply stuck_app. left. unfold not. intros. rewrite H0 in E_getx. inversion E_getx.
  - destruct e1; try (inversion H_lc; destruct IHe1; [ assumption | intros; apply H_st; apply stuck_pair1; assumption | intros; inversion H4 |
                      destruct x as [H' e1']; exists (H', pair e1' e2); apply step_pair1; assumption; assumption]; fail).
    + destruct e2; try(inversion H_lc; destruct IHe2; [ assumption |  intros; apply H_st; apply stuck_pair2; assumption | intros; inversion H4 |
                       destruct x0 as [H' e2']; exists ((H', pair (var_f x) (e2'))); apply step_pair2; [assumption | assumption]]; fail).
      * pick fresh y for (dom H). exists ([(y, pair (var_f x) (var_f x0))] ++ H, var_f y).
                apply step_alloc. auto.  assumption. apply heap_pair.
  - destruct e; try(inversion H_lc; destruct IHe; [ assumption | intros; apply H_st; apply stuck_proj1; assumption | intros; inversion H2 |
                    destruct x as [H' e']; exists (H', proj1 e'); apply step_proj1; assumption ]; fail).
    + destruct (get x H) eqn:E_getx.
      * destruct e eqn:Ee;
        try (exfalso; apply H_st; apply stuck_proj1_value; unfold not; intros; rewrite H0 in E_getx; inversion E_getx; fail).
        destruct e0_1; try (exfalso; apply H_st; apply stuck_proj1_value; unfold not; intros; rewrite H0 in E_getx; inversion E_getx; fail).
        destruct e0_2; try (exfalso; apply H_st; apply stuck_proj1_value; unfold not; intros; rewrite H0 in E_getx; inversion E_getx; fail).
        exists (H, var_f x0). apply step_proj1_heap with x1. assumption.
      * exfalso. apply H_st. apply stuck_proj1_value. unfold not. intros. rewrite H0 in E_getx. inversion E_getx.
  - destruct e; try(inversion H_lc; destruct IHe; [ assumption | intros; apply H_st; apply stuck_proj2; assumption | intros; inversion H2 |
                    destruct x as [H' e']; exists (H', proj2 e'); apply step_proj2; assumption ]; fail).
    + destruct (get x H) eqn:E_getx.
    * destruct e eqn:Ee;
      try (exfalso; apply H_st; apply stuck_proj2_value; unfold not; intros; rewrite H0 in E_getx; inversion E_getx; fail).
      destruct e0_1; try (exfalso; apply H_st; apply stuck_proj2_value; unfold not; intros; rewrite H0 in E_getx; inversion E_getx; fail).
      destruct e0_2; try (exfalso; apply H_st; apply stuck_proj2_value; unfold not; intros; rewrite H0 in E_getx; inversion E_getx; fail).
      exists (H, var_f x1). apply step_proj2_heap with x0. assumption.
    * exfalso. apply H_st. apply stuck_proj2_value. unfold not. intros. rewrite H0 in E_getx. inversion E_getx.
Qed. *)

(* Theorem step_deterministic : forall p1 p2 p2',
  step p1 p2 ->
  step p1 p2' ->
  p2 = p2'.
Proof.
  intros p1 p2 p2' H1 H2. generalize dependent p2'. induction H1; intros;
  inversion H2; subst; auto; try solve_by_inverts 3.
  - rewrite H0 in H6. inversion H6. auto.
  - rewrite H0 in H6. inversion H6. auto.
  - rewrite H0 in H8. inversion H8. rewrite H1 in H9.
    inversion H9. auto.
  - apply IHstep in H9. inversion H9. auto.
  - apply IHstep in H7. inversion H7. auto.
  - apply IHstep in H9. inversion H9. auto.
  - apply IHstep in H9. inversion H9. auto.
  - apply IHstep in H6. inversion H6. auto.
  - apply IHstep in H6. inversion H6. auto.
Qed. *)

Example divergent_program :
  step ([(fresh nil, abs (app (var_b 0) (var_b 0)))] ,
       app (var_f (fresh nil)) (var_f (fresh nil)))
       ([(fresh ([fresh nil]), abs (app (var_b 0) (var_b 0)))] ++ [(fresh nil, abs (app (var_b 0) (var_b 0)))] ,
       abs (app (var_b 0) (var_b 0)) ^  (fresh ([fresh nil])) ).
  Proof.
  Admitted.


Require Import UnitaryListRepresentation.

(* This file defines 'respects_constraints' predicates for describing when a
   program is properly mapped (i.e. respects architecture connectivity
   constraints) and utilities for proving 'respects_constraints' properties. *)

(** Predicates describing a correctly mapped program (gate set independent). **)
Inductive respects_constraints_undirected {U dim} : (nat -> nat -> bool) -> gate_list U dim -> Prop :=
  | res_und_nil : forall is_in_graph,
      respects_constraints_undirected is_in_graph []
  | res_und_app1 : forall u n t is_in_graph,
      respects_constraints_undirected is_in_graph t ->
      respects_constraints_undirected is_in_graph (App1 u n :: t)
  | res_und_app2 : forall u n1 n2 t is_in_graph,
      is_in_graph n1 n2 = true \/ is_in_graph n2 n1 = true -> (* undirected *)
      respects_constraints_undirected is_in_graph t ->
      respects_constraints_undirected is_in_graph (App2 u n1 n2 :: t).

Inductive respects_constraints_directed {U : nat -> Set} {dim} : (nat -> nat -> bool) -> U 2%nat -> gate_list U dim -> Prop :=
  | res_dir_nil : forall is_in_graph cnot,
      respects_constraints_directed is_in_graph cnot []
  | res_dir_app1 : forall u n t is_in_graph cnot,
      respects_constraints_directed is_in_graph cnot t ->
      respects_constraints_directed is_in_graph cnot (App1 u n :: t)
  | res_dir_app2 : forall n1 n2 t is_in_graph cnot,
      is_in_graph n1 n2 = true -> (* directed *)
      respects_constraints_directed is_in_graph cnot t ->
      respects_constraints_directed is_in_graph cnot (App2 cnot n1 n2 :: t).

Lemma respects_constraints_undirected_app : forall {U dim} (l1 l2 : gate_list U dim) is_in_graph,
  respects_constraints_undirected is_in_graph l1 ->
  respects_constraints_undirected is_in_graph l2 ->
  respects_constraints_undirected is_in_graph (l1 ++ l2).
Proof.
  intros U dim l1 l2 is_in_graph Hl1 Hl2.
  induction Hl1.
  simpl; assumption.
  rewrite <- app_comm_cons.
  constructor; auto.
  constructor; auto.
Qed.

Lemma respects_constraints_undirected_app_split : forall {U dim} (l1 l2 : gate_list U dim) is_in_graph,
  respects_constraints_undirected is_in_graph (l1 ++ l2) ->
  respects_constraints_undirected is_in_graph l2 /\
  respects_constraints_undirected is_in_graph l1.
Proof.
  intros U dim l1 l2 is_in_graph H.
  split.
  - induction l1.
    simpl in H.
    assumption.
    rewrite <- app_comm_cons in H.
    destruct a; remember (l1 ++ l2) as l; inversion H; subst;
      try (apply IHl1 in H2); auto.
  - induction l1.
    constructor.
    rewrite <- app_comm_cons in H;
      destruct a; remember (l1 ++ l2) as l; inversion H; subst.
    constructor; auto.
    constructor; auto.
Qed.

Lemma rev_respects_constraints_undirected:
  forall {U dim} (l : gate_list U dim) (is_in_graph : nat -> nat -> bool),
    respects_constraints_undirected is_in_graph l ->
    respects_constraints_undirected is_in_graph (rev l).
Proof.
  intros.
  induction l; simpl; auto.
  destruct a; inversion H; subst.
  apply respects_constraints_undirected_app; auto.
  constructor. constructor.
  apply respects_constraints_undirected_app; auto.
  constructor. auto. constructor.
Qed.

Lemma rev_append_respects_constraints_undirected:
  forall {U dim} (l1 l2 : gate_list U dim) (is_in_graph : nat -> nat -> bool),
    respects_constraints_undirected is_in_graph l1 ->
    respects_constraints_undirected is_in_graph l2 ->
    respects_constraints_undirected is_in_graph (rev_append l1 l2).
Proof.
  intros.
  rewrite rev_append_rev.
  apply respects_constraints_undirected_app.
  apply rev_respects_constraints_undirected.
  assumption.
  assumption.
Qed.

Lemma next_two_qubit_gate_respects_constraints_undirected:
  forall {U dim} (l l1 l2: gate_list U dim) g (q q1 q2 : nat) (is_in_graph : nat -> nat -> bool),
  respects_constraints_undirected is_in_graph l ->
  next_two_qubit_gate l q = Some (l1, g, q1, q2, l2) ->
  respects_constraints_undirected is_in_graph l1
    /\ respects_constraints_undirected is_in_graph l2 /\
      (is_in_graph q1 q2 = true \/ is_in_graph q2 q1 = true).
Proof.
  intros.
  apply ntqg_preserves_structure in H0.
  rewrite H0 in H.
  eapply respects_constraints_undirected_app_split in H.
  destruct H as [rcdapp rcdl1].
  eapply respects_constraints_undirected_app_split in rcdapp.
  destruct rcdapp as [rcdl2 rcdapp2].
  repeat split; auto.
  inversion rcdapp2; subst.
  assumption.
Qed.

Lemma respects_constraints_directed_app : forall {U dim} (l1 l2 : gate_list U dim) is_in_graph cnot,
  respects_constraints_directed is_in_graph cnot l1 ->
  respects_constraints_directed is_in_graph cnot l2 ->
  respects_constraints_directed is_in_graph cnot (l1 ++ l2).
Proof.
  intros U dim l1 l2 is_in_graph cnot Hl1 Hl2.
  induction Hl1.
  simpl; assumption.
  rewrite <- app_comm_cons.
  constructor; auto.
  constructor; auto.
Qed.

Lemma respects_constraints_directed_app_split : forall {U dim} (l1 l2 : gate_list U dim) is_in_graph cnot,
  respects_constraints_directed is_in_graph cnot (l1 ++ l2) ->
  respects_constraints_directed is_in_graph cnot l2 /\
  respects_constraints_directed is_in_graph cnot l1.
Proof.
  intros U dim l1 l2 is_in_graph cnot H.
  split.
  - induction l1.
    simpl in H.
    assumption.
    rewrite <- app_comm_cons in H.
    destruct a; remember (l1 ++ l2) as l; inversion H; subst;
    try (apply IHl1 in H2); try assumption.
    + apply IHl1 in H3. assumption.
    + apply IHl1 in H7.  assumption.
  -induction l1.
   + apply res_dir_nil.
   + rewrite <- app_comm_cons in H;
   destruct a; remember (l1 ++ l2) as l; inversion H; subst.
   * apply IHl1 in H3.
     eapply res_dir_app1.
     assumption.
   * apply IHl1 in H7.
     eapply res_dir_app2.
     assumption.
     assumption.
Qed.

Lemma rev_respects_constraints:
  forall {U dim} (l : gate_list U dim) (is_in_graph : nat -> nat -> bool) cnot,
    respects_constraints_directed is_in_graph cnot l ->
    respects_constraints_directed is_in_graph cnot (rev l).
Proof.
  intros.
  induction l.
  - simpl. assumption.
  - simpl.
    apply respects_constraints_directed_app.
    apply IHl.
    inversion H; subst.
    assumption.
    assumption.
    destruct a; try constructor; try constructor.
    inversion H; subst.
    constructor; try assumption.
    constructor.
    inversion H; subst.
Qed.

Lemma rev_append_respects_constraints:
  forall {U dim} (l1 l2 : gate_list U dim) (is_in_graph : nat -> nat -> bool) cnot,
    respects_constraints_directed is_in_graph cnot l1 ->
    respects_constraints_directed is_in_graph cnot l2 ->
    respects_constraints_directed is_in_graph cnot (rev_append l1 l2).
Proof.
  intros.
  rewrite rev_append_rev.
  apply respects_constraints_directed_app.
  apply rev_respects_constraints.
  assumption.
  assumption.
Qed.

(** X_respects_constraints facts about the defns in UnitaryListRepresentation. **)

Lemma next_single_qubit_gate_respects_constraints:
  forall {U dim} (l l1 l2: gate_list U dim) g (q : nat) (is_in_graph : nat -> nat -> bool) cnot,
  respects_constraints_directed is_in_graph cnot l ->
  Some (l1, g, l2) = (next_single_qubit_gate l q) ->
  respects_constraints_directed is_in_graph cnot l1
    /\ respects_constraints_directed is_in_graph  cnot l2.
Proof.
  intros.
  symmetry in H0.
  apply nsqg_preserves_structure in H0.
  split;
  inversion H0; subst;
  eapply respects_constraints_directed_app_split in H;
  destruct H as [rcdapp rcdl1].
  apply rcdl1.
  eapply respects_constraints_directed_app_split in rcdapp.
  destruct rcdapp as [rcdl2 rcda1].
  assumption.
Qed.

Lemma next_two_qubit_gate_respects_constraints:
  forall {U dim} (l l1 l2: gate_list U dim) g (q q1 q2 : nat) (is_in_graph : nat -> nat -> bool) cnot,
  respects_constraints_directed is_in_graph cnot l ->
  Some (l1, g, q1, q2, l2) = (next_two_qubit_gate l q) ->
  respects_constraints_directed is_in_graph cnot l1
    /\ respects_constraints_directed is_in_graph cnot l2 /\ is_in_graph q1 q2 = true.
Proof.
  intros.
  symmetry in H0.
  apply ntqg_preserves_structure in H0.
  rewrite H0 in H.
  eapply respects_constraints_directed_app_split in H.
  destruct H as [rcdapp rcdl1].
  eapply respects_constraints_directed_app_split in rcdapp.
  destruct rcdapp as [rcdl2 rcdapp2].
  split.
  assumption.
  split.
  assumption.
  inversion rcdapp2; subst.
  assumption.
Qed.

Ltac assert_next_single_qubit_gate  :=
  match reverse goal with
  |[ H :   Some (?l11, ?gat, ?l22) = next_single_qubit_gate ?in_l ?qub
    |- respects_constraints_directed ?iig _ /\
       respects_constraints_directed ?iig _] =>
    assert (respects_constraints_directed iig l11
            /\ respects_constraints_directed iig l22)
  | H :   Some (?l11, ?gat, ?l22) = next_single_qubit_gate ?in_l ?qub
     |- respects_constraints_directed ?iig _  =>
   assert (respects_constraints_directed iig l11
           /\ respects_constraints_directed iig l22)
end.

Ltac assert_next_two_qubit_gate :=
  match reverse goal with
  |[ H :   Some (?l11, _, ?n0, ?n, ?l22) = next_two_qubit_gate ?in_l ?qub
    |- respects_constraints_directed ?iig _ /\
       respects_constraints_directed ?iig _] =>
    assert (respects_constraints_directed iig l11
            /\ respects_constraints_directed iig l22
            /\ iig n0 n = true)
  |[ H :   Some (?l11, _, ?n0, ?n, ?l22) = next_two_qubit_gate ?in_l ?qub
     |- respects_constraints_directed ?iig _] =>
   assert (respects_constraints_directed iig l11
           /\ respects_constraints_directed iig l22
           /\ iig n0 n = true)
  end.

Ltac prove_next_gates_assertion  :=
  match reverse goal with
  | H :   Some (?l11, ?gat, ?l22) = next_single_qubit_gate ?in_l ?qub
    |- respects_constraints_directed ?iig ?ll1 /\
       respects_constraints_directed ?iig ?ll2 =>

    try (eapply next_single_qubit_gate_respects_constraints
           with (l := in_l) (l1 := l11) (l2 := l22) (g5 := gat) (q0 := qub));
    try (eapply next_single_qubit_gate_respects_constraints
           with (l := in_l) (l1 := l11) (l2 := l22) (g1 := gat) (q0 := qub));
    try assumption

  | H :   Some  (?l11, _, ?n0, ?n, ?l22) = next_two_qubit_gate ?in_l ?qub
    |- respects_constraints_directed ?iig ?ll1 /\
       respects_constraints_directed ?iig ?ll2 /\ ?iig ?n0 ?n = true=>

    try (eapply next_two_qubit_gate_respects_constraints
           with (l := in_l) (l1 := l11) (l2 := l22) (q0 := qub));
        try (eapply next_two_qubit_gate_respects_constraints
      with (l := in_l) (l1 := l11) (l2 := l22) (q0 := qub));
    try assumption
  end.

Ltac clear_next_gates  :=
  match reverse goal with
  | H : Some (_) = _  |- _ => clear H
  end.

Lemma try_rewrites_respects_constraints:
  forall {U dim} (l l' : gate_list U dim) rules  (is_in_graph : nat -> nat -> bool) cnot,
    respects_constraints_directed is_in_graph cnot l ->
    (forall r, List.In r rules ->
               forall l l', respects_constraints_directed is_in_graph cnot l ->
                            r l = Some l' ->
                            respects_constraints_directed is_in_graph cnot l') ->
    try_rewrites l rules = Some l' ->
    respects_constraints_directed is_in_graph cnot l'.
Proof.
  intros.
  induction rules.
  inversion H1.
  simpl in H1.
  destruct (a l) eqn:al.
  inversion H1; subst.
  eapply H0.
  left. reflexivity. apply H. apply al.
  apply IHrules.
  intros.
  eapply H0.  right.
  apply H2.
  apply H3.
  apply H4.
  apply H1.
Qed.

Lemma try_rewrites2_respects_constraints:
  forall {U dim} (l l1 l2 : gate_list U dim) rules (is_in_graph : nat -> nat -> bool) cnot,
    respects_constraints_directed is_in_graph cnot l ->
    (forall r, List.In r rules ->
               forall l l1 l2, respects_constraints_directed is_in_graph cnot l ->
                               r l = Some (l1, l2) ->
                               respects_constraints_directed is_in_graph cnot l1
    /\ respects_constraints_directed is_in_graph cnot l2) ->
    try_rewrites2 l rules = Some (l1, l2) ->
    respects_constraints_directed is_in_graph cnot l1
    /\ respects_constraints_directed is_in_graph cnot l2.
Proof.
  intros.
  induction rules.
  inversion H1.
  simpl in H1.
  destruct (a l) eqn:al.
  inversion H1; subst.
  eapply H0.
  left. reflexivity. apply H. apply al.
  apply IHrules.
  intros.
  eapply H0.  right.
  apply H2.
  apply H3.
  apply H4.
  apply H1.
Qed.

Definition cancel_rules_respect_constraints {dim U} rules is_in_graph cnot :=
  forall r,
  List.In r rules ->
  forall (l l' : gate_list U dim), (respects_constraints_directed is_in_graph cnot l ->
                                    r l = Some l' ->
                                    respects_constraints_directed is_in_graph cnot l').

Definition commute_rules_respect_constraints  {dim U} rules is_in_graph cnot :=
  forall r,
  List.In r rules ->
  forall (l l1 l2: gate_list U dim), (respects_constraints_directed is_in_graph cnot l ->
                                      r l = Some (l1, l2) ->
                                      respects_constraints_directed is_in_graph cnot l1
                                      /\ respects_constraints_directed is_in_graph cnot l2).

Lemma propagate'_respects_constraints :
  forall {U dim} (l : gate_list U dim)
    commute_rules cancel_rules n acc l'  is_in_graph cnot,
  respects_constraints_directed is_in_graph cnot l ->
  respects_constraints_directed is_in_graph cnot acc ->
  cancel_rules_respect_constraints cancel_rules is_in_graph cnot ->
  commute_rules_respect_constraints commute_rules is_in_graph cnot ->
  propagate' l commute_rules cancel_rules n acc = Some l' ->
  respects_constraints_directed is_in_graph cnot l'.
Proof.
  intros.
  generalize dependent acc.
  generalize dependent l'.
  generalize dependent l.
  induction n; intros l respects_l l' acc respects_acc res; try discriminate.
  simpl in res.
  destruct (try_rewrites l cancel_rules) eqn:rewr1.
  inversion res; subst.
  rewrite rev_append_rev.
  apply respects_constraints_directed_app.
  apply rev_respects_constraints.
  assumption.
  eapply try_rewrites_respects_constraints.
  apply respects_l.
  intros r Hr l0 l' Hrcdl H0.
  apply H1 with (r := r) (l := l0); try apply Hr; try assumption.
  assumption.
  destruct (try_rewrites2 l commute_rules) eqn:rewr2; try discriminate.
  destruct p.
  assert (respects_constraints_directed is_in_graph cnot g
          /\ respects_constraints_directed is_in_graph cnot g0).
  eapply try_rewrites2_respects_constraints.
  apply respects_l.
  intros r Hr l0 l1 l2 Hrcdl0 rls.
  eapply H2. apply Hr. apply Hrcdl0. apply rls. apply rewr2.
  apply IHn with (l := g0) (acc := (rev_append g acc)).
  apply H.
  apply rev_append_respects_constraints; try assumption.
  apply H.
  assumption.
Qed.

Lemma propagate_respects_constraints :  forall {U dim} (l l' : gate_list U dim)
                                           n  commute_rules cancel_rules
                                          (is_in_graph : nat -> nat -> bool) cnot,
    respects_constraints_directed is_in_graph cnot l ->
    cancel_rules_respect_constraints  cancel_rules is_in_graph cnot ->
    commute_rules_respect_constraints commute_rules is_in_graph cnot ->
    propagate l commute_rules cancel_rules n = Some l' ->
    respects_constraints_directed is_in_graph cnot l'.
Proof.
  intros.
  apply (propagate'_respects_constraints l commute_rules cancel_rules n [] l' is_in_graph);
    try assumption; try constructor.
Qed.

Ltac destruct_matches :=
  match goal with
  | H :   match ?Y with _ => _  end = _ |- _ =>
    let h:= fresh in remember Y as h;
                     try destruct h;
                     try dependent destruction h;
                     try discriminate; destruct_pairs; subst
  end.

Lemma next_gate'_respects_constraints:
  forall {U dim} (l l1 l2 acc: gate_list U dim) g (f : nat -> bool) is_in_graph cnot,
  respects_constraints_directed is_in_graph cnot l ->
  respects_constraints_directed is_in_graph cnot acc ->
  next_gate' l f acc  = Some (l1, g,  l2) ->
  respects_constraints_directed is_in_graph cnot l1
    /\ respects_constraints_directed is_in_graph cnot l2
    /\ respects_constraints_directed is_in_graph cnot [g].
Proof.
  intros.
  generalize dependent acc.
  induction l; intros.
  - simpl in H1.
    inversion H1.
  - inversion H1; subst.
    repeat destruct_matches;
      try (
          inversion H3; subst;
          try split;
          try apply rev_append_respects_constraints; try assumption;  try constructor;
          try split ;
          try inversion H; try subst;  try assumption ;
          try constructor; try constructor).
    all: try (
             assert(respects_constraints_directed is_in_graph cnot (App1 u n :: acc));
             try constructor; try assumption; try apply H2; try assumption).
    all: try (eapply IHl;  try assumption;  try apply H2;  try assumption ).
    assumption.

    all: try (
             assert(respects_constraints_directed is_in_graph u (App2 u n n0 :: acc));
             try apply res_dir_app2; try apply H8; try assumption; try apply H0).
Qed.

Lemma next_gate_respects_constraints:
  forall {U dim} (l l1 l2: gate_list U dim) g (f : nat -> bool) is_in_graph cnot ,
    respects_constraints_directed is_in_graph cnot l ->
    Some (l1, g,  l2) = next_gate l f  ->
    respects_constraints_directed is_in_graph cnot l1
    /\ respects_constraints_directed is_in_graph cnot l2
    /\ respects_constraints_directed is_in_graph cnot [g].
Proof.
  intros.
  eapply next_gate'_respects_constraints.
  apply H.
  apply res_dir_nil.
  unfold next_gate in H0.
  symmetry in H0.
  apply H0.
Qed.

(* This is nested matches so it finds the first hypothesis and doesn't try to find first match expression*)
Ltac assert_and_prove_next_gate :=

  match reverse goal with
  |[ H1 : respects_constraints_directed ?iig ?cnot _ |- _] =>
   match reverse goal with
   |[ H :   Some ?tuple = ?n_g ?in_l ?qub
      |-  _ ] =>
    match n_g with
    | next_single_qubit_gate =>
      match tuple with
      |(?l11, ?gat,  ?l22) =>
       assert (respects_constraints_directed iig cnot l11
               /\ respects_constraints_directed iig cnot l22);
       [try eapply (next_single_qubit_gate_respects_constraints in_l l11 l22 gat qub);
        try assumption|]; clear H end
    | next_two_qubit_gate =>
      match tuple with
      |(?l11, ?cnot, ?n0, ?n, ?l22) =>
       assert (respects_constraints_directed iig cnot l11
               /\ respects_constraints_directed iig cnot l22
               /\ iig n0 n = true);
       [try eapply (next_two_qubit_gate_respects_constraints in_l l11 l22 cnot qub);
        try assumption|]; clear H end
    | next_gate =>
      match tuple with
        (?l11, ?gat, ?l22) =>
        assert (respects_constraints_directed iig cnot l11
                /\ respects_constraints_directed iig cnot l22
                /\ respects_constraints_directed iig cnot [gat]);
               [try eapply (next_gate_respects_constraints in_l l11 l22 gat qub);
        try assumption|]; clear H end
    end
   end
  end.

 Lemma remove_prefix_respects_constraints:
   forall {U dim} (l l' pfx: gate_list U dim)
          (match_gate : (forall {n}, U n -> U n -> bool))
         is_in_graph cons,
    respects_constraints_directed is_in_graph cons l ->
    respects_constraints_directed is_in_graph cons pfx ->
    remove_prefix l pfx (fun n => @match_gate n)  = Some l' ->
    respects_constraints_directed is_in_graph cons l'.
Proof.
  intros.
  generalize dependent l'.
  generalize dependent l.
  induction pfx.
  - intros.
    induction l.
    + inversion H1.
      constructor.
    + simpl in H1.
      destruct a; inversion H1;
        inversion H;  try constructor; try assumption.
  - intros.
    induction l.
    + simpl in H1. destruct a; inversion H1.
    + simpl in H1.
      repeat destruct_matches.
      * eapply IHpfx.
        inversion H0; subst; assumption.
        assert_and_prove_next_gate.
        destruct H2 as [rcdg0 rcdg].
        assert (respects_constraints_directed is_in_graph cons (g0 ++ g)).
        apply respects_constraints_directed_app.
        apply rcdg0. apply rcdg.
        apply H2.
        assumption.
      * eapply IHpfx.
        inversion H0; subst; assumption.
        assert_and_prove_next_gate.
        destruct H2 as [iigg0 [iigg iigA2]].
        assert (respects_constraints_directed is_in_graph cons (g0++g)).
        apply respects_constraints_directed_app; assumption.
        apply H2.
        apply H1.
Qed.

Lemma remove_suffix_respects_constraints:
  forall {U dim} (l l' sfx: gate_list U dim) (match_gate : (forall {n}, U n -> U n -> bool))
         is_in_graph cnot,
    respects_constraints_directed is_in_graph cnot l ->
    respects_constraints_directed is_in_graph cnot  sfx ->
    remove_suffix l sfx (fun n => @match_gate n)  = Some l' ->
    respects_constraints_directed is_in_graph cnot l'.
Proof.
  intros.
  unfold remove_suffix in H1.
  destruct_matches.
  inversion H1; subst.
  assert (respects_constraints_directed is_in_graph cnot g).
  eapply remove_prefix_respects_constraints.
  apply rev_append_respects_constraints.
  apply H. apply res_dir_nil.
  apply rev_append_respects_constraints.
  apply H0. apply res_dir_nil.
  symmetry in HeqH2.
  apply HeqH2.
  apply rev_append_respects_constraints; try assumption; try constructor.
Qed.

Ltac assert_get_matching_prefix' :=
      match reverse goal with
    |[ H :  get_matching_prefix' ?l1 ?l2 ?pacc ?lacc _ _ _ = _
       |- respects_constraints_directed ?iig ?c _ /\
           _] =>
     assert (respects_constraints_directed iig c l1
             /\ respects_constraints_directed iig c l2
             /\ respects_constraints_directed iig c pacc
             /\ respects_constraints_directed iig c lacc
            )
    end.

 Lemma get_matching_prefix'_respects_constraints:
   forall {U dim} n (l1 l2 pacc lacc l2a l2b u2: gate_list U  dim) blst
          (match_gate : (forall {n}, U n -> U n -> bool))
         is_in_graph cnot ,
    respects_constraints_directed is_in_graph cnot l1 ->
    respects_constraints_directed is_in_graph cnot l2 ->
    respects_constraints_directed is_in_graph cnot  lacc ->
    respects_constraints_directed is_in_graph cnot pacc ->
    get_matching_prefix' l1 l2 pacc lacc blst n (fun n => @match_gate n)  = (l2a, u2, l2b) ->
    respects_constraints_directed is_in_graph cnot l2a
    /\ respects_constraints_directed is_in_graph cnot l2b
    /\ respects_constraints_directed is_in_graph cnot u2.
Proof.
  intros.
  generalize dependent l1.
  generalize dependent l2.
  generalize dependent pacc.
  generalize dependent lacc.
  generalize dependent blst.
  induction n.
  - intros.
    simpl in H3.
    inversion H3; subst; clear H3.
    split.
    + apply rev_append_respects_constraints; try assumption;  constructor.
    + split.
      assumption.
      apply rev_append_respects_constraints; try assumption; try constructor.
  - intros.
    simpl in H3.
    repeat destruct_matches;

      (* Each case has one or two next gate type calls*)
      try (assert_and_prove_next_gate; destruct H4 as [rcdg0 [rcdg rcdaun0]]) ;
      try (assert_and_prove_next_gate; destruct H4 as [rcdg2 rcdg1]) ;
      try destruct rcdg1 as [rcdg11 rcdg12];

      (* Last two cases *)
      try (inversion H3; subst; clear H3; split;
           [apply rev_append_respects_constraints; try assumption; try constructor|
            split;
            [assumption|apply rev_append_respects_constraints; try assumption; try constructor]]
          ).
    +
      assert_get_matching_prefix'.
       split; try assumption; split; try assumption.
       apply respects_constraints_directed_app;
         assumption.
       split.
       constructor.
       assumption.
       apply rev_append_respects_constraints; try assumption; try constructor.
       destruct H4 as [s1 [s2 [s3 s4]]]; eapply IHn.
       apply s4. apply s3. apply s2. apply s1.
       apply H3.
    + assert_get_matching_prefix'.
      split; try assumption; split; try  assumption; split; try assumption.
      constructor.
      apply rev_append_respects_constraints; try assumption; try constructor.
      destruct H4 as [s1 [s2 [s3 s4]]]; eapply IHn.
      apply s4. apply s3. apply s2. apply s1.
      apply H3.
    + assert_get_matching_prefix'.
      split; try assumption; split; try  assumption; split; try assumption.
      constructor.
      apply rev_append_respects_constraints; try assumption; try constructor.
      destruct H4 as [s1 [s2 [s3 s4]]]; eapply IHn.
      apply s4. apply s3. apply s2. apply s1.
      apply H3.
    + assert_get_matching_prefix'.
      split; try assumption; split; try assumption; split; try assumption; try constructor.
      inversion rcdaun0; subst.
      constructor.
      assumption.
      apply rev_append_respects_constraints; try assumption; try constructor.
      destruct H4 as [s1 [s2 [s3 s4]]]; eapply IHn.
      apply s4. apply s3. apply s2. apply s1.
      apply H3.
    + assert_get_matching_prefix'.
      split; try assumption; split.
      apply respects_constraints_directed_app; try assumption.
      split.
      inversion rcdaun0; subst; try constructor; try assumption.
      apply rev_append_respects_constraints; try assumption.
      destruct H4 as [s1 [s2 [s3 s4]]]; eapply IHn.
      apply s4. apply s3. apply s2. apply s1.
      apply H3.
    + assert_get_matching_prefix'.
      split; try assumption; split; try assumption; split; try assumption.
      inversion rcdaun0; subst; try constructor; try assumption.
      apply rev_append_respects_constraints; try assumption.
      destruct H4 as [s1 [s2 [s3 s4]]]; eapply IHn.
      apply s4. apply s3. apply s2. apply s1.
      apply H3.
    + assert_get_matching_prefix'.
      split; try assumption; split; try assumption; split; try assumption.
      inversion rcdaun0; subst; try constructor; try assumption.
      apply rev_append_respects_constraints; try assumption.
      destruct H4 as [s1 [s2 [s3 s4]]]; eapply IHn.
      apply s4. apply s3. apply s2. apply s1.
      apply H3.
    + assert_get_matching_prefix'.
      split; try assumption; split; try assumption; split; try assumption.
      inversion rcdaun0; subst; try constructor; try assumption.
      apply rev_append_respects_constraints; try assumption.
      destruct H4 as [s1 [s2 [s3 s4]]]; eapply IHn.
      apply s4. apply s3. apply s2. apply s1.
      apply H3.
Qed.

Lemma get_matching_prefix_respects_constraints:
  forall {U dim}  (l1 l2 pacc lacc l2a l2b u2: gate_list U dim)
         (match_gate : (forall {n}, U n -> U n -> bool))
         is_in_graph cnot ,
    respects_constraints_directed is_in_graph cnot l1 ->
    respects_constraints_directed is_in_graph cnot l2 ->
    get_matching_prefix l1 l2 (fun n => @match_gate n) = (l2a, u2, l2b) ->
    respects_constraints_directed is_in_graph cnot l2a
    /\ respects_constraints_directed is_in_graph cnot l2b
    /\ respects_constraints_directed is_in_graph cnot u2.
Proof.
  intros.
  unfold get_matching_prefix in H1.
  eapply get_matching_prefix'_respects_constraints.
  apply H. apply H0. apply res_dir_nil. apply res_dir_nil. apply H1.
Qed.

Lemma LCR_respects_constraints:
  forall {U dim} (b l2a l2b u2: gate_list U dim) opt
         (match_gate : (forall {n}, U n -> U n -> bool))
         is_in_graph cnot,
    (forall p, respects_constraints_directed is_in_graph cnot p ->
        respects_constraints_directed is_in_graph cnot (opt p)) ->
    respects_constraints_directed is_in_graph cnot b ->
    LCR b opt (fun n => @match_gate n) = Some (l2a, u2, l2b) ->
    respects_constraints_directed is_in_graph cnot l2a
    /\ respects_constraints_directed is_in_graph cnot l2b
    /\ respects_constraints_directed is_in_graph cnot u2.
Proof.
  intros.
  unfold LCR in H1.
  repeat destruct_matches.
  assert (respects_constraints_directed is_in_graph cnot (opt b)).
  apply H. assumption.
  assert (respects_constraints_directed is_in_graph cnot (opt b ++ opt b)).
  apply respects_constraints_directed_app; assumption.
  assert (respects_constraints_directed is_in_graph cnot (opt b ++ opt b ++ opt b)).
  apply respects_constraints_directed_app. assumption.
  apply respects_constraints_directed_app; assumption.
  assert (respects_constraints_directed is_in_graph cnot (opt (opt b ++ opt b))).
  apply H; assumption.
  assert (respects_constraints_directed is_in_graph cnot (opt (opt b ++ opt b ++ opt b))).
  apply H; assumption.
  assert (respects_constraints_directed is_in_graph cnot l
    /\ respects_constraints_directed is_in_graph cnot g
    /\ respects_constraints_directed is_in_graph cnot l0).
  eapply get_matching_prefix_respects_constraints; try assumption.
  apply H2. apply H5. symmetry in HeqH2. apply HeqH2.
  inversion H1; subst.
  split. apply H7. split. apply H7.
  destruct H7 as [rcdl2a [rcdl2b rcdl0]].
  assert (respects_constraints_directed is_in_graph cnot g0).
  eapply remove_prefix_respects_constraints.
  apply H6. apply rcdl2a. symmetry in HeqH0. apply HeqH0.
  eapply remove_suffix_respects_constraints.
  apply H7. apply rcdl2b. symmetry. apply HeqH1.
Qed.

Lemma replace_pattern_respects_constraints:
  forall {U dim} (l l' pat rep: gate_list U dim) match_gate is_in_graph cnot,
    respects_constraints_directed is_in_graph cnot l ->
    respects_constraints_directed is_in_graph cnot pat ->
    respects_constraints_directed is_in_graph cnot rep ->
    replace_pattern l pat rep match_gate = Some l' ->
    respects_constraints_directed is_in_graph cnot l'.
Proof.
  intros.
  unfold replace_pattern in H2.
  destruct_matches.
  inversion H2; subst.
  assert (respects_constraints_directed is_in_graph cnot g).
  eapply remove_prefix_respects_constraints.
  apply H. apply H0. symmetry in HeqH3.  apply HeqH3.
  apply respects_constraints_directed_app; assumption.
Qed.