From iris.algebra Require Import frac_auth gset.
From iris.base_logic.lib Require Import invariants.
From iris.heap_lang Require Import notation.

From SkipList.atomic Require Import proofmode weakestpre.
From SkipList.lazy_list Require Import code inv.
From SkipList.lazy_list.spec Require Import spec.

Class rwG Σ := RWG {
  rw_mutG :> inG Σ (frac_authR (gsetR Z));
  rw_agrG :> inG Σ (frac_authR (agreeR (gset Z)));
  rw_setG :> lazyG Σ
}.

Record rw_gname := mk_rw_gname {
  mut_gname: gname;
  agr_gname: gname
}.

Module RWSpec (Params: LAZY_LIST_PARAMS).
  Import Params.
  Module LASpec := LASpec Params.
  Export LASpec.

  Section invariant.
    Context `{!heapGS Σ, !rwG Σ} (N: namespace).

    Definition rw_lazyN := N .@ "rw_lazy".

    (* Public state for concurrent writes *)
    Definition mut_set (s: gset Z) (q: frac) (Γ: rw_gname) : iProp Σ :=
      own Γ.(mut_gname) (◯F{q} s).
    Lemma mut_set_sep (s: gset Z) (q1 q2: frac) (Γ: rw_gname) :
      mut_set s (q1 + q2) Γ -∗ mut_set s q1 Γ ∗ mut_set s q2 Γ.
    Proof. iIntros "(Hmut1 & Hmut2)"; iFrame. Qed.
    Lemma mut_set_join (s1 s2: gset Z) (q1 q2: frac) (Γ: rw_gname) :
      mut_set s1 q1 Γ ∗ mut_set s2 q2 Γ -∗ mut_set (s1 ⋅ s2) (q1 + q2) Γ.
    Proof. iIntros "(Hmut1 & Hmut2)"; by iCombine "Hmut1 Hmut2" as "Hmut". Qed.

    (* Public state for concurrent reads *)
    Definition const_set (s: gset Z) (q: frac) (Γ: rw_gname) : iProp Σ :=
      own Γ.(agr_gname) (◯F{q} (to_agree s)).
    Lemma const_set_sep (s: gset Z) (q1 q2: frac) (Γ: rw_gname) :
      const_set s (q1 + q2) Γ -∗ const_set s q1 Γ ∗ const_set s q2 Γ.
    Proof. iIntros "(Hmut1 & Hmut2)"; iFrame. Qed.
    Lemma const_set_join (s1 s2: gset Z) (q1 q2: frac) (Γ: rw_gname) :
      const_set s1 q1 Γ ∗ const_set s2 q2 Γ -∗ const_set (s1 ⋅ s2) (q1 + q2) Γ.
    Proof.
      iIntros "(Hmut1 & Hmut2)"; iCombine "Hmut1 Hmut2" as "Hmut".
      iDestruct (own_valid with "Hmut") as %[_ <-%to_agree_op_inv_L]%frac_auth_frag_valid.
      rewrite gset_op union_idemp_L agree_idemp //.
    Qed.

    (* Invariant concealing the abstract state of the full set *)
    Definition set_inv (p: loc) (Γl: lazy_gname) (Γ: rw_gname) : iProp Σ :=
      ∃ (s: gset Z),
        set p s Γl
        ∗
        own Γ.(mut_gname) (●F s)
        ∗
        own Γ.(agr_gname) (●F (to_agree s))
        ∗
        (own Γ.(mut_gname) (◯F s) ∨ own Γ.(agr_gname) (◯F (to_agree s))).
    Definition is_set (p: loc) (Γ: rw_gname) : iProp Σ :=
      ∃ (Γl: lazy_gname), inv rw_lazyN (set_inv p Γl Γ).
    Lemma rw_inv_alloc_mut (p: loc) (s: gset Z) (Γl: lazy_gname) :
      set p s Γl ={⊤}=∗ ∃ (Γ: rw_gname), is_set p Γ ∗ mut_set s 1 Γ.
    Proof.
      iIntros "Hset".
      iMod (own_alloc (●F s ⋅ ◯F s)) as (γmut) "[Hmut● Hmut◯]";
        first by apply auth_both_valid.
      iMod (own_alloc (●F (to_agree s) ⋅ ◯F (to_agree s))) as (γagr) "[Hagr● Hagr◯]";
        first by apply auth_both_valid.
      set (Γ := mk_rw_gname γmut γagr).
      iMod (inv_alloc rw_lazyN ⊤ (set_inv p Γl Γ)
        with "[Hset Hmut● Hagr● Hagr◯]") as "#Hinv".
      { iNext; iExists s; iFrame. }
      iModIntro; iExists Γ; iFrame "# ∗"; by iExists Γl.
    Qed.
    Lemma rw_inv_alloc_const (p: loc) (s: gset Z) (Γl: lazy_gname) :
      set p s Γl ={⊤}=∗ ∃ (Γ: rw_gname), is_set p Γ ∗ const_set s 1 Γ.
    Proof.
      iIntros "Hset".
      iMod (own_alloc (●F s ⋅ ◯F s)) as (γmut) "[Hmut● Hmut◯]";
        first by apply auth_both_valid.
      iMod (own_alloc (●F (to_agree s) ⋅ ◯F (to_agree s))) as (γagr) "[Hagr● Hagr◯]";
        first by apply auth_both_valid.
      set (Γ := mk_rw_gname γmut γagr).
      iMod (inv_alloc rw_lazyN ⊤ (set_inv p Γl Γ)
        with "[Hset Hmut● Hmut◯ Hagr●]") as "#Hinv".
      { iNext; iExists s; iFrame. }
      iModIntro; iExists Γ; iFrame "# ∗"; by iExists Γl.
    Qed.

    (* Helper lemmas for switching between concurrent writes and concurrent reads *)
    Lemma mut_to_const (p: loc) (s: gset Z) (Γ: rw_gname) :
      is_set p Γ -∗ mut_set s 1 Γ ={⊤}=∗ const_set s 1 Γ.
    Proof.
      rewrite /mut_set/const_set; iIntros "[%Γl #Hinv] Hmut◯".
      iInv "Hinv" as (s') ">(Hset & Hmut● & Hagr● & Hagr◯)".
      iDestruct (own_valid_2 with "Hmut● Hmut◯") as %->%frac_auth_agree_L.
      iDestruct "Hagr◯" as "[Hfalse|Hagr◯]".
      { by iDestruct (own_valid_2 with "Hmut◯ Hfalse") as %[Hfalse%Qp.not_add_le_r _]%frac_auth_frag_valid. }
      iModIntro. iSplitR "Hagr◯"; last (iModIntro; iFrame).
      iNext; iExists s; iFrame.
    Qed.
    Lemma const_to_mut (p: loc) (s: gset Z) (Γ: rw_gname) :
      is_set p Γ -∗ const_set s 1 Γ ={⊤}=∗ mut_set s 1 Γ.
    Proof.
      rewrite /mut_set/const_set; iIntros "[%Γl #Hinv] Hagr◯".
      iInv "Hinv" as (s') ">(Hset & Hmut● & Hagr● & Hmut◯)".
      iDestruct (own_valid_2 with "Hagr● Hagr◯") as %Heq%frac_auth_agree.
      replace s' with s by rewrite -to_agree_op_valid_L Heq agree_idemp //.
      iDestruct "Hmut◯" as "[Hmut◯|Hfalse]"; last first.
      { by iDestruct (own_valid_2 with "Hagr◯ Hfalse") as %[Hfalse%Qp.not_add_le_r _]%frac_auth_frag_valid. }
      iModIntro. iSplitR "Hmut◯"; last (iModIntro; iFrame).
      iNext; iExists s; iFrame.
    Qed.
  End invariant.

  Section proofs.
    Context `{!heapGS Σ, !rwG Σ} (N: namespace).
    Local Open Scope Z.

    Theorem read_spec (p: loc) (Γ: rw_gname)
      (k: Z) (Hrange: INT_MIN < k < INT_MAX) :
      is_set N p Γ -∗
      <<< ∀∀ (s: gset Z) (q: frac), const_set s q Γ >>>
        contains #p #k @ ↑N
      <<< ∃∃ (b: bool), const_set s q Γ ∗ ⌜ if b then k ∈ s else k ∉ s ⌝, RET #b >>>
      {{{ True }}}.
    Proof.
      iIntros "[%Γl #Hinv]".
      iApply (atomic_wp_inv_timeless with "[] Hinv"); first solve_ndisj.
      iIntros (Φ) "AU".

      awp_apply contains_spec; first done.
      iApply (aacc_aupd_sub with "[] AU"); first solve_ndisj; first done.
      {
        iIntros "!> %s %q [Hset ?]". iDestruct "Hset" as (s') "[? ?]".
        iExists s'. iFrame. iIntros. iExists s'. iFrame.
      }
      iIntros (s q) "[Hset Hagr◯]".
      iDestruct "Hset" as (s') "(Hset & Hmut● & Hagr● & Hmut◯)".
      iAaccIntro with "Hset".
      { iIntros "?"; iModIntro; iFrame. iSplitR ""; last by iIntros. iExists s'; iFrame. }
      iIntros (b) "(Hset & Hif)".

      iDestruct (own_valid_2 with "Hagr● Hagr◯") as %Heq%frac_auth_included.
      rewrite Some_included_total to_agree_included leibniz_equiv_iff in Heq;
        rewrite -Heq; clear Heq.

      iModIntro. iExists s. iFrame. iIntros "Hset".
      iRight. iExists b. iFrame. iSplitR ""; first (iExists s; iFrame).
      iIntros "AP". iMod (atomic_post_commit with "AP") as "HΦ".
      iModIntro. iIntros "_".
      iApply fupd_mask_mono; last by iApply "HΦ". solve_ndisj.
    Qed.

    Theorem write_spec (p: loc) (Γ: rw_gname)
      (k: Z) (Hrange: INT_MIN < k < INT_MAX) :
      is_set N p Γ -∗
      <<< ∀∀ (s: gset Z) (q: frac), mut_set s q Γ >>>
        add #p #k @ ↑N
      <<< mut_set (s ⋅ {[ k ]}) q Γ, RET #() >>>
      {{{ True }}}.
    Proof.
      iIntros "[%Γl #Hinv]".
      iApply (atomic_wp_inv_timeless with "[] Hinv"); first solve_ndisj.
      iIntros (Φ) "AU".

      awp_apply add_spec; first done.
      iApply (aacc_aupd_sub with "[] AU"); first solve_ndisj; first done.
      {
        iIntros "!> %s %q [Hset ?]". iDestruct "Hset" as (s') "[? ?]".
        iExists s'. iFrame. iIntros. iExists s'. iFrame.
      }
      iIntros (s q) "[Hset Hmut◯]".
      iDestruct "Hset" as (s') "(Hset & Hmut● & Hagr● & Hagr◯)".
      iAaccIntro with "Hset".
      { iIntros "?"; iModIntro; iFrame. iSplitR ""; last by iIntros. iExists s'; iFrame. }
      iIntros "Hset".

      iMod (own_update_2 with "Hmut● Hmut◯") as "[Hmut● Hmut◯]".
      { by apply frac_auth_update, (op_local_update_discrete _ _ {[k]}). }
      do 2 rewrite (comm _ {[k]} _) gset_op.
      iDestruct "Hagr◯" as "[Hfalse|Hagr◯]".
      { by iDestruct (own_valid_2 with "Hmut◯ Hfalse") as %[Hfalse%Qp.not_add_le_r _]%frac_auth_frag_valid. }
      iMod (own_update_2 with "Hagr● Hagr◯") as "[Hagr● Hagr◯]".
      { by apply (frac_auth_update_1 _ _ (to_agree (s' ∪ {[k]}))). }

      iModIntro. iExists (s' ∪ {[k]}). iFrame. iIntros "Hset".
      iRight. iFrame. iSplitR ""; first (iExists (s' ∪ {[k]}); iFrame).
      iIntros "AP". iMod (atomic_post_commit with "AP") as "HΦ".
      iModIntro. iIntros "_".
      iApply fupd_mask_mono; last by iApply "HΦ". solve_ndisj.
    Qed.
  End proofs.
End RWSpec.


(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

(* Like digraph, a graph is a type dependant of a set of vertices and   *)
(* a set of arcs. A graph is inhabited, when the construction is        *)
(* possible.Inversion lemmas are proved.                                *)

(* The following notion are defined :                                   *)
(*      - (Graph v a): dependant of a set of vertices and a set of arcs *)
(*              constructors : G_empty, G_vertex, G_edge, G_eq;         *)
(*      - GV_list : list of vertices in order of construction;          *)
(*      - GA_list : list of arcs containing (xy) and (yx);              *)
(*      - GE_list : list of edge containing (xy) or (yx);               *)
(*      - G_order : number of vertices;                                 *)
(*      - G_size : number of edges.                                     *)

Require Export Digraphs.
Require Export Edges.

Section GRAPH.

Inductive Graph : V_set -> A_set -> Type :=
  | G_empty : Graph V_empty A_empty
  | G_vertex :
      forall (v : V_set) (a : A_set) (d : Graph v a) (x : Vertex),
      ~ v x -> Graph (V_union (V_single x) v) a
  | G_edge :
      forall (v : V_set) (a : A_set) (d : Graph v a) (x y : Vertex),
      v x ->
      v y ->
      x <> y ->
      ~ a (A_ends x y) -> ~ a (A_ends y x) -> Graph v (A_union (E_set x y) a)
  | G_eq :
      forall (v v' : V_set) (a a' : A_set),
      v = v' -> a = a' -> Graph v a -> Graph v' a'.

Fixpoint GV_list (v : V_set) (a : A_set) (g : Graph v a) {struct g} :
 V_list :=
  match g with
  | G_empty => V_nil
  | G_vertex v' a' g' x _ => x :: GV_list v' a' g'
  | G_edge v' a' g' x y _ _ _ _ _ => GV_list v' a' g'
  | G_eq v' _ a' _ _ _ g' => GV_list v' a' g'
  end.

Fixpoint GA_list (v : V_set) (a : A_set) (g : Graph v a) {struct g} :
 A_list :=
  match g with
  | G_empty => A_nil
  | G_vertex v' a' g' x _ => GA_list v' a' g'
  | G_edge v' a' g' x y _ _ _ _ _ =>
      A_ends x y :: A_ends y x :: GA_list v' a' g'
  | G_eq v' _ a' _ _ _ g' => GA_list v' a' g'
  end.

Fixpoint GE_list (v : V_set) (a : A_set) (g : Graph v a) {struct g} :
 E_list :=
  match g with
  | G_empty => E_nil
  | G_vertex v' a' g' x _ => GE_list v' a' g'
  | G_edge v' a' g' x y _ _ _ _ _ => E_ends x y :: GE_list v' a' g'
  | G_eq v' _ a' _ _ _ g' => GE_list v' a' g'
  end.

Definition G_order (v : V_set) (a : A_set) (g : Graph v a) :=
  length (GV_list v a g).

Definition G_size (v : V_set) (a : A_set) (g : Graph v a) :=
  length (GE_list v a g).

Lemma G_v_dec :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x : Vertex), {v x} + {~ v x}.
Proof.
        intros v a g; elim g; intros.
        right; apply V_empty_nothing.

        case (H x0) as [|n0].
        left; apply V_in_right; trivial.

        case (V_eq_dec x x0) as [e|n1].
        left; apply V_in_left; rewrite e; apply V_in_single.

        right; red; intros H0; inversion H0.
        elim n1; inversion H1; trivial.

        elim n0; trivial.

        auto.

        case (H x); intros.
        left; elim e; trivial.

        right; elim e; trivial.
Qed.

Lemma G_a_dec :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x : Arc), {a x} + {~ a x}.
Proof.
        intros v a g; elim g; intros.
        right; apply A_empty_nothing.

        auto.

        case (H x0) as [H0|n2].
        left; apply A_in_right; trivial.

        case (A_eq_dec (A_ends x y) x0) as [e|n3].
        left; apply A_in_left; rewrite <- e; apply E_right; trivial.

        case (A_eq_dec (A_ends y x) x0) as [e0|n4].
        left; apply A_in_left; rewrite <- e0; apply E_left; trivial.

        right; red; intros H3; inversion H3 as [? H0|].
        inversion H0.
        elim n3; trivial.

        elim n4; trivial.

        elim n2; trivial.

        case (H x); intros.
        left; elim e0; trivial.

        right; elim e0; trivial.
Qed.

Lemma G_non_directed :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x y : Vertex),
 a (A_ends x y) -> a (A_ends y x).
Proof.
        intros v a g; elim g; intros.
        inversion H.

        auto.

        inversion H0.
        apply A_in_left.
        inversion H1.
        apply E_left.

        apply E_right.

        apply A_in_right; auto.

        generalize H0; elim e0; auto.
Qed.

Lemma G_ina_inv1 :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x y : Vertex),
 a (A_ends x y) -> v x.
Proof.
        intros v a g; elim g; intros.
        inversion H.

        apply V_in_right; apply (H x0 y); trivial.

        inversion H0.
        inversion H1; rewrite <- H4; trivial.

        apply (H x0 y0); trivial.

        rewrite <- e; apply (H x y); rewrite e0; trivial.
Qed.

Lemma G_ina_inv2 :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x y : Vertex),
 a (A_ends x y) -> v y.
Proof.
        intros v a g; elim g; intros.
        inversion H.

        apply V_in_right; apply (H x0 y); trivial.

        inversion H0.
        inversion H1; rewrite <- H5; trivial.

        apply (H x0 y0); trivial.

        rewrite <- e; apply (H x y); rewrite e0; trivial.
Qed.

End GRAPH.

Section GRAPH_TO_DIGRAPH.

Lemma graph_isa_digraph :
 forall (v : V_set) (a : A_set) (d : Graph v a), Digraph v a.
 (*
Proof.
        intros v a d; elim d; intros.
        exact D_empty.

        apply D_vertex; auto.

        apply
         (D_eq v0 v0
            (A_union (A_single (A_ends x y))
               (A_union (A_single (A_ends y x)) a0))
            (A_union (E_set x y) a0)).
        trivial.

        symmetry ; apply E_add_edge.

        apply D_arc.
        apply D_arc; auto.

        trivial.

        trivial.

        red; intros; inversion_clear H0.
        inversion H1.
        elim n; auto.

        elim n0; auto.

        apply (D_eq v0 v' a0 a'); auto.
Defined.
*)
Admitted.
End GRAPH_TO_DIGRAPH.

Section UNION_GRAPHS.

Lemma G_union :
 forall (v1 v2 : V_set) (a1 a2 : A_set),
 Graph v1 a1 -> Graph v2 a2 -> Graph (V_union v1 v2) (A_union a1 a2).
 (*
Proof.
        intros; elim H; intros.
        apply G_eq with (v := v2) (a := a2).
        symmetry ; apply V_union_neutral.

        symmetry ; apply A_union_neutral.

        trivial.

        case (G_v_dec v2 a2 H0 x); intros.
        apply G_eq with (v := V_union v v2) (a := A_union a a2).
        rewrite V_union_assoc; rewrite (V_union_absorb (V_single x)); trivial.
        apply V_included_single; apply V_in_right; trivial.

        trivial.

        trivial.

        apply
         G_eq
          with (v := V_union (V_single x) (V_union v v2)) (a := A_union a a2).
        symmetry ; apply V_union_assoc.

        trivial.

        apply G_vertex.
        trivial.

        apply V_not_union; trivial.

        case (G_a_dec v2 a2 H0 (A_ends x y)); intros H2.
        apply G_eq with (v := V_union v v2) (a := A_union a a2).
        trivial.

        rewrite A_union_assoc; rewrite (A_union_absorb (E_set x y)); trivial.
        apply E_inclusion.
        apply A_in_right; trivial.

        apply A_in_right; apply (G_non_directed v2 a2 H0); auto.

        trivial.

        apply
         G_eq
          with (v := V_union v v2) (a := A_union (E_set x y) (A_union a a2)).
        trivial.

        symmetry ; apply A_union_assoc.

        apply G_edge.
        trivial.

        apply V_in_left; trivial.

        apply V_in_left; trivial.

        trivial.

        apply A_not_union; trivial.

        apply A_not_union.
        trivial.

        red; intro; elim H2; apply (G_non_directed v2 a2 H0); trivial.

        apply G_eq with (v := V_union v v2) (a := A_union a a2).
        elim e; trivial.

        elim e0; trivial.

        trivial.
Qed.
*)
Admitted.

End UNION_GRAPHS.

Section INVERSION_GRAPH.

Lemma G_empty_empty :
 forall (v : V_set) (a : A_set), Graph v a -> v = V_empty -> a = A_empty.
Proof.
        intros v a g; elim g; intros.
        trivial.

        elim (V_empty_nothing x); fold V_empty; rewrite <- H0;
         apply V_in_left; apply V_in_single.

        elim (V_empty_nothing x); fold V_empty; rewrite <- H0;
         trivial.

        rewrite <- e0; apply H; rewrite e; trivial.
Qed.

Lemma V_union_single_inter :
 forall (x y : Vertex) (v v' : V_set),
 ~ v x ->
 x <> y ->
 V_union (V_single x) v = V_union (V_single y) v' ->
 V_union (V_single x) (V_inter v v') = v'.
Proof.
        intros; rewrite V_distributivity_union_inter.
        fold V_union; rewrite H1;
         rewrite (V_union_commut (V_single x));
         rewrite (V_union_commut (V_single y));
         rewrite <- V_distributivity_union_inter.
        rewrite V_single_single_disjoint.
        rewrite V_union_commut; apply V_union_neutral.

        auto.
Qed.

Lemma G_minus_vertex :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x : Vertex),
 v x ->
 (forall y : Vertex, ~ a (A_ends x y)) ->
 forall v' : V_set, ~ v' x -> v = V_union (V_single x) v' -> Graph v' a.
(*
Proof.
intros v a g; elim g; intros.
elim (V_empty_nothing x); trivial.

case (V_union_single_dec x x0 v0 n H0) as [e|v1].
apply G_eq with (v := v0) (a := a0).
apply V_union_inversion with (E := V_single x).
apply V_single_disjoint; trivial.

apply V_single_disjoint; rewrite e; trivial.

pattern x at 2; rewrite e; trivial.

trivial.

trivial.

generalize (H x0 v1 H1); intros.
apply G_eq with (v := V_union (V_single x) (V_inter v0 v')) (a := a0).
apply (V_union_single_inter x x0).
trivial.

red; intros Heq; elim n; rewrite Heq; trivial.

trivial.

trivial.

apply G_vertex.
apply H4.
unfold V_inter.
rewrite (V_inter_commut v0 v'); apply V_not_inter; trivial.

rewrite V_inter_commut; symmetry ; apply (V_union_single_inter x0 x).
trivial.

red; intros Heq; elim n; rewrite <- Heq; trivial.

auto.

apply V_not_inter; trivial.

apply G_edge.
apply (H x0).
trivial.

red; intros; elim (H1 y0).
apply A_in_right; trivial.

trivial.

trivial.

rewrite H3 in v1; inversion v1.
elim (H1 y); inversion H4; apply A_in_left; apply E_right.

trivial.

rewrite H3 in v2; inversion v2.
elim (H1 x); inversion H4; apply A_in_left; apply E_left.

trivial.

trivial.

trivial.

trivial.

apply G_eq with (v := v'0) (a := a0).
trivial.

trivial.

apply (H x).
rewrite e; rewrite H3; apply V_in_left; apply V_in_single.

rewrite e0; trivial.

trivial.

rewrite e; trivial.
Qed.*)
Admitted.

Lemma A_union_single_inter :
 forall (x y x' y' : Vertex) (a a' : A_set),
 ~ a (A_ends x y) ->
 ~ a (A_ends y x) ->
 E_set x y <> E_set x' y' ->
 A_union (E_set x y) a = A_union (E_set x' y') a' ->
 A_union (E_set x y) (A_inter a a') = a'.
Proof.
        intros; rewrite A_distributivity_union_inter.
        fold A_union; rewrite H2;
         rewrite (A_union_commut (E_set x y));
         rewrite (A_union_commut (E_set x' y'));
         rewrite <- A_distributivity_union_inter.
        rewrite E_inter_empty.
        rewrite A_union_commut; apply A_union_neutral.

        auto.
Qed.

Lemma G_minus_edge :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x y : Vertex),
 a (A_ends x y) ->
 forall a' : A_set,
 ~ a' (A_ends x y) ->
 ~ a' (A_ends y x) -> a = A_union (E_set x y) a' -> Graph v a'.
 (*
Proof.
intros v a g; elim g.
unfold A_empty; tauto.

intros; apply G_vertex; eauto 2.

intros; case (E_set_eq_dec x x0 y y0); intros H4.
apply G_eq with (v := v0) (a := a0).
trivial.

apply (A_union_inversion (E_set x y) a0 a').
apply E_set_disjoint; trivial.

rewrite H4; apply E_set_disjoint; trivial.

rewrite <- H4 in H3; trivial.

trivial.

apply G_eq with (v := v0) (a := A_union (E_set x y) (A_inter a0 a')).
trivial.

apply A_union_single_inter with (x' := x0) (y' := y0); trivial.

apply G_edge.
apply (H x0 y0).
inversion H0 as [? H5 H6|? H5 H6].
absurd (E_set x y = E_set x0 y0).
trivial.

inversion H5.
trivial.

apply E_set_eq.

trivial.

red; intros Ha; inversion Ha; elim H1; trivial.

red; intros Ha; inversion Ha; elim H2; trivial.

rewrite A_inter_commut; symmetry ;
 apply A_union_single_inter with (x' := x) (y' := y).
trivial.

trivial.

auto.

auto.

trivial.

trivial.

trivial.

red; intros Ha; inversion Ha; elim n0; trivial.

red; intros Ha; inversion Ha; elim n1; trivial.

intros.
apply G_eq with (v := v0) (a := a'0).
trivial.

trivial.

apply (H x y).
rewrite e0; trivial.

trivial.

trivial.

rewrite e0; trivial.
Qed.
*)
Admitted.

End INVERSION_GRAPH.


From isla Require Import opsem.

Definition a0 : isla_trace :=
  Smt (DeclareConst 0%Z (Ty_BitVec 64%N)) Mk_annot :t:
  Assume (AExp_Binop (Eq) (AExp_Unop (Extract 1%N 1%N) (AExp_Val (AVal_Var "PC" []) Mk_annot) Mk_annot) (AExp_Val (AVal_Bits (BV 1%N 0x0%Z)) Mk_annot) Mk_annot) Mk_annot :t:
  ReadReg "PC" [] (RegVal_Base (Val_Symbolic 0%Z)) Mk_annot :t:
  Smt (DefineConst 1%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 0%Z) Mk_annot; Val (Val_Bits (BV 64%N 0x4%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  Smt (DeclareConst 13%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadReg "x12" [] (RegVal_Base (Val_Symbolic 13%Z)) Mk_annot :t:
  Smt (DefineConst 14%Z (Binop (Eq) (Val (Val_Symbolic 13%Z) Mk_annot) (Val (Val_Bits (BV 64%N 0x0%Z)) Mk_annot) Mk_annot)) Mk_annot :t:
  Smt (DefineConst 15%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 0%Z) Mk_annot; Val (Val_Bits (BV 64%N 0x1c%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  tcases [
    Smt (Assert (Val (Val_Symbolic 14%Z) Mk_annot)) Mk_annot :t:
    Smt (DefineConst 16%Z (Unop (Extract 0%N 0%N) (Binop ((Bvarith Bvlshr)) (Val (Val_Symbolic 15%Z) Mk_annot) (Val (Val_Bits (BV 64%N 0x1%Z)) Mk_annot) Mk_annot) Mk_annot)) Mk_annot :t:
    BranchAddress (RegVal_Base (Val_Symbolic 15%Z)) Mk_annot :t:
    WriteReg "PC" [] (RegVal_Base (Val_Symbolic 15%Z)) Mk_annot :t:
    tnil;
    Smt (Assert (Unop (Not) (Val (Val_Symbolic 14%Z) Mk_annot) Mk_annot)) Mk_annot :t:
    WriteReg "PC" [] (RegVal_Base (Val_Symbolic 1%Z)) Mk_annot :t:
    tnil
  ]
.


Require Coq.Classes.EquivDec.
Require Coq.Lists.List.
Import List.ListNotations.
Require Import Coq.Program.Program.
Require Import Leapfrog.Syntax.
Require Import Leapfrog.FinType.
Require Import Leapfrog.Sum.
Require Import Leapfrog.Notations.

Require Import Leapfrog.BisimChecker.

Open Scope p4a.

Ltac prep_equiv :=
  unfold Equivalence.equiv, RelationClasses.complement in *;
  program_simpl; try congruence.

Obligation Tactic := prep_equiv.

Module MemoryWide.
  Inductive state :=
  | start
  | state_0
  | state_1
  | state_2
  | state_3
  | state_4
  | state_5
  | state_6
  | state_7
  | state_8
  | state_9
  | state_10
  | state_11
  | state_12
  | state_13
  | state_14
  | state_15
  | state_16
  | state_17
  | state_18
  | state_19
  | state_20
  | state_21
  | state_22
  | state_23
  | state_24
  | state_25
  | state_26
  | state_27
  | state_28
  | state_29
  | state_30
  | state_31
  | finish.

  Scheme Equality for state.
  Global Instance state_eqdec: EquivDec.EqDec state eq := state_eq_dec.
  Global Instance state_finite: @Finite state _ state_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Inductive header := | Scratch1 | Val.

  Definition sz (h: header) : nat :=
    match h with
    | Scratch1 => 1
    | Val => 5
    end.

  Scheme Equality for header.
  Global Instance header_eqdec: EquivDec.EqDec header eq := header_eq_dec.
  Global Instance header_finite: @Finite header _ header_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Definition states (s: state) :=
    match s with
    | start =>
      {| st_op := extract(Val) ;
         st_trans := transition select (| EHdr (Hdr_sz := sz) Val |) {{
            [| exact #b|0|0|0|0|0 |] ==> inl state_0 ;;;
            [| exact #b|0|0|0|0|1 |] ==> inl state_1 ;;;
            [| exact #b|0|0|0|1|0 |] ==> inl state_2 ;;;
            [| exact #b|0|0|0|1|1 |] ==> inl state_3 ;;;
            [| exact #b|0|0|1|0|0 |] ==> inl state_4 ;;;
            [| exact #b|0|0|1|0|1 |] ==> inl state_5 ;;;
            [| exact #b|0|0|1|1|0 |] ==> inl state_6 ;;;
            [| exact #b|0|0|1|1|1 |] ==> inl state_7 ;;;
            [| exact #b|0|1|0|0|0 |] ==> inl state_8 ;;;
            [| exact #b|0|1|0|0|1 |] ==> inl state_9 ;;;
            [| exact #b|0|1|0|1|0 |] ==> inl state_10 ;;;
            [| exact #b|0|1|0|1|1 |] ==> inl state_11 ;;;
            [| exact #b|0|1|1|0|0 |] ==> inl state_12 ;;;
            [| exact #b|0|1|1|0|1 |] ==> inl state_13 ;;;
            [| exact #b|0|1|1|1|0 |] ==> inl state_14 ;;;
            [| exact #b|0|1|1|1|1 |] ==> inl state_15 ;;;
            [| exact #b|1|0|0|0|0 |] ==> inl state_16 ;;;
            [| exact #b|1|0|0|0|1 |] ==> inl state_17 ;;;
            [| exact #b|1|0|0|1|0 |] ==> inl state_18 ;;;
            [| exact #b|1|0|0|1|1 |] ==> inl state_19 ;;;
            [| exact #b|1|0|1|0|0 |] ==> inl state_20 ;;;
            [| exact #b|1|0|1|0|1 |] ==> inl state_21 ;;;
            [| exact #b|1|0|1|1|0 |] ==> inl state_22 ;;;
            [| exact #b|1|0|1|1|1 |] ==> inl state_23 ;;;
            [| exact #b|1|1|0|0|0 |] ==> inl state_24 ;;;
            [| exact #b|1|1|0|0|1 |] ==> inl state_25 ;;;
            [| exact #b|1|1|0|1|0 |] ==> inl state_26 ;;;
            [| exact #b|1|1|0|1|1 |] ==> inl state_27 ;;;
            [| exact #b|1|1|1|0|0 |] ==> inl state_28 ;;;
            [| exact #b|1|1|1|0|1 |] ==> inl state_29 ;;;
            [| exact #b|1|1|1|1|0 |] ==> inl state_30 ;;;
            [| exact #b|1|1|1|1|1 |] ==> inl state_31 ;;;
            reject
         }}
      |}
    | state_0 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_1 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_2 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_3 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_4 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_5 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_6 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_7 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_8 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_9 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_10 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_11 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_12 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_13 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_14 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_15 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_16 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_17 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_18 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_19 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_20 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_21 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_22 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_23 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_24 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_25 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_26 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_27 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_28 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_29 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_30 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_31 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | finish => {|
        st_op := extract(Scratch1);
        st_trans := transition accept
      |}
    end.

  Program Definition aut: Syntax.t state sz :=
    {| t_states := states |}.
  Solve Obligations with (destruct s || destruct h; cbv; Lia.lia).

End MemoryWide.

Module WideSelf.
  Definition aut := Sum.sum MemoryWide.aut MemoryWide.aut.
End WideSelf.

Module MemoryTall.
  Inductive state :=
| state_1
| state_0
| state_11
| state_10
| state_01
| state_00
| state_111
| state_110
| state_101
| state_100
| state_011
| state_010
| state_001
| state_000
| state_1111
| state_1110
| state_1101
| state_1100
| state_1011
| state_1010
| state_1001
| state_1000
| state_0111
| state_0110
| state_0101
| state_0100
| state_0011
| state_0010
| state_0001
| state_0000
| state_11111
| state_11110
| state_11101
| state_11100
| state_11011
| state_11010
| state_11001
| state_11000
| state_10111
| state_10110
| state_10101
| state_10100
| state_10011
| state_10010
| state_10001
| state_10000
| state_01111
| state_01110
| state_01101
| state_01100
| state_01011
| state_01010
| state_01001
| state_01000
| state_00111
| state_00110
| state_00101
| state_00100
| state_00011
| state_00010
| state_00001
| state_00000
| state_111111
| state_111110
| state_111101
| state_111100
| state_111011
| state_111010
| state_111001
| state_111000
| state_110111
| state_110110
| state_110101
| state_110100
| state_110011
| state_110010
| state_110001
| state_110000
| state_101111
| state_101110
| state_101101
| state_101100
| state_101011
| state_101010
| state_101001
| state_101000
| state_100111
| state_100110
| state_100101
| state_100100
| state_100011
| state_100010
| state_100001
| state_100000
| state_011111
| state_011110
| state_011101
| state_011100
| state_011011
| state_011010
| state_011001
| state_011000
| state_010111
| state_010110
| state_010101
| state_010100
| state_010011
| state_010010
| state_010001
| state_010000
| state_001111
| state_001110
| state_001101
| state_001100
| state_001011
| state_001010
| state_001001
| state_001000
| state_000111
| state_000110
| state_000101
| state_000100
| state_000011
| state_000010
| state_000001
| state_000000
  | start .

  Scheme Equality for state.
  Global Instance state_eqdec: EquivDec.EqDec state eq := state_eq_dec.
  Global Instance state_finite: @Finite state _ state_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Inductive header := | Scratch1 | Val.
  Definition sz (h: header) : nat :=
    match h with
    | Scratch1 => 1
    | Val => 6
    end.

  Scheme Equality for header.
  Global Instance header_eqdec: EquivDec.EqDec header eq := header_eq_dec.
  Global Instance header_finite: @Finite header _ header_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Definition states (s: state) :=
    match s with
    | start => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_0 ;;; [| exact #b|1 |] ==> inl state_1 ;;; reject }} |}
    | state_1 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_10 ;;; [| exact #b|1 |] ==> inl state_11 ;;; reject }} |}
| state_0 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_00 ;;; [| exact #b|1 |] ==> inl state_01 ;;; reject }} |}
| state_11 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_110 ;;; [| exact #b|1 |] ==> inl state_111 ;;; reject }} |}
| state_10 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_100 ;;; [| exact #b|1 |] ==> inl state_101 ;;; reject }} |}
| state_01 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_010 ;;; [| exact #b|1 |] ==> inl state_011 ;;; reject }} |}
| state_00 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_000 ;;; [| exact #b|1 |] ==> inl state_001 ;;; reject }} |}
| state_111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_1110 ;;; [| exact #b|1 |] ==> inl state_1111 ;;; reject }} |}
| state_110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_1100 ;;; [| exact #b|1 |] ==> inl state_1101 ;;; reject }} |}
| state_101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_1010 ;;; [| exact #b|1 |] ==> inl state_1011 ;;; reject }} |}
| state_100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_1000 ;;; [| exact #b|1 |] ==> inl state_1001 ;;; reject }} |}
| state_011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_0110 ;;; [| exact #b|1 |] ==> inl state_0111 ;;; reject }} |}
| state_010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_0100 ;;; [| exact #b|1 |] ==> inl state_0101 ;;; reject }} |}
| state_001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_0010 ;;; [| exact #b|1 |] ==> inl state_0011 ;;; reject }} |}
| state_000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_0000 ;;; [| exact #b|1 |] ==> inl state_0001 ;;; reject }} |}
| state_1111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_11110 ;;; [| exact #b|1 |] ==> inl state_11111 ;;; reject }} |}
| state_1110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_11100 ;;; [| exact #b|1 |] ==> inl state_11101 ;;; reject }} |}
| state_1101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_11010 ;;; [| exact #b|1 |] ==> inl state_11011 ;;; reject }} |}
| state_1100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_11000 ;;; [| exact #b|1 |] ==> inl state_11001 ;;; reject }} |}
| state_1011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_10110 ;;; [| exact #b|1 |] ==> inl state_10111 ;;; reject }} |}
| state_1010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_10100 ;;; [| exact #b|1 |] ==> inl state_10101 ;;; reject }} |}
| state_1001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_10010 ;;; [| exact #b|1 |] ==> inl state_10011 ;;; reject }} |}
| state_1000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_10000 ;;; [| exact #b|1 |] ==> inl state_10001 ;;; reject }} |}
| state_0111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_01110 ;;; [| exact #b|1 |] ==> inl state_01111 ;;; reject }} |}
| state_0110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_01100 ;;; [| exact #b|1 |] ==> inl state_01101 ;;; reject }} |}
| state_0101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_01010 ;;; [| exact #b|1 |] ==> inl state_01011 ;;; reject }} |}
| state_0100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_01000 ;;; [| exact #b|1 |] ==> inl state_01001 ;;; reject }} |}
| state_0011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_00110 ;;; [| exact #b|1 |] ==> inl state_00111 ;;; reject }} |}
| state_0010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_00100 ;;; [| exact #b|1 |] ==> inl state_00101 ;;; reject }} |}
| state_0001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_00010 ;;; [| exact #b|1 |] ==> inl state_00011 ;;; reject }} |}
| state_0000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_00000 ;;; [| exact #b|1 |] ==> inl state_00001 ;;; reject }} |}
| state_11111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_111110 ;;; [| exact #b|1 |] ==> inl state_111111 ;;; reject }} |}
| state_11110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_111100 ;;; [| exact #b|1 |] ==> inl state_111101 ;;; reject }} |}
| state_11101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_111010 ;;; [| exact #b|1 |] ==> inl state_111011 ;;; reject }} |}
| state_11100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_111000 ;;; [| exact #b|1 |] ==> inl state_111001 ;;; reject }} |}
| state_11011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_110110 ;;; [| exact #b|1 |] ==> inl state_110111 ;;; reject }} |}
| state_11010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_110100 ;;; [| exact #b|1 |] ==> inl state_110101 ;;; reject }} |}
| state_11001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_110010 ;;; [| exact #b|1 |] ==> inl state_110011 ;;; reject }} |}
| state_11000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_110000 ;;; [| exact #b|1 |] ==> inl state_110001 ;;; reject }} |}
| state_10111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_101110 ;;; [| exact #b|1 |] ==> inl state_101111 ;;; reject }} |}
| state_10110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_101100 ;;; [| exact #b|1 |] ==> inl state_101101 ;;; reject }} |}
| state_10101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_101010 ;;; [| exact #b|1 |] ==> inl state_101011 ;;; reject }} |}
| state_10100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_101000 ;;; [| exact #b|1 |] ==> inl state_101001 ;;; reject }} |}
| state_10011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_100110 ;;; [| exact #b|1 |] ==> inl state_100111 ;;; reject }} |}
| state_10010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_100100 ;;; [| exact #b|1 |] ==> inl state_100101 ;;; reject }} |}
| state_10001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_100010 ;;; [| exact #b|1 |] ==> inl state_100011 ;;; reject }} |}
| state_10000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_100000 ;;; [| exact #b|1 |] ==> inl state_100001 ;;; reject }} |}
| state_01111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_011110 ;;; [| exact #b|1 |] ==> inl state_011111 ;;; reject }} |}
| state_01110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_011100 ;;; [| exact #b|1 |] ==> inl state_011101 ;;; reject }} |}
| state_01101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_011010 ;;; [| exact #b|1 |] ==> inl state_011011 ;;; reject }} |}
| state_01100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_011000 ;;; [| exact #b|1 |] ==> inl state_011001 ;;; reject }} |}
| state_01011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_010110 ;;; [| exact #b|1 |] ==> inl state_010111 ;;; reject }} |}
| state_01010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_010100 ;;; [| exact #b|1 |] ==> inl state_010101 ;;; reject }} |}
| state_01001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_010010 ;;; [| exact #b|1 |] ==> inl state_010011 ;;; reject }} |}
| state_01000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_010000 ;;; [| exact #b|1 |] ==> inl state_010001 ;;; reject }} |}
| state_00111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_001110 ;;; [| exact #b|1 |] ==> inl state_001111 ;;; reject }} |}
| state_00110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_001100 ;;; [| exact #b|1 |] ==> inl state_001101 ;;; reject }} |}
| state_00101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_001010 ;;; [| exact #b|1 |] ==> inl state_001011 ;;; reject }} |}
| state_00100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_001000 ;;; [| exact #b|1 |] ==> inl state_001001 ;;; reject }} |}
| state_00011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_000110 ;;; [| exact #b|1 |] ==> inl state_000111 ;;; reject }} |}
| state_00010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_000100 ;;; [| exact #b|1 |] ==> inl state_000101 ;;; reject }} |}
| state_00001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_000010 ;;; [| exact #b|1 |] ==> inl state_000011 ;;; reject }} |}
| state_00000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_000000 ;;; [| exact #b|1 |] ==> inl state_000001 ;;; reject }} |}
| state_111111 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|1|1|1 ; st_trans := transition accept  |}
| state_111110 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|1|1|0 ; st_trans := transition accept  |}
| state_111101 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|1|0|1 ; st_trans := transition accept  |}
| state_111100 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|1|0|0 ; st_trans := transition accept  |}
| state_111011 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|0|1|1 ; st_trans := transition accept  |}
| state_111010 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|0|1|0 ; st_trans := transition accept  |}
| state_111001 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|0|0|1 ; st_trans := transition accept  |}
| state_111000 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|0|0|0 ; st_trans := transition accept  |}
| state_110111 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|1|1|1 ; st_trans := transition accept  |}
| state_110110 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|1|1|0 ; st_trans := transition accept  |}
| state_110101 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|1|0|1 ; st_trans := transition accept  |}
| state_110100 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|1|0|0 ; st_trans := transition accept  |}
| state_110011 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|0|1|1 ; st_trans := transition accept  |}
| state_110010 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|0|1|0 ; st_trans := transition accept  |}
| state_110001 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|0|0|1 ; st_trans := transition accept  |}
| state_110000 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|0|0|0 ; st_trans := transition accept  |}
| state_101111 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|1|1|1 ; st_trans := transition accept  |}
| state_101110 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|1|1|0 ; st_trans := transition accept  |}
| state_101101 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|1|0|1 ; st_trans := transition accept  |}
| state_101100 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|1|0|0 ; st_trans := transition accept  |}
| state_101011 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|0|1|1 ; st_trans := transition accept  |}
| state_101010 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|0|1|0 ; st_trans := transition accept  |}
| state_101001 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|0|0|1 ; st_trans := transition accept  |}
| state_101000 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|0|0|0 ; st_trans := transition accept  |}
| state_100111 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|1|1|1 ; st_trans := transition accept  |}
| state_100110 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|1|1|0 ; st_trans := transition accept  |}
| state_100101 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|1|0|1 ; st_trans := transition accept  |}
| state_100100 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|1|0|0 ; st_trans := transition accept  |}
| state_100011 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|0|1|1 ; st_trans := transition accept  |}
| state_100010 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|0|1|0 ; st_trans := transition accept  |}
| state_100001 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|0|0|1 ; st_trans := transition accept  |}
| state_100000 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|0|0|0 ; st_trans := transition accept  |}
| state_011111 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|1|1|1 ; st_trans := transition accept  |}
| state_011110 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|1|1|0 ; st_trans := transition accept  |}
| state_011101 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|1|0|1 ; st_trans := transition accept  |}
| state_011100 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|1|0|0 ; st_trans := transition accept  |}
| state_011011 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|0|1|1 ; st_trans := transition accept  |}
| state_011010 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|0|1|0 ; st_trans := transition accept  |}
| state_011001 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|0|0|1 ; st_trans := transition accept  |}
| state_011000 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|0|0|0 ; st_trans := transition accept  |}
| state_010111 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|1|1|1 ; st_trans := transition accept  |}
| state_010110 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|1|1|0 ; st_trans := transition accept  |}
| state_010101 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|1|0|1 ; st_trans := transition accept  |}
| state_010100 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|1|0|0 ; st_trans := transition accept  |}
| state_010011 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|0|1|1 ; st_trans := transition accept  |}
| state_010010 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|0|1|0 ; st_trans := transition accept  |}
| state_010001 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|0|0|1 ; st_trans := transition accept  |}
| state_010000 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|0|0|0 ; st_trans := transition accept  |}
| state_001111 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|1|1|1 ; st_trans := transition accept  |}
| state_001110 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|1|1|0 ; st_trans := transition accept  |}
| state_001101 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|1|0|1 ; st_trans := transition accept  |}
| state_001100 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|1|0|0 ; st_trans := transition accept  |}
| state_001011 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|0|1|1 ; st_trans := transition accept  |}
| state_001010 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|0|1|0 ; st_trans := transition accept  |}
| state_001001 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|0|0|1 ; st_trans := transition accept  |}
| state_001000 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|0|0|0 ; st_trans := transition accept  |}
| state_000111 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|1|1|1 ; st_trans := transition accept  |}
| state_000110 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|1|1|0 ; st_trans := transition accept  |}
| state_000101 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|1|0|1 ; st_trans := transition accept  |}
| state_000100 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|1|0|0 ; st_trans := transition accept  |}
| state_000011 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|0|1|1 ; st_trans := transition accept  |}
| state_000010 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|0|1|0 ; st_trans := transition accept  |}
| state_000001 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|0|0|1 ; st_trans := transition accept  |}
| state_000000 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|0|0|0 ; st_trans := transition accept  |}
    end.

  Program Definition aut: Syntax.t state sz :=
    {| t_states := states |}.
  Solve Obligations with (destruct s || destruct h; cbv; Lia.lia).

End MemoryTall.

Module TallSelf.
  Definition aut := Sum.sum MemoryTall.aut MemoryTall.aut.
End TallSelf.

Module MemoryWide16.
  Inductive state :=
  | start
  | state_0
  | state_1
  | state_2
  | state_3
  | state_4
  | state_5
  | state_6
  | state_7
  | state_8
  | state_9
  | state_10
  | state_11
  | state_12
  | state_13
  | state_14
  | state_15
  | finish.

  Scheme Equality for state.
  Global Instance state_eqdec: EquivDec.EqDec state eq := state_eq_dec.
  Global Instance state_finite: @Finite state _ state_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Inductive header := | Scratch1 | Val.

  Definition sz (h: header) : nat :=
    match h with
    | Scratch1 => 1
    | Val => 4
    end.

  Scheme Equality for header.
  Global Instance header_eqdec: EquivDec.EqDec header eq := header_eq_dec.
  Global Instance header_finite: @Finite header _ header_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Definition states (s: state) :=
    match s with
    | start =>
      {| st_op := extract(Val) ;
         st_trans := transition select (| EHdr (Hdr_sz := sz) Val |) {{
            [| exact #b|0|0|0|0 |] ==> inl state_0 ;;;
            [| exact #b|0|0|0|1 |] ==> inl state_1 ;;;
            [| exact #b|0|0|1|0 |] ==> inl state_2 ;;;
            [| exact #b|0|0|1|1 |] ==> inl state_3 ;;;
            [| exact #b|0|1|0|0 |] ==> inl state_4 ;;;
            [| exact #b|0|1|0|1 |] ==> inl state_5 ;;;
            [| exact #b|0|1|1|0 |] ==> inl state_6 ;;;
            [| exact #b|0|1|1|1 |] ==> inl state_7 ;;;
            [| exact #b|1|0|0|0 |] ==> inl state_8 ;;;
            [| exact #b|1|0|0|1 |] ==> inl state_9 ;;;
            [| exact #b|1|0|1|0 |] ==> inl state_10 ;;;
            [| exact #b|1|0|1|1 |] ==> inl state_11 ;;;
            [| exact #b|1|1|0|0 |] ==> inl state_12 ;;;
            [| exact #b|1|1|0|1 |] ==> inl state_13 ;;;
            [| exact #b|1|1|1|0 |] ==> inl state_14 ;;;
            [| exact #b|1|1|1|1 |] ==> inl state_15 ;;;
            reject
         }}
      |}
    | state_0 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_1 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_2 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_3 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_4 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_5 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_6 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_7 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_8 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_9 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_10 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_11 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_12 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_13 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_14 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_15 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | finish => {|
        st_op := extract(Scratch1);
        st_trans := transition accept
      |}
    end.

  Program Definition aut: Syntax.t state sz :=
    {| t_states := states |}.
  Solve Obligations with (destruct s || destruct h; cbv; Lia.lia).

End MemoryWide16.

Module Wide16Self.
  Definition aut := Sum.sum MemoryWide16.aut MemoryWide16.aut.
End Wide16Self.


Variables S1 S2 : Set.

Goal @eq Type S1 S2 -> @eq Type S1 S2.
intro H.
tauto.
(*assumption.*)
Qed.

(*This is in 8.5pl1, and Matthieq Sozeau says: "That's a regression in tauto indeed, which now requires exact equality of the universes, through a non linear goal pattern matching:
match goal with ?X1 |- ?X1 forces both instances of X1 to be convertible,
with no additional universe constraints currently, but the two types are
initially different. This can be fixed easily to allow the same flexibility
as in 8.4 (or assumption) to unify the universes as well."*)


(* !!! WARNING: AUTO GENERATED. DO NOT MODIFY !!! *)
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Program.Equality.

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

Require Export syntax_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 typ_ind' := Induction for typ Sort Prop.

Definition typ_mutind :=
  fun H1 H2 H3 H4 H5 =>
  typ_ind' H1 H2 H3 H4 H5.

Scheme typ_rec' := Induction for typ Sort Set.

Definition typ_mutrec :=
  fun H1 H2 H3 H4 H5 =>
  typ_rec' H1 H2 H3 H4 H5.

Scheme exp_ind' := Induction for exp Sort Prop.

Definition exp_mutind :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 =>
  exp_ind' H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.

Scheme exp_rec' := Induction for exp Sort Set.

Definition exp_mutrec :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 =>
  exp_rec' H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.

(* *********************************************************************** *)
(** * Close *)

Fixpoint close_exp_wrt_exp_rec (n1 : nat) (x1 : var) (e1 : exp) {struct e1} : exp :=
  match e1 with
    | e_var_f x2 => if (x1 == x2) then (e_var_b n1) else (e_var_f x2)
    | e_var_b n2 => if (lt_ge_dec n2 n1) then (e_var_b n2) else (e_var_b (S n2))
    | e_lit i1 => e_lit i1
    | e_abs A1 e2 B1 => e_abs A1 (close_exp_wrt_exp_rec (S n1) x1 e2) B1
    | e_app e2 e3 => e_app (close_exp_wrt_exp_rec n1 x1 e2) (close_exp_wrt_exp_rec n1 x1 e3)
    | e_anno e2 A1 => e_anno (close_exp_wrt_exp_rec n1 x1 e2) A1
    | e_add e2 e3 => e_add (close_exp_wrt_exp_rec n1 x1 e2) (close_exp_wrt_exp_rec n1 x1 e3)
    | e_save e2 A1 => e_save (close_exp_wrt_exp_rec n1 x1 e2) A1
  end.

Definition close_exp_wrt_exp x1 e1 := close_exp_wrt_exp_rec 0 x1 e1.

(* *********************************************************************** *)
(** * Size *)

Fixpoint size_typ (A1 : typ) {struct A1} : nat :=
  match A1 with
    | t_int => 1
    | t_arrow A2 B1 => 1 + (size_typ A2) + (size_typ B1)
    | t_dyn => 1
  end.

Fixpoint size_exp (e1 : exp) {struct e1} : nat :=
  match e1 with
    | e_var_f x1 => 1
    | e_var_b n1 => 1
    | e_lit i1 => 1
    | e_abs A1 e2 B1 => 1 + (size_typ A1) + (size_exp e2) + (size_typ B1)
    | e_app e2 e3 => 1 + (size_exp e2) + (size_exp e3)
    | e_anno e2 A1 => 1 + (size_exp e2) + (size_typ A1)
    | e_add e2 e3 => 1 + (size_exp e2) + (size_exp e3)
    | e_save e2 A1 => 1 + (size_exp e2) + (size_typ A1)
  end.

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

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

Inductive degree_exp_wrt_exp : nat -> exp -> Prop :=
  | degree_wrt_exp_e_var_f : forall n1 x1,
    degree_exp_wrt_exp n1 (e_var_f x1)
  | degree_wrt_exp_e_var_b : forall n1 n2,
    lt n2 n1 ->
    degree_exp_wrt_exp n1 (e_var_b n2)
  | degree_wrt_exp_e_lit : forall n1 i1,
    degree_exp_wrt_exp n1 (e_lit i1)
  | degree_wrt_exp_e_abs : forall n1 A1 e1 B1,
    degree_exp_wrt_exp (S n1) e1 ->
    degree_exp_wrt_exp n1 (e_abs A1 e1 B1)
  | degree_wrt_exp_e_app : forall n1 e1 e2,
    degree_exp_wrt_exp n1 e1 ->
    degree_exp_wrt_exp n1 e2 ->
    degree_exp_wrt_exp n1 (e_app e1 e2)
  | degree_wrt_exp_e_anno : forall n1 e1 A1,
    degree_exp_wrt_exp n1 e1 ->
    degree_exp_wrt_exp n1 (e_anno e1 A1)
  | degree_wrt_exp_e_add : forall n1 e1 e2,
    degree_exp_wrt_exp n1 e1 ->
    degree_exp_wrt_exp n1 e2 ->
    degree_exp_wrt_exp n1 (e_add e1 e2)
  | degree_wrt_exp_e_save : forall n1 e1 A1,
    degree_exp_wrt_exp n1 e1 ->
    degree_exp_wrt_exp n1 (e_save e1 A1).

Scheme degree_exp_wrt_exp_ind' := Induction for degree_exp_wrt_exp Sort Prop.

Definition degree_exp_wrt_exp_mutind :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 =>
  degree_exp_wrt_exp_ind' H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.

Hint Constructors degree_exp_wrt_exp : core lngen.

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

Inductive lc_set_exp : exp -> Set :=
  | lc_set_e_var_f : forall x1,
    lc_set_exp (e_var_f x1)
  | lc_set_e_lit : forall i1,
    lc_set_exp (e_lit i1)
  | lc_set_e_abs : forall A1 e1 B1,
    (forall x1 : var, lc_set_exp (open_exp_wrt_exp e1 (e_var_f x1))) ->
    lc_set_exp (e_abs A1 e1 B1)
  | lc_set_e_app : forall e1 e2,
    lc_set_exp e1 ->
    lc_set_exp e2 ->
    lc_set_exp (e_app e1 e2)
  | lc_set_e_anno : forall e1 A1,
    lc_set_exp e1 ->
    lc_set_exp (e_anno e1 A1)
  | lc_set_e_add : forall e1 e2,
    lc_set_exp e1 ->
    lc_set_exp e2 ->
    lc_set_exp (e_add e1 e2)
  | lc_set_e_save : forall e1 A1,
    lc_set_exp e1 ->
    lc_set_exp (e_save e1 A1).

Scheme lc_exp_ind' := Induction for lc_exp Sort Prop.

Definition lc_exp_mutind :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 =>
  lc_exp_ind' H1 H2 H3 H4 H5 H6 H7 H8 H9.

Scheme lc_set_exp_ind' := Induction for lc_set_exp Sort Prop.

Definition lc_set_exp_mutind :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 =>
  lc_set_exp_ind' H1 H2 H3 H4 H5 H6 H7 H8 H9.

Scheme lc_set_exp_rec' := Induction for lc_set_exp Sort Set.

Definition lc_set_exp_mutrec :=
  fun H1 H2 H3 H4 H5 H6 H7 H8 H9 =>
  lc_set_exp_rec' H1 H2 H3 H4 H5 H6 H7 H8 H9.

Hint Constructors lc_exp : core lngen.

Hint Constructors lc_set_exp : core lngen.

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

Definition body_exp_wrt_exp e1 := forall x1, lc_exp (open_exp_wrt_exp e1 (e_var_f x1)).

Hint Unfold body_exp_wrt_exp : 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_typ_min_mutual :
(forall A1, 1 <= size_typ A1).
Proof.
apply_mutual_ind typ_mutind;
default_simp.
Qed.

(* end hide *)

Lemma size_typ_min :
forall A1, 1 <= size_typ A1.
Proof.
pose proof size_typ_min_mutual as H; intuition eauto.
Qed.

Hint Resolve size_typ_min : lngen.

(* begin hide *)

Lemma size_exp_min_mutual :
(forall e1, 1 <= size_exp e1).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma size_exp_min :
forall e1, 1 <= size_exp e1.
Proof.
pose proof size_exp_min_mutual as H; intuition eauto.
Qed.

Hint Resolve size_exp_min : lngen.

(* begin hide *)

Lemma size_exp_close_exp_wrt_exp_rec_mutual :
(forall e1 x1 n1,
  size_exp (close_exp_wrt_exp_rec n1 x1 e1) = size_exp e1).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma size_exp_close_exp_wrt_exp_rec :
forall e1 x1 n1,
  size_exp (close_exp_wrt_exp_rec n1 x1 e1) = size_exp e1.
Proof.
pose proof size_exp_close_exp_wrt_exp_rec_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma size_exp_close_exp_wrt_exp :
forall e1 x1,
  size_exp (close_exp_wrt_exp x1 e1) = size_exp e1.
Proof.
unfold close_exp_wrt_exp; default_simp.
Qed.

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

(* begin hide *)

Lemma size_exp_open_exp_wrt_exp_rec_mutual :
(forall e1 e2 n1,
  size_exp e1 <= size_exp (open_exp_wrt_exp_rec n1 e2 e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma size_exp_open_exp_wrt_exp_rec :
forall e1 e2 n1,
  size_exp e1 <= size_exp (open_exp_wrt_exp_rec n1 e2 e1).
Proof.
pose proof size_exp_open_exp_wrt_exp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve size_exp_open_exp_wrt_exp_rec : lngen.

(* end hide *)

Lemma size_exp_open_exp_wrt_exp :
forall e1 e2,
  size_exp e1 <= size_exp (open_exp_wrt_exp e1 e2).
Proof.
unfold open_exp_wrt_exp; default_simp.
Qed.

Hint Resolve size_exp_open_exp_wrt_exp : lngen.

(* begin hide *)

Lemma size_exp_open_exp_wrt_exp_rec_var_mutual :
(forall e1 x1 n1,
  size_exp (open_exp_wrt_exp_rec n1 (e_var_f x1) e1) = size_exp e1).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma size_exp_open_exp_wrt_exp_rec_var :
forall e1 x1 n1,
  size_exp (open_exp_wrt_exp_rec n1 (e_var_f x1) e1) = size_exp e1.
Proof.
pose proof size_exp_open_exp_wrt_exp_rec_var_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma size_exp_open_exp_wrt_exp_var :
forall e1 x1,
  size_exp (open_exp_wrt_exp e1 (e_var_f x1)) = size_exp e1.
Proof.
unfold open_exp_wrt_exp; default_simp.
Qed.

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

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

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

(* begin hide *)

Lemma degree_exp_wrt_exp_S_mutual :
(forall n1 e1,
  degree_exp_wrt_exp n1 e1 ->
  degree_exp_wrt_exp (S n1) e1).
Proof.
apply_mutual_ind degree_exp_wrt_exp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma degree_exp_wrt_exp_S :
forall n1 e1,
  degree_exp_wrt_exp n1 e1 ->
  degree_exp_wrt_exp (S n1) e1.
Proof.
pose proof degree_exp_wrt_exp_S_mutual as H; intuition eauto.
Qed.

Hint Resolve degree_exp_wrt_exp_S : lngen.

Lemma degree_exp_wrt_exp_O :
forall n1 e1,
  degree_exp_wrt_exp O e1 ->
  degree_exp_wrt_exp n1 e1.
Proof.
induction n1; default_simp.
Qed.

Hint Resolve degree_exp_wrt_exp_O : lngen.

(* begin hide *)

Lemma degree_exp_wrt_exp_close_exp_wrt_exp_rec_mutual :
(forall e1 x1 n1,
  degree_exp_wrt_exp n1 e1 ->
  degree_exp_wrt_exp (S n1) (close_exp_wrt_exp_rec n1 x1 e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma degree_exp_wrt_exp_close_exp_wrt_exp_rec :
forall e1 x1 n1,
  degree_exp_wrt_exp n1 e1 ->
  degree_exp_wrt_exp (S n1) (close_exp_wrt_exp_rec n1 x1 e1).
Proof.
pose proof degree_exp_wrt_exp_close_exp_wrt_exp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve degree_exp_wrt_exp_close_exp_wrt_exp_rec : lngen.

(* end hide *)

Lemma degree_exp_wrt_exp_close_exp_wrt_exp :
forall e1 x1,
  degree_exp_wrt_exp 0 e1 ->
  degree_exp_wrt_exp 1 (close_exp_wrt_exp x1 e1).
Proof.
unfold close_exp_wrt_exp; default_simp.
Qed.

Hint Resolve degree_exp_wrt_exp_close_exp_wrt_exp : lngen.

(* begin hide *)

Lemma degree_exp_wrt_exp_close_exp_wrt_exp_rec_inv_mutual :
(forall e1 x1 n1,
  degree_exp_wrt_exp (S n1) (close_exp_wrt_exp_rec n1 x1 e1) ->
  degree_exp_wrt_exp n1 e1).
Proof.
apply_mutual_ind exp_mutind;
default_simp; eauto with lngen.
Qed.

(* end hide *)

(* begin hide *)

Lemma degree_exp_wrt_exp_close_exp_wrt_exp_rec_inv :
forall e1 x1 n1,
  degree_exp_wrt_exp (S n1) (close_exp_wrt_exp_rec n1 x1 e1) ->
  degree_exp_wrt_exp n1 e1.
Proof.
pose proof degree_exp_wrt_exp_close_exp_wrt_exp_rec_inv_mutual as H; intuition eauto.
Qed.

Hint Immediate degree_exp_wrt_exp_close_exp_wrt_exp_rec_inv : lngen.

(* end hide *)

Lemma degree_exp_wrt_exp_close_exp_wrt_exp_inv :
forall e1 x1,
  degree_exp_wrt_exp 1 (close_exp_wrt_exp x1 e1) ->
  degree_exp_wrt_exp 0 e1.
Proof.
unfold close_exp_wrt_exp; eauto with lngen.
Qed.

Hint Immediate degree_exp_wrt_exp_close_exp_wrt_exp_inv : lngen.

(* begin hide *)

Lemma degree_exp_wrt_exp_open_exp_wrt_exp_rec_mutual :
(forall e1 e2 n1,
  degree_exp_wrt_exp (S n1) e1 ->
  degree_exp_wrt_exp n1 e2 ->
  degree_exp_wrt_exp n1 (open_exp_wrt_exp_rec n1 e2 e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma degree_exp_wrt_exp_open_exp_wrt_exp_rec :
forall e1 e2 n1,
  degree_exp_wrt_exp (S n1) e1 ->
  degree_exp_wrt_exp n1 e2 ->
  degree_exp_wrt_exp n1 (open_exp_wrt_exp_rec n1 e2 e1).
Proof.
pose proof degree_exp_wrt_exp_open_exp_wrt_exp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve degree_exp_wrt_exp_open_exp_wrt_exp_rec : lngen.

(* end hide *)

Lemma degree_exp_wrt_exp_open_exp_wrt_exp :
forall e1 e2,
  degree_exp_wrt_exp 1 e1 ->
  degree_exp_wrt_exp 0 e2 ->
  degree_exp_wrt_exp 0 (open_exp_wrt_exp e1 e2).
Proof.
unfold open_exp_wrt_exp; default_simp.
Qed.

Hint Resolve degree_exp_wrt_exp_open_exp_wrt_exp : lngen.

(* begin hide *)

Lemma degree_exp_wrt_exp_open_exp_wrt_exp_rec_inv_mutual :
(forall e1 e2 n1,
  degree_exp_wrt_exp n1 (open_exp_wrt_exp_rec n1 e2 e1) ->
  degree_exp_wrt_exp (S n1) e1).
Proof.
apply_mutual_ind exp_mutind;
default_simp; eauto with lngen.
Qed.

(* end hide *)

(* begin hide *)

Lemma degree_exp_wrt_exp_open_exp_wrt_exp_rec_inv :
forall e1 e2 n1,
  degree_exp_wrt_exp n1 (open_exp_wrt_exp_rec n1 e2 e1) ->
  degree_exp_wrt_exp (S n1) e1.
Proof.
pose proof degree_exp_wrt_exp_open_exp_wrt_exp_rec_inv_mutual as H; intuition eauto.
Qed.

Hint Immediate degree_exp_wrt_exp_open_exp_wrt_exp_rec_inv : lngen.

(* end hide *)

Lemma degree_exp_wrt_exp_open_exp_wrt_exp_inv :
forall e1 e2,
  degree_exp_wrt_exp 0 (open_exp_wrt_exp e1 e2) ->
  degree_exp_wrt_exp 1 e1.
Proof.
unfold open_exp_wrt_exp; eauto with lngen.
Qed.

Hint Immediate degree_exp_wrt_exp_open_exp_wrt_exp_inv : lngen.

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

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

(* begin hide *)

Lemma close_exp_wrt_exp_rec_inj_mutual :
(forall e1 e2 x1 n1,
  close_exp_wrt_exp_rec n1 x1 e1 = close_exp_wrt_exp_rec n1 x1 e2 ->
  e1 = e2).
Proof.
apply_mutual_ind exp_mutind;
intros; match goal with
          | |- _ = ?term => destruct term
        end;
default_simp; eauto with lngen.
Qed.

(* end hide *)

(* begin hide *)

Lemma close_exp_wrt_exp_rec_inj :
forall e1 e2 x1 n1,
  close_exp_wrt_exp_rec n1 x1 e1 = close_exp_wrt_exp_rec n1 x1 e2 ->
  e1 = e2.
Proof.
pose proof close_exp_wrt_exp_rec_inj_mutual as H; intuition eauto.
Qed.

Hint Immediate close_exp_wrt_exp_rec_inj : lngen.

(* end hide *)

Lemma close_exp_wrt_exp_inj :
forall e1 e2 x1,
  close_exp_wrt_exp x1 e1 = close_exp_wrt_exp x1 e2 ->
  e1 = e2.
Proof.
unfold close_exp_wrt_exp; eauto with lngen.
Qed.

Hint Immediate close_exp_wrt_exp_inj : lngen.

(* begin hide *)

Lemma close_exp_wrt_exp_rec_open_exp_wrt_exp_rec_mutual :
(forall e1 x1 n1,
  x1 `notin` fv_exp e1 ->
  close_exp_wrt_exp_rec n1 x1 (open_exp_wrt_exp_rec n1 (e_var_f x1) e1) = e1).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma close_exp_wrt_exp_rec_open_exp_wrt_exp_rec :
forall e1 x1 n1,
  x1 `notin` fv_exp e1 ->
  close_exp_wrt_exp_rec n1 x1 (open_exp_wrt_exp_rec n1 (e_var_f x1) e1) = e1.
Proof.
pose proof close_exp_wrt_exp_rec_open_exp_wrt_exp_rec_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma close_exp_wrt_exp_open_exp_wrt_exp :
forall e1 x1,
  x1 `notin` fv_exp e1 ->
  close_exp_wrt_exp x1 (open_exp_wrt_exp e1 (e_var_f x1)) = e1.
Proof.
unfold close_exp_wrt_exp; unfold open_exp_wrt_exp; default_simp.
Qed.

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

(* begin hide *)

Lemma open_exp_wrt_exp_rec_close_exp_wrt_exp_rec_mutual :
(forall e1 x1 n1,
  open_exp_wrt_exp_rec n1 (e_var_f x1) (close_exp_wrt_exp_rec n1 x1 e1) = e1).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma open_exp_wrt_exp_rec_close_exp_wrt_exp_rec :
forall e1 x1 n1,
  open_exp_wrt_exp_rec n1 (e_var_f x1) (close_exp_wrt_exp_rec n1 x1 e1) = e1.
Proof.
pose proof open_exp_wrt_exp_rec_close_exp_wrt_exp_rec_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma open_exp_wrt_exp_close_exp_wrt_exp :
forall e1 x1,
  open_exp_wrt_exp (close_exp_wrt_exp x1 e1) (e_var_f x1) = e1.
Proof.
unfold close_exp_wrt_exp; unfold open_exp_wrt_exp; default_simp.
Qed.

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

(* begin hide *)

Lemma open_exp_wrt_exp_rec_inj_mutual :
(forall e2 e1 x1 n1,
  x1 `notin` fv_exp e2 ->
  x1 `notin` fv_exp e1 ->
  open_exp_wrt_exp_rec n1 (e_var_f x1) e2 = open_exp_wrt_exp_rec n1 (e_var_f x1) e1 ->
  e2 = e1).
Proof.
apply_mutual_ind exp_mutind;
intros; match goal with
          | |- _ = ?term => destruct term
        end;
default_simp; eauto with lngen.
Qed.

(* end hide *)

(* begin hide *)

Lemma open_exp_wrt_exp_rec_inj :
forall e2 e1 x1 n1,
  x1 `notin` fv_exp e2 ->
  x1 `notin` fv_exp e1 ->
  open_exp_wrt_exp_rec n1 (e_var_f x1) e2 = open_exp_wrt_exp_rec n1 (e_var_f x1) e1 ->
  e2 = e1.
Proof.
pose proof open_exp_wrt_exp_rec_inj_mutual as H; intuition eauto.
Qed.

Hint Immediate open_exp_wrt_exp_rec_inj : lngen.

(* end hide *)

Lemma open_exp_wrt_exp_inj :
forall e2 e1 x1,
  x1 `notin` fv_exp e2 ->
  x1 `notin` fv_exp e1 ->
  open_exp_wrt_exp e2 (e_var_f x1) = open_exp_wrt_exp e1 (e_var_f x1) ->
  e2 = e1.
Proof.
unfold open_exp_wrt_exp; eauto with lngen.
Qed.

Hint Immediate open_exp_wrt_exp_inj : lngen.

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

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

(* begin hide *)

Lemma degree_exp_wrt_exp_of_lc_exp_mutual :
(forall e1,
  lc_exp e1 ->
  degree_exp_wrt_exp 0 e1).
Proof.
apply_mutual_ind lc_exp_mutind;
intros;
let x1 := fresh "x1" in pick_fresh x1;
repeat (match goal with
          | H1 : _, H2 : _ |- _ => specialize H1 with H2
        end);
default_simp; eauto with lngen.
Qed.

(* end hide *)

Lemma degree_exp_wrt_exp_of_lc_exp :
forall e1,
  lc_exp e1 ->
  degree_exp_wrt_exp 0 e1.
Proof.
pose proof degree_exp_wrt_exp_of_lc_exp_mutual as H; intuition eauto.
Qed.

Hint Resolve degree_exp_wrt_exp_of_lc_exp : lngen.

(* begin hide *)

Lemma lc_exp_of_degree_size_mutual :
forall i1,
(forall e1,
  size_exp e1 = i1 ->
  degree_exp_wrt_exp 0 e1 ->
  lc_exp e1).
Proof.
intros i1; pattern i1; apply lt_wf_rec;
clear i1; intros i1 H1;
apply_mutual_ind exp_mutind;
default_simp;
(* non-trivial cases *)
constructor; default_simp; eapply_first_lt_hyp;
(* instantiate the size *)
match goal with
  | |- _ = _ => reflexivity
  | _ => idtac
end;
instantiate;
(* everything should be easy now *)
default_simp.
Qed.

(* end hide *)

Lemma lc_exp_of_degree :
forall e1,
  degree_exp_wrt_exp 0 e1 ->
  lc_exp e1.
Proof.
intros e1; intros;
pose proof (lc_exp_of_degree_size_mutual (size_exp e1));
intuition eauto.
Qed.

Hint Resolve lc_exp_of_degree : lngen.

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

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

Lemma lc_e_abs_exists :
forall x1 A1 e1 B1,
  lc_exp (open_exp_wrt_exp e1 (e_var_f x1)) ->
  lc_exp (e_abs A1 e1 B1).
Proof.
intros; exp_lc_exists_tac; eauto with lngen.
Qed.

Hint Extern 1 (lc_exp (e_abs _ _ _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_e_abs_exists x1) : core.

Lemma lc_body_exp_wrt_exp :
forall e1 e2,
  body_exp_wrt_exp e1 ->
  lc_exp e2 ->
  lc_exp (open_exp_wrt_exp e1 e2).
Proof.
unfold body_exp_wrt_exp;
default_simp;
let x1 := fresh "x" in
pick_fresh x1;
specialize_all x1;
exp_lc_exists_tac;
eauto with lngen.
Qed.

Hint Resolve lc_body_exp_wrt_exp : lngen.

Lemma lc_body_e_abs_2 :
forall A1 e1 B1,
  lc_exp (e_abs A1 e1 B1) ->
  body_exp_wrt_exp e1.
Proof.
default_simp.
Qed.

Hint Resolve lc_body_e_abs_2 : lngen.

(* begin hide *)

Lemma lc_exp_unique_mutual :
(forall e1 (proof2 proof3 : lc_exp e1), proof2 = proof3).
Proof.
apply_mutual_ind lc_exp_mutind;
intros;
let proof1 := fresh "proof1" in
rename_last_into proof1; dependent destruction proof1;
f_equal; default_simp; auto using @functional_extensionality_dep with lngen.
Qed.

(* end hide *)

Lemma lc_exp_unique :
forall e1 (proof2 proof3 : lc_exp e1), proof2 = proof3.
Proof.
pose proof lc_exp_unique_mutual as H; intuition eauto.
Qed.

Hint Resolve lc_exp_unique : lngen.

(* begin hide *)

Lemma lc_exp_of_lc_set_exp_mutual :
(forall e1, lc_set_exp e1 -> lc_exp e1).
Proof.
apply_mutual_ind lc_set_exp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma lc_exp_of_lc_set_exp :
forall e1, lc_set_exp e1 -> lc_exp e1.
Proof.
pose proof lc_exp_of_lc_set_exp_mutual as H; intuition eauto.
Qed.

Hint Resolve lc_exp_of_lc_set_exp : lngen.

(* begin hide *)

Lemma lc_set_exp_of_lc_exp_size_mutual :
forall i1,
(forall e1,
  size_exp e1 = i1 ->
  lc_exp e1 ->
  lc_set_exp e1).
Proof.
intros i1; pattern i1; apply lt_wf_rec;
clear i1; intros i1 H1;
apply_mutual_ind exp_mutrec;
default_simp;
try solve [assert False by default_simp; tauto];
(* non-trivial cases *)
constructor; default_simp;
try first [apply lc_set_typ_of_lc_typ
 | apply lc_set_exp_of_lc_exp];
default_simp; eapply_first_lt_hyp;
(* instantiate the size *)
match goal with
  | |- _ = _ => reflexivity
  | _ => idtac
end;
instantiate;
(* everything should be easy now *)
default_simp.
Qed.

(* end hide *)

Lemma lc_set_exp_of_lc_exp :
forall e1,
  lc_exp e1 ->
  lc_set_exp e1.
Proof.
intros e1; intros;
pose proof (lc_set_exp_of_lc_exp_size_mutual (size_exp e1));
intuition eauto.
Qed.

Hint Resolve lc_set_exp_of_lc_exp : lngen.

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

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

(* begin hide *)

Lemma close_exp_wrt_exp_rec_degree_exp_wrt_exp_mutual :
(forall e1 x1 n1,
  degree_exp_wrt_exp n1 e1 ->
  x1 `notin` fv_exp e1 ->
  close_exp_wrt_exp_rec n1 x1 e1 = e1).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma close_exp_wrt_exp_rec_degree_exp_wrt_exp :
forall e1 x1 n1,
  degree_exp_wrt_exp n1 e1 ->
  x1 `notin` fv_exp e1 ->
  close_exp_wrt_exp_rec n1 x1 e1 = e1.
Proof.
pose proof close_exp_wrt_exp_rec_degree_exp_wrt_exp_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma close_exp_wrt_exp_lc_exp :
forall e1 x1,
  lc_exp e1 ->
  x1 `notin` fv_exp e1 ->
  close_exp_wrt_exp x1 e1 = e1.
Proof.
unfold close_exp_wrt_exp; default_simp.
Qed.

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

(* begin hide *)

Lemma open_exp_wrt_exp_rec_degree_exp_wrt_exp_mutual :
(forall e2 e1 n1,
  degree_exp_wrt_exp n1 e2 ->
  open_exp_wrt_exp_rec n1 e1 e2 = e2).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma open_exp_wrt_exp_rec_degree_exp_wrt_exp :
forall e2 e1 n1,
  degree_exp_wrt_exp n1 e2 ->
  open_exp_wrt_exp_rec n1 e1 e2 = e2.
Proof.
pose proof open_exp_wrt_exp_rec_degree_exp_wrt_exp_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma open_exp_wrt_exp_lc_exp :
forall e2 e1,
  lc_exp e2 ->
  open_exp_wrt_exp e2 e1 = e2.
Proof.
unfold open_exp_wrt_exp; default_simp.
Qed.

Hint Resolve open_exp_wrt_exp_lc_exp : lngen.
Hint Rewrite open_exp_wrt_exp_lc_exp 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_exp_close_exp_wrt_exp_rec_mutual :
(forall e1 x1 n1,
  fv_exp (close_exp_wrt_exp_rec n1 x1 e1) [=] remove x1 (fv_exp e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

(* begin hide *)

Lemma fv_exp_close_exp_wrt_exp_rec :
forall e1 x1 n1,
  fv_exp (close_exp_wrt_exp_rec n1 x1 e1) [=] remove x1 (fv_exp e1).
Proof.
pose proof fv_exp_close_exp_wrt_exp_rec_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma fv_exp_close_exp_wrt_exp :
forall e1 x1,
  fv_exp (close_exp_wrt_exp x1 e1) [=] remove x1 (fv_exp e1).
Proof.
unfold close_exp_wrt_exp; default_simp.
Qed.

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

(* begin hide *)

Lemma fv_exp_open_exp_wrt_exp_rec_lower_mutual :
(forall e1 e2 n1,
  fv_exp e1 [<=] fv_exp (open_exp_wrt_exp_rec n1 e2 e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

(* begin hide *)

Lemma fv_exp_open_exp_wrt_exp_rec_lower :
forall e1 e2 n1,
  fv_exp e1 [<=] fv_exp (open_exp_wrt_exp_rec n1 e2 e1).
Proof.
pose proof fv_exp_open_exp_wrt_exp_rec_lower_mutual as H; intuition eauto.
Qed.

Hint Resolve fv_exp_open_exp_wrt_exp_rec_lower : lngen.

(* end hide *)

Lemma fv_exp_open_exp_wrt_exp_lower :
forall e1 e2,
  fv_exp e1 [<=] fv_exp (open_exp_wrt_exp e1 e2).
Proof.
unfold open_exp_wrt_exp; default_simp.
Qed.

Hint Resolve fv_exp_open_exp_wrt_exp_lower : lngen.

(* begin hide *)

Lemma fv_exp_open_exp_wrt_exp_rec_upper_mutual :
(forall e1 e2 n1,
  fv_exp (open_exp_wrt_exp_rec n1 e2 e1) [<=] fv_exp e2 `union` fv_exp e1).
Proof.
apply_mutual_ind exp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

(* begin hide *)

Lemma fv_exp_open_exp_wrt_exp_rec_upper :
forall e1 e2 n1,
  fv_exp (open_exp_wrt_exp_rec n1 e2 e1) [<=] fv_exp e2 `union` fv_exp e1.
Proof.
pose proof fv_exp_open_exp_wrt_exp_rec_upper_mutual as H; intuition eauto.
Qed.

Hint Resolve fv_exp_open_exp_wrt_exp_rec_upper : lngen.

(* end hide *)

Lemma fv_exp_open_exp_wrt_exp_upper :
forall e1 e2,
  fv_exp (open_exp_wrt_exp e1 e2) [<=] fv_exp e2 `union` fv_exp e1.
Proof.
unfold open_exp_wrt_exp; default_simp.
Qed.

Hint Resolve fv_exp_open_exp_wrt_exp_upper : lngen.

(* begin hide *)

Lemma fv_exp_subst_exp_fresh_mutual :
(forall e1 e2 x1,
  x1 `notin` fv_exp e1 ->
  fv_exp (subst_exp e2 x1 e1) [=] fv_exp e1).
Proof.
apply_mutual_ind exp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

Lemma fv_exp_subst_exp_fresh :
forall e1 e2 x1,
  x1 `notin` fv_exp e1 ->
  fv_exp (subst_exp e2 x1 e1) [=] fv_exp e1.
Proof.
pose proof fv_exp_subst_exp_fresh_mutual as H; intuition eauto.
Qed.

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

(* begin hide *)

Lemma fv_exp_subst_exp_lower_mutual :
(forall e1 e2 x1,
  remove x1 (fv_exp e1) [<=] fv_exp (subst_exp e2 x1 e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

Lemma fv_exp_subst_exp_lower :
forall e1 e2 x1,
  remove x1 (fv_exp e1) [<=] fv_exp (subst_exp e2 x1 e1).
Proof.
pose proof fv_exp_subst_exp_lower_mutual as H; intuition eauto.
Qed.

Hint Resolve fv_exp_subst_exp_lower : lngen.

(* begin hide *)

Lemma fv_exp_subst_exp_notin_mutual :
(forall e1 e2 x1 x2,
  x2 `notin` fv_exp e1 ->
  x2 `notin` fv_exp e2 ->
  x2 `notin` fv_exp (subst_exp e2 x1 e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

Lemma fv_exp_subst_exp_notin :
forall e1 e2 x1 x2,
  x2 `notin` fv_exp e1 ->
  x2 `notin` fv_exp e2 ->
  x2 `notin` fv_exp (subst_exp e2 x1 e1).
Proof.
pose proof fv_exp_subst_exp_notin_mutual as H; intuition eauto.
Qed.

Hint Resolve fv_exp_subst_exp_notin : lngen.

(* begin hide *)

Lemma fv_exp_subst_exp_upper_mutual :
(forall e1 e2 x1,
  fv_exp (subst_exp e2 x1 e1) [<=] fv_exp e2 `union` remove x1 (fv_exp e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

Lemma fv_exp_subst_exp_upper :
forall e1 e2 x1,
  fv_exp (subst_exp e2 x1 e1) [<=] fv_exp e2 `union` remove x1 (fv_exp e1).
Proof.
pose proof fv_exp_subst_exp_upper_mutual as H; intuition eauto.
Qed.

Hint Resolve fv_exp_subst_exp_upper : lngen.

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

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

(* begin hide *)

Lemma subst_exp_close_exp_wrt_exp_rec_mutual :
(forall e2 e1 x1 x2 n1,
  degree_exp_wrt_exp n1 e1 ->
  x1 <> x2 ->
  x2 `notin` fv_exp e1 ->
  subst_exp e1 x1 (close_exp_wrt_exp_rec n1 x2 e2) = close_exp_wrt_exp_rec n1 x2 (subst_exp e1 x1 e2)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_exp_close_exp_wrt_exp_rec :
forall e2 e1 x1 x2 n1,
  degree_exp_wrt_exp n1 e1 ->
  x1 <> x2 ->
  x2 `notin` fv_exp e1 ->
  subst_exp e1 x1 (close_exp_wrt_exp_rec n1 x2 e2) = close_exp_wrt_exp_rec n1 x2 (subst_exp e1 x1 e2).
Proof.
pose proof subst_exp_close_exp_wrt_exp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_exp_close_exp_wrt_exp_rec : lngen.

Lemma subst_exp_close_exp_wrt_exp :
forall e2 e1 x1 x2,
  lc_exp e1 ->  x1 <> x2 ->
  x2 `notin` fv_exp e1 ->
  subst_exp e1 x1 (close_exp_wrt_exp x2 e2) = close_exp_wrt_exp x2 (subst_exp e1 x1 e2).
Proof.
unfold close_exp_wrt_exp; default_simp.
Qed.

Hint Resolve subst_exp_close_exp_wrt_exp : lngen.

(* begin hide *)

Lemma subst_exp_degree_exp_wrt_exp_mutual :
(forall e1 e2 x1 n1,
  degree_exp_wrt_exp n1 e1 ->
  degree_exp_wrt_exp n1 e2 ->
  degree_exp_wrt_exp n1 (subst_exp e2 x1 e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_exp_degree_exp_wrt_exp :
forall e1 e2 x1 n1,
  degree_exp_wrt_exp n1 e1 ->
  degree_exp_wrt_exp n1 e2 ->
  degree_exp_wrt_exp n1 (subst_exp e2 x1 e1).
Proof.
pose proof subst_exp_degree_exp_wrt_exp_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_exp_degree_exp_wrt_exp : lngen.

(* begin hide *)

Lemma subst_exp_fresh_eq_mutual :
(forall e2 e1 x1,
  x1 `notin` fv_exp e2 ->
  subst_exp e1 x1 e2 = e2).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_exp_fresh_eq :
forall e2 e1 x1,
  x1 `notin` fv_exp e2 ->
  subst_exp e1 x1 e2 = e2.
Proof.
pose proof subst_exp_fresh_eq_mutual as H; intuition eauto.
Qed.

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

(* begin hide *)

Lemma subst_exp_fresh_same_mutual :
(forall e2 e1 x1,
  x1 `notin` fv_exp e1 ->
  x1 `notin` fv_exp (subst_exp e1 x1 e2)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_exp_fresh_same :
forall e2 e1 x1,
  x1 `notin` fv_exp e1 ->
  x1 `notin` fv_exp (subst_exp e1 x1 e2).
Proof.
pose proof subst_exp_fresh_same_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_exp_fresh_same : lngen.

(* begin hide *)

Lemma subst_exp_fresh_mutual :
(forall e2 e1 x1 x2,
  x1 `notin` fv_exp e2 ->
  x1 `notin` fv_exp e1 ->
  x1 `notin` fv_exp (subst_exp e1 x2 e2)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_exp_fresh :
forall e2 e1 x1 x2,
  x1 `notin` fv_exp e2 ->
  x1 `notin` fv_exp e1 ->
  x1 `notin` fv_exp (subst_exp e1 x2 e2).
Proof.
pose proof subst_exp_fresh_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_exp_fresh : lngen.

Lemma subst_exp_lc_exp :
forall e1 e2 x1,
  lc_exp e1 ->
  lc_exp e2 ->
  lc_exp (subst_exp e2 x1 e1).
Proof.
default_simp.
Qed.

Hint Resolve subst_exp_lc_exp : lngen.

(* begin hide *)

Lemma subst_exp_open_exp_wrt_exp_rec_mutual :
(forall e3 e1 e2 x1 n1,
  lc_exp e1 ->
  subst_exp e1 x1 (open_exp_wrt_exp_rec n1 e2 e3) = open_exp_wrt_exp_rec n1 (subst_exp e1 x1 e2) (subst_exp e1 x1 e3)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma subst_exp_open_exp_wrt_exp_rec :
forall e3 e1 e2 x1 n1,
  lc_exp e1 ->
  subst_exp e1 x1 (open_exp_wrt_exp_rec n1 e2 e3) = open_exp_wrt_exp_rec n1 (subst_exp e1 x1 e2) (subst_exp e1 x1 e3).
Proof.
pose proof subst_exp_open_exp_wrt_exp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_exp_open_exp_wrt_exp_rec : lngen.

(* end hide *)

Lemma subst_exp_open_exp_wrt_exp :
forall e3 e1 e2 x1,
  lc_exp e1 ->
  subst_exp e1 x1 (open_exp_wrt_exp e3 e2) = open_exp_wrt_exp (subst_exp e1 x1 e3) (subst_exp e1 x1 e2).
Proof.
unfold open_exp_wrt_exp; default_simp.
Qed.

Hint Resolve subst_exp_open_exp_wrt_exp : lngen.

Lemma subst_exp_open_exp_wrt_exp_var :
forall e2 e1 x1 x2,
  x1 <> x2 ->
  lc_exp e1 ->
  open_exp_wrt_exp (subst_exp e1 x1 e2) (e_var_f x2) = subst_exp e1 x1 (open_exp_wrt_exp e2 (e_var_f x2)).
Proof.
intros; rewrite subst_exp_open_exp_wrt_exp; default_simp.
Qed.

Hint Resolve subst_exp_open_exp_wrt_exp_var : lngen.

(* begin hide *)

Lemma subst_exp_spec_rec_mutual :
(forall e1 e2 x1 n1,
  subst_exp e2 x1 e1 = open_exp_wrt_exp_rec n1 e2 (close_exp_wrt_exp_rec n1 x1 e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma subst_exp_spec_rec :
forall e1 e2 x1 n1,
  subst_exp e2 x1 e1 = open_exp_wrt_exp_rec n1 e2 (close_exp_wrt_exp_rec n1 x1 e1).
Proof.
pose proof subst_exp_spec_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_exp_spec_rec : lngen.

(* end hide *)

Lemma subst_exp_spec :
forall e1 e2 x1,
  subst_exp e2 x1 e1 = open_exp_wrt_exp (close_exp_wrt_exp x1 e1) e2.
Proof.
unfold close_exp_wrt_exp; unfold open_exp_wrt_exp; default_simp.
Qed.

Hint Resolve subst_exp_spec : lngen.

(* begin hide *)

Lemma subst_exp_subst_exp_mutual :
(forall e1 e2 e3 x2 x1,
  x2 `notin` fv_exp e2 ->
  x2 <> x1 ->
  subst_exp e2 x1 (subst_exp e3 x2 e1) = subst_exp (subst_exp e2 x1 e3) x2 (subst_exp e2 x1 e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_exp_subst_exp :
forall e1 e2 e3 x2 x1,
  x2 `notin` fv_exp e2 ->
  x2 <> x1 ->
  subst_exp e2 x1 (subst_exp e3 x2 e1) = subst_exp (subst_exp e2 x1 e3) x2 (subst_exp e2 x1 e1).
Proof.
pose proof subst_exp_subst_exp_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_exp_subst_exp : lngen.

(* begin hide *)

Lemma subst_exp_close_exp_wrt_exp_rec_open_exp_wrt_exp_rec_mutual :
(forall e2 e1 x1 x2 n1,
  x2 `notin` fv_exp e2 ->
  x2 `notin` fv_exp e1 ->
  x2 <> x1 ->
  degree_exp_wrt_exp n1 e1 ->
  subst_exp e1 x1 e2 = close_exp_wrt_exp_rec n1 x2 (subst_exp e1 x1 (open_exp_wrt_exp_rec n1 (e_var_f x2) e2))).
Proof.
apply_mutual_ind exp_mutrec;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma subst_exp_close_exp_wrt_exp_rec_open_exp_wrt_exp_rec :
forall e2 e1 x1 x2 n1,
  x2 `notin` fv_exp e2 ->
  x2 `notin` fv_exp e1 ->
  x2 <> x1 ->
  degree_exp_wrt_exp n1 e1 ->
  subst_exp e1 x1 e2 = close_exp_wrt_exp_rec n1 x2 (subst_exp e1 x1 (open_exp_wrt_exp_rec n1 (e_var_f x2) e2)).
Proof.
pose proof subst_exp_close_exp_wrt_exp_rec_open_exp_wrt_exp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_exp_close_exp_wrt_exp_rec_open_exp_wrt_exp_rec : lngen.

(* end hide *)

Lemma subst_exp_close_exp_wrt_exp_open_exp_wrt_exp :
forall e2 e1 x1 x2,
  x2 `notin` fv_exp e2 ->
  x2 `notin` fv_exp e1 ->
  x2 <> x1 ->
  lc_exp e1 ->
  subst_exp e1 x1 e2 = close_exp_wrt_exp x2 (subst_exp e1 x1 (open_exp_wrt_exp e2 (e_var_f x2))).
Proof.
unfold close_exp_wrt_exp; unfold open_exp_wrt_exp; default_simp.
Qed.

Hint Resolve subst_exp_close_exp_wrt_exp_open_exp_wrt_exp : lngen.

Lemma subst_exp_e_abs :
forall x2 A1 e2 B1 e1 x1,
  lc_exp e1 ->
  x2 `notin` fv_exp e1 `union` fv_exp e2 `union` singleton x1 ->
  subst_exp e1 x1 (e_abs A1 e2 B1) = e_abs (A1) (close_exp_wrt_exp x2 (subst_exp e1 x1 (open_exp_wrt_exp e2 (e_var_f x2)))) (B1).
Proof.
default_simp.
Qed.

Hint Resolve subst_exp_e_abs : lngen.

(* begin hide *)

Lemma subst_exp_intro_rec_mutual :
(forall e1 x1 e2 n1,
  x1 `notin` fv_exp e1 ->
  open_exp_wrt_exp_rec n1 e2 e1 = subst_exp e2 x1 (open_exp_wrt_exp_rec n1 (e_var_f x1) e1)).
Proof.
apply_mutual_ind exp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_exp_intro_rec :
forall e1 x1 e2 n1,
  x1 `notin` fv_exp e1 ->
  open_exp_wrt_exp_rec n1 e2 e1 = subst_exp e2 x1 (open_exp_wrt_exp_rec n1 (e_var_f x1) e1).
Proof.
pose proof subst_exp_intro_rec_mutual as H; intuition eauto.
Qed.

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

Lemma subst_exp_intro :
forall x1 e1 e2,
  x1 `notin` fv_exp e1 ->
  open_exp_wrt_exp e1 e2 = subst_exp e2 x1 (open_exp_wrt_exp e1 (e_var_f x1)).
Proof.
unfold open_exp_wrt_exp; default_simp.
Qed.

Hint Resolve subst_exp_intro : lngen.

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

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