(** * Propositions with a distinguished point representing true *)
(** This allows for something between [bool] and [Prop], where we can
    computationally reduce things like [True /\ True], but can still
    express equality of types. *)
Require Import Coq.Setoids.Setoid.
Require Export Fiat.Common.Coq__8_4__8_5__Compat.

Declare Scope pointed_prop_scope.
Delimit Scope pointed_prop_scope with pointed_prop.
Declare Scope option_pointed_prop_scope.
Delimit Scope option_pointed_prop_scope with option_pointed_prop.
Inductive pointed_Prop := trivial | inject (_ : Prop).
Bind Scope pointed_prop_scope with pointed_Prop.

Definition to_prop (x : pointed_Prop) : Prop
  := match x with
     | trivial => True
     | inject p => p
     end.

Coercion option_pointed_Prop_of_bool (x : bool) : option pointed_Prop
  := if x then Some trivial else None.
Coercion option_pointed_Prop_of_pointed_Prop (x : pointed_Prop) : option pointed_Prop
  := Some x.

Definition prop_of_option (x : option pointed_Prop) : Prop
  := match x with
     | Some p => to_prop p
     | None => False
     end.

Definition and_pointed_Prop (x y : pointed_Prop) : pointed_Prop
  := match x, y with
     | trivial, y => y
     | x, trivial => x
     | inject p, inject q => inject (p /\ q)
     end.

Definition or_pointed_Prop (x y : pointed_Prop) : pointed_Prop
  := match x, y with
     | trivial, _ => trivial
     | _, trivial => trivial
     | inject p, inject q => inject (p \/ q)
     end.

Definition impl_pointed_Prop (x y : pointed_Prop) : pointed_Prop
  := match x, y with
     | trivial, y => y
     | _, trivial => trivial
     | inject p, inject q => inject (p -> q)
     end.

Definition not_option_pointed_Prop (x : option pointed_Prop) : option pointed_Prop
  := match x with
     | Some trivial => None
     | None => Some trivial
     | Some (inject p) => Some (inject (~p))
     end.
Arguments not_option_pointed_Prop _%option_pointed_prop.

Definition and_option_pointed_Prop (x y : option pointed_Prop) : option pointed_Prop
  := match x, y with
     | Some x, Some y => Some (and_pointed_Prop x y)
     | _, _ => None
     end.
Arguments and_option_pointed_Prop (_ _)%option_pointed_prop.

Definition or_option_pointed_Prop (x y : option pointed_Prop) : option pointed_Prop
  := match x, y with
     | Some x, Some y => Some (or_pointed_Prop x y)
     | Some x, None => Some x
     | None, Some y => Some y
     | None, None => None
     end.
Arguments or_option_pointed_Prop (_ _)%option_pointed_prop.

Definition impl_option_pointed_Prop (x y : option pointed_Prop) : option pointed_Prop
  := match x, y with
     | None, _ => Some trivial
     | Some x, Some y => Some (impl_pointed_Prop x y)
     | Some p, None => not_option_pointed_Prop p
     end.
Arguments impl_option_pointed_Prop (_ _)%option_pointed_prop.

Infix "/\" := and_pointed_Prop : pointed_prop_scope.
Infix "\/" := or_pointed_Prop : pointed_prop_scope.
(*Infix "->" := impl_pointed_Prop : pointed_prop_scope.*)
Infix "/\" := and_option_pointed_Prop : option_pointed_prop_scope.
Infix "\/" := or_option_pointed_Prop : option_pointed_prop_scope.
(*Infix "->" := impl_option_pointed_Prop : option_pointed_prop_scope.*)
Notation "~ P" := (not_option_pointed_Prop P) : option_pointed_prop_scope.

Ltac inversion_pointed_Prop_step :=
  match goal with
  | [ H : inject _ = inject _ |- _ ] => progress (inversion H; clear H)
  end.
Ltac inversion_pointed_Prop := repeat inversion_pointed_Prop_step.

Create HintDb push_prop_of_option discriminated.
Create HintDb push_to_prop discriminated.
#[export]
Hint Extern 1 => progress autorewrite with push_prop_of_option in * : push_prop_of_option.
#[export]
Hint Extern 1 => progress autorewrite with push_to_prop in * : push_to_prop.

Lemma to_prop_and P Q : to_prop (P /\ Q)%pointed_prop
                        <-> (to_prop P /\ to_prop Q).
Proof. destruct P, Q; simpl; tauto. Qed.
Hint Rewrite to_prop_and : push_to_prop.

Lemma to_prop_or P Q : to_prop (P \/ Q)%pointed_prop
                       <-> (to_prop P \/ to_prop Q).
Proof. destruct P, Q; simpl; tauto. Qed.
Hint Rewrite to_prop_or : push_to_prop.

Lemma to_prop_impl P Q : to_prop (impl_pointed_Prop P Q)%pointed_prop
                         <-> (to_prop P -> to_prop Q).
Proof. destruct P, Q; simpl; tauto. Qed.
Hint Rewrite to_prop_impl : push_to_prop.

Lemma prop_of_option_and P Q : prop_of_option (P /\ Q)%option_pointed_prop
                               <-> (prop_of_option P /\ prop_of_option Q).
Proof. destruct P, Q; simpl; autorewrite with push_to_prop; tauto. Qed.
Hint Rewrite prop_of_option_and : push_prop_of_option.

Lemma prop_of_option_or P Q : prop_of_option (P \/ Q)%option_pointed_prop
                               <-> (prop_of_option P \/ prop_of_option Q).
Proof. destruct P, Q; simpl; autorewrite with push_to_prop; tauto. Qed.
Hint Rewrite prop_of_option_or : push_prop_of_option.

Lemma prop_of_option_impl P Q : prop_of_option (impl_option_pointed_Prop P Q)%option_pointed_prop
                               <-> (prop_of_option P -> prop_of_option Q).
Proof. destruct P as [ [|P] |], Q as [ [|Q] |]; simpl; tauto. Qed.
Hint Rewrite prop_of_option_impl : push_prop_of_option.

Lemma prop_of_option_not P : prop_of_option (~P)%option_pointed_prop
                               <-> (~prop_of_option P).
Proof. destruct P as [ [|] | ]; simpl; tauto. Qed.
Hint Rewrite prop_of_option_not : push_prop_of_option.


Require Import Iron.Language.SystemF.SubstTypeExp.
Require Import Iron.Language.SystemF.SubstExpExp.
Require Export Iron.Language.SystemF.Exp.

(* Small step evaluation *)
Inductive STEP : exp -> exp -> Prop :=
  (* value applications *)
  | ESLamApp
    :  forall t11 x12 v2
    ,  value v2
    -> STEP (XApp (XLam t11 x12) v2) (substXX 0 v2 x12)

  | ESApp1
    :  forall x1 x1' x2
    ,  STEP x1 x1'
    -> STEP (XApp x1 x2) (XApp x1' x2)

  | ESApp2
    :  forall v1 x2 x2'
    ,  value v1
    -> STEP x2 x2'
    -> STEP (XApp v1 x2) (XApp v1 x2')

  (* type applications *)
  | ESLAMAPP
    :  forall x12 t2
    ,  STEP (XAPP (XLAM x12) t2) (substTX 0 t2 x12)

  | ESAPP1
    :  forall x1 x1' t2
    ,  STEP x1 x1'
    -> STEP (XAPP x1 t2) (XAPP x1' t2).

Hint Constructors STEP.

(********************************************************************)
(* Multi-step evaluation.
   A sequence of small step transitions.
   As opposed to STEPSL, this version has an append constructor
   ESAppend that makes it easy to join two evaluations together.
   We use this when converting big-step evaluations to small-step.
 *)
Inductive STEPS : exp -> exp -> Prop :=

 (* After no steps, we get the same exp.
    We need this constructor to match the EVDone constructor
    in the big-step evaluation, so we can convert between big-step
    and multi-step evaluations. *)
 | ESNone
   :  forall x1
   ,  STEPS x1 x1

 (* Take a single step. *)
 | ESStep
   :  forall x1 x2
   ,  STEP  x1 x2
   -> STEPS x1 x2

 (* Combine two evaluations into a third. *)
 | ESAppend
   :  forall x1 x2 x3
   ,  STEPS x1 x2 -> STEPS x2 x3
   -> STEPS x1 x3.

Hint Constructors STEPS.

(* Context lemmas
   These help when proving something about a reduction in a given
   context. They're all trivial.
   TODO: Define contexts directly like in the Simple proof.
 *)
Lemma steps_app1
 :  forall x1 x1' x2
 ,  STEPS x1 x1'
 -> STEPS (XApp x1 x2) (XApp x1' x2).
Proof.
 intros. induction H; eauto.
Qed.
Hint Resolve steps_app1.

Lemma steps_app2
 :  forall v1 x2 x2'
 ,  value v1
 -> STEPS x2 x2'
 -> STEPS (XApp v1 x2) (XApp v1 x2').
Proof.
 intros. induction H0; eauto.
Qed.
Hint Resolve steps_app2.

Lemma steps_APP1
 :  forall x1 x1' t2
 ,  STEPS x1 x1'
 -> STEPS (XAPP x1 t2) (XAPP x1' t2).
Proof.
 intros. induction H; eauto.
Qed.

(********************************************************************)
(* Left linearised multi-step evaluation
   As opposed to STEPS, this version provides a single step at a time
   and does not have an append constructor. This is convenient
   when converting a small-step evaluations to big-step, via the
   eval_expansion lemma.
 *)
Inductive STEPSL : exp -> exp -> Prop :=

 | ESLNone
   : forall x1
   , STEPSL x1 x1

 | ESLCons
   :  forall x1 x2 x3
   ,  STEP   x1 x2 -> STEPSL x2 x3
   -> STEPSL x1 x3.

Hint Constructors STEPSL.

(* Transitivity of left linearised multi-step evaluation.
   We use this when "flattening" a big step evaluation to the
   small step one.
 *)
Lemma stepsl_trans
 :  forall x1 x2 x3
 ,  STEPSL x1 x2 -> STEPSL x2 x3
 -> STEPSL x1 x3.
Proof.
 intros.
 induction H.
  eauto.
  eapply ESLCons. eauto. eauto.
Qed.

(* Linearise a regular multi-step evaluation.
   This flattens out all the append constructors, leaving us with
   a list of individual transitions.
 *)
Lemma stepsl_of_steps
 :  forall x1 x2
 ,  STEPS  x1 x2
 -> STEPSL x1 x2.
Proof.
 intros.
 induction H.
  auto.
  eauto.
  eapply stepsl_trans; eauto.
Qed.


(*
  Copyright 2014 Cornell University
  Copyright 2015 Cornell University

  This file is part of VPrl (the Verified Nuprl project).

  VPrl is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  VPrl 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 General Public License
  along with VPrl.  If not, see <http://www.gnu.org/licenses/>.

  Website: http://nuprl.org/html/verification/
  Authors: Abhishek Anand & Vincent Rahli & Mark Bickford

*)

Require Export computation_arith.
Require Export approx_props2.
Require Export sequents_tacs.
Require Export sequents_tacs2.
Require Export per_props_equality.
Require Export sequents_equality.
Require Export per_props_nat.
Require Export per_can.
Require Export per_props_top.
Require Export integer_type.
Require Export terms_arith.

Unset Regular Subst Tactic.

Lemma mkc_integer_eq_iff {o} :
  forall a b, @mkc_integer o a = mkc_integer b <-> a = b.
Proof. intros; split; introv H.
   -  apply @mkc_integer_eq in H; auto.
   - subst. auto.
Qed.

(*
   H |- (m+n)+k = m+(n+k) in Z

     By addAssociative

     H |- m in Z
     H |- n in Z
     H |- k in Z
 *)
Definition rule_add_associative {o}
           (H : barehypotheses)
           (m n k: @NTerm o) :=
  mk_rule
    (mk_baresequent H (mk_conclax (mk_equality (mk_add (mk_add m n) k) (mk_add m (mk_add n k)) mk_int)))
    [ mk_baresequent H (mk_conclax (mk_member m mk_int)),
      mk_baresequent H (mk_conclax (mk_member n mk_int)),
      mk_baresequent H (mk_conclax (mk_member k mk_int))
    ]
    [].

(*
   H |- (m*n)*k = m*(n*k) in Z

     By mulAssociative

     H |- m in Z
     H |- n in Z
     H |- k in Z
 *)
Definition rule_mul_associative {o}
           (H : barehypotheses)
           (m n k: @NTerm o) :=
  mk_rule
    (mk_baresequent H (mk_conclax (mk_equality (mk_mul (mk_mul m n) k) (mk_mul m (mk_mul n k)) mk_int)))
    [ mk_baresequent H (mk_conclax (mk_member m mk_int)),
      mk_baresequent H (mk_conclax (mk_member n mk_int)),
      mk_baresequent H (mk_conclax (mk_member k mk_int))
    ]
    [].

(*
   H |- m*(n+k) = (m*n) + (m*k) in Z

     By mulDistributive

     H |- m in Z
     H |- n in Z
     H |- k in Z
 *)
Definition rule_mul_distributive {o}
           (H : barehypotheses)
           (m n k: @NTerm o) :=
  mk_rule
    (mk_baresequent H (mk_conclax (mk_equality (mk_mul m (mk_add n k))
                        (mk_add (mk_mul m n) (mk_mul m k)) mk_int)))
    [ mk_baresequent H (mk_conclax (mk_member m mk_int)),
      mk_baresequent H (mk_conclax (mk_member n mk_int)),
      mk_baresequent H (mk_conclax (mk_member k mk_int))
    ]
    [].

(*
   H |- m + (n - m) = n in Z

     By addInverse

     H |- m in Z
     H |- n in Z
 *)
Definition rule_add_inverse {o}
           (H : barehypotheses)
           (m n: @NTerm o) :=
  mk_rule
    (mk_baresequent H (mk_conclax
                       (mk_equality (mk_add m (mk_sub n m))
                                     n mk_int)))
    [ mk_baresequent H (mk_conclax (mk_member m mk_int)),
      mk_baresequent H (mk_conclax (mk_member n mk_int))
    ]
    [].

(*
   H |- m op n = m op n in Z

     By arithopEquality

     H |- m in Z
     H |- n in Z

 *)
Definition rule_arithop_equality {o}
           (H : barehypotheses)
           op
           (m n: @NTerm o) :=
  mk_rule
    (mk_baresequent H (mk_conclax (mk_equality (mk_arithop op m n) (mk_arithop op m n) mk_int)))
    [ mk_baresequent H (mk_conclax (mk_member m mk_int)),
      mk_baresequent H (mk_conclax (mk_member n mk_int))
    ]
    [].

(*
   H |- (m+n) = (n+m) in Z

     By addCommutative

     H |- m in Z
     H |- n in Z
 *)
Definition rule_add_commutative {o}
           (H : barehypotheses)
           (m n : @NTerm o) :=
  mk_rule
    (mk_baresequent H (mk_conclax (mk_equality (mk_add m n) (mk_add n m ) mk_int)))
    [ mk_baresequent H (mk_conclax (mk_member m mk_int)),
      mk_baresequent H (mk_conclax (mk_member n mk_int))
    ]
    [].

(*
   H |- (m*n) = (n*m) in Z

     By mullCommutative

     H |- m in Z
     H |- n in Z
 *)
Definition rule_mul_commutative {o}
           (H : barehypotheses)
           (m n : @NTerm o) :=
  mk_rule
    (mk_baresequent H (mk_conclax (mk_equality (mk_mul m n) (mk_mul n m ) mk_int)))
    [ mk_baresequent H (mk_conclax (mk_member m mk_int)),
      mk_baresequent H (mk_conclax (mk_member n mk_int))
    ]
    [].

(*
   H |- (0+n) = n in Z

     By addZero

     H |- n in Z
 *)
Definition rule_add_zero {o}
           (H : barehypotheses)
           (n : @NTerm o) :=
  mk_rule
    (mk_baresequent H (mk_conclax (mk_equality (mk_add (mk_integer 0) n) n mk_int)))
    [ mk_baresequent H (mk_conclax (mk_member n mk_int)) ]
    [].

(*
   H |- (1*n) = n in Z

     By mulOne

     H |- n in Z
 *)
Definition rule_mul_one {o}
           (H : barehypotheses)
           (n : @NTerm o) :=
  mk_rule
    (mk_baresequent H (mk_conclax (mk_equality (mk_mul (mk_integer 1) n) n  mk_int)))
    [ mk_baresequent H (mk_conclax (mk_member n mk_int)) ]
    [].

Lemma rule_arithop_equality_true {o} :
  forall lib (H : barehypotheses) op
         (m n : @NTerm o),
    rule_true lib (rule_arithop_equality H op m n).
Proof.
  unfold rule_arithop_equality, rule_true, closed_type_baresequent, closed_extract_baresequent; simpl.
  intros.
  clear cargs.
  (* We prove the well-formedness of things *)
  destseq; allsimpl.
  dLin_hyp; exrepnd.
  rename Hyp0 into hyp1.
  rename Hyp1 into hyp2.
  destseq; allsimpl; proof_irr; GC.

  exists (@covered_axiom o (nh_vars_hyps H)).

  (* we now start proving the sequent *)
  vr_seq_true.
  vr_seq_true in hyp1.
  pose proof (hyp1 s1 s2 eqh sim) as hyp; clear hyp1.
  vr_seq_true in hyp2.
  pose proof (hyp2 s1 s2 eqh sim) as hyp1; clear hyp2.
  exrepnd.
  lsubst_tac.
  allrw (@equality_in_member o).
  exrepnd.
  apply (@tequality_member_int o) in hyp2; auto.
  apply (@tequality_member_int o) in hyp0; auto.
  generalize_lsubstc_terms m1.
  generalize_lsubstc_terms n1.
  generalize_lsubstc_terms m2.
  generalize_lsubstc_terms n2.
(*
 assert (equality_of_int lib (mkc_arithop op m1 n1)
          (mkc_arithop op m2 n2)) by (apply @equality_of_int_arithop; auto).
 *) split.
  - (* tequality *) apply @tequality_mkc_equality_sp; split.
    apply tequality_int. split; left; apply equality_in_int;
    auto; apply equality_of_int_arithop; auto.

  - (* equality *)
     rw @member_eq. rw <- @member_equality_iff.
     rw @equality_in_int.
      clear dependent n2. clear dependent m2.
    allrw @member_int_iff. spcast. exrepnd.
     exists (get_arith_op op z0 z). sp; spcast; apply computes_to_valc_arithop; auto.

Qed.

Lemma rule_add_associative_true {o} :
  forall lib (H : barehypotheses)
         (m n k : @NTerm o),
    rule_true lib (rule_add_associative H m n k).
Proof.
  unfold rule_add_associative, rule_true, closed_type_baresequent, closed_extract_baresequent; simpl.
  intros.
  clear cargs.
  (* We prove the well-formedness of things *)
  destseq; allsimpl.
  dLin_hyp; exrepnd.
  rename Hyp0 into hyp1.
  rename Hyp1 into hyp2.
  rename Hyp2 into hyp3.
  destseq; allsimpl; proof_irr; GC.
  exists (@covered_axiom o (nh_vars_hyps H)).

  (* we now start proving the sequent *)
  vr_seq_true.
  vr_seq_true in hyp1.
  pose proof (hyp1 s1 s2 eqh sim) as hyp; clear hyp1.
  vr_seq_true in hyp2.
  pose proof (hyp2 s1 s2 eqh sim) as hyp1; clear hyp2.
  vr_seq_true in hyp3.
  pose proof (hyp3 s1 s2 eqh sim) as hyp2; clear hyp3.
  exrepnd.
  fold_mk_arithop.
  lsubst_tac.
  allrw (@equality_in_member o).
  exrepnd.
  apply (@tequality_member_int o) in hyp4; auto.
  apply (@tequality_member_int o) in hyp3; auto.
  apply (@tequality_member_int o) in hyp0; auto.
  generalize_lsubstc_terms m1.
  generalize_lsubstc_terms n1.
  generalize_lsubstc_terms k1.
  generalize_lsubstc_terms m2.
  generalize_lsubstc_terms n2.
  generalize_lsubstc_terms k2.
  split.
  - (* tequality *) apply @tequality_mkc_equality_sp; split.
    + apply tequality_int.
    + split; left; apply equality_in_int; auto;
      repeat (apply @equality_of_int_arithop; auto).

  - (* equality *)
     rw @member_eq. rw <- @member_equality_iff.
     rw @equality_in_int.
     clear dependent k2. clear dependent n2. clear dependent m2.
    allrw @member_int_iff. spcast. exrepnd.
   unfold equality_of_int.
   assert ((z0 + z1 + z)%Z = (z0 + (z1 + z))%Z) as eq by omega.
   exists (z0 + z1 + z)%Z. sp; auto; spcast;
     [ | rw eq]; repeat (apply computes_to_valc_arithop;auto).
Qed.

Lemma rule_add_commutative_true {o} :
  forall lib (H : barehypotheses)
         (m n : @NTerm o),
    rule_true lib (rule_add_commutative H m n).
Proof.
  unfold rule_add_commutative, rule_true, closed_type_baresequent, closed_extract_baresequent; simpl.
  intros.
  clear cargs.
  (* We prove the well-formedness of things *)
  destseq; allsimpl.
  dLin_hyp; exrepnd.
  rename Hyp0 into hyp1.
  rename Hyp1 into hyp2.
  destseq; allsimpl; proof_irr; GC.
  exists (@covered_axiom o (nh_vars_hyps H)).

  (* we now start proving the sequent *)
  vr_seq_true.
  vr_seq_true in hyp1.
  pose proof (hyp1 s1 s2 eqh sim) as hyp; clear hyp1.
  vr_seq_true in hyp2.
  pose proof (hyp2 s1 s2 eqh sim) as hyp1; clear hyp2.
  exrepnd.
  fold_mk_arithop.
  lsubst_tac.
  allrw (@equality_in_member o).
  exrepnd.
  apply (@tequality_member_int o) in hyp2; auto.
  apply (@tequality_member_int o) in hyp0; auto.
  generalize_lsubstc_terms m1.
  generalize_lsubstc_terms n1.
  generalize_lsubstc_terms m2.
  generalize_lsubstc_terms n2.
  split.
  - (* tequality *) apply @tequality_mkc_equality_sp; split.
    + apply tequality_int.
    + split; left; apply equality_in_int; auto;
      repeat (apply @equality_of_int_arithop; auto).

  - (* equality *)
     rw @member_eq. rw <- @member_equality_iff.
     rw @equality_in_int.
     clear dependent n2. clear dependent m2.
    allrw @member_int_iff. spcast. exrepnd.
   unfold equality_of_int.
   assert ((z0 + z)%Z = (z + z0)%Z) as eq by omega.
   exists (z0 + z)%Z. sp; auto; spcast;
     [ | rw eq]; repeat (apply computes_to_valc_arithop;auto).
Qed.

Lemma rule_mul_associative_true {o} :
  forall lib (H : barehypotheses)
         (m n k : @NTerm o),
    rule_true lib (rule_mul_associative H m n k).
Proof.
  unfold rule_mul_associative, rule_true, closed_type_baresequent, closed_extract_baresequent; simpl.
  intros.
  clear cargs.
  (* We prove the well-formedness of things *)
  destseq; allsimpl.
  dLin_hyp; exrepnd.
  rename Hyp0 into hyp1.
  rename Hyp1 into hyp2.
  rename Hyp2 into hyp3.
  destseq; allsimpl; proof_irr; GC.
  exists (@covered_axiom o (nh_vars_hyps H)).

  (* we now start proving the sequent *)
  vr_seq_true.
  vr_seq_true in hyp1.
  pose proof (hyp1 s1 s2 eqh sim) as hyp; clear hyp1.
  vr_seq_true in hyp2.
  pose proof (hyp2 s1 s2 eqh sim) as hyp1; clear hyp2.
  vr_seq_true in hyp3.
  pose proof (hyp3 s1 s2 eqh sim) as hyp2; clear hyp3.
  exrepnd.
  fold_mk_arithop.
  lsubst_tac.
  allrw (@equality_in_member o).
  exrepnd.
  apply (@tequality_member_int o) in hyp4; auto.
  apply (@tequality_member_int o) in hyp3; auto.
  apply (@tequality_member_int o) in hyp0; auto.
  generalize_lsubstc_terms m1.
  generalize_lsubstc_terms n1.
  generalize_lsubstc_terms k1.
  generalize_lsubstc_terms m2.
  generalize_lsubstc_terms n2.
  generalize_lsubstc_terms k2.
  split.
  - (* tequality *) apply @tequality_mkc_equality_sp; split.
    + apply tequality_int.
    + split; left; apply equality_in_int; auto;
      repeat (apply @equality_of_int_arithop; auto).

  - (* equality *)
     rw @member_eq. rw <- @member_equality_iff.
     rw @equality_in_int.
     clear dependent k2. clear dependent n2. clear dependent m2.
    allrw @member_int_iff. spcast. exrepnd.
   unfold equality_of_int.
   assert ((z0 * z1 * z)%Z = (z0 * (z1 * z))%Z) as eq by (rw Z.mul_assoc;auto).
   exists (z0 * z1 * z)%Z. sp; auto; spcast;
     [ | rw eq]; repeat (apply computes_to_valc_arithop;auto).
Qed.

Lemma rule_mul_distributive_true {o} :
  forall lib (H : barehypotheses)
         (m n k : @NTerm o),
    rule_true lib (rule_mul_distributive H m n k).
Proof.
  unfold rule_mul_distributive, rule_true, closed_type_baresequent, closed_extract_baresequent; simpl.
  intros.
  clear cargs.
  (* We prove the well-formedness of things *)
  destseq; allsimpl.
  dLin_hyp; exrepnd.
  rename Hyp0 into hyp1.
  rename Hyp1 into hyp2.
  rename Hyp2 into hyp3.
  destseq; allsimpl; proof_irr; GC.
  exists (@covered_axiom o (nh_vars_hyps H)).

  (* we now start proving the sequent *)
  vr_seq_true.
  vr_seq_true in hyp1.
  pose proof (hyp1 s1 s2 eqh sim) as hyp; clear hyp1.
  vr_seq_true in hyp2.
  pose proof (hyp2 s1 s2 eqh sim) as hyp1; clear hyp2.
  vr_seq_true in hyp3.
  pose proof (hyp3 s1 s2 eqh sim) as hyp2; clear hyp3.
  exrepnd.
  fold_mk_arithop.
  lsubst_tac.
  allrw (@equality_in_member o).
  exrepnd.
  apply (@tequality_member_int o) in hyp4; auto.
  apply (@tequality_member_int o) in hyp3; auto.
  apply (@tequality_member_int o) in hyp0; auto.
  generalize_lsubstc_terms m1.
  generalize_lsubstc_terms n1.
  generalize_lsubstc_terms k1.
  generalize_lsubstc_terms m2.
  generalize_lsubstc_terms n2.
  generalize_lsubstc_terms k2.
  split.
  - (* tequality *) apply @tequality_mkc_equality_sp; split.
    + apply tequality_int.
    + split; left; apply equality_in_int; auto;
      repeat (apply @equality_of_int_arithop; auto).

  - (* equality *)
     rw @member_eq. rw <- @member_equality_iff.
     rw @equality_in_int.
     clear dependent k2. clear dependent n2. clear dependent m2.
    allrw @member_int_iff. spcast. exrepnd.
   unfold equality_of_int.
   assert ((z0 * (z1 + z))%Z = ((z0 * z1) + (z0 * z))%Z) as eq by (rw Z.mul_add_distr_l;auto).
   exists (z0 * (z1 + z))%Z. sp; auto; spcast;
     [ | rw eq]; repeat (apply computes_to_valc_arithop;auto).
Qed.

Lemma rule_mul_commutative_true {o} :
  forall lib (H : barehypotheses)
         (m n : @NTerm o),
    rule_true lib (rule_mul_commutative H m n).
Proof.
  unfold rule_mul_commutative, rule_true, closed_type_baresequent, closed_extract_baresequent; simpl.
  intros.
  clear cargs.
  (* We prove the well-formedness of things *)
  destseq; allsimpl.
  dLin_hyp; exrepnd.
  rename Hyp0 into hyp1.
  rename Hyp1 into hyp2.
  destseq; allsimpl; proof_irr; GC.
  exists (@covered_axiom o (nh_vars_hyps H)).

  (* we now start proving the sequent *)
  vr_seq_true.
  vr_seq_true in hyp1.
  pose proof (hyp1 s1 s2 eqh sim) as hyp; clear hyp1.
  vr_seq_true in hyp2.
  pose proof (hyp2 s1 s2 eqh sim) as hyp1; clear hyp2.
  exrepnd.
  fold_mk_arithop.
  lsubst_tac.
  allrw (@equality_in_member o).
  exrepnd.
  apply (@tequality_member_int o) in hyp2; auto.
  apply (@tequality_member_int o) in hyp0; auto.
  generalize_lsubstc_terms m1.
  generalize_lsubstc_terms n1.
  generalize_lsubstc_terms m2.
  generalize_lsubstc_terms n2.
  split.
  - (* tequality *) apply @tequality_mkc_equality_sp; split.
    + apply tequality_int.
    + split; left; apply equality_in_int; auto;
      repeat (apply @equality_of_int_arithop; auto).

  - (* equality *)
     rw @member_eq. rw <- @member_equality_iff.
     rw @equality_in_int.
     clear dependent n2. clear dependent m2.
    allrw @member_int_iff. spcast. exrepnd.
   unfold equality_of_int.
   assert ((z0 * z)%Z = (z * z0)%Z) as eq by(rw Z.mul_comm;auto).
   exists (z0 * z)%Z. sp; auto; spcast;
     [ | rw eq]; repeat (apply computes_to_valc_arithop;auto).
Qed.

Lemma rule_add_inverse_true {o} :
  forall lib (H : barehypotheses)
         (m n : @NTerm o),
    rule_true lib (rule_add_inverse H m n).
Proof.
  unfold rule_add_inverse, rule_true, closed_type_baresequent, closed_extract_baresequent; simpl.
  intros.
  clear cargs.
  (* We prove the well-formedness of things *)
  destseq; allsimpl.
  dLin_hyp; exrepnd.
  rename Hyp0 into hyp1.
  rename Hyp1 into hyp2.
  destseq; allsimpl; proof_irr; GC.
  exists (@covered_axiom o (nh_vars_hyps H)).

  (* we now start proving the sequent *)
  vr_seq_true.
  vr_seq_true in hyp1.
  pose proof (hyp1 s1 s2 eqh sim) as hyp; clear hyp1.
  vr_seq_true in hyp2.
  pose proof (hyp2 s1 s2 eqh sim) as hyp1; clear hyp2.
  exrepnd.
  fold_mk_arithop.
  lsubst_tac.
  allrw (@equality_in_member o).
  exrepnd.
  apply (@tequality_member_int o) in hyp2; auto.
  apply (@tequality_member_int o) in hyp0; auto.
  generalize_lsubstc_terms m1.
  generalize_lsubstc_terms n1.
  generalize_lsubstc_terms m2.
  generalize_lsubstc_terms n2.
  split.
  - (* tequality *) apply @tequality_mkc_equality_sp; split.
    + apply tequality_int.
    + split; left; apply equality_in_int; auto;
      repeat (apply @equality_of_int_arithop; auto).

  - (* equality *)
     rw @member_eq. rw <- @member_equality_iff.
     rw @equality_in_int.
     clear dependent n2. clear dependent m2.
    allrw @member_int_iff. spcast. exrepnd.
   unfold equality_of_int.
   exists z. sp; auto; spcast; auto.
   assert ( (mkc_integer z) = @mkc_integer o (z0 + (z - z0))) as eq by
     (apply mkc_integer_eq_iff; omega).
     rw eq; repeat (apply computes_to_valc_arithop;auto).
Qed.

Lemma rule_mul_one_true {o} :
  forall lib (H : barehypotheses)
         (n : @NTerm o),
    rule_true lib (rule_mul_one H n).
Proof.
  unfold rule_mul_one, rule_true, closed_type_baresequent, closed_extract_baresequent; simpl.
  intros.
  clear cargs.
  (* We prove the well-formedness of things *)
  destseq; allsimpl.
  dLin_hyp; exrepnd.
  rename Hyp0 into hyp1.
  destseq; allsimpl; proof_irr; GC.
  exists (@covered_axiom o (nh_vars_hyps H)).

  (* we now start proving the sequent *)
  vr_seq_true.
  vr_seq_true in hyp1.
  pose proof (hyp1 s1 s2 eqh sim) as hyp; clear hyp1.
  exrepnd.
  fold_mk_arithop.
  lsubst_tac.

  allrw (@equality_in_member o).
  exrepnd.
  apply (@tequality_member_int o) in hyp0; auto.
  generalize_lsubstc_terms n1.
  generalize_lsubstc_terms n2.
  split.
  - (* tequality *) apply @tequality_mkc_equality_sp; split.
    + apply tequality_int.
    + split; left; apply equality_in_int; auto;
      repeat (apply @equality_of_int_arithop; auto).
     apply equality_of_int_mkc_integer; auto.

  - (* equality *)
     rw @member_eq. rw <- @member_equality_iff.
     rw @equality_in_int.
     clear dependent n2.
    allrw @member_int_iff. spcast. exrepnd.
   unfold equality_of_int.
   assert (mkc_integer (1 * z) = @mkc_integer o z) as eq by
     (apply mkc_integer_eq_iff; omega).
    exists z; sp; spcast; auto.
    rw<- eq. apply @computes_to_valc_arithop; auto.
    apply computes_to_valc_refl.
    apply iscvalue_mkc_integer.

Qed.

Lemma rule_add_zero_true {o} :
  forall lib (H : barehypotheses)
         (n : @NTerm o),
    rule_true lib (rule_add_zero H n).
Proof.
  unfold rule_add_zero, rule_true, closed_type_baresequent, closed_extract_baresequent; simpl.
  intros.
  clear cargs.
  (* We prove the well-formedness of things *)
  destseq; allsimpl.
  dLin_hyp; exrepnd.
  rename Hyp0 into hyp1.
  destseq; allsimpl; proof_irr; GC.
  exists (@covered_axiom o (nh_vars_hyps H)).

  (* we now start proving the sequent *)
  vr_seq_true.
  vr_seq_true in hyp1.
  pose proof (hyp1 s1 s2 eqh sim) as hyp; clear hyp1.
  exrepnd.
  fold_mk_arithop.
  lsubst_tac.

  allrw (@equality_in_member o).
  exrepnd.
  apply (@tequality_member_int o) in hyp0; auto.
  generalize_lsubstc_terms n1.
  generalize_lsubstc_terms n2.
  split.
  - (* tequality *) apply @tequality_mkc_equality_sp; split.
    + apply tequality_int.
    + split; left; apply equality_in_int; auto;
      repeat (apply @equality_of_int_arithop; auto).
     apply equality_of_int_mkc_integer; auto.

  - (* equality *)
     rw @member_eq. rw <- @member_equality_iff.
     rw @equality_in_int.
     clear dependent n2.
    allrw @member_int_iff. spcast. exrepnd.
   unfold equality_of_int.
   assert (mkc_integer (0 + z) = @mkc_integer o z) as eq by
     (apply mkc_integer_eq_iff; omega).
    exists z; sp; spcast; auto.
    rw<- eq. apply @computes_to_valc_arithop; auto.
    apply computes_to_valc_refl.
    apply iscvalue_mkc_integer.

Qed.

(*
*** Local Variables:
*** coq-load-path: ("." "./close/")
*** End:
*)


Require Export Base.

Module Cone.

Section category.
Context {S T: Category} (F: Functor S T).

Structure obj := Obj {
  vertex: T;
  edge x: vertex ~> F x;
  edge_comm x y (f: x ~> y): fmap F f ∘ edge x = edge y;
}.

Lemma obj_eq (N L: obj): N = L <-> vertex N = vertex L /\ (forall (x: S) (e: vertex N = vertex L), edge N x = edge L x ∘ eq_iso e).
Proof.
  split.
  + intros H.
    subst L.
    split.
    reflexivity.
    intros x e.
    rewrite eq_iso_refl.
    symmetry.
    apply comp_id_r.
  + destruct N as [v1 e1 H1], L as [v2 e2 H2].
    simpl.
    intros [Hv He].
    subst v2.
    assert (e1 = e2).
    extensionality x.
    rewrite <- comp_id_r.
    exact (He x eq_refl).
    subst e2.
    f_equal.
    apply proof_irrelevance.
Qed.

Structure hom (N L: obj) := Hom {
  mediator: vertex N ~> vertex L;
  mediator_comm x: edge L x ∘ mediator = edge N x;
}.

Lemma hom_eq {N L: obj} (f g: hom N L): f = g <-> (mediator _ _ f = mediator _ _ g).
Proof.
  split; intros H.
  now subst g.
  destruct f as [f Hf], g as [g Hg].
  simpl in H.
  subst g.
  f_equal.
  apply proof_irrelevance.
Qed.

Ltac hom_eq :=
  match goal with
  | [ |- ?f = ?g] =>
    apply (hom_eq f g);
    simpl
  end.

Definition id (c: obj): hom c c := {|
  mediator := id (vertex c);
  mediator_comm x := comp_id_r (edge c x);
|}.

Definition comp {X Y Z: obj} (f: hom Y Z) (g: hom X Y): hom X Z := {|
  mediator := mediator _ _ f ∘ mediator _ _ g;
  mediator_comm x := eq_trans (comp_assoc _ _ _)
    (eq_trans (f_equal2 _ (mediator_comm _ _ f x) eq_refl) (mediator_comm _ _ g x));
|}.

Lemma comp_assoc {A B C D: obj} (f: hom C D) (g: hom B C) (h: hom A B): comp f (comp g h) = comp (comp f g) h.
Proof.
  hom_eq.
  apply comp_assoc.
Qed.

Lemma comp_id_l {X Y: obj} (f: hom X Y): comp (id Y) f = f.
Proof.
  hom_eq.
  apply comp_id_l.
Qed.

Lemma comp_id_r {X Y: obj} (f: hom X Y): comp f (id X) = f.
Proof.
  hom_eq.
  apply comp_id_r.
Qed.

Definition cat_mixin: Category.mixin_of obj :=
  Category.Mixin obj hom id (@comp) (@comp_assoc) (@comp_id_l) (@comp_id_r).

Definition cat: Category :=
  Category.Pack obj cat_mixin.

End category.

Arguments vertex {_ _ _} _.
Arguments edge {_ _ _} _ _.
Arguments edge_comm {_ _ _} _ {_ _} _.

Arguments mediator {_ _ _ _ _} _.
Arguments mediator_comm {_ _ _ _ _} _ _.

Coercion mediator: hom >-> Categories.hom.

Ltac hom_eq :=
  match goal with
  | [ |- ?f = ?g] =>
    apply (hom_eq _ f g);
    simpl
  end.

Lemma mediator_is_eq {S T: Category} {F: Functor S T} {x y: cat F} (f: x ~> y): is_eq f -> is_eq (mediator f).
Proof.
  intros [e H].
  subst f y.
  simpl.
  apply is_eq_id.
Qed.

End Cone.

Coercion Cone.mediator: Cone.hom >-> Categories.hom.
Canonical Cone.cat.

Notation Cone := Cone.cat.

Module Cocone.

Section category.
Context {S T: Category} (F: Functor S T).

Structure obj := Obj {
  vertex: T;
  edge x: F x ~> vertex;
  edge_comm x y (f: x ~> y): edge y ∘ fmap F f = edge x;
}.

Lemma obj_eq (N L: obj): N = L <-> vertex N = vertex L /\ (forall (x: S) (e: vertex N = vertex L), eq_iso e ∘ edge N x = edge L x).
Proof.
  split.
  + intros H.
    subst L.
    split.
    reflexivity.
    intros x e.
    rewrite eq_iso_refl.
    apply comp_id_l.
  + destruct N as [v1 e1 H1], L as [v2 e2 H2].
    simpl.
    intros [Hv He].
    subst v2.
    assert (e1 = e2).
    extensionality x.
    rewrite <- (comp_id_l (e1 x)).
    exact (He x eq_refl).
    subst e2.
    f_equal.
    apply proof_irrelevance.
Qed.

Structure hom (N L: obj) := Hom {
  mediator: vertex N ~> vertex L;
  mediator_comm x: mediator ∘ edge N x = edge L x;
}.

Lemma hom_eq {N L: obj} (f g: hom N L): f = g <-> (mediator _ _ f = mediator _ _ g).
Proof.
  split; intros H.
  now subst g.
  destruct f as [f Hf], g as [g Hg].
  simpl in H.
  subst g.
  f_equal.
  apply proof_irrelevance.
Qed.

Ltac hom_eq :=
  match goal with
  | [ |- ?f = ?g] =>
    apply (hom_eq f g);
    simpl
  end.

Definition id (c: obj): hom c c := {|
  mediator := id (vertex c);
  mediator_comm x := comp_id_l (edge c x);
|}.

Program Definition comp {X Y Z: obj} (f: hom Y Z) (g: hom X Y): hom X Z := {|
  mediator := mediator _ _ f ∘ mediator _ _ g;
  mediator_comm x := _;
|}.
Next Obligation.
  rewrite <- comp_assoc.
  rewrite mediator_comm.
  apply mediator_comm.
Qed.

Lemma comp_assoc {A B C D: obj} (f: hom C D) (g: hom B C) (h: hom A B): comp f (comp g h) = comp (comp f g) h.
Proof.
  hom_eq.
  apply comp_assoc.
Qed.

Lemma comp_id_l {X Y: obj} (f: hom X Y): comp (id Y) f = f.
Proof.
  hom_eq.
  apply comp_id_l.
Qed.

Lemma comp_id_r {X Y: obj} (f: hom X Y): comp f (id X) = f.
Proof.
  hom_eq.
  apply comp_id_r.
Qed.

Definition cat_mixin: Category.mixin_of obj :=
  Category.Mixin obj hom id (@comp) (@comp_assoc) (@comp_id_l) (@comp_id_r).

Definition cat: Category :=
  Category.Pack obj cat_mixin.

End category.

Arguments vertex {_ _ _} _.
Arguments edge {_ _ _} _ _.
Arguments edge_comm {_ _ _} _ {_ _} _.

Arguments mediator {_ _ _ _ _} _.
Arguments mediator_comm {_ _ _ _ _} _ _.

Coercion mediator: hom >-> Categories.hom.

Ltac hom_eq :=
  match goal with
  | [ |- ?f = ?g] =>
    apply (hom_eq _ f g);
    simpl
  end.

Lemma mediator_is_eq {S T: Category} {F: Functor S T} {x y: cat F} (f: x ~> y): is_eq f -> is_eq (mediator f).
Proof.
  intros [e H].
  subst f y.
  simpl.
  apply is_eq_id.
Qed.

End Cocone.

Coercion Cocone.mediator: Cocone.hom >-> Categories.hom.
Canonical Cocone.cat.

Notation Cocone := Cocone.cat.

Section cocone.
Context {S T: Category} (F: Functor S T).

Program Definition cocone_to: Functor (co (Cone F)) (Cocone (cof F)) := {|
  fobj X := {|
    Cocone.vertex := Cone.vertex X;
    Cocone.edge := Cone.edge X;
    Cocone.edge_comm _ _ f := Cone.edge_comm X f;
  |};
  fmap X Y f := {|
    Cocone.mediator := Cone.mediator f;
    Cocone.mediator_comm := Cone.mediator_comm f;
  |};
|}.
Next Obligation.
  now Cocone.hom_eq.
Qed.
Next Obligation.
  now Cocone.hom_eq.
Qed.

Program Definition cocone_from: Functor (Cocone (cof F)) (co (Cone F)) := {|
  fobj X := {|
    Cone.vertex := Cocone.vertex X;
    Cone.edge := Cocone.edge X;
    Cone.edge_comm _ _ f := Cocone.edge_comm X f;
  |};
  fmap X Y f := {|
    Cone.mediator := Cocone.mediator f;
    Cone.mediator_comm := Cocone.mediator_comm f;
  |};
|}.
Next Obligation.
  now Cone.hom_eq.
Qed.
Next Obligation.
  now Cone.hom_eq.
Qed.

Lemma cocone_inv_l: cocone_from ∘ cocone_to = id (co (Cone F)).
Proof.
  fun_eq X Y f.
  now destruct x.
  destruct X as [X x Hx], Y as [Y y Hy], f as [f Hf].
  simpl in *.
  rewrite !eq_iso_refl; clear H H0.
  simpl.
  rewrite comp_id_r.
  apply comp_id_l.
Qed.

Lemma cocone_inv_r: cocone_to ∘ cocone_from = id (Cocone (cof F)).
Proof.
  fun_eq X Y f.
  now destruct x.
  destruct X as [X x Hx], Y as [Y y Hy], f as [f Hf].
  simpl in *.
  rewrite !eq_iso_refl; clear H H0.
  simpl.
  rewrite comp_id_r.
  apply comp_id_l.
Qed.

Canonical cocone: co (Cone F) <~> Cocone (cof F) :=
  Isomorphism.Pack cocone_to (Isomorphism.Mixin _ _ _ cocone_to cocone_from cocone_inv_l cocone_inv_r).

Lemma cone_co: co (Cone F) ≃ Cocone (cof F).
Proof.
  constructor.
  exact cocone.
Qed.

End cocone.

Definition nat_cone {S T: Category} {F: Functor S T} (c: Cone F): Δ (Cone.vertex c) ~> F := {|
  transform := Cone.edge c: forall x, Δ (Cone.vertex c) x ~> F x;
  naturality x y f := eq_trans (comp_id_r _) (eq_sym (Cone.edge_comm c f));
|}.

Definition nat_cocone {S T: Category} {F: Functor S T} (c: Cocone F): F ~> Δ (Cocone.vertex c) := {|
  transform := Cocone.edge c: forall x: S, F x ~> Δ (Cocone.vertex c) x;
  naturality x y f := eq_sym (eq_trans (comp_id_l _) (eq_sym (Cocone.edge_comm c f)));
|}.

Definition cone_nat {S T: Category} {F: Functor S T} (c: T) (η: Δ c ~> F): Cone F := {|
  Cone.vertex := c;
  Cone.edge := transform η;
  Cone.edge_comm x y f := eq_trans (eq_sym (naturality η f)) (comp_id_r _);
|}.

Definition cocone_nat {S T: Category} {F: Functor S T} (c: T) (η: F ~> Δ c): Cocone F := {|
  Cocone.vertex := c;
  Cocone.edge := transform η;
  Cocone.edge_comm x y f := eq_trans (naturality η f) (comp_id_l _);
|}.

Lemma nat_cone_inv {S T: Category} {F: Functor S T} (c: Cone F): cone_nat (Cone.vertex c) (nat_cone c) = c.
Proof.
  destruct c as [c edge Hc]; simpl.
  unfold nat_cone; simpl.
  unfold cone_nat; simpl.
  f_equal.
  apply proof_irrelevance.
Qed.

Lemma nat_cocone_inv {S T: Category} {F: Functor S T} (c: Cocone F): cocone_nat (Cocone.vertex c) (nat_cocone c: F ~> Δ (Cocone.vertex c)) = c.
Proof.
  destruct c as [c edge Hc]; simpl.
  unfold nat_cocone; simpl.
  unfold cocone_nat; simpl.
  f_equal.
  apply proof_irrelevance.
Qed.

Lemma cone_nat_inv {S T: Category} {F: Functor S T} (c: T) (η: Δ c ~> F): nat_cone (cone_nat c η) = η.
Proof. now natural_eq x. Qed.

Lemma cocone_nat_inv {S T: Category} {F: Functor S T} (c: T) (η: F ~> Δ c): nat_cocone (cocone_nat c η) = η.
Proof. now natural_eq x. Qed.

Lemma cone_iso_ex {S T: Category} {F: Functor S T} (X: Cone F) (y: T): Cone.vertex X ≃ y -> exists Y, Cone.vertex Y = y /\ X ≃ Y.
Proof.
  intros [i].
  unshelve eexists.
  exists y (fun x => Cone.edge X x ∘ i⁻¹).
  2: split.
  2: reflexivity.
  2: constructor.
  2: unshelve eexists.
  3: unshelve eexists.
  2: exists (to i).
  3: exists (to i⁻¹).
  4, 5: Cone.hom_eq.
  all: simpl.
  all: change (from i) with (to i⁻¹).
  + intros a b f.
    rewrite comp_assoc.
    f_equal.
    apply Cone.edge_comm.
  + intros a.
    rewrite <- comp_assoc, inv_l.
    apply comp_id_r.
  + now intros a.
  + apply inv_l.
  + apply inv_r.
Qed.

Lemma cocone_iso_ex {S T: Category} {F: Functor S T} (X: Cocone F) (y: T): Cocone.vertex X ≃ y -> exists Y, Cocone.vertex Y = y /\ X ≃ Y.
Proof.
  intros [i].
  unshelve eexists.
  exists y (fun x => i ∘ Cocone.edge X x).
  2: split.
  2: reflexivity.
  2: constructor.
  2: unshelve eexists.
  3: unshelve eexists.
  2: exists (to i).
  3: exists (to i⁻¹).
  4, 5: Cocone.hom_eq.
  all: simpl.
  all: change (from i) with (to i⁻¹).
  + intros a b f.
    rewrite <- comp_assoc.
    f_equal.
    apply Cocone.edge_comm.
  + now intros a.
  + intros a.
    rewrite comp_assoc, inv_l.
    apply comp_id_l.
  + apply inv_l.
  + apply inv_r.
Qed.

Program Definition cone_lift {S T: Category} (F G: Functor S T) (η: F ~> G): Cone F ~> Cone G := {|
  fobj C := {|
    Cone.vertex := Cone.vertex C;
    Cone.edge i := η i ∘ Cone.edge C i;
  |};
  fmap A B f := {|
    Cone.mediator := Cone.mediator f;
  |}
|}.
Next Obligation.
  rewrite comp_assoc.
  rewrite <- naturality.
  rewrite <- comp_assoc.
  f_equal.
  apply Cone.edge_comm.
Qed.
Next Obligation.
  rewrite <- comp_assoc.
  f_equal.
  apply Cone.mediator_comm.
Qed.
Next Obligation.
  now Cone.hom_eq.
Qed.
Next Obligation.
  now Cone.hom_eq.
Qed.

Program Definition cocone_lift {S T: Category} (F G: Functor S T) (η: F ~> G): Cocone G ~> Cocone F := {|
  fobj C := {|
    Cocone.vertex := Cocone.vertex C;
    Cocone.edge i := Cocone.edge C i ∘ η i;
  |};
  fmap A B f := {|
    Cocone.mediator := Cocone.mediator f;
  |}
|}.
Next Obligation.
  rewrite <- comp_assoc.
  rewrite naturality.
  rewrite comp_assoc.
  f_equal.
  apply Cocone.edge_comm.
Qed.
Next Obligation.
  rewrite comp_assoc.
  f_equal.
  apply Cocone.mediator_comm.
Qed.
Next Obligation.
  now Cocone.hom_eq.
Qed.
Next Obligation.
  now Cocone.hom_eq.
Qed.

Program Definition cone_whisk_l {A B C: Category} (F: Functor B C) (G: Functor A B): Cone G ~> Cone (F ∘ G) := {|
  fobj X := {|
    Cone.vertex := F (Cone.vertex X);
    Cone.edge i := fmap F (Cone.edge X i);
  |};
  fmap X Y f := {|
    Cone.mediator := fmap F f;
  |}
|}.
Next Obligation.
  rewrite <- fmap_comp.
  f_equal.
  apply Cone.edge_comm.
Qed.
Next Obligation.
  rewrite <- fmap_comp.
  f_equal.
  apply Cone.mediator_comm.
Qed.
Next Obligation.
  Cone.hom_eq.
  apply fmap_id.
Qed.
Next Obligation.
  Cone.hom_eq.
  apply fmap_comp.
Qed.

Program Definition cocone_whisk_l {A B C: Category} (F: Functor B C) (G: Functor A B): Cocone G ~> Cocone (F ∘ G) := {|
  fobj X := {|
    Cocone.vertex := F (Cocone.vertex X);
    Cocone.edge i := fmap F (Cocone.edge X i);
  |};
  fmap X Y f := {|
    Cocone.mediator := fmap F f;
  |}
|}.
Next Obligation.
  rewrite <- fmap_comp.
  f_equal.
  apply Cocone.edge_comm.
Qed.
Next Obligation.
  rewrite <- fmap_comp.
  f_equal.
  apply Cocone.mediator_comm.
Qed.
Next Obligation.
  Cocone.hom_eq.
  apply fmap_id.
Qed.
Next Obligation.
  Cocone.hom_eq.
  apply fmap_comp.
Qed.

Program Definition cone_whisk_r {A B C: Category} (F: Functor B C) (G: Functor A B): Cone F ~> Cone (F ∘ G) := {|
  fobj X := {|
    Cone.vertex := Cone.vertex X;
    Cone.edge i := Cone.edge X (G i);
  |};
  fmap X Y f := {|
    Cone.mediator := f;
  |}
|}.
Next Obligation.
  apply Cone.edge_comm.
Qed.
Next Obligation.
  apply Cone.mediator_comm.
Qed.
Next Obligation.
  now Cone.hom_eq.
Qed.
Next Obligation.
  now Cone.hom_eq.
Qed.

Program Definition cocone_whisk_r {A B C: Category} (F: Functor B C) (G: Functor A B): Cocone F ~> Cocone (F ∘ G) := {|
  fobj X := {|
    Cocone.vertex := Cocone.vertex X;
    Cocone.edge i := Cocone.edge X (G i);
  |};
  fmap X Y f := {|
    Cocone.mediator := f;
  |}
|}.
Next Obligation.
  apply Cocone.edge_comm.
Qed.
Next Obligation.
  apply Cocone.mediator_comm.
Qed.
Next Obligation.
  now Cocone.hom_eq.
Qed.
Next Obligation.
  now Cocone.hom_eq.
Qed.


Module Monoid.
Section Monoid.

Class T__c : Type := T : Set.
Context {T__p : T__c}.

Class m_zero__c : Type := m_zero : T.
Context {m_zero__p : m_zero__c}.

Class m_plus__c : Type := m_plus : T -> T -> T.
Context {m_plus__p : m_plus__c}.

Definition m_zero_left__tp : Prop :=
  forall x, m_plus m_zero x = x.

Definition m_zero_right__tp : Prop :=
  forall x, m_plus x m_zero = x.

Definition m_plus_assoc__tp : Prop :=
  forall x y z, m_plus x (m_plus y z) = m_plus (m_plus x y) z.

Class Monoid : Prop :=
  { m_zero_left: m_zero_left__tp;
    m_zero_right: m_zero_right__tp;
    m_plus_assoc: m_plus_assoc__tp }.

End Monoid.
End Monoid.

Set Printing All.
Print Monoid.Monoid.

Require Import Coq.Program.Tactics.
Import EqNotations.

Program Definition foo (T: Set) (T__eq: T = nat) (f: T -> T) : nat :=
  rew _ in (f (rew _ in 5)).
Print foo.
Check foo_obligation_2.

Program Definition foo1 (T: Set) (T__eq: T = nat) (f: T -> T) : nat :=
  ((rew _ in f) : _ -> _) 5.

Program Definition foo2 (T: Set) (T__eq: T = nat) (f: T -> nat) : nat :=
  (f (rew _ in 5)).
  (* this fails: rew _ in (f (rew _ in 5)). *)

Definition eq_proj {A} (a1 a2:A) (e: a1 = a2) := a1.
(* this does not work at all:
Program Definition foo3 (T: Set) (T__eq: T = nat) (f: eq_proj _ _ T__eq -> eq_proj _ _ T__eq) : nat :=
  rew _ in (f (rew _ in 5)).
*)

Program Definition foo4 (T: Set) (T__eq: T = nat) (f: T -> T) : nat :=
  ((rew _ in f) : _ -> _) 5.

Program Definition foo4 (T: Set) (T__eq: T = nat) (f: T -> nat) : nat :=

Class T__c : Type := T : Set.
Class m_zero__c {T__p:T__c} : Type := m_zero : T.
Class m_plus__c {T__p:T__c} {m_zero__p:m_zero__c} : Type := m_plus : T -> T -> T.

Class m_zero_left__c {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} : Prop :=
  m_zero_left : forall x, m_plus m_zero x = x.

Class m_zero_right__c {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} : Prop :=
  m_zero_right : forall x, m_plus x m_zero = x.

Class m_plus_assoc__c {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} : Prop :=
  m_plus_assoc : forall x y z, m_plus x (m_plus y z) = m_plus (m_plus x y) z.

Class Monoid {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c}
      {m_zero_left__p:m_zero_left__c} {m_zero_right__p:m_zero_right__c}
      {m_plus_assoc__p:m_plus_assoc__c}
: Prop :=
  { }.

Lemma left_id_uniq `{Monoid} (x:T) :
  (forall y, m_plus x y = y) -> x = m_zero.
  intros left_id.
  rewrite <- (left_id m_zero).
  rewrite m_zero_right.
  reflexivity.
Qed.

Require Import Coq.Arith.Plus.

(* FIXME HERE: how to start building an instance of Monoid without
   already having all the proofs? *)
Require Import Coq.Program.Tactics.
Program Definition m_nat_inst__def :
  Monoid (T__p:=nat) (m_zero__p:=O) (m_plus__p:=plus)
         (m_zero_left__p:=_) (m_zero_right__p:=_) (m_plus_assoc__p:=_) := Build_Monoid _ _ _ _ _ _.
Obligation 1.
constructor.
Qed.
Obligation 2.
unfold m_zero_right__c; intro; rewrite <- plus_n_O; reflexivity.
Qed.
Obligation 3.
unfold m_plus_assoc__c; intros. rewrite plus_assoc; reflexivity.
Qed.

Instance m_nat_inst : Monoid (T__p:=nat) (m_zero__p:=O) (m_plus__p:=plus)
                             (m_zero_left__p:=_) (m_zero_right__p:=_) (m_plus_assoc__p:=_) := m_nat_inst__def.

(* Old way of doing things: no classes for axioms *)

Class T__c : Type := T : Set.
Class m_zero__c {T__p:T__c} : Type := m_zero : T.
Class m_plus__c {T__p:T__c} {m_zero__p:m_zero__c} : Type := m_plus : T -> T -> T.

Class Monoid {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} : Prop :=
  { m_zero_left :> m_zero_left__c;
    m_zero_right :> m_zero_right__c;
    m_plus_assoc : m_plus_assoc__c }.

Lemma left_id_uniq `{Monoid} (x:T) :
  (forall y, m_plus x y = y) -> x = m_zero.
  intros left_id.
  rewrite <- (left_id m_zero).
  rewrite m_zero_right.
  reflexivity.
Qed.

Class U__c : Type := U : Set.
Instance T__inst {U__p:U__c} : T__c := U__p.

Eval unfold T__inst,m_zero__c,T in (forall {U__p:U__c}, m_zero__c (T__p:=T__inst)).
(*
Definition g_zero__t := Eval unfold T__inst,m_zero__c,T in (forall {U__p:U__c}, m_zero__c (T__p:=T__inst)).
*)
(*
Definition g_zero__t {U__p:U__c} : Type := $( apply m_zero__c; unfold m_zero__c )$.
*)
(*
Definition g_zero__t {U__p:U__c} := Eval fold (@U U__p) in U__p.
*)
(* Print g_zero__t. *)

Section blah.
Context {U__p:U__c}.
Definition g_zero__t := Eval fold U in U__p.
End blah.
Print g_zero__t.

Eval unfold m_zero__c,T,T__inst in (forall {U__p:U__c}, m_zero__c (T__p:=T__inst)).

Typeclasses Transparent T__inst.
Class g_zero__c {U__p:U__c} : Type := g_zero : T.
Instance m_zero__inst {U__p:U__c} {g_zero__p:g_zero__c} : m_zero__c (T__p:=T__inst) := g_zero__p.
Typeclasses Transparent m_zero__inst.
Class g_plus__c {U__p:U__c} {g_zero__p:g_zero__c} : Type := g_plus : T -> T -> T.
Instance m_plus__inst {U__p:U__c} {g_zero__p:g_zero__c} {g_plus__p:g_plus__c} :
  m_plus__c (T__p:=T__inst) (m_zero__p:=m_zero__inst) := g_plus__p.
Typeclasses Transparent m_plus__inst.
Class g_inv__c {U__p:U__c} {g_zero__p:g_zero__c} {g_plus__p:g_plus__c} : Type := g_inv : T -> T.

Class Group {U__p:U__c} {g_zero__p:g_zero__c} {g_plus__p:g_plus__c} {g_inv__p:g_inv__c} : Prop :=
  { g_zero_left : forall x, g_plus g_zero x = x;
    g_zero_right : forall x, g_plus x g_zero = x;
    g_plus_assoc : forall x y z, g_plus x (g_plus y z) = g_plus (g_plus x y) z;
    g_inv_left : forall x, g_plus (g_inv x) x = g_zero;
    g_inv_right : forall x, g_plus x (g_inv x) = g_zero }.

Instance Group_Monoid `{Group} : Monoid (T__p:=T__inst) (m_zero__p:=m_zero__inst) (m_plus__p:=m_plus__inst) :=
  {| m_zero_left := g_zero_left;
     m_zero_right := g_zero_right;
     m_plus_assoc := g_plus_assoc |}.

Lemma left_inv_uniq `{Group} (x x_inv:T) :
  g_plus x_inv x = g_zero -> x_inv = g_inv x.
  intro left_inv.
  rewrite <- (g_zero_right x_inv).
  Check g_inv_right.
  rewrite <- (g_inv_right x).
  rewrite g_plus_assoc.
  rewrite left_inv.
  rewrite g_zero_left.
  reflexivity.
Qed.

Lemma g_left_id_uniq `{Group} (x:T) : (forall y, g_plus x y = y) -> x = g_zero.
  apply left_id_uniq.
Qed.

(* FIXME: old versions below *)

Definition T__t : Type := Set.
Class T__c : Type := T : T__t.
Definition m_zero__t {T__p:T__c} : Type := T.
Class m_zero__c {T__p:T__c} : Type := m_zero : m_zero__t.
Definition m_plus__t {T__p:T__c} {m_zero__p:m_zero__c} : Type := T -> T -> T.
Class m_plus__c {T__p:T__c} {m_zero__p:m_zero__c} : Type := m_plus : m_plus__t.

Definition m_zero_left__type {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} := forall x, m_plus m_zero x = x.
Definition m_zero_right {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} := (forall x, m_plus x m_zero = x).
Definition m_plus_assoc {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} := (forall x y z, m_plus x (m_plus y z) = m_plus (m_plus x y) z).

Set Printing All.
Check m_zero_left__type.

Class Monoid {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} : Prop :=
  { m_zero_left : forall x, m_plus m_zero x = x;
    m_zero_right : forall x, m_plus x m_zero = x;
    m_plus_assoc : forall x y z, m_plus x (m_plus y z) = m_plus (m_plus x y) z }.

Check m_zero_left.

Definition m_plus_inv {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} : Prop :=
  forall x, m_plus x x = m_zero.

Class U__c : Type := U : T__t.
Instance T__inst {U__p:U__c} : T__c := U__p.
Class g_zero__c {U__p:U__c} : Type := g_zero : m_zero__t (T__p:=T__inst).
Instance m_zero__inst {U__p:U__c} {g_zero__p:g_zero__c} : m_zero__c (T__p:=T__inst) := g_zero__p.
Class g_plus__c {U__p:U__c} {g_zero__p:g_zero__c} : Type := g_plus : m_plus__t (T__p:=T__inst) (m_zero__p:=m_zero__inst).
Instance m_plus__inst {U__p:U__c} {g_zero__p:g_zero__c} {g_plus__p:g_plus__c} :
  m_plus__c (T__p:=T__inst) (m_zero__p:=m_zero__inst) := g_plus__p.

Set Printing All.

Definition g_plus_inv {U__p:U__c} {g_zero__p:g_zero__c} {g_plus__p:g_plus__c} : Prop :=
  forall x, g_plus x x = g_zero.

Definition T__t : Type := Set.
Class T__c : Type := T : T__t.
Definition m_zero__t {T__p:T__c} : Type := T.
Class m_zero__c {T__p:T__c} : Type := m_zero : m_zero__t.
Definition m_plus__t {T__p:T__c} {m_zero__p:m_zero__c} : Type := T -> T -> T.
Class m_plus__c {T__p:T__c} {m_zero__p:m_zero__c} : Type := m_plus : m_plus__t.

Definition m_plus_inv {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} : Prop :=
  forall x, m_plus x x = m_zero.

Class U__c : Type := U : T__t.
Instance T__inst {U__p:U__c} : T__c := U__p.
Class g_zero__c {U__p:U__c} : Type := g_zero : m_zero__t (T__p:=T__inst).
Instance m_zero__inst {U__p:U__c} {g_zero__p:g_zero__c} : m_zero__c (T__p:=T__inst) := g_zero__p.
Class g_plus__c {U__p:U__c} {g_zero__p:g_zero__c} : Type := g_plus : m_plus__t (T__p:=T__inst) (m_zero__p:=m_zero__inst).
Instance m_plus__inst {U__p:U__c} {g_zero__p:g_zero__c} {g_plus__p:g_plus__c} :
  m_plus__c (T__p:=T__inst) (m_zero__p:=m_zero__inst) := g_plus__p.

Set Printing All.

Definition g_plus_inv {U__p:U__c} {g_zero__p:g_zero__c} {g_plus__p:g_plus__c} : Prop :=
  forall x, g_plus x x = g_zero.

(* FIXME HERE: this does not work! (g_plus_inv fails below) *)
(*
Class T__c : Type := T : Set.
Class m_zero__c {T__p:T__c} : Type := m_zero : T.
Class m_plus__c {T__p:T__c} {m_zero__p:m_zero__c} : Type := m_plus : T -> T -> T.

Definition m_plus_inv {T__p:T__c} {m_zero__p:m_zero__c} {m_plus__p:m_plus__c} : Prop :=
  forall x, m_plus x x = m_zero.

Class U__c : Type := U : T__c.
(*Instance T__inst {U__p:U__c} : T__c := U__p.*)
Class g_zero__c {U__p:U__c} : Type := g_zero : m_zero__c (T__p:=U__p).
(* Instance m_zero__inst {U__p:U__c} {g_zero__p:g_zero__c} : m_zero__c (T__p:=U__p) := g_zero__p. *)
Class g_plus__c {U__p:U__c} {g_zero__p:g_zero__c} : Type := g_plus : m_plus__c (T__p:=U__p) (m_zero__p:=g_zero__p).
(*
Instance m_plus__inst {U__p:U__c} {g_zero__p:g_zero__c} {g_plus__p:g_plus__c} :
  m_plus__c (T__p:=T__inst) (m_zero__p:=m_zero__inst) := g_plus__p.
*)

Set Printing All.

Definition g_plus_inv {U__p:U__c} {g_zero__p:g_zero__c} {g_plus__p:g_plus__c} : Prop :=
  forall x, g_plus x x = g_zero.
*)


(*|
#################################
How to solve contradiction in Coq
#################################

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

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

I have statement ``true <> false``, in hypothesis. I want to prove
``true = false``. Can I solve it? The problem is that, it can not be
solved by contradiction.
|*)

(*|
Answer
******

I agree that you should provide a better example. That said! You need
to be clear...is ``true <> false`` above the line (eg a hypothesis) or
below the line (a goal)?

I'm assuming it is a goal, because as a hypothesis, it doesn't
actually tell you anything (it's just a tautology).

If it's a goal:
|*)

Goal (true <> false).
  intros contra. discriminate.
Qed.

(*|
There are a lot of general ways to deal with contradictions...\
``discriminate`` and ``inversion`` are quite common. But a clearer
example would be better.

Something to note in general is that ``A <> B`` is just a notation for
``A = B -> False``, which is why ``intros contra`` above works,
because it's pulling out the hypothesis. In cases where you're not
sure what to do, you can use intros to put the equality above the line
and then derive a contradiction.

In the case where you have something like ``true <> true`` *above* the
line (that's important), then you can apply it.

Example
|*)

Goal (true <> true -> 0 = 1).
  intros contra. exfalso. apply contra. reflexivity.
Qed.

(*|
``exfalso`` clears out the current goal and replaces it with ``False``
-- this is useful when you have an impossible goal but a contradiction
in your hypothesis (above the line). ``apply contra`` uses the fact
that ``<>`` is ``... -> False`` like I mentioned above.
|*)


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 dexp_ind' := Induction for dexp Sort Prop.

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

Scheme dexp_rec' := Induction for dexp Sort Set.

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

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

Fixpoint close_dexp_wrt_dexp_rec (n1 : nat) (x1 : var) (ee1 : dexp) {struct ee1} : dexp :=
  match ee1 with
    | de_var_f x2 => if (x1 == x2) then (de_var_b n1) else (de_var_f x2)
    | de_var_b n2 => if (lt_ge_dec n2 n1) then (de_var_b n2) else (de_var_b (S n2))
    | de_top => de_top
    | de_lit i1 => de_lit i1
    | de_abs ee2 => de_abs (close_dexp_wrt_dexp_rec (S n1) x1 ee2)
    | de_app ee2 ee3 => de_app (close_dexp_wrt_dexp_rec n1 x1 ee2) (close_dexp_wrt_dexp_rec n1 x1 ee3)
    | de_merge ee2 ee3 => de_merge (close_dexp_wrt_dexp_rec n1 x1 ee2) (close_dexp_wrt_dexp_rec n1 x1 ee3)
    | de_ann ee2 A => de_ann (close_dexp_wrt_dexp_rec n1 x1 ee2) A
    | de_fixpoint ee2 => de_fixpoint (close_dexp_wrt_dexp_rec (S n1) x1 ee2)
  end.

Definition close_dexp_wrt_dexp x1 ee1 := close_dexp_wrt_dexp_rec 0 x1 ee1.

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

Fixpoint size_dexp (ee1 : dexp) {struct ee1} : nat :=
  match ee1 with
    | de_var_f x1 => 1
    | de_var_b n1 => 1
    | de_top => 1
    | de_lit i1 => 1
    | de_abs ee2 => 1 + (size_dexp ee2)
    | de_app ee2 ee3 => 1 + (size_dexp ee2) + (size_dexp ee3)
    | de_merge ee2 ee3 => 1 + (size_dexp ee2) + (size_dexp ee3)
    | de_ann ee2 A => 1 + (size_dexp ee2)
    | de_fixpoint ee2 => 1 + (size_dexp ee2)
  end.

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

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

Inductive degree_dexp_wrt_dexp : nat -> dexp -> Prop :=
  | degree_wrt_dexp_de_var_f : forall n1 x1,
    degree_dexp_wrt_dexp n1 (de_var_f x1)
  | degree_wrt_dexp_de_var_b : forall n1 n2,
    lt n2 n1 ->
    degree_dexp_wrt_dexp n1 (de_var_b n2)
  | degree_wrt_dexp_de_top : forall n1,
    degree_dexp_wrt_dexp n1 (de_top)
  | degree_wrt_dexp_de_lit : forall n1 i1,
    degree_dexp_wrt_dexp n1 (de_lit i1)
  | degree_wrt_dexp_de_abs : forall n1 ee1,
    degree_dexp_wrt_dexp (S n1) ee1 ->
    degree_dexp_wrt_dexp n1 (de_abs ee1)
  | degree_wrt_dexp_de_app : forall n1 ee1 ee2,
    degree_dexp_wrt_dexp n1 ee1 ->
    degree_dexp_wrt_dexp n1 ee2 ->
    degree_dexp_wrt_dexp n1 (de_app ee1 ee2)
  | degree_wrt_dexp_de_merge : forall n1 ee1 ee2,
    degree_dexp_wrt_dexp n1 ee1 ->
    degree_dexp_wrt_dexp n1 ee2 ->
    degree_dexp_wrt_dexp n1 (de_merge ee1 ee2)
  | degree_wrt_dexp_de_ann : forall n1 ee1 A,
    degree_dexp_wrt_dexp n1 ee1 ->
    degree_dexp_wrt_dexp n1 (de_ann ee1 A)
  | degree_wrt_dexp_de_fixpoint : forall n1 ee1,
    degree_dexp_wrt_dexp (S n1) ee1 ->
    degree_dexp_wrt_dexp n1 (de_fixpoint ee1).

Scheme degree_dexp_wrt_dexp_ind' := Induction for degree_dexp_wrt_dexp Sort Prop.

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

Hint Constructors degree_dexp_wrt_dexp : core lngen.

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

Inductive lc_set_dexp : dexp -> Set :=
  | lc_set_de_var_f : forall x1,
    lc_set_dexp (de_var_f x1)
  | lc_set_de_top :
    lc_set_dexp (de_top)
  | lc_set_de_lit : forall i1,
    lc_set_dexp (de_lit i1)
  | lc_set_de_abs : forall ee1,
    (forall x1 : var, lc_set_dexp (open_dexp_wrt_dexp ee1 (de_var_f x1))) ->
    lc_set_dexp (de_abs ee1)
  | lc_set_de_app : forall ee1 ee2,
    lc_set_dexp ee1 ->
    lc_set_dexp ee2 ->
    lc_set_dexp (de_app ee1 ee2)
  | lc_set_de_merge : forall ee1 ee2,
    lc_set_dexp ee1 ->
    lc_set_dexp ee2 ->
    lc_set_dexp (de_merge ee1 ee2)
  | lc_set_de_ann : forall ee1 A,
    lc_set_dexp ee1 ->
    lc_set_dexp (de_ann ee1 A)
  | lc_set_de_fixpoint : forall ee1,
    (forall x1 : var, lc_set_dexp (open_dexp_wrt_dexp ee1 (de_var_f x1))) ->
    lc_set_dexp (de_fixpoint ee1).

Scheme lc_dexp_ind' := Induction for lc_dexp Sort Prop.

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

Scheme lc_set_dexp_ind' := Induction for lc_set_dexp Sort Prop.

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

Scheme lc_set_dexp_rec' := Induction for lc_set_dexp Sort Set.

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

Hint Constructors lc_dexp : core lngen.

Hint Constructors lc_set_dexp : core lngen.

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

Definition body_dexp_wrt_dexp ee1 := forall x1, lc_dexp (open_dexp_wrt_dexp ee1 (de_var_f x1)).

Hint Unfold body_dexp_wrt_dexp : 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_dexp_min_mutual :
(forall ee1, 1 <= size_dexp ee1).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma size_dexp_min :
forall ee1, 1 <= size_dexp ee1.
Proof.
pose proof size_dexp_min_mutual as H; intuition eauto.
Qed.

Hint Resolve size_dexp_min : lngen.

(* begin hide *)

Lemma size_dexp_close_dexp_wrt_dexp_rec_mutual :
(forall ee1 x1 n1,
  size_dexp (close_dexp_wrt_dexp_rec n1 x1 ee1) = size_dexp ee1).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma size_dexp_close_dexp_wrt_dexp_rec :
forall ee1 x1 n1,
  size_dexp (close_dexp_wrt_dexp_rec n1 x1 ee1) = size_dexp ee1.
Proof.
pose proof size_dexp_close_dexp_wrt_dexp_rec_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma size_dexp_close_dexp_wrt_dexp :
forall ee1 x1,
  size_dexp (close_dexp_wrt_dexp x1 ee1) = size_dexp ee1.
Proof.
unfold close_dexp_wrt_dexp; default_simp.
Qed.

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

(* begin hide *)

Lemma size_dexp_open_dexp_wrt_dexp_rec_mutual :
(forall ee1 ee2 n1,
  size_dexp ee1 <= size_dexp (open_dexp_wrt_dexp_rec n1 ee2 ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma size_dexp_open_dexp_wrt_dexp_rec :
forall ee1 ee2 n1,
  size_dexp ee1 <= size_dexp (open_dexp_wrt_dexp_rec n1 ee2 ee1).
Proof.
pose proof size_dexp_open_dexp_wrt_dexp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve size_dexp_open_dexp_wrt_dexp_rec : lngen.

(* end hide *)

Lemma size_dexp_open_dexp_wrt_dexp :
forall ee1 ee2,
  size_dexp ee1 <= size_dexp (open_dexp_wrt_dexp ee1 ee2).
Proof.
unfold open_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve size_dexp_open_dexp_wrt_dexp : lngen.

(* begin hide *)

Lemma size_dexp_open_dexp_wrt_dexp_rec_var_mutual :
(forall ee1 x1 n1,
  size_dexp (open_dexp_wrt_dexp_rec n1 (de_var_f x1) ee1) = size_dexp ee1).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma size_dexp_open_dexp_wrt_dexp_rec_var :
forall ee1 x1 n1,
  size_dexp (open_dexp_wrt_dexp_rec n1 (de_var_f x1) ee1) = size_dexp ee1.
Proof.
pose proof size_dexp_open_dexp_wrt_dexp_rec_var_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma size_dexp_open_dexp_wrt_dexp_var :
forall ee1 x1,
  size_dexp (open_dexp_wrt_dexp ee1 (de_var_f x1)) = size_dexp ee1.
Proof.
unfold open_dexp_wrt_dexp; default_simp.
Qed.

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

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

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

(* begin hide *)

Lemma degree_dexp_wrt_dexp_S_mutual :
(forall n1 ee1,
  degree_dexp_wrt_dexp n1 ee1 ->
  degree_dexp_wrt_dexp (S n1) ee1).
Proof.
apply_mutual_ind degree_dexp_wrt_dexp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma degree_dexp_wrt_dexp_S :
forall n1 ee1,
  degree_dexp_wrt_dexp n1 ee1 ->
  degree_dexp_wrt_dexp (S n1) ee1.
Proof.
pose proof degree_dexp_wrt_dexp_S_mutual as H; intuition eauto.
Qed.

Hint Resolve degree_dexp_wrt_dexp_S : lngen.

Lemma degree_dexp_wrt_dexp_O :
forall n1 ee1,
  degree_dexp_wrt_dexp O ee1 ->
  degree_dexp_wrt_dexp n1 ee1.
Proof.
induction n1; default_simp.
Qed.

Hint Resolve degree_dexp_wrt_dexp_O : lngen.

(* begin hide *)

Lemma degree_dexp_wrt_dexp_close_dexp_wrt_dexp_rec_mutual :
(forall ee1 x1 n1,
  degree_dexp_wrt_dexp n1 ee1 ->
  degree_dexp_wrt_dexp (S n1) (close_dexp_wrt_dexp_rec n1 x1 ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma degree_dexp_wrt_dexp_close_dexp_wrt_dexp_rec :
forall ee1 x1 n1,
  degree_dexp_wrt_dexp n1 ee1 ->
  degree_dexp_wrt_dexp (S n1) (close_dexp_wrt_dexp_rec n1 x1 ee1).
Proof.
pose proof degree_dexp_wrt_dexp_close_dexp_wrt_dexp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve degree_dexp_wrt_dexp_close_dexp_wrt_dexp_rec : lngen.

(* end hide *)

Lemma degree_dexp_wrt_dexp_close_dexp_wrt_dexp :
forall ee1 x1,
  degree_dexp_wrt_dexp 0 ee1 ->
  degree_dexp_wrt_dexp 1 (close_dexp_wrt_dexp x1 ee1).
Proof.
unfold close_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve degree_dexp_wrt_dexp_close_dexp_wrt_dexp : lngen.

(* begin hide *)

Lemma degree_dexp_wrt_dexp_close_dexp_wrt_dexp_rec_inv_mutual :
(forall ee1 x1 n1,
  degree_dexp_wrt_dexp (S n1) (close_dexp_wrt_dexp_rec n1 x1 ee1) ->
  degree_dexp_wrt_dexp n1 ee1).
Proof.
apply_mutual_ind dexp_mutind;
default_simp; eauto with lngen.
Qed.

(* end hide *)

(* begin hide *)

Lemma degree_dexp_wrt_dexp_close_dexp_wrt_dexp_rec_inv :
forall ee1 x1 n1,
  degree_dexp_wrt_dexp (S n1) (close_dexp_wrt_dexp_rec n1 x1 ee1) ->
  degree_dexp_wrt_dexp n1 ee1.
Proof.
pose proof degree_dexp_wrt_dexp_close_dexp_wrt_dexp_rec_inv_mutual as H; intuition eauto.
Qed.

Hint Immediate degree_dexp_wrt_dexp_close_dexp_wrt_dexp_rec_inv : lngen.

(* end hide *)

Lemma degree_dexp_wrt_dexp_close_dexp_wrt_dexp_inv :
forall ee1 x1,
  degree_dexp_wrt_dexp 1 (close_dexp_wrt_dexp x1 ee1) ->
  degree_dexp_wrt_dexp 0 ee1.
Proof.
unfold close_dexp_wrt_dexp; eauto with lngen.
Qed.

Hint Immediate degree_dexp_wrt_dexp_close_dexp_wrt_dexp_inv : lngen.

(* begin hide *)

Lemma degree_dexp_wrt_dexp_open_dexp_wrt_dexp_rec_mutual :
(forall ee1 ee2 n1,
  degree_dexp_wrt_dexp (S n1) ee1 ->
  degree_dexp_wrt_dexp n1 ee2 ->
  degree_dexp_wrt_dexp n1 (open_dexp_wrt_dexp_rec n1 ee2 ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma degree_dexp_wrt_dexp_open_dexp_wrt_dexp_rec :
forall ee1 ee2 n1,
  degree_dexp_wrt_dexp (S n1) ee1 ->
  degree_dexp_wrt_dexp n1 ee2 ->
  degree_dexp_wrt_dexp n1 (open_dexp_wrt_dexp_rec n1 ee2 ee1).
Proof.
pose proof degree_dexp_wrt_dexp_open_dexp_wrt_dexp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve degree_dexp_wrt_dexp_open_dexp_wrt_dexp_rec : lngen.

(* end hide *)

Lemma degree_dexp_wrt_dexp_open_dexp_wrt_dexp :
forall ee1 ee2,
  degree_dexp_wrt_dexp 1 ee1 ->
  degree_dexp_wrt_dexp 0 ee2 ->
  degree_dexp_wrt_dexp 0 (open_dexp_wrt_dexp ee1 ee2).
Proof.
unfold open_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve degree_dexp_wrt_dexp_open_dexp_wrt_dexp : lngen.

(* begin hide *)

Lemma degree_dexp_wrt_dexp_open_dexp_wrt_dexp_rec_inv_mutual :
(forall ee1 ee2 n1,
  degree_dexp_wrt_dexp n1 (open_dexp_wrt_dexp_rec n1 ee2 ee1) ->
  degree_dexp_wrt_dexp (S n1) ee1).
Proof.
apply_mutual_ind dexp_mutind;
default_simp; eauto with lngen.
Qed.

(* end hide *)

(* begin hide *)

Lemma degree_dexp_wrt_dexp_open_dexp_wrt_dexp_rec_inv :
forall ee1 ee2 n1,
  degree_dexp_wrt_dexp n1 (open_dexp_wrt_dexp_rec n1 ee2 ee1) ->
  degree_dexp_wrt_dexp (S n1) ee1.
Proof.
pose proof degree_dexp_wrt_dexp_open_dexp_wrt_dexp_rec_inv_mutual as H; intuition eauto.
Qed.

Hint Immediate degree_dexp_wrt_dexp_open_dexp_wrt_dexp_rec_inv : lngen.

(* end hide *)

Lemma degree_dexp_wrt_dexp_open_dexp_wrt_dexp_inv :
forall ee1 ee2,
  degree_dexp_wrt_dexp 0 (open_dexp_wrt_dexp ee1 ee2) ->
  degree_dexp_wrt_dexp 1 ee1.
Proof.
unfold open_dexp_wrt_dexp; eauto with lngen.
Qed.

Hint Immediate degree_dexp_wrt_dexp_open_dexp_wrt_dexp_inv : lngen.

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

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

(* begin hide *)

Lemma close_dexp_wrt_dexp_rec_inj_mutual :
(forall ee1 ee2 x1 n1,
  close_dexp_wrt_dexp_rec n1 x1 ee1 = close_dexp_wrt_dexp_rec n1 x1 ee2 ->
  ee1 = ee2).
Proof.
apply_mutual_ind dexp_mutind;
intros; match goal with
          | |- _ = ?term => destruct term
        end;
default_simp; eauto with lngen.
Qed.

(* end hide *)

(* begin hide *)

Lemma close_dexp_wrt_dexp_rec_inj :
forall ee1 ee2 x1 n1,
  close_dexp_wrt_dexp_rec n1 x1 ee1 = close_dexp_wrt_dexp_rec n1 x1 ee2 ->
  ee1 = ee2.
Proof.
pose proof close_dexp_wrt_dexp_rec_inj_mutual as H; intuition eauto.
Qed.

Hint Immediate close_dexp_wrt_dexp_rec_inj : lngen.

(* end hide *)

Lemma close_dexp_wrt_dexp_inj :
forall ee1 ee2 x1,
  close_dexp_wrt_dexp x1 ee1 = close_dexp_wrt_dexp x1 ee2 ->
  ee1 = ee2.
Proof.
unfold close_dexp_wrt_dexp; eauto with lngen.
Qed.

Hint Immediate close_dexp_wrt_dexp_inj : lngen.

(* begin hide *)

Lemma close_dexp_wrt_dexp_rec_open_dexp_wrt_dexp_rec_mutual :
(forall ee1 x1 n1,
  x1 `notin` fv_dexp ee1 ->
  close_dexp_wrt_dexp_rec n1 x1 (open_dexp_wrt_dexp_rec n1 (de_var_f x1) ee1) = ee1).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma close_dexp_wrt_dexp_rec_open_dexp_wrt_dexp_rec :
forall ee1 x1 n1,
  x1 `notin` fv_dexp ee1 ->
  close_dexp_wrt_dexp_rec n1 x1 (open_dexp_wrt_dexp_rec n1 (de_var_f x1) ee1) = ee1.
Proof.
pose proof close_dexp_wrt_dexp_rec_open_dexp_wrt_dexp_rec_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma close_dexp_wrt_dexp_open_dexp_wrt_dexp :
forall ee1 x1,
  x1 `notin` fv_dexp ee1 ->
  close_dexp_wrt_dexp x1 (open_dexp_wrt_dexp ee1 (de_var_f x1)) = ee1.
Proof.
unfold close_dexp_wrt_dexp; unfold open_dexp_wrt_dexp; default_simp.
Qed.

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

(* begin hide *)

Lemma open_dexp_wrt_dexp_rec_close_dexp_wrt_dexp_rec_mutual :
(forall ee1 x1 n1,
  open_dexp_wrt_dexp_rec n1 (de_var_f x1) (close_dexp_wrt_dexp_rec n1 x1 ee1) = ee1).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma open_dexp_wrt_dexp_rec_close_dexp_wrt_dexp_rec :
forall ee1 x1 n1,
  open_dexp_wrt_dexp_rec n1 (de_var_f x1) (close_dexp_wrt_dexp_rec n1 x1 ee1) = ee1.
Proof.
pose proof open_dexp_wrt_dexp_rec_close_dexp_wrt_dexp_rec_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma open_dexp_wrt_dexp_close_dexp_wrt_dexp :
forall ee1 x1,
  open_dexp_wrt_dexp (close_dexp_wrt_dexp x1 ee1) (de_var_f x1) = ee1.
Proof.
unfold close_dexp_wrt_dexp; unfold open_dexp_wrt_dexp; default_simp.
Qed.

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

(* begin hide *)

Lemma open_dexp_wrt_dexp_rec_inj_mutual :
(forall ee2 ee1 x1 n1,
  x1 `notin` fv_dexp ee2 ->
  x1 `notin` fv_dexp ee1 ->
  open_dexp_wrt_dexp_rec n1 (de_var_f x1) ee2 = open_dexp_wrt_dexp_rec n1 (de_var_f x1) ee1 ->
  ee2 = ee1).
Proof.
apply_mutual_ind dexp_mutind;
intros; match goal with
          | |- _ = ?term => destruct term
        end;
default_simp; eauto with lngen.
Qed.

(* end hide *)

(* begin hide *)

Lemma open_dexp_wrt_dexp_rec_inj :
forall ee2 ee1 x1 n1,
  x1 `notin` fv_dexp ee2 ->
  x1 `notin` fv_dexp ee1 ->
  open_dexp_wrt_dexp_rec n1 (de_var_f x1) ee2 = open_dexp_wrt_dexp_rec n1 (de_var_f x1) ee1 ->
  ee2 = ee1.
Proof.
pose proof open_dexp_wrt_dexp_rec_inj_mutual as H; intuition eauto.
Qed.

Hint Immediate open_dexp_wrt_dexp_rec_inj : lngen.

(* end hide *)

Lemma open_dexp_wrt_dexp_inj :
forall ee2 ee1 x1,
  x1 `notin` fv_dexp ee2 ->
  x1 `notin` fv_dexp ee1 ->
  open_dexp_wrt_dexp ee2 (de_var_f x1) = open_dexp_wrt_dexp ee1 (de_var_f x1) ->
  ee2 = ee1.
Proof.
unfold open_dexp_wrt_dexp; eauto with lngen.
Qed.

Hint Immediate open_dexp_wrt_dexp_inj : lngen.

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

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

(* begin hide *)

Lemma degree_dexp_wrt_dexp_of_lc_dexp_mutual :
(forall ee1,
  lc_dexp ee1 ->
  degree_dexp_wrt_dexp 0 ee1).
Proof.
apply_mutual_ind lc_dexp_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_dexp_wrt_dexp_of_lc_dexp :
forall ee1,
  lc_dexp ee1 ->
  degree_dexp_wrt_dexp 0 ee1.
Proof.
pose proof degree_dexp_wrt_dexp_of_lc_dexp_mutual as H; intuition eauto.
Qed.

Hint Resolve degree_dexp_wrt_dexp_of_lc_dexp : lngen.

(* begin hide *)

Lemma lc_dexp_of_degree_size_mutual :
forall i1,
(forall ee1,
  size_dexp ee1 = i1 ->
  degree_dexp_wrt_dexp 0 ee1 ->
  lc_dexp ee1).
Proof.
intros i1; pattern i1; apply lt_wf_rec;
clear i1; intros i1 H1;
apply_mutual_ind dexp_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_dexp_of_degree :
forall ee1,
  degree_dexp_wrt_dexp 0 ee1 ->
  lc_dexp ee1.
Proof.
intros ee1; intros;
pose proof (lc_dexp_of_degree_size_mutual (size_dexp ee1));
intuition eauto.
Qed.

Hint Resolve lc_dexp_of_degree : lngen.

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

Lemma lc_de_abs_exists :
forall x1 ee1,
  lc_dexp (open_dexp_wrt_dexp ee1 (de_var_f x1)) ->
  lc_dexp (de_abs ee1).
Proof.
intros; dexp_lc_exists_tac; eauto with lngen.
Qed.

Lemma lc_de_fixpoint_exists :
forall x1 ee1,
  lc_dexp (open_dexp_wrt_dexp ee1 (de_var_f x1)) ->
  lc_dexp (de_fixpoint ee1).
Proof.
intros; dexp_lc_exists_tac; eauto with lngen.
Qed.

Hint Extern 1 (lc_dexp (de_abs _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_de_abs_exists x1) : core.

Hint Extern 1 (lc_dexp (de_fixpoint _)) =>
  let x1 := fresh in
  pick_fresh x1;
  apply (lc_de_fixpoint_exists x1) : core.

Lemma lc_body_dexp_wrt_dexp :
forall ee1 ee2,
  body_dexp_wrt_dexp ee1 ->
  lc_dexp ee2 ->
  lc_dexp (open_dexp_wrt_dexp ee1 ee2).
Proof.
unfold body_dexp_wrt_dexp;
default_simp;
let x1 := fresh "x" in
pick_fresh x1;
specialize_all x1;
dexp_lc_exists_tac;
eauto with lngen.
Qed.

Hint Resolve lc_body_dexp_wrt_dexp : lngen.

Lemma lc_body_de_abs_1 :
forall ee1,
  lc_dexp (de_abs ee1) ->
  body_dexp_wrt_dexp ee1.
Proof.
default_simp.
Qed.

Hint Resolve lc_body_de_abs_1 : lngen.

Lemma lc_body_de_fixpoint_1 :
forall ee1,
  lc_dexp (de_fixpoint ee1) ->
  body_dexp_wrt_dexp ee1.
Proof.
default_simp.
Qed.

Hint Resolve lc_body_de_fixpoint_1 : lngen.

(* begin hide *)

Lemma lc_dexp_unique_mutual :
(forall ee1 (proof2 proof3 : lc_dexp ee1), proof2 = proof3).
Proof.
apply_mutual_ind lc_dexp_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_dexp_unique :
forall ee1 (proof2 proof3 : lc_dexp ee1), proof2 = proof3.
Proof.
pose proof lc_dexp_unique_mutual as H; intuition eauto.
Qed.

Hint Resolve lc_dexp_unique : lngen.

(* begin hide *)

Lemma lc_dexp_of_lc_set_dexp_mutual :
(forall ee1, lc_set_dexp ee1 -> lc_dexp ee1).
Proof.
apply_mutual_ind lc_set_dexp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma lc_dexp_of_lc_set_dexp :
forall ee1, lc_set_dexp ee1 -> lc_dexp ee1.
Proof.
pose proof lc_dexp_of_lc_set_dexp_mutual as H; intuition eauto.
Qed.

Hint Resolve lc_dexp_of_lc_set_dexp : lngen.

(* begin hide *)

Lemma lc_set_dexp_of_lc_dexp_size_mutual :
forall i1,
(forall ee1,
  size_dexp ee1 = i1 ->
  lc_dexp ee1 ->
  lc_set_dexp ee1).
Proof.
intros i1; pattern i1; apply lt_wf_rec;
clear i1; intros i1 H1;
apply_mutual_ind dexp_mutrec;
default_simp;
try solve [assert False by default_simp; tauto];
(* non-trivial cases *)
constructor; default_simp;
try first [apply lc_set_dexp_of_lc_dexp];
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_dexp_of_lc_dexp :
forall ee1,
  lc_dexp ee1 ->
  lc_set_dexp ee1.
Proof.
intros ee1; intros;
pose proof (lc_set_dexp_of_lc_dexp_size_mutual (size_dexp ee1));
intuition eauto.
Qed.

Hint Resolve lc_set_dexp_of_lc_dexp : lngen.

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

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

(* begin hide *)

Lemma close_dexp_wrt_dexp_rec_degree_dexp_wrt_dexp_mutual :
(forall ee1 x1 n1,
  degree_dexp_wrt_dexp n1 ee1 ->
  x1 `notin` fv_dexp ee1 ->
  close_dexp_wrt_dexp_rec n1 x1 ee1 = ee1).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma close_dexp_wrt_dexp_rec_degree_dexp_wrt_dexp :
forall ee1 x1 n1,
  degree_dexp_wrt_dexp n1 ee1 ->
  x1 `notin` fv_dexp ee1 ->
  close_dexp_wrt_dexp_rec n1 x1 ee1 = ee1.
Proof.
pose proof close_dexp_wrt_dexp_rec_degree_dexp_wrt_dexp_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma close_dexp_wrt_dexp_lc_dexp :
forall ee1 x1,
  lc_dexp ee1 ->
  x1 `notin` fv_dexp ee1 ->
  close_dexp_wrt_dexp x1 ee1 = ee1.
Proof.
unfold close_dexp_wrt_dexp; default_simp.
Qed.

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

(* begin hide *)

Lemma open_dexp_wrt_dexp_rec_degree_dexp_wrt_dexp_mutual :
(forall ee2 ee1 n1,
  degree_dexp_wrt_dexp n1 ee2 ->
  open_dexp_wrt_dexp_rec n1 ee1 ee2 = ee2).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma open_dexp_wrt_dexp_rec_degree_dexp_wrt_dexp :
forall ee2 ee1 n1,
  degree_dexp_wrt_dexp n1 ee2 ->
  open_dexp_wrt_dexp_rec n1 ee1 ee2 = ee2.
Proof.
pose proof open_dexp_wrt_dexp_rec_degree_dexp_wrt_dexp_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma open_dexp_wrt_dexp_lc_dexp :
forall ee2 ee1,
  lc_dexp ee2 ->
  open_dexp_wrt_dexp ee2 ee1 = ee2.
Proof.
unfold open_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve open_dexp_wrt_dexp_lc_dexp : lngen.
Hint Rewrite open_dexp_wrt_dexp_lc_dexp 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_dexp_close_dexp_wrt_dexp_rec_mutual :
(forall ee1 x1 n1,
  fv_dexp (close_dexp_wrt_dexp_rec n1 x1 ee1) [=] remove x1 (fv_dexp ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

(* begin hide *)

Lemma fv_dexp_close_dexp_wrt_dexp_rec :
forall ee1 x1 n1,
  fv_dexp (close_dexp_wrt_dexp_rec n1 x1 ee1) [=] remove x1 (fv_dexp ee1).
Proof.
pose proof fv_dexp_close_dexp_wrt_dexp_rec_mutual as H; intuition eauto.
Qed.

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

(* end hide *)

Lemma fv_dexp_close_dexp_wrt_dexp :
forall ee1 x1,
  fv_dexp (close_dexp_wrt_dexp x1 ee1) [=] remove x1 (fv_dexp ee1).
Proof.
unfold close_dexp_wrt_dexp; default_simp.
Qed.

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

(* begin hide *)

Lemma fv_dexp_open_dexp_wrt_dexp_rec_lower_mutual :
(forall ee1 ee2 n1,
  fv_dexp ee1 [<=] fv_dexp (open_dexp_wrt_dexp_rec n1 ee2 ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

(* begin hide *)

Lemma fv_dexp_open_dexp_wrt_dexp_rec_lower :
forall ee1 ee2 n1,
  fv_dexp ee1 [<=] fv_dexp (open_dexp_wrt_dexp_rec n1 ee2 ee1).
Proof.
pose proof fv_dexp_open_dexp_wrt_dexp_rec_lower_mutual as H; intuition eauto.
Qed.

Hint Resolve fv_dexp_open_dexp_wrt_dexp_rec_lower : lngen.

(* end hide *)

Lemma fv_dexp_open_dexp_wrt_dexp_lower :
forall ee1 ee2,
  fv_dexp ee1 [<=] fv_dexp (open_dexp_wrt_dexp ee1 ee2).
Proof.
unfold open_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve fv_dexp_open_dexp_wrt_dexp_lower : lngen.

(* begin hide *)

Lemma fv_dexp_open_dexp_wrt_dexp_rec_upper_mutual :
(forall ee1 ee2 n1,
  fv_dexp (open_dexp_wrt_dexp_rec n1 ee2 ee1) [<=] fv_dexp ee2 `union` fv_dexp ee1).
Proof.
apply_mutual_ind dexp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

(* begin hide *)

Lemma fv_dexp_open_dexp_wrt_dexp_rec_upper :
forall ee1 ee2 n1,
  fv_dexp (open_dexp_wrt_dexp_rec n1 ee2 ee1) [<=] fv_dexp ee2 `union` fv_dexp ee1.
Proof.
pose proof fv_dexp_open_dexp_wrt_dexp_rec_upper_mutual as H; intuition eauto.
Qed.

Hint Resolve fv_dexp_open_dexp_wrt_dexp_rec_upper : lngen.

(* end hide *)

Lemma fv_dexp_open_dexp_wrt_dexp_upper :
forall ee1 ee2,
  fv_dexp (open_dexp_wrt_dexp ee1 ee2) [<=] fv_dexp ee2 `union` fv_dexp ee1.
Proof.
unfold open_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve fv_dexp_open_dexp_wrt_dexp_upper : lngen.

(* begin hide *)

Lemma fv_dexp_subst_dexp_fresh_mutual :
(forall ee1 ee2 x1,
  x1 `notin` fv_dexp ee1 ->
  fv_dexp (subst_dexp ee2 x1 ee1) [=] fv_dexp ee1).
Proof.
apply_mutual_ind dexp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

Lemma fv_dexp_subst_dexp_fresh :
forall ee1 ee2 x1,
  x1 `notin` fv_dexp ee1 ->
  fv_dexp (subst_dexp ee2 x1 ee1) [=] fv_dexp ee1.
Proof.
pose proof fv_dexp_subst_dexp_fresh_mutual as H; intuition eauto.
Qed.

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

(* begin hide *)

Lemma fv_dexp_subst_dexp_lower_mutual :
(forall ee1 ee2 x1,
  remove x1 (fv_dexp ee1) [<=] fv_dexp (subst_dexp ee2 x1 ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

Lemma fv_dexp_subst_dexp_lower :
forall ee1 ee2 x1,
  remove x1 (fv_dexp ee1) [<=] fv_dexp (subst_dexp ee2 x1 ee1).
Proof.
pose proof fv_dexp_subst_dexp_lower_mutual as H; intuition eauto.
Qed.

Hint Resolve fv_dexp_subst_dexp_lower : lngen.

(* begin hide *)

Lemma fv_dexp_subst_dexp_notin_mutual :
(forall ee1 ee2 x1 x2,
  x2 `notin` fv_dexp ee1 ->
  x2 `notin` fv_dexp ee2 ->
  x2 `notin` fv_dexp (subst_dexp ee2 x1 ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

Lemma fv_dexp_subst_dexp_notin :
forall ee1 ee2 x1 x2,
  x2 `notin` fv_dexp ee1 ->
  x2 `notin` fv_dexp ee2 ->
  x2 `notin` fv_dexp (subst_dexp ee2 x1 ee1).
Proof.
pose proof fv_dexp_subst_dexp_notin_mutual as H; intuition eauto.
Qed.

Hint Resolve fv_dexp_subst_dexp_notin : lngen.

(* begin hide *)

Lemma fv_dexp_subst_dexp_upper_mutual :
(forall ee1 ee2 x1,
  fv_dexp (subst_dexp ee2 x1 ee1) [<=] fv_dexp ee2 `union` remove x1 (fv_dexp ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp; fsetdec.
Qed.

(* end hide *)

Lemma fv_dexp_subst_dexp_upper :
forall ee1 ee2 x1,
  fv_dexp (subst_dexp ee2 x1 ee1) [<=] fv_dexp ee2 `union` remove x1 (fv_dexp ee1).
Proof.
pose proof fv_dexp_subst_dexp_upper_mutual as H; intuition eauto.
Qed.

Hint Resolve fv_dexp_subst_dexp_upper : lngen.

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

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

(* begin hide *)

Lemma subst_dexp_close_dexp_wrt_dexp_rec_mutual :
(forall ee2 ee1 x1 x2 n1,
  degree_dexp_wrt_dexp n1 ee1 ->
  x1 <> x2 ->
  x2 `notin` fv_dexp ee1 ->
  subst_dexp ee1 x1 (close_dexp_wrt_dexp_rec n1 x2 ee2) = close_dexp_wrt_dexp_rec n1 x2 (subst_dexp ee1 x1 ee2)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_dexp_close_dexp_wrt_dexp_rec :
forall ee2 ee1 x1 x2 n1,
  degree_dexp_wrt_dexp n1 ee1 ->
  x1 <> x2 ->
  x2 `notin` fv_dexp ee1 ->
  subst_dexp ee1 x1 (close_dexp_wrt_dexp_rec n1 x2 ee2) = close_dexp_wrt_dexp_rec n1 x2 (subst_dexp ee1 x1 ee2).
Proof.
pose proof subst_dexp_close_dexp_wrt_dexp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_dexp_close_dexp_wrt_dexp_rec : lngen.

Lemma subst_dexp_close_dexp_wrt_dexp :
forall ee2 ee1 x1 x2,
  lc_dexp ee1 ->  x1 <> x2 ->
  x2 `notin` fv_dexp ee1 ->
  subst_dexp ee1 x1 (close_dexp_wrt_dexp x2 ee2) = close_dexp_wrt_dexp x2 (subst_dexp ee1 x1 ee2).
Proof.
unfold close_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve subst_dexp_close_dexp_wrt_dexp : lngen.

(* begin hide *)

Lemma subst_dexp_degree_dexp_wrt_dexp_mutual :
(forall ee1 ee2 x1 n1,
  degree_dexp_wrt_dexp n1 ee1 ->
  degree_dexp_wrt_dexp n1 ee2 ->
  degree_dexp_wrt_dexp n1 (subst_dexp ee2 x1 ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_dexp_degree_dexp_wrt_dexp :
forall ee1 ee2 x1 n1,
  degree_dexp_wrt_dexp n1 ee1 ->
  degree_dexp_wrt_dexp n1 ee2 ->
  degree_dexp_wrt_dexp n1 (subst_dexp ee2 x1 ee1).
Proof.
pose proof subst_dexp_degree_dexp_wrt_dexp_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_dexp_degree_dexp_wrt_dexp : lngen.

(* begin hide *)

Lemma subst_dexp_fresh_eq_mutual :
(forall ee2 ee1 x1,
  x1 `notin` fv_dexp ee2 ->
  subst_dexp ee1 x1 ee2 = ee2).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_dexp_fresh_eq :
forall ee2 ee1 x1,
  x1 `notin` fv_dexp ee2 ->
  subst_dexp ee1 x1 ee2 = ee2.
Proof.
pose proof subst_dexp_fresh_eq_mutual as H; intuition eauto.
Qed.

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

(* begin hide *)

Lemma subst_dexp_fresh_same_mutual :
(forall ee2 ee1 x1,
  x1 `notin` fv_dexp ee1 ->
  x1 `notin` fv_dexp (subst_dexp ee1 x1 ee2)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_dexp_fresh_same :
forall ee2 ee1 x1,
  x1 `notin` fv_dexp ee1 ->
  x1 `notin` fv_dexp (subst_dexp ee1 x1 ee2).
Proof.
pose proof subst_dexp_fresh_same_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_dexp_fresh_same : lngen.

(* begin hide *)

Lemma subst_dexp_fresh_mutual :
(forall ee2 ee1 x1 x2,
  x1 `notin` fv_dexp ee2 ->
  x1 `notin` fv_dexp ee1 ->
  x1 `notin` fv_dexp (subst_dexp ee1 x2 ee2)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_dexp_fresh :
forall ee2 ee1 x1 x2,
  x1 `notin` fv_dexp ee2 ->
  x1 `notin` fv_dexp ee1 ->
  x1 `notin` fv_dexp (subst_dexp ee1 x2 ee2).
Proof.
pose proof subst_dexp_fresh_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_dexp_fresh : lngen.

Lemma subst_dexp_lc_dexp :
forall ee1 ee2 x1,
  lc_dexp ee1 ->
  lc_dexp ee2 ->
  lc_dexp (subst_dexp ee2 x1 ee1).
Proof.
default_simp.
Qed.

Hint Resolve subst_dexp_lc_dexp : lngen.

(* begin hide *)

Lemma subst_dexp_open_dexp_wrt_dexp_rec_mutual :
(forall ee3 ee1 ee2 x1 n1,
  lc_dexp ee1 ->
  subst_dexp ee1 x1 (open_dexp_wrt_dexp_rec n1 ee2 ee3) = open_dexp_wrt_dexp_rec n1 (subst_dexp ee1 x1 ee2) (subst_dexp ee1 x1 ee3)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma subst_dexp_open_dexp_wrt_dexp_rec :
forall ee3 ee1 ee2 x1 n1,
  lc_dexp ee1 ->
  subst_dexp ee1 x1 (open_dexp_wrt_dexp_rec n1 ee2 ee3) = open_dexp_wrt_dexp_rec n1 (subst_dexp ee1 x1 ee2) (subst_dexp ee1 x1 ee3).
Proof.
pose proof subst_dexp_open_dexp_wrt_dexp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_dexp_open_dexp_wrt_dexp_rec : lngen.

(* end hide *)

Lemma subst_dexp_open_dexp_wrt_dexp :
forall ee3 ee1 ee2 x1,
  lc_dexp ee1 ->
  subst_dexp ee1 x1 (open_dexp_wrt_dexp ee3 ee2) = open_dexp_wrt_dexp (subst_dexp ee1 x1 ee3) (subst_dexp ee1 x1 ee2).
Proof.
unfold open_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve subst_dexp_open_dexp_wrt_dexp : lngen.

Lemma subst_dexp_open_dexp_wrt_dexp_var :
forall ee2 ee1 x1 x2,
  x1 <> x2 ->
  lc_dexp ee1 ->
  open_dexp_wrt_dexp (subst_dexp ee1 x1 ee2) (de_var_f x2) = subst_dexp ee1 x1 (open_dexp_wrt_dexp ee2 (de_var_f x2)).
Proof.
intros; rewrite subst_dexp_open_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve subst_dexp_open_dexp_wrt_dexp_var : lngen.

(* begin hide *)

Lemma subst_dexp_spec_rec_mutual :
(forall ee1 ee2 x1 n1,
  subst_dexp ee2 x1 ee1 = open_dexp_wrt_dexp_rec n1 ee2 (close_dexp_wrt_dexp_rec n1 x1 ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma subst_dexp_spec_rec :
forall ee1 ee2 x1 n1,
  subst_dexp ee2 x1 ee1 = open_dexp_wrt_dexp_rec n1 ee2 (close_dexp_wrt_dexp_rec n1 x1 ee1).
Proof.
pose proof subst_dexp_spec_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_dexp_spec_rec : lngen.

(* end hide *)

Lemma subst_dexp_spec :
forall ee1 ee2 x1,
  subst_dexp ee2 x1 ee1 = open_dexp_wrt_dexp (close_dexp_wrt_dexp x1 ee1) ee2.
Proof.
unfold close_dexp_wrt_dexp; unfold open_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve subst_dexp_spec : lngen.

(* begin hide *)

Lemma subst_dexp_subst_dexp_mutual :
(forall ee1 ee2 ee3 x2 x1,
  x2 `notin` fv_dexp ee2 ->
  x2 <> x1 ->
  subst_dexp ee2 x1 (subst_dexp ee3 x2 ee1) = subst_dexp (subst_dexp ee2 x1 ee3) x2 (subst_dexp ee2 x1 ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_dexp_subst_dexp :
forall ee1 ee2 ee3 x2 x1,
  x2 `notin` fv_dexp ee2 ->
  x2 <> x1 ->
  subst_dexp ee2 x1 (subst_dexp ee3 x2 ee1) = subst_dexp (subst_dexp ee2 x1 ee3) x2 (subst_dexp ee2 x1 ee1).
Proof.
pose proof subst_dexp_subst_dexp_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_dexp_subst_dexp : lngen.

(* begin hide *)

Lemma subst_dexp_close_dexp_wrt_dexp_rec_open_dexp_wrt_dexp_rec_mutual :
(forall ee2 ee1 x1 x2 n1,
  x2 `notin` fv_dexp ee2 ->
  x2 `notin` fv_dexp ee1 ->
  x2 <> x1 ->
  degree_dexp_wrt_dexp n1 ee1 ->
  subst_dexp ee1 x1 ee2 = close_dexp_wrt_dexp_rec n1 x2 (subst_dexp ee1 x1 (open_dexp_wrt_dexp_rec n1 (de_var_f x2) ee2))).
Proof.
apply_mutual_ind dexp_mutrec;
default_simp.
Qed.

(* end hide *)

(* begin hide *)

Lemma subst_dexp_close_dexp_wrt_dexp_rec_open_dexp_wrt_dexp_rec :
forall ee2 ee1 x1 x2 n1,
  x2 `notin` fv_dexp ee2 ->
  x2 `notin` fv_dexp ee1 ->
  x2 <> x1 ->
  degree_dexp_wrt_dexp n1 ee1 ->
  subst_dexp ee1 x1 ee2 = close_dexp_wrt_dexp_rec n1 x2 (subst_dexp ee1 x1 (open_dexp_wrt_dexp_rec n1 (de_var_f x2) ee2)).
Proof.
pose proof subst_dexp_close_dexp_wrt_dexp_rec_open_dexp_wrt_dexp_rec_mutual as H; intuition eauto.
Qed.

Hint Resolve subst_dexp_close_dexp_wrt_dexp_rec_open_dexp_wrt_dexp_rec : lngen.

(* end hide *)

Lemma subst_dexp_close_dexp_wrt_dexp_open_dexp_wrt_dexp :
forall ee2 ee1 x1 x2,
  x2 `notin` fv_dexp ee2 ->
  x2 `notin` fv_dexp ee1 ->
  x2 <> x1 ->
  lc_dexp ee1 ->
  subst_dexp ee1 x1 ee2 = close_dexp_wrt_dexp x2 (subst_dexp ee1 x1 (open_dexp_wrt_dexp ee2 (de_var_f x2))).
Proof.
unfold close_dexp_wrt_dexp; unfold open_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve subst_dexp_close_dexp_wrt_dexp_open_dexp_wrt_dexp : lngen.

Lemma subst_dexp_de_abs :
forall x2 ee2 ee1 x1,
  lc_dexp ee1 ->
  x2 `notin` fv_dexp ee1 `union` fv_dexp ee2 `union` singleton x1 ->
  subst_dexp ee1 x1 (de_abs ee2) = de_abs (close_dexp_wrt_dexp x2 (subst_dexp ee1 x1 (open_dexp_wrt_dexp ee2 (de_var_f x2)))).
Proof.
default_simp.
Qed.

Hint Resolve subst_dexp_de_abs : lngen.

Lemma subst_dexp_de_fixpoint :
forall x2 ee2 ee1 x1,
  lc_dexp ee1 ->
  x2 `notin` fv_dexp ee1 `union` fv_dexp ee2 `union` singleton x1 ->
  subst_dexp ee1 x1 (de_fixpoint ee2) = de_fixpoint (close_dexp_wrt_dexp x2 (subst_dexp ee1 x1 (open_dexp_wrt_dexp ee2 (de_var_f x2)))).
Proof.
default_simp.
Qed.

Hint Resolve subst_dexp_de_fixpoint : lngen.

(* begin hide *)

Lemma subst_dexp_intro_rec_mutual :
(forall ee1 x1 ee2 n1,
  x1 `notin` fv_dexp ee1 ->
  open_dexp_wrt_dexp_rec n1 ee2 ee1 = subst_dexp ee2 x1 (open_dexp_wrt_dexp_rec n1 (de_var_f x1) ee1)).
Proof.
apply_mutual_ind dexp_mutind;
default_simp.
Qed.

(* end hide *)

Lemma subst_dexp_intro_rec :
forall ee1 x1 ee2 n1,
  x1 `notin` fv_dexp ee1 ->
  open_dexp_wrt_dexp_rec n1 ee2 ee1 = subst_dexp ee2 x1 (open_dexp_wrt_dexp_rec n1 (de_var_f x1) ee1).
Proof.
pose proof subst_dexp_intro_rec_mutual as H; intuition eauto.
Qed.

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

Lemma subst_dexp_intro :
forall x1 ee1 ee2,
  x1 `notin` fv_dexp ee1 ->
  open_dexp_wrt_dexp ee1 ee2 = subst_dexp ee2 x1 (open_dexp_wrt_dexp ee1 (de_var_f x1)).
Proof.
unfold open_dexp_wrt_dexp; default_simp.
Qed.

Hint Resolve subst_dexp_intro : lngen.

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

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