From discprob.basic Require Import base Series_Ext.
Require Import Reals Fourier Omega Psatz.
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype choice fintype bigop.
From Coquelicot Require Import Rcomplements Rbar Series Lim_seq Hierarchy Markov.

(*

   The ssreflect library defines a notion of countable types, which
   are types A with a map pickle : A → nat such that pickle has a left inverse
   unpickle: nat → option A and a partial right inverse pickle_inv.

   Here we define series indexed by countable types and develop some
   additional properties and facts about countable types that are needed.

*)

Definition countable_sum {A: countType} (f: A → R) :=
  λ n: nat, oapp f R0 (pickle_inv A n).

Lemma countable_sum_ext {A: countType} (f f': A → R) n :
  (∀ n, f n = f' n) → countable_sum f n = countable_sum f' n.
Proof.
  intros Hext. rewrite /countable_sum. destruct (pickle_inv) => //=.
Qed.

Lemma LPO_count {A: countType} (P: A → Prop):
      (∀ a, P a ∨ ¬ P a) → {a : A | P a} + {(∀ a, ¬ P a)}.
Proof.
  set (P' := λ n, match (@unpickle A n) with
                    | Some a => P a
                    | None => False
                  end).
  intros.
  destruct (LPO P') as [(n&HP)|Hnot].
  { intros n. rewrite /P'. destruct (unpickle n); auto. }
  - left. rewrite /P' in HP. destruct (unpickle n); eauto; done.
  - right. intros a Ha. apply (Hnot (pickle a)). rewrite /P'.
    by rewrite pickleK.
Qed.

Lemma LPO_countb {A: countType} (P: A → bool):
      {a : A | P a} + {(∀ a, ¬ P a)}.
Proof.
  apply LPO_count => a. destruct (P a); auto.
Qed.

Definition exC {A: countType} (B: pred A) : bool := LPO_countb B.

Lemma exCP {A: countType} (B: pred A) : reflect (∃ x, B x) (exC B).
Proof.
  rewrite /exC. destruct (LPO_countb) as [(a&HB)|Hfalse]; econstructor.
  - eexists; eauto.
  - intros (x'&HB). eapply Hfalse; eauto.
Qed.

Lemma pickle_inv_some_inv {A: countType} n a':
  pickle_inv A n = Some a' →
  pickle a' = n.
Proof.
  intros Heq.
  assert (H: @oapp _ _ (@pickle A) n (pickle_inv A n) = n) by rewrite pickle_invK //.
  rewrite Heq in H. done.
Qed.

Lemma pickle_inv_some_inj {A: countType} n n' a':
  pickle_inv A n = Some a' →
  pickle_inv A n = pickle_inv A n' →
  n = n'.
Proof.
  intros. transitivity (pickle a').
  - by symmetry; apply pickle_inv_some_inv.
  - apply pickle_inv_some_inv. congruence.
Qed.

Lemma pickle_inj {A: countType} (a a': A):
  pickle a = pickle a' → a = a'.
Proof.
  intros Hpickle.
  apply (f_equal (pickle_inv A)) in Hpickle.
  rewrite ?pickleK_inv in Hpickle.
  congruence.
Qed.

(* The image of a countable type is also a countable type *)

Definition img {A: countType} {B: eqType} (f: A → B ) : pred B := λ y, exC (λ x, f x == y).
Definition imgT {A: countType} {B: eqType} (f: A → B) := {y | y \in img f}.

Definition img_pickle {A: countType} {B: eqType} (f: A → B) : { y | exC (λ x, f x == y) } → nat.
Proof.
  intros (y&Hex).
  destruct (LPO (λ n, omap f (unpickle n) == Some y)) as [(n&HP)|Hfalse].
  { abstract (intros n => //=; rewrite /omap/obind/oapp//=;
              destruct (unpickle n); destruct (_ == _) => //; auto). }
  - exact n.
  - exfalso. move /exCP in Hex.
    abstract (edestruct Hex as (a&Heq);
              apply (Hfalse (pickle a)) => //=;
              rewrite pickleK //=; subst; done).
Defined.

Definition img_unpickle {A: countType} {B: eqType} (f: A → B) (n: nat)
  : option { y | exC (λ x, f x == y) } :=
 (match unpickle n with
 | Some a =>
     Some (exist (λ y : B, exC (λ x : A, f x == y)) (f a)
          (introT (exCP (λ x : A, f x == f a)) (ex_intro (λ x : A, f x == f a) a (eqxx (T:=B) (f a)))))
 | None => None
 end).

Lemma pickle_imgK {A: countType} {B: eqType} (f: A → B):
  pcancel (img_pickle f) (img_unpickle f).
Proof.
  rewrite /img_pickle/img_unpickle//=.
  intros (b&HexC) => //=.
  destruct LPO as [(n&Heq')|];
    last by (exfalso; eapply img_pickle_subproof0; eauto; apply (elimT (exCP _))).
  destruct (unpickle n); rewrite //= in Heq'.
  move /eqP in Heq'. inversion Heq'; subst.
  do 2!f_equal.
  apply bool_irrelevance.
Qed.

Definition img_choiceMixin {A: countType} {B: eqType} (f: A → B) :=
  PcanChoiceMixin (pickle_imgK f).
Canonical img_choiceType {A: countType} {B: eqType} {f: A → B} :=
  Eval hnf in ChoiceType (imgT f) (@img_choiceMixin A B f).

Definition img_countMixin {A: countType} {B: eqType} (f: A → B) :=
  PcanCountMixin (pickle_imgK f).
Canonical img_countType {A: countType} {B: eqType} (f: A → B) :=
  Eval hnf in CountType (imgT f) (@img_countMixin A B f).

(* Some facts about series over countable types *)

Section countable_series_facts.
Variable (A: countType).
Implicit Types (a b: A → R).

(*
Lemma countable_sum_finType {B: finType} (a: B → R):
  Series (countable_sum a) = \big[Rplus/0]_(i : B) (a i).
Proof.
  rewrite /countable_sum.
  transitivity (\big[Rplus/0]_(i < |B|) (
  rewrite /pickle_inv/pickle/Countable.pickle//=.k
  int
*)

Lemma countable_sum_scal c a:
  ∀ n, countable_sum (λ x, scal c (a x)) n = (λ n, scal c (countable_sum a n)) n.
Proof.
  intros. rewrite //=/countable_sum/scal//=/mult//=; destruct pickle_inv => //=; nra.
Qed.

Lemma is_seriesC_0 a: (∀ n, a n = 0) → is_series (countable_sum a) 0.
Proof.
  intros Heq0. apply is_series_0 => n. rewrite /countable_sum/oapp.
  destruct (pickle_inv A n); auto.
Qed.

Lemma is_seriesC_filter_pos a (P: pred A) (v: R):
  (∀ n, a n >= 0) →
  is_series (countable_sum a) v → ex_series (countable_sum (λ n, if P n then a n else 0)).
Proof.
  intros Hge Hconv.
  apply: ex_series_le; last by (exists v; eauto).
  intros n. rewrite /norm//=/abs//=.
  rewrite /countable_sum//=.
  destruct (pickle_inv) as [x|] => //=.
  - destruct (P x); rewrite Rabs_right => //=; try nra.
    specialize (Hge x); nra.
  - rewrite Rabs_right; nra.
Qed.

Lemma is_seriesC_filter_PQ a (P Q: pred A) (v: R):
  (∀ n, a n >= 0) →
  is_series (countable_sum (λ n, if P n then a n else 0)) v →
  (∀ n, Q n → P n) →
  ex_series (countable_sum (λ n, if Q n then a n else 0)).
Proof.
  intros Hge Hconv Himp. apply ex_series_Rabs.
  apply: ex_series_le; last by (exists v; eauto).
  intros n. rewrite /norm//=/abs//=.
  rewrite /countable_sum//=.
  destruct (pickle_inv) as [x|] => //=.
  - specialize (Himp x); specialize (Hge x).
    destruct (P x), (Q x); rewrite Rabs_Rabsolu Rabs_right => //=; try nra.
    exfalso; auto.
  - rewrite Rabs_Rabsolu Rabs_right; nra.
Qed.

Lemma ex_seriesC_filter_PQ a (P Q: pred A):
  (∀ n, a n >= 0) →
  ex_series (countable_sum (λ n, if P n then a n else 0)) →
  (∀ n, Q n → P n) →
  ex_series (countable_sum (λ n, if Q n then a n else 0)).
Proof.
  intros ? [v His] ?. eapply is_seriesC_filter_PQ; eauto.
Qed.

Lemma ex_seriesC_filter_P a (Q: pred A):
  (∀ n, a n >= 0) →
  ex_series (countable_sum a) →
  ex_series (countable_sum (λ n, if Q n then a n else 0)).
Proof.
  intros ? [v His]. eapply is_seriesC_filter_PQ with (P := xpredT); eauto.
Qed.

Lemma is_seriesC_filter_split a (P: pred A) (v: R):
  (∀ n, a n >= 0) →
  is_series (countable_sum a) v →
  Series (countable_sum (λ n, if P n then a n else 0)) +
  Series (countable_sum (λ n, if ~~ P n then a n else 0)) = v.
Proof.
  intros.
  rewrite -Series_plus; try (eapply is_seriesC_filter_pos; eauto).
  rewrite -(is_series_unique (countable_sum a) v) //.
  apply Series_ext => n.
  rewrite /countable_sum//=.
  destruct (pickle_inv) as [x|] => //=; last by nra.
  destruct (P x) => //=; nra.
Qed.

Lemma is_seriesC_filter_union a (P Q: pred A) (v: R):
  (∀ n, a n >= 0) →
  is_series (countable_sum (λ n, if P n || Q n then a n else 0)) v →
  Series (countable_sum (λ n, if P n then a n else 0)) +
  Series (countable_sum (λ n, if Q n then a n else 0))
    - Series (countable_sum (λ n, if P n && Q n then a n else 0)) = v.
Proof.
  intros Hge Hexists.
  rewrite -Series_plus; try (eapply (is_seriesC_filter_PQ _ _ _ _ Hge Hexists); eauto;
                             try (intros n; destruct (P n), (Q n); auto)).
  rewrite -Series_minus; try (eapply (is_seriesC_filter_PQ _ _ _ _ Hge Hexists); eauto;
                             try (intros n; destruct (P n), (Q n); auto)).
  - rewrite -(is_series_unique _ v Hexists).
    apply Series_ext => n.
    rewrite /countable_sum//=.
    destruct (pickle_inv) as [x|] => //=; last by nra.
    destruct (P x) => //=; nra.
  - apply: (ex_series_le _ (countable_sum (λ n, scal 2 (if P n || Q n then a n else 0)))).
    + intros n.
      rewrite /countable_sum//=.
      rewrite /norm//=/abs//=/scal//=/mult/=.
      destruct (pickle_inv) as [x|] => //=.
      * specialize (Hge x). destruct (P x), (Q x) => //=; rewrite Rabs_right; nra.
      * rewrite Rabs_right; nra.
    + exists (scal 2 v).
      apply (is_series_ext _ _ _
              (λ n, Logic.eq_sym (countable_sum_scal 2 (λ x, if P x || Q x then a x else 0) n))).
      by apply: is_series_scal.
Qed.

Lemma SeriesC_ext a b:
  (∀ n, a n = b n) →
  Series (countable_sum a) = Series (countable_sum b).
Proof.
  intros Hext. apply Series_ext => // n. rewrite /countable_sum.
  destruct (pickle_inv) => //=; nra.
Qed.

Lemma SeriesC_le a b:
  (∀ n, 0 <= a n <= b n) → ex_series (countable_sum b) →
  Series (countable_sum a) <= Series (countable_sum b).
Proof.
  intros Hrange Hex. apply Series_le => // n. rewrite /countable_sum.
  destruct (pickle_inv) => //=; nra.
Qed.

Lemma countable_sum_plus a b:
  ∀ n, (countable_sum (λ x, a x + b x) n = (λ n, countable_sum a n + countable_sum b n) n).
Proof.
  intros. rewrite //=/countable_sum; destruct pickle_inv => //=. nra.
Qed.

Lemma countable_sum_scal_l c a:
  ∀ n, (countable_sum (λ x, c * a x) n = (λ n, c * (countable_sum a n)) n).
Proof.
  intros. rewrite //=/countable_sum; destruct pickle_inv => //=. nra.
Qed.

Lemma countable_sum_scal_r c a:
  ∀ n, (countable_sum (λ x, a x * c) n = (λ n, (countable_sum a n) * c) n).
Proof.
  intros. rewrite //=/countable_sum; destruct pickle_inv => //=. nra.
Qed.

Lemma SeriesC_scal_l (c : R) a:
  Series (λ n, countable_sum (λ x, c * a x) n) = c * Series (countable_sum a).
Proof.
  intros. rewrite -Series_scal_l. apply Series_ext. apply countable_sum_scal_l.
Qed.

Lemma SeriesC_scal_r (c : R) a:
  Series (λ n, countable_sum (λ x, a x * c) n) = Series (countable_sum a) * c.
Proof.
  intros. rewrite -Series_scal_r. apply Series_ext. apply countable_sum_scal_r.
Qed.

Lemma is_seriesC_bump (x' : A) v:
  is_series (countable_sum (λ x, if x == x' then v else 0)) v.
Proof.
  eapply is_series_ext; last apply (is_series_bump (pickle x')).
  intros n => //=.
  destruct (eq_nat_dec n (pickle x')) as [Heq|Hneq].
  - by rewrite /countable_sum Heq pickleK_inv //= eq_refl.
  - rewrite /countable_sum//=. case_eq (pickle_inv A n).
    * intros s Heq => //=. case: ifP.
      ** move /eqP; intros; subst. exfalso.
         apply Hneq. symmetry; apply pickle_inv_some_inv; eauto.
      ** done.
    * rewrite //=.
Qed.

Lemma SeriesC_bump (x' : A) v:
  Series (countable_sum (λ x, if x == x' then v else 0)) = v.
Proof.
  apply is_series_unique, is_seriesC_bump.
Qed.

Lemma SeriesC_0 a:
  (∀ x, a x = 0) →
  Series (countable_sum a) = 0.
Proof.
  intros Heq0. apply Series_0 => n. rewrite /countable_sum.
  destruct (pickle_inv); eauto.
Qed.

End countable_series_facts.


Require Import Coq.Bool.Bool.
Require Coq.Classes.Equivalence.
Require Import ExtLib.Tactics.Consider.

Ltac think' ext solver :=
  repeat (match goal with
            | [ H : Some _ = Some _ |- _ ] => inversion H ; clear H ; subst
            | [ H : inl _ = inr _ |- _ ] => inversion H ; clear H ; subst
            | [ H : inr _ = inr _ |- _ ] => inversion H ; clear H ; subst
            | [ H : _ |- _ ] => erewrite H in * |- by solver
            | [ H : _ |- _ ] => erewrite H by solver
            | [ H : andb _ _ = true |- _ ] =>
              apply Bool.andb_true_iff in H ; destruct H
            | [ H : orb _ _ = false |- _ ] =>
              apply Bool.orb_false_iff in H ; destruct H
            | [ H : Equivalence.equiv _ _ |- _ ] =>
              unfold Equivalence.equiv in H ; subst
            | [ H : _ /\ _ |- _ ] => destruct H
            | [ H : exists x, _ |- _ ] => destruct H
            | [ H : context [ match ?X with _ => _ end ] |- _ ] =>
              ((consider X ; try congruence); [ intros ]) ||
                (consider X ; solve [ congruence | solver ])
          end || (progress ext)).

Ltac think := think' idtac ltac:(eauto).

(** Lemmas About Lists **)
Require Import Coq.Lists.List.
Lemma nth_error_None_length : forall (T : Type) (ls : list T) (n : nat),
  nth_error ls n = None -> length ls <= n.
Proof.
  induction ls; destruct n; simpl; intros; think.
  constructor.
  apply Le.le_0_n.
  inversion H.
  eapply IHls in H. apply Le.le_n_S. assumption.
Qed.

Lemma map_nth_error_full : forall T U (F : T -> U) ls n,
  nth_error (map F ls) n = match nth_error ls n with
                             | None => None
                             | Some v => Some (F v)
                           end.
Proof.
  induction ls; destruct n; simpl; intros; think; auto.
Qed.


(* This file defines some lemmas on maps (used to represent monoids) *)

Require Import PolyDefs.
Require Import BoolHelp.
Import ZArith Arith Bool Lia.
Import FMapList NatMap P F Coq.FSets.FMapFacts.
Require Import Valid.

Lemma eq_map_add_add (i x y :nat) (m:monoid) : Equal (add i x m) (add i x (add i y m)).
Proof.
  unfold Equal.
  intros.
  elim (Nat.eq_dec i y0); intro.
  - rewrite F.add_eq_o; [|assumption].
	rewrite F.add_eq_o; [|assumption].
	reflexivity.
  - rewrite F.add_neq_o; [|assumption].
	rewrite F.add_neq_o; [|assumption].
	rewrite F.add_neq_o; [|assumption].
	reflexivity.
Qed.

Lemma eq_map_add_each (i x :nat) (m1 m2:monoid) : Equal m1 m2 -> Equal (add i x m1) (add i x m2).
Proof.
  unfold Equal.
  intros.
  elim (Nat.eq_dec i y); intro.
  - rewrite F.add_eq_o; [|assumption].
	rewrite F.add_eq_o; [|assumption].
	reflexivity.
  - rewrite F.add_neq_o; [|assumption].
	rewrite F.add_neq_o; [|assumption].
	apply H.
Qed.

Lemma eq_map_add_remove (i x :nat) (m:monoid) : Equal (add i x m) (add i x (NatMap.remove i m)).
Proof.
  unfold Equal.
  intros.
  elim (Nat.eq_dec i y); intro.
  - rewrite F.add_eq_o; [|assumption].
	rewrite F.add_eq_o; [|assumption].
	reflexivity.
  - rewrite F.add_neq_o; [|assumption].
	rewrite F.add_neq_o; [|assumption].
	rewrite F.remove_neq_o; [|assumption].
	reflexivity.
Qed.

Lemma eq_map_add_same_in (i n :nat) (m:monoid) : NatMap.find i m = Some n ->  Equal m (add i n m) .
Proof.
  unfold Equal.
  intros.
  elim (Nat.eq_dec i y); intro.
  - rewrite <- a. rewrite F.add_eq_o; intuition.
  - rewrite F.add_neq_o; intuition.
Qed.

Lemma eq_map_add_swap (i j x y :nat) (m:monoid) : i <> j -> Equal (add i x (add j y m)) (add j y (add i x m)).
Proof.
  unfold Equal.
  intros.
  elim (Nat.eq_dec i y0); intro.
  - rewrite F.add_eq_o; [|intuition].
	rewrite F.add_neq_o; [|intuition].
	rewrite F.add_eq_o; [|intuition].
	reflexivity.
  - rewrite F.add_neq_o; [|intuition].
	elim (Nat.eq_dec j y0); intro.
	+ rewrite F.add_eq_o; [|intuition].
	  rewrite F.add_eq_o; [|intuition].
	  reflexivity.
	+ rewrite F.add_neq_o; [|intuition].
	  rewrite F.add_neq_o; [|intuition].
	  rewrite F.add_neq_o; [|intuition].
	  reflexivity.
Qed.

Lemma for_all_eq_map (m1 m2 :monoid) : Equal m1 m2 -> P.for_all (fun _ v : nat => v =? 0) m1 = P.for_all (fun _ v : nat => v =? 0) m2.
Proof.
  intro.
  unfold P.for_all.
  rewrite P.fold_Equal with (m2:=m2).
  - intuition.
  - intuition.
  - intuition.
  - unfold P.transpose_neqkey.
	intros.
	destruct e,e'; intuition.
  - assumption.
Qed.

Lemma find_eq_map (m1 m2 :monoid) (x:nat) : Equal m1 m2 -> NatMap.find x m1 = NatMap.find x m2.
Proof.
  apply F.find_m; intuition.
Qed.

Lemma for_all_add_0_notin (m:monoid) (i:nat) :
NatMap.find i m = None -> P.for_all (fun _ v : nat => v =? 0) m = P.for_all (fun _ v : nat => v =? 0) (add i 0 m).
Proof.
  intro.
  unfold P.for_all.
  rewrite P.fold_add.
  - simpl. reflexivity.
  - intuition.
  - intuition.
  - unfold P.transpose_neqkey; intros; destruct e,e'; intuition.
  - rewrite F.not_find_in_iff; assumption.
Qed.

Lemma for_all_remove (m:monoid) (n:nat) : P.for_all (fun _ v : nat => v =? 0) m = true -> P.for_all (fun _ v : nat => v =? 0) (NatMap.remove n m) = true.
Proof.
  intros.
  unfold P.for_all.
  apply P.fold_rec_nodep.
  - trivial.
  - intros.
	rewrite P.for_all_iff in H; [|intuition].
	elim (Nat.eq_dec k n); intro.
	+ specialize (H k e). rewrite a0 in H0. rewrite F.remove_mapsto_iff in H0. destruct H0. contradiction (H0 eq_refl).
	+ specialize (H k e). rewrite H1. rewrite F.remove_mapsto_iff in H0. destruct H0 as [_ H0]. specialize (H H0). rewrite H. reflexivity.
Qed.

Lemma for_all_add_0 (m:monoid) (i:nat) : P.for_all (fun _ v : nat => v =? 0) m = true -> P.for_all (fun _ v : nat => v =? 0) (add i 0 m) = true.
Proof.
  intros.
  rewrite for_all_eq_map with (m2:= add i 0 (NatMap.remove i m)).
  - erewrite <- for_all_add_0_notin.
	+ apply for_all_remove; assumption.
	+ rewrite F.remove_eq_o; intuition.
  - apply eq_map_add_remove.
Qed.

Local Definition for_all_add_S_notin (m:monoid) (i n:nat) :
NatMap.find i m = None -> P.for_all (fun _ v : nat => v =? 0) (add i (S n) m) = false.
Proof.
  intro.
  unfold P.for_all.
  rewrite P.fold_add.
  - simpl. reflexivity.
	- intuition.
	- intuition.
	- unfold P.transpose_neqkey.
	  intuition.
	  destruct e,e'; intuition.
	- rewrite F.not_find_in_iff; assumption.
Qed.

Lemma for_all_add_S  (m:monoid) (i n:nat) :  P.for_all (fun _ v : nat => v =? 0) (add i (S n) m) = false.
Proof.
  rewrite for_all_eq_map with (m2:= add i (S n) (NatMap.remove i m)).
  - apply for_all_add_S_notin.
	apply F.remove_eq_o; reflexivity.
  - rewrite eq_map_add_remove; reflexivity.
Qed.

Lemma for_all_add_add (m:monoid) (n0 n1 i: nat) :  P.for_all (fun _ v : nat => (v =? 0)%nat) (add i n1 (add i n0 m)) = P.for_all (fun _ v : nat => (v =? 0)%nat) (add i n1 m).
Proof.
  rewrite for_all_eq_map with (m2:= add i n1 m).
  - reflexivity.
  - rewrite <- eq_map_add_add; reflexivity.
Qed.

Lemma for_all_exist_pos  (m:monoid) : (exists (n' r:nat), NatMap.find n' m = Some r /\ r <> 0) ->  P.for_all (fun _ v : nat => v =? 0) m = false.
Proof.
  intro.
  do 3 destruct H.
  destruct x0; [contradiction|].
  rewrite for_all_eq_map with (m2 := add x (S x0) m).
  - apply for_all_add_S.
  - unfold Equal.
	intros.
	elim (Nat.eq_dec x y); intro.
	+ rewrite a in *.
	  rewrite F.add_eq_o; intuition.
	+ rewrite F.add_neq_o; [|assumption].
	  reflexivity.
Qed.

Lemma get_coeff_eq_map (m1 m2:monoid)  (p:poly) : valid_b p = true ->
Equal m1 m2 ->
get_coefficient_ p m1 = get_coefficient_ p m2.
Proof.
  intro.
  revert m2.
  revert m1.
  induction p; intros.
  - simpl.
	rewrite for_all_eq_map with (m2:=m2); intuition.
  - valid_destr H.
	specialize (IHp1 V0).
	specialize (IHp2 V1).
	simpl.
	specialize H0 as Heq.
	unfold Equal in H0.
	rewrite (H0 n).
	destruct (NatMap.find (elt:=nat) n m2).
	+ rewrite (IHp1 m1 m2 Heq).
	  destruct n0; [reflexivity|].
	  simpl; rewrite Nat.sub_0_r.
	  rewrite (IHp2 (add n n0 m1) (add n n0 m2)).
	  * reflexivity.
	  * apply eq_map_add_each; apply Heq.
	+ apply (IHp1 m1 m2 Heq).
Qed.

Lemma get_coeff_add_add (i x y :nat) (m:monoid)  (p:poly) : valid_b p = true -> get_coefficient_ p (add i x m) = get_coefficient_ p (add i x (add i y m)).
Proof.
  intro.
  erewrite get_coeff_eq_map with (m2:=(add i x (add i y m))).
  - reflexivity.
  - assumption.
  - rewrite <- eq_map_add_add. reflexivity.
Qed.


Require
  MathClasses.orders.naturals MathClasses.implementations.peano_naturals.
Require Import
  Coq.setoid_ring.Ring MathClasses.interfaces.abstract_algebra MathClasses.interfaces.naturals MathClasses.interfaces.orders MathClasses.interfaces.additional_operations.

Section contents.
Context `{Naturals N}.
Add Ring N : (rings.stdlib_semiring_theory N).

(* NatDistance instances are all equivalent, because their behavior is fully
 determined by the specification. *)
Lemma nat_distance_unique_respectful {a b : NatDistance N} :
  ((=) ==> (=) ==> (=))%signature (nat_distance (nd:=a)) (nat_distance (nd:= b)).
Proof.
  intros x1 y1 E x2 y2 F.
  unfold nat_distance, nat_distance_sig.
  destruct a as [[z1 A]|[z1 A]], b as [[z2 B]|[z2 B]]; simpl.
     apply (left_cancellation (+) x1). now rewrite A, E, B.
    destruct (naturals.zero_sum z1 z2).
     apply (left_cancellation (+) x1).
     rewrite associativity, A, F, B, E. ring.
    transitivity 0; intuition.
   destruct (naturals.zero_sum z1 z2).
   rewrite commutativity.
   apply (left_cancellation (+) y1).
   rewrite associativity, B, <-F, A, E. ring.
   transitivity 0; intuition.
  apply (left_cancellation (+) x2).
  now rewrite A, E, F, B.
Qed.

Lemma nat_distance_unique {a b: NatDistance N} {x y : N} : nat_distance (nd:=a) x y = nat_distance (nd:=b) x y.
Proof. now apply nat_distance_unique_respectful. Qed.

Context `{!NatDistance N}.

Global Instance nat_distance_proper : Proper ((=) ==> (=) ==> (=)) nat_distance.
Proof. apply nat_distance_unique_respectful. Qed.
End contents.

(* An existing instance of [CutMinus] allows to create an instance of [NatDistance] *)
Program Instance natdistance_cut_minus `{Naturals N} `{Apart N} `{!TrivialApart N} `{!FullPseudoSemiRingOrder Nle Nlt}
    `{!CutMinusSpec N cm} `{∀ x y, Decision (x ≤ y)} : NatDistance N :=
  λ x y, if decide_rel (≤) x y then inl (y ∸ x) else inr (x ∸ y).
Next Obligation. rewrite commutativity. now apply cut_minus_le. Qed.
Next Obligation. rewrite commutativity. now apply cut_minus_le, orders.le_flip. Qed.

(* Using the preceding instance we can make an instance for arbitrary models of the naturals
    by translation into [nat] on which we already have a [CutMinus] instance. *)
Global Program Instance natdistance_default `{Naturals N} : NatDistance N | 10 := λ x y,
  match nat_distance_sig (naturals_to_semiring N nat x) (naturals_to_semiring N nat y) with
  | inl (n↾E) => inl (naturals_to_semiring nat N n)
  | inr (n↾E) => inr (naturals_to_semiring nat N n)
  end.
Next Obligation.
  rewrite <-(naturals.to_semiring_involutive N nat y), <-E.
  now rewrite rings.preserves_plus, (naturals.to_semiring_involutive _ _).
Qed.
Next Obligation.
  rewrite <-(naturals.to_semiring_involutive N nat x), <-E.
  now rewrite rings.preserves_plus, (naturals.to_semiring_involutive _ _).
Qed.


Require Export prosa.results.fixed_priority.rta.bounded_nps.
Require Export prosa.analysis.facts.preemption.task.preemptive.
Require Export prosa.analysis.facts.preemption.rtc_threshold.preemptive.

From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq path fintype bigop.

(** * RTA for Fully Preemptive FP Model *)
(** In this section we prove the RTA theorem for the fully preemptive FP model *)

(** Throughout this file, we assume the FP priority policy, ideal uni-processor
    schedules, and the basic (i.e., Liu & Layland) readiness model. *)
Require Import prosa.model.processor.ideal.
Require Import prosa.model.readiness.basic.

(** Furthermore, we assume the fully preemptive task model. *)
Require Import prosa.model.task.preemption.fully_preemptive.

(** ** Setup and Assumptions *)

Section RTAforFullyPreemptiveFPModelwithArrivalCurves.

  (** Consider any type of tasks ... *)
  Context {Task : TaskType}.
  Context `{TaskCost Task}.

  (**  ... and any type of jobs associated with these tasks. *)
  Context {Job : JobType}.
  Context `{JobTask Job Task}.
  Context `{JobArrival Job}.
  Context `{JobCost Job}.

  (** Consider any arrival sequence with consistent, non-duplicate arrivals. *)
  Variable arr_seq : arrival_sequence Job.
  Hypothesis H_arrival_times_are_consistent : consistent_arrival_times arr_seq.
  Hypothesis H_arr_seq_is_a_set : arrival_sequence_uniq arr_seq.

  (** Consider an arbitrary task set ts, ... *)
  Variable ts : list Task.

  (** ... assume that all jobs come from the task set, ... *)
  Hypothesis H_all_jobs_from_taskset : all_jobs_from_taskset arr_seq ts.

  (** ... and the cost of a job cannot be larger than the task cost. *)
  Hypothesis H_valid_job_cost:
    arrivals_have_valid_job_costs arr_seq.

  (** Let max_arrivals be a family of valid arrival curves, i.e., for
      any task [tsk] in ts [max_arrival tsk] is (1) an arrival bound of
      [tsk], and (2) it is a monotonic function that equals 0 for the
      empty interval [delta = 0]. *)
  Context `{MaxArrivals Task}.
  Hypothesis H_valid_arrival_curve : valid_taskset_arrival_curve ts max_arrivals.
  Hypothesis H_is_arrival_curve : taskset_respects_max_arrivals arr_seq ts.

  (** Let [tsk] be any task in ts that is to be analyzed. *)
  Variable tsk : Task.
  Hypothesis H_tsk_in_ts : tsk \in ts.

  (** Next, consider any ideal uniprocessor schedule of this arrival sequence ... *)
  Variable sched : schedule (ideal.processor_state Job).
  Hypothesis H_jobs_come_from_arrival_sequence:
    jobs_come_from_arrival_sequence sched arr_seq.

  (** ... where jobs do not execute before their arrival or after completion. *)
  Hypothesis H_jobs_must_arrive_to_execute : jobs_must_arrive_to_execute sched.
  Hypothesis H_completed_jobs_dont_execute : completed_jobs_dont_execute sched.

  (** Consider an FP policy that indicates a higher-or-equal priority relation,
     and assume that the relation is reflexive and transitive. *)
  Context `{FP_policy Task}.
  Hypothesis H_priority_is_reflexive : reflexive_priorities.
  Hypothesis H_priority_is_transitive : transitive_priorities.

  (** Assume we have sequential tasks, i.e, tasks from the
     same task execute in the order of their arrival. *)
  Hypothesis H_sequential_tasks : sequential_tasks sched.

  (** Next, we assume that the schedule is a work-conserving schedule... *)
  Hypothesis H_work_conserving : work_conserving arr_seq sched.

  (** ... and the schedule respects the policy defined by the [job_preemptable]
     function (i.e., jobs have bounded non-preemptive segments). *)
  Hypothesis H_respects_policy : respects_policy_at_preemption_point arr_seq sched.

  (** ** Total Workload and Length of Busy Interval *)

  (** We introduce the abbreviation [rbf] for the task request bound function,
       which is defined as [task_cost(T) × max_arrivals(T,Δ)] for a task T. *)
  Let rbf := task_request_bound_function.

  (** Next, we introduce [task_rbf] as an abbreviation
      for the task request bound function of task [tsk]. *)
  Let task_rbf := rbf tsk.

  (** Using the sum of individual request bound functions, we define
      the request bound function of all tasks with higher priority
      ... *)
  Let total_hep_rbf := total_hep_request_bound_function_FP ts tsk.

  (** ... and the request bound function of all tasks with higher
      priority other than task [tsk]. *)
  Let total_ohep_rbf := total_ohep_request_bound_function_FP ts tsk.

  (** Let L be any positive fixed point of the busy interval recurrence, determined by
      the sum of blocking and higher-or-equal-priority workload. *)
  Variable L : duration.
  Hypothesis H_L_positive : L > 0.
  Hypothesis H_fixed_point : L = total_hep_rbf L.

  (** ** Response-Time Bound *)

  (** To reduce the time complexity of the analysis, recall the notion of search space. *)
  Let is_in_search_space := is_in_search_space tsk L.

  (** Next, consider any value R, and assume that for any given
       arrival A from search space there is a solution of the
       response-time bound recurrence which is bounded by R. *)
  Variable R : duration.
  Hypothesis H_R_is_maximum:
    forall (A : duration),
      is_in_search_space A ->
      exists (F : duration),
        A + F = task_rbf (A + ε) + total_ohep_rbf (A + F) /\
        F <= R.

  (** Now, we can leverage the results for the abstract model with
      bounded non-preemptive segments to establish a response-time
      bound for the more concrete model of fully preemptive
      scheduling. *)

  Let response_time_bounded_by := task_response_time_bound arr_seq sched.

  Theorem uniprocessor_response_time_bound_fully_preemptive_fp:
    response_time_bounded_by tsk R.
  Proof.
    have BLOCK: blocking_bound ts tsk = 0.
    { by rewrite /blocking_bound /parameters.task_max_nonpreemptive_segment
               /fully_preemptive.fully_preemptive_model subnn big1_eq. }
    eapply uniprocessor_response_time_bound_fp_with_bounded_nonpreemptive_segments.
    all: eauto 2 with basic_facts.
    - by rewrite BLOCK add0n.
    - move => A /andP [LT NEQ].
      edestruct H_R_is_maximum as [F [FIX BOUND]].
      { by apply/andP; split; eauto 2. }
      exists F; split.
      + by rewrite BLOCK add0n subnn subn0.
      + by rewrite subnn addn0.
  Qed.

End RTAforFullyPreemptiveFPModelwithArrivalCurves.


Require Import HypotheticalExternLib.
Require Import ZArith.
Require Import interface_6.

Definition RealProvable `{para} (e: (nat -> option X) -> Prop) := forall st, e st.
Definition join `{para} : (nat -> option X) -> (nat -> option X) -> (nat -> option X) -> Prop :=
    fun x y z =>
      forall p: nat,
       (exists v, x p = Some v /\ y p = None /\ z p = Some v) \/
       (exists v, x p = None /\ y p = Some v /\ z p = Some v) \/
       (x p = None /\ y p = None /\ z p = None).
Definition SepCon `{para} (e1 e2 : (nat -> option X) -> Prop) : (nat -> option X) -> Prop := fun st =>
    exists st1 st2, join st1 st2 st /\ e1 st1 /\ e2 st2.
Definition Emp `{para}: (nat -> option X) -> Prop :=
  fun st =>
    forall p, st p = None.

Module NaiveLang <: LanguageSig.
  Definition expr `{para} := (nat -> option X) -> Prop.
  Section NaiveLang.
  Context `{para}.
  Definition context := expr -> Prop.
  Definition impp (e1 e2 : expr) : expr := fun st => e1 st -> e2 st.
  Definition andp (e1 e2 : expr) : expr := fun st => e1 st /\ e2 st.
  Definition emp : expr := Emp.
  Definition sepcon := SepCon.
  Definition provable := RealProvable.
  End NaiveLang.
End NaiveLang.

Module NaiveRule.
  Include DerivedNames (NaiveLang).
  Section NaiveRule.
  Context `{para}.

  Lemma modus_ponens :
    forall x y : expr, provable (impp x y) -> provable x -> provable y.
  Proof. unfold provable, RealProvable, impp. auto. Qed.

  Lemma axiom1 : forall x y : expr, provable (impp x (impp y x)).
  Proof. unfold provable, RealProvable, impp. auto. Qed.

  Lemma axiom2 : forall x y z : expr,
      provable (impp (impp x (impp y z)) (impp (impp x y) (impp x z))).
  Proof. unfold provable, RealProvable, impp. auto. Qed.

  Lemma andp_intros :
    forall x y : expr, provable (impp x (impp y (andp x y))).
  Proof. unfold provable, RealProvable, impp, andp. auto. Qed.

  Lemma andp_elim1 : forall x y : expr, provable (impp (andp x y) x).
  Proof. unfold provable, RealProvable, impp, andp. tauto. Qed.

  Lemma andp_elim2 : forall x y : expr, provable (impp (andp x y) y).
  Proof. unfold provable, RealProvable, impp, andp. tauto. Qed.

  Axiom sepcon_comm: forall x y, provable (iffp (sepcon x y) (sepcon y x)).
  Axiom sepcon_assoc: forall x y z,
      provable (iffp (sepcon x (sepcon y z)) (sepcon (sepcon x y) z)).
  Axiom sepcon_mono : (forall x1 x2 y1 y2 : expr, provable (impp x1 x2) -> provable (impp y1 y2) -> provable (impp (sepcon x1 y1) (sepcon x2 y2))) .
  Axiom sepcon_emp : (forall x : expr, provable (iffp (sepcon x emp) x)) .
  End NaiveRule.
End NaiveRule.

Module T := LogicTheorem NaiveLang NaiveRule.
(*Module Solver := IPSolver NaiveLang.*)
Import T.
(*Import Solver.*)


Set Implicit Arguments.
Require Import Metalib.Metatheory.
Require Import Program.Equality.
Require Export Reflexivity.

Definition transitivity_on Q := forall E S T,
    sub E S Q -> sub E Q T -> sub E S T.

Lemma sub_transitivity : forall Q,
  transitivity_on Q.
Proof with auto.
  intros.
  unfold transitivity_on.
  intros.
  assert (WF E Q).
  get_well_form...
  generalize dependent S.
  generalize dependent T.
  induction H1;intros...
  -
    dependent destruction H0...
  -
    dependent destruction H0...
    constructor...
    get_well_form...
  -
    dependent induction H0...
    constructor...
    get_well_form...
    dependent induction H2...
    apply sa_trans_tvar with (U:=U0)...
    apply sa_trans_tvar with (U:=U1)...
    apply IHsub0 with (X0:=X)...
  -
    dependent induction H0...
    constructor...
    get_well_form...
    dependent induction H...
    apply sa_trans_tvar with (U:=U)...
    apply IHsub with (A0:=A) (B0:=B)...
  -
    dependent induction H3...
    apply sa_trans_tvar with (U:=U)...
    apply IHsub with (T3:=T1) (T4:=T2)...
    dependent induction H2...
    constructor...
    apply WF_all with (L:=L0);intros...
    apply H4 in H7.
    get_well_form...
    apply sa_all with (L:=L \u L0 \u L1)...
  -
    dependent induction H3...
    constructor...
    get_well_form...
    clear H6.
    dependent induction H7...
    apply sa_trans_tvar with (U:=U)...
    apply IHsub with (A0:=A)...
    clear H9.
    apply sa_rec with (L:=L \u L0 \u L1);intros...
  -
    dependent induction H0...
    constructor...
    get_well_form...
    clear IHsub.
    dependent induction H...
    apply sa_trans_tvar with (U:=U)...
    apply IHsub with (X0:=X) (A0:=A)...
Qed.

Lemma wf_env_narrowing: forall F Z Q E P,
    wf_env (F ++ Z ~ bind_sub Q ++ E) ->
    WF E P ->
    wf_env  (F ++ Z ~ bind_sub P ++ E).
Proof with auto.
  induction F;intros...
  -
    simpl...
    dependent destruction H...
    constructor...
  -
    dependent destruction H...
    +
      rewrite_env ((X, bind_sub T) :: F ++ Z ~ bind_sub P ++ E).
      constructor...
      apply IHF with (Q:=Q)...
      apply WF_narrowing with (V:=Q)...
    +
      rewrite_env ((x, bind_typ T) :: F ++ Z ~ bind_sub P ++ E).
      constructor...
      apply IHF with (Q:=Q)...
      apply WF_narrowing with (V:=Q)...
Qed.

Lemma sub_narrowing_aux : forall Q F E Z P S T,
  transitivity_on Q ->
  sub (F ++ Z ~ bind_sub Q ++ E) S T ->
  sub E P Q ->
  sub (F ++ Z ~ bind_sub P ++ E) S T.
Proof with auto.
  intros.
  generalize dependent P.
  dependent induction H0;intros...
  -
    constructor...
    apply wf_env_narrowing with (Q:=Q)...
    get_well_form...
  -
    constructor...
    apply wf_env_narrowing with (Q:=Q)...
    get_well_form...
    apply WF_narrowing with (V:=Q)...
  -
    constructor...
    apply wf_env_narrowing with (Q:=Q)...
    get_well_form...
    apply WF_narrowing with (V:=Q)...
  -
    destruct (X==Z);subst...
    +
      apply sa_trans_tvar with (U:=P)...
      apply H...
      * Case "P < Q".
        rewrite_env (nil ++ (F ++ Z ~ bind_sub P) ++ E).
        apply Sub_weakening...
        get_well_form...
        rewrite_env (F ++ Z ~ bind_sub P ++ E).
        apply wf_env_narrowing with (Q:=Q)...
      * Case "Q < T".
        analyze_binds_uniq H1...
        apply uniq_from_wf_env...
        get_well_form...
        dependent destruction BindsTacVal.
        apply IHsub with (Q0:=Q)...
    +
      apply sa_trans_tvar with (U:=U)...
      analyze_binds_uniq H1...
      apply uniq_from_wf_env...
      get_well_form...
      apply IHsub with (Q0:=Q)...
  -
    constructor...
    apply IHsub1 with (Q0:=Q)...
    apply IHsub2 with (Q0:=Q)...
  -
    apply sa_all with (L:=L);intros...
    +
      apply WF_narrowing with (V:=Q)...
    +
      rewrite_env ((X ~ bind_sub S ++ F) ++ Z ~ bind_sub P ++ E).
      apply H1 with (Q0:=Q)...
  -
    apply sa_rec with (L:=L \u fv_tt A1 \u fv_tt A2);intros...
    +
      rewrite_env ((X ~ bind_sub typ_top ++ F) ++ Z ~ bind_sub P ++ E).
      apply WF_narrowing with (V:=Q)...
      rewrite_env (X ~ bind_sub typ_top ++ F ++ Z ~ bind_sub Q ++ E)...
    +
      rewrite_env ((X ~ bind_sub typ_top ++ F) ++ Z ~ bind_sub P ++ E).
      apply WF_narrowing with (V:=Q)...
      rewrite_env (X ~ bind_sub typ_top ++ F ++ Z ~ bind_sub Q ++ E)...
    +
      rewrite_env ((X ~ bind_sub typ_top ++ F) ++ Z ~ bind_sub P ++ E).
      apply H2 with (Q0:=Q)...
  -
    constructor.
    apply IHsub with (Q0:=Q)...
Qed.

Lemma sub_narrowing : forall Q E F Z P S T,
  sub E P Q ->
  sub (F ++ Z ~ bind_sub Q ++ E) S T ->
  sub (F ++ Z ~ bind_sub P ++ E) S T.
Proof with auto.
  intros.
  apply sub_narrowing_aux with (Q:=Q)...
  apply sub_transitivity.
Qed.


(*|
####################################
Typeclass resolution and autorewrite
####################################

:Link: https://stackoverflow.com/q/39335437
|*)

(*|
Question
********

I have a base of rewrite lemmas. Some of them are parameterized by
typeclasses. When applying a lemma, it is important that the rewrite
fails when the typeclass cannot be automatically resolved by Coq. The
only way I have found to get this behaviour is to declare most of the
parameters implicit.
|*)

Class T (t : Type) : Type.
Instance T1 : T nat.
Qed.
Instance T2 : forall {A1 A2 : Type} {t1 : T A1} {t2 : T A2}, T (A1 * A2).
Qed.

Definition f {A : Type} (x : A) := x.

Lemma f_eq : forall {A : Type} (t : T A) (x : A), f x = x.
Proof.
  reflexivity.
Qed.

Lemma test1 : f (0, 1) = (0, 1).
Proof.
  rewrite f_eq.
  (* a subgoal T (nat * nat) is generated, which should have been
     resolved directly *)
Abort.

Lemma test2 : f (0, true) = (0, true).
Proof.
  rewrite f_eq.
  (* a subgoal T (nat * bool) is generated, while it should have
     failed *)
Abort.

Arguments f_eq {_ _} _.

Lemma test1 : f (0, 1) = (0, 1).
Proof.
  rewrite f_eq.
  reflexivity. (* OK *)
Qed.

Lemma test2 : f (0, true) = (0, true).
Proof.
  Fail rewrite f_eq. (* fails as expected *)
Abort.

(*|
Then I want to add my lemmas to a rewrite database, but the lemma
added to the database is already specialized.
|*)

Hint Rewrite f_eq : my_db.

Print Rewrite HintDb my_db. (* .unfold *)

(*|
How can I add my lemmas to a rewrite database and get the proper
behaviour in terms of typeclass resolution of their arguments?

EDIT: there is an option ``Set Typeclass Resolution After Apply.``
that seems to enable the behaviour that I expect, but only for
``apply``, not ``rewrite``. The corresponding commit gives the
following description:

    Add an option to solve typeclass goals generated by apply which
    can't be catched otherwise due to the discrepancy between evars
    and metas.
|*)

(*|
Answer (ejgallego)
******************

One possible solution is to use ssreflect's rewrite (this will fix the
first part of the problem) and replace the hint db by multi-rewrite
rules. That is to say:
|*)

Reset Initial. (* .none *)
From mathcomp Require Import ssreflect.

Class T (t : Type) : Type.
Instance T1 : T nat.
Qed.
Instance T2 : forall {A1 A2 : Type} {t1 : T A1} {t2 : T A2}, T (A1 * A2).
Qed.

Definition f {A : Type} (x : A) := x.

Lemma f_eq : forall {A : Type} (t : T A) (x : A), f x = x.
Proof. by []. Qed.

(* Add more lemmas as needed *)
Definition my_db A := (@f_eq A, @f_eq A).

Lemma test1 : f (0, 1) = (0, 1).
Proof. by rewrite my_db. Qed.

Lemma test2 : f (0, true) = (0, true).
Proof.
  Fail rewrite f_eq.
Abort.

(*|
Answer (Anton Trunov)
*********************

Here is a workaround. First, we add the *generalized* lemma, but we
tell the ``autorewrite`` tactic to use the tactic ``exact _`` to solve
the secondary goal of resolving the necessary typeclass instance.

.. coq:: none
|*)

Reset Initial.

Class T (t : Type) : Type.
Instance T1 : T nat.
Qed.
Instance T2 : forall {A1 A2 : Type} {t1 : T A1} {t2 : T A2}, T (A1 * A2).
Qed.

Definition f {A : Type} (x : A) := x.

Lemma f_eq : forall {A : Type} (t : T A) (x : A), f x = x.
Proof. reflexivity. Qed.

(*||*)

Hint Rewrite @f_eq using (exact _) : my_db.
Print Rewrite HintDb my_db. (* .unfold *)

(*|
Then you can keep rewriting with ``rewrite`` as you've shown in the
body of your question, or you can use your database:
|*)

Lemma test1' : f (0, 1) = (0, 1).
Proof.
  autorewrite with my_db. reflexivity.
Qed.

Lemma test2 : f (0, true) = (0, true).
Proof.
  autorewrite with my_db.
  (* does nothing: no rewrites, no error messages *)
Abort.

(*|
Notice that when we use ``exact _`` Coq does *not* generate new
instances of the form ``Build_T (nat * bool)`` in the last case, as it
would do if we used ``reflexivity`` instead. Here is an example of
what I mean by that. If we started with this hint
|*)

Hint Rewrite @f_eq using reflexivity : my_db.

(*| we could prove ``test2`` this way |*)

Lemma test2 : f (0, true) = (0, true).
Proof.
  autorewrite with my_db. reflexivity.
Qed.

(*|
But if we look at it using ``Set Printing All. Print test2.`` we will
see that Coq constructed a *new instance* of ``T``: ``(Build_T (prod
nat bool))`` which I think goes against your goal -- it seems you'd
prefer Coq to infer an already existing instance of ``T`` if it's
possible at all or fail in some way.

We can repeat the same thing manually:
|*)

Lemma test2' : f (0, true) = (0, true).
Proof.
  rewrite @f_eq.
  - reflexivity.
  - exact (Build_T (nat * bool)). (* `exact _` won't work *)
Qed.


Require Import Coq.Strings.String.
Require Import Ascii.

Local Open Scope char.
Local Open Scope string.

Inductive regex_rule : Type :=
| Epsilon
| Literal : Ascii.ascii -> regex_rule
| Or : regex_rule -> regex_rule -> regex_rule
| Concat : regex_rule -> regex_rule -> regex_rule
| Star : regex_rule -> regex_rule.

Definition ε := Epsilon.

Fixpoint show_regex r : string :=
  match r with
    | Epsilon => "ε"
    | Literal c => String c ""
    | Or a b => "(" ++ show_regex a ++ "|" ++ show_regex b ++ ")"
    | Concat a b => "(" ++ show_regex a ++ show_regex b ++ ")"
    | Star a => "(" ++ show_regex a ++ ")"
  end.

Eval compute in show_regex (Concat (Concat (Concat (Literal "a") (Star (Literal "a"))) (Star (Literal "b"))) (Or (Literal "a") (Literal "c"))).


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

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

Require Export 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_top => e_top
    | 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_fixpoint e2 A1 => e_fixpoint (close_exp_wrt_exp_rec (S n1) x1 e2) A1
    | e_app e2 e3 => e_app (close_exp_wrt_exp_rec n1 x1 e2) (close_exp_wrt_exp_rec n1 x1 e3)
    | e_merge e2 e3 => e_merge (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
  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_top => 1
    | t_arrow A2 B1 => 1 + (size_typ A2) + (size_typ B1)
    | t_and A2 B1 => 1 + (size_typ A2) + (size_typ B1)
  end.

Fixpoint size_exp (e1 : exp) {struct e1} : nat :=
  match e1 with
    | e_var_f x1 => 1
    | e_var_b n1 => 1
    | e_top => 1
    | e_lit i1 => 1
    | e_abs A1 e2 B1 => 1 + (size_typ A1) + (size_exp e2) + (size_typ B1)
    | e_fixpoint e2 A1 => 1 + (size_exp e2) + (size_typ A1)
    | e_app e2 e3 => 1 + (size_exp e2) + (size_exp e3)
    | e_merge e2 e3 => 1 + (size_exp e2) + (size_exp e3)
    | e_anno 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_top : forall n1,
    degree_exp_wrt_exp n1 (e_top)
  | 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_fixpoint : forall n1 e1 A1,
    degree_exp_wrt_exp (S n1) e1 ->
    degree_exp_wrt_exp n1 (e_fixpoint e1 A1)
  | 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_merge : forall n1 e1 e2,
    degree_exp_wrt_exp n1 e1 ->
    degree_exp_wrt_exp n1 e2 ->
    degree_exp_wrt_exp n1 (e_merge 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).

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_top :
    lc_set_exp (e_top)
  | 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_fixpoint : forall e1 A1,
    (forall x1 : var, lc_set_exp (open_exp_wrt_exp e1 (e_var_f x1))) ->
    lc_set_exp (e_fixpoint e1 A1)
  | 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_merge : forall e1 e2,
    lc_set_exp e1 ->
    lc_set_exp e2 ->
    lc_set_exp (e_merge e1 e2)
  | lc_set_e_anno : forall e1 A1,
    lc_set_exp e1 ->
    lc_set_exp (e_anno 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.

Lemma lc_e_fixpoint_exists :
forall x1 e1 A1,
  lc_exp (open_exp_wrt_exp e1 (e_var_f x1)) ->
  lc_exp (e_fixpoint e1 A1).
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.

Hint Extern 1 (lc_exp (e_fixpoint _ _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_e_fixpoint_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.

Lemma lc_body_e_fixpoint_1 :
forall e1 A1,
  lc_exp (e_fixpoint e1 A1) ->
  body_exp_wrt_exp e1.
Proof.
default_simp.
Qed.

Hint Resolve lc_body_e_fixpoint_1 : 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.

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

Hint Resolve subst_exp_e_fixpoint : 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.