(**
 ============================================================================
 Project     : Nominal A, AC and C Unification
 File        : Substs.v
 Authors     : Washington Lu\'is R. de Carvalho Segundo and
               Mauricio Ayala Rinc\'on
               Universidade de Bras\'ilia (UnB) - Brazil
               Group of Theory of Computation

 Description : This file contains all the definitions and lemmas regarding
               substitutions of variables by terms.

 Last Modified On: Sep 17, 2017.
 ============================================================================
*)

Require Export Problems.
Require Import Max GenericMinMax.

(** Definitions *)

(** look_up searches a variable in the domain of a substitution and
 replaces this variable by the term in its correspondent image *)

Fixpoint look_up (X : Var) (S : Subst) {struct S}: term :=
match S with
 | []         => []|.X
 | (Y,t)::S0  => if var_eqdec Y X then t else (look_up X S0)
end.

(** subs extends the application of look_up of any term of the grammar *)

Fixpoint subs (t: term) (S : Subst) {struct t} : term :=
 match  t with
      | <<>>       => <<>>
      | % a        => % a
      | [a]^t1     => [a]^(subs t1 S)
      | <|t1,t2|>  => <|(subs t1 S),(subs t2 S)|>
      | Fc E n t1    => Fc E n (subs t1 S)
      | p|.X        => p @ (look_up X S)
 end.
Notation "t |^ S" := (subs t S) (at level 67).

Definition In_dom (X : Var) (S : Subst) :=  ([]|.X)|^S <> []|.X .
Notation "X € S" := (In_dom X S) (at level 67).

Lemma In_dom_dec : forall X S, {X € S} + {~ X € S}.
Proof.
 intros. case (term_eqdec (([]|.X)|^S) ([]|.X)); intros; unfold In_dom.
 right~. left~.
Qed.

(** alist_rec allows the construction of a fuction of composition of substitutions *)

Fixpoint alist_rec (S1 S2: Subst)
                   (F: Var -> term -> Subst -> Subst -> Subst) : Subst :=
 match S1 with
    | []          =>  S2
    | (X,t)::S0  =>  F X t S2 (alist_rec S0 S2 F)
 end.

Definition F_rec (S1: Subst) (X:Var) (t:term) (S2 S3: Subst) := (X,t|^S1)::S3.

(** Subst_comp operates the substitution composition *)

Definition Subst_comp (S1 S2: Subst) := alist_rec S1 S2 (F_rec S2).
Notation "S1 © S2" := (Subst_comp S1 S2) (at level 67).

(** subs_fresh_constraints applies a substitution to a freshness context *)

Fixpoint subs_fresh_constraints (C : Context) (S : Subst) : Problem :=
  match C with
    | [] => []
    | (a,X)::C0 => if (In_dom_dec X S) then
                      set_add Constraint_eqdec (a#?(([]|.X)|^S))
                      (subs_fresh_constraints C0 S)
                    else
                      (subs_fresh_constraints C0 S)
  end.

Notation "C /? S" := (subs_fresh_constraints C S) (at level 67).

(** subs_Constraint applies a subtitution to a atomic problem *)

Definition subs_Constraint (u : Constraint) (S : Subst) : Constraint :=
  match u with
    | a#?t => a#?(t|^S)
    | s~?t => s|^S~?(t|^S)
  end.

(** subs_Problem applies a subtitution to a generic problem *)

Fixpoint subs_Problem (P : Problem) (S : Subst) : Problem :=
  match P with
    | [] => []
    | (a#?t)::P0 => (a#?(t|^S))::(subs_Problem P0 S)
    | (s~?t)::P0 => ((s|^S)~?(t|^S))::(subs_Problem P0 S)
  end.

Notation "P |^^ S" := (subs_Problem P S) (at level 67).

(** fresh_env is a property over two freshness contexts and a substitution *)

Definition fresh_env (C C' : Context) (S : Subst) :=
  forall a X, set_In (a, X) C -> C' |- a # (([]|.X)|^S) .

(** subs_equiv is a equivalence property between two substitutions under a freshness context  *)

Definition subs_equiv (C: Context) (E : Context -> term -> term -> Prop) (S S' : Subst) :=
forall X, (X € S) \/ (X € S') -> E C (([]|.X)|^S) (([]|.X)|^S').

(** subst_dom_vars extracts the variables that contains the substitution domain *)

Fixpoint subst_dom_vars (S : Subst) : set Var :=
  match S with
    | [] => []
    | (X,t)::S0 => set_add var_eqdec X (subst_dom_vars S0)
  end.

(** dom_rec_aux is a auxiliar function to build the correct domain of a substitution *)

Fixpoint dom_rec_aux (S : Subst) (St : set Var) : set Var :=
  match St with
    | [] => []
    | X::St0 => if (term_eqdec (([]|.X)|^S) ([]|.X)) then
                   (dom_rec_aux S St0) else
                   (set_add var_eqdec X (dom_rec_aux S St0))
  end.

(** dom_rec is the recursive function that gives the domain of a substitution *)

Definition dom_rec (S : Subst) := dom_rec_aux S (subst_dom_vars S).

(** im_rec_aux is a auxiliar function to build the correct image of a substitution *)

Fixpoint im_rec_aux (S : Subst) (St : set Var) : set term :=
  match St with
    | [] => []
    | X::St0 => ([]|.X|^S)::(im_rec_aux S St0)
  end.

(** im_rec is the recursive function that gives the image of a substitution *)

Definition im_rec (S : Subst) := im_rec_aux S (dom_rec S).

(** terms_set_vars gives the set of variables that occur in a set of terms *)

Fixpoint terms_set_vars (T: set term) : set Var :=
  match T with
    | [] => []
    | s::T0 => set_union var_eqdec (term_vars s) (terms_set_vars T0)
  end.

(** im_vars gives the set of variables that occur in the image of a substiturion *)

Definition im_vars (S : Subst) := terms_set_vars (im_rec S).

(** set_subst applies a substitution in a set of terms *)

Fixpoint set_subst (St : set term) (S : Subst) : set term :=
  match St with
    | [] => []
    | s::St0 => set_add term_eqdec (s|^S) (set_subst St0 S)
  end.

(** Lemmas *)

(** Basic results about substitutions *)

(** Substitutions and permutations commutes. *)

Lemma subst_perm_comm : forall S pi t, (pi @ t)|^S = pi @ (t|^S).
Proof.
  intros; induction t;
  autorewrite with perm; simpl subs;
  autorewrite with perm; auto.
  rewrite IHt; trivial.
  rewrite IHt1; rewrite IHt2; trivial.
  rewrite IHt; trivial.
  rewrite perm_comp; trivial.
Qed.

(** The empty substitution has no action over a term. *)

Lemma subst_id : forall t, t|^([]) = t.
Proof.
  intros. induction t; auto.
  simpl. rewrite IHt; trivial.
  simpl. rewrite IHt1; rewrite IHt2; trivial.
  simpl. rewrite IHt; trivial.
Qed.

(** The singleton substitution |[(X,t)]| applied over pi|.X
 will result in pi @ t. *)

Lemma subst_var_eq : forall X pi t, (pi|.X)|^(|[(X,t)]|) = pi @ t.
Proof.
  intros. simpl. case (var_eqdec X X); intro H; trivial. false.
Qed.

(** A suspension will not be
    affect the action of a substitution if and only if
    it is not in its domain. *)

Lemma not_In_dom : forall X S pi, ~ X € S -> (pi|.X)|^S = pi|.X.
Proof.
  intros. replace (pi|.X) with (pi @ ([]|.X)).
  rewrite subst_perm_comm. rewrite <- perm_term_invariance.
  unfold In_dom. case (term_eqdec ((([])|.X) |^ S) (([])|.X));
    intro H0; try contradiction; trivial.
  autorewrite with perm. simpl; trivial.
Qed.

Lemma not_In_dom_iff : forall X S pi, ~ X € S <-> (pi|.X)|^S = pi|.X.
Proof.
  intros. split~; intro. apply not_In_dom; trivial.
  intro H0. unfold In_dom in H0. apply H0.
  apply perm_term_invariance with (pi:=pi).
  rewrite <- subst_perm_comm.
  autorewrite with perm. simpl; trivial.
Qed.

(** A recursive definition for the domain of a substitution. *)

Lemma dom_rec_aux_to_In_dom : forall X S St, set_In X (dom_rec_aux S St) -> X € S.
Proof.
  intros. unfold In_dom. simpl. autorewrite with perm.
  induction St; simpl in H; try contradiction.
  gen H. autorewrite with perm.
  case (term_eqdec (look_up a S) (([])|.a)); intros H0 H.
  apply IHSt; trivial. apply set_add_elim in H.
  destruct H. rewrite H; trivial. apply IHSt; trivial.
Qed.

Lemma In_dom_to_dom_rec_aux : forall X S St,
                                X € S -> set_In X St -> set_In X (dom_rec_aux S St).
Proof.
  intros. unfold In_dom in H.
  simpl in H. autorewrite with perm in H.
  induction St; simpl in H0|-*; try contradiction.
  autorewrite with perm. case (term_eqdec (look_up a S) (([])|.a)); intro H1.
  destruct H0. rewrite H0 in H1. contradiction.
  apply IHSt; trivial. destruct H0.
  rewrite H0. apply set_add_intro2; trivial.
  apply set_add_intro1. apply IHSt; trivial.
Qed.

Lemma In_dom_to_subst_dom_vars : forall X S,
                                 X € S -> set_In X (subst_dom_vars S).
Proof.
  intros. unfold In_dom in H.
  simpl in H. autorewrite with perm in H.
  induction S; simpl in *|-*. apply H; trivial.
  destruct a. gen H. case (var_eqdec v X); intros H0 H.
  rewrite H0. apply set_add_intro2; trivial.
  apply set_add_intro1. apply IHS; trivial.
Qed.

Lemma In_dom_eq_dom_rec : forall X S, X € S <-> set_In X (dom_rec S).
Proof.
  intros. split~; intro H.
  apply In_dom_to_dom_rec_aux; trivial.
  apply In_dom_to_subst_dom_vars; trivial.
  apply dom_rec_aux_to_In_dom in H; trivial.
Qed.

(** If the domain of a substitution is empty than it is
    the identity. *)

Lemma dom_rec_nil : forall S t, dom_rec S = [] -> t|^S = t.
Proof.
  intros. induction t; simpl; trivial.
  rewrite IHt; trivial.
  rewrite IHt1. rewrite IHt2; trivial.
  rewrite IHt; trivial.
  replace (p @ look_up v S) with ((p|.v)|^S); trivial.
  apply not_In_dom. intro H0.
  apply In_dom_eq_dom_rec in H0.
  rewrite H in H0. simpl in H0; trivial.
Qed.

(** For a "singleton" substitution (|[(X, t)]|),
    if X is not in its domain, then it has
    a empty domain. *)

Lemma singleton_dom_rec_nil : forall X t, ~ X € (|[(X, t)]|) -> dom_rec (|[(X, t)]|) = [] .
Proof.
  intros. apply not_In_dom with (pi := []) in H.
  simpl in H. unfold dom_rec. simpl. gen H.
  autorewrite with perm. case (var_eqdec X X); intros.
  case (term_eqdec t (([])|.X)); intro H1; trivial.
  contradiction. false.
Qed.

(**
The intersection between the variables of a term and the
domain of a substitution is empty if, and only if, this substitution
has no action over the term.
*)

Lemma inter_dom_term_vars : forall t S,
      set_inter var_eqdec (term_vars t) (dom_rec S) = [] -> t|^S = t.
Proof.
  intros. induction t; simpl; trivial.
  simpl in H. rewrite IHt; trivial.
  simpl in H. rewrite IHt1. rewrite IHt2; trivial.
  apply set_inter_nil; intros. intro H0.
  apply set_inter_nil with (a:=a) in H.
  apply H. apply set_inter_elim in H0. destruct H0.
  apply set_inter_intro; trivial. apply set_union_intro2; trivial.
  apply set_inter_nil; intros. intro H0.
  apply set_inter_nil with (a:=a) in H.
  apply H. apply set_inter_elim in H0. destruct H0.
  apply set_inter_intro; trivial. apply set_union_intro1; trivial.
  simpl in H. rewrite IHt; trivial.
  replace (p @ look_up v S) with ((p|.v)|^S).
  apply not_In_dom. intro H0.
  apply set_inter_nil with (a:=v) in H.
  apply H. apply set_inter_intro.
  simpl. left~. apply In_dom_eq_dom_rec; trivial.
  simpl; trivial.
Qed.

Lemma inter_dom_term_vars_iff : forall t S,
      set_inter var_eqdec (term_vars t) (dom_rec S) = [] <-> t|^S = t.
Proof.
  intros. split~; intro. apply inter_dom_term_vars; trivial.
  apply set_inter_nil; intros X H0.
  apply set_inter_elim in H0. destruct H0.
  induction t; simpl in *|-; trivial.
  inverts H. apply IHt in H3; trivial.
  apply set_union_elim in H0. inverts H. destruct H0.
  apply IHt1 in H3; trivial. apply IHt2 in H4; trivial.
  inverts H. apply IHt in H3; trivial.
  destruct H0; try contradiction. rewrite <- H0 in H1.
  apply In_dom_eq_dom_rec in H1.
  replace (p|.v) with (p @ ([]|.v)) in H; autorewrite with perm; simpl; trivial.
  apply perm_term_invariance in H.
  apply H1. simpl. autorewrite with perm. trivial.
Qed.

(** A corollary of the previous result *)

Corollary not_occurs : forall X t1 t2, (~ set_In X (term_vars t1)) -> t1|^(|[(X,t2)]|) = t1.
Proof.
  intros. apply inter_dom_term_vars.
  apply set_inter_nil; intros Y H0.
  apply set_inter_elim in H0.
  destruct H0. unfold dom_rec in H1.
  simpl in H1. autorewrite with perm in H1.
  gen H1. case (var_eqdec X X); intro H1.
  case (term_eqdec t2 (([])|.X)); intros H2 H3;
  simpl in H3; trivial. destruct H3; trivial.
  rewrite H3 in H. contradiction.
  false.
Qed.

(** A recursive definition for the image of a substitution. *)

Lemma im_rec_aux_std : forall t S St,
       set_In t (im_rec_aux S St) ->
       exists X, set_In X St /\ t = ([]|.X)|^S.
Proof.
  intros. simpl. induction St; simpl in H.
  contradiction. destruct H.
  exists a. rewrite H. simpl. split~.
  apply IHSt in H. case H; clear H; intros X H.
  destruct H. exists X. simpl. split~.
Qed.

Lemma In_dom_to_im_rec : forall X S, X € S -> set_In (([]|.X)|^S) (im_rec S).
Proof.
  intros. generalize H. intro H'.
  unfold In_dom in H.
  apply In_dom_eq_dom_rec in H'.
  unfold im_rec. induction (dom_rec S).
  simpl in H'. contradiction.
  simpl in *|-*. autorewrite with perm in *|-*.
  destruct H'. rewrite H0. left~. right~.
Qed.

Lemma im_rec_to_In_dom : forall t S,
                                set_In t (im_rec S) <-> exists X, X € S /\ t = ([]|.X)|^S.
Proof.
  intros. unfold im_rec.
  setoid_rewrite In_dom_eq_dom_rec.
  split~; intro. apply im_rec_aux_std; trivial.
  case H; clear H; intros X H. destruct H.
  rewrite H0. apply In_dom_to_im_rec.
  apply In_dom_eq_dom_rec; trivial.
Qed.

(** Some results about composition of substitutions *)

Lemma subst_comp_id_left : forall S, (([]) © S) = S.
Proof.
  intros. unfold Subst_comp. simpl; trivial.
Qed.

Lemma subst_comp_id_right : forall S, (S © ([])) = S.
Proof.
  intros. unfold Subst_comp.
  induction S; simpl; trivial.
  destruct a. rewrite IHS.
  unfold F_rec. rewrite subst_id; trivial.
Qed.

Lemma look_up_comp_expand : forall X S1 S2, look_up X (S1 © S2) = (look_up X S1)|^S2 .
Proof.
  intros. induction S1; simpl; autorewrite with perm.
  rewrite subst_comp_id_left; trivial.
  destruct a. simpl. case (var_eqdec v X); intro H; trivial.
Qed.

Lemma subst_comp_expand : forall t S1 S2, t|^(S1 © S2) = (t|^S1)|^S2.
Proof.
 intros. induction t; simpl; trivial.
 rewrite IHt; trivial.
 rewrite IHt1; rewrite IHt2; trivial.
 rewrite IHt; trivial.
 rewrite subst_perm_comm.
 fequals. apply look_up_comp_expand.
Qed.

Lemma subst_comp_assoc: forall S1 S2 S3 t, t|^(S1 © (S2 © S3)) = t|^((S1 © S2) © S3).
Proof.
  intros. rewrite 4 subst_comp_expand; trivial.
Qed.

Lemma fresh_subst: forall C1 C2 S a t,
C1 |- a # t ->  fresh_env C1 C2 S -> C2 |- a # (t|^S).
Proof.
  intros. induction H; simpl; auto.
  apply H0 in H. simpl in H.
  autorewrite with perm in H.
  apply fresh_lemma_1 in H; trivial.
Qed.

(** Some results about "AACC-equivalence" between substitutions. *)

Notation "C |- S ~:c S'" := (subs_equiv C (equiv (|[2]|)) S S') (at level 67).

Lemma c_equiv_subst: forall C1 C2 S t1 t2,
C1|- t1 ~c t2 -> fresh_env C1 C2 S -> C2 |- (t1|^S) ~c (t2|^S).
Proof.
  intros. induction H; simpl; auto.
  apply IHequiv in H0. clear IHequiv.
  apply c_equiv_Fc; trivial.
   rewrite subst_perm_comm in IHequiv.
  apply equiv_Ab_2; trivial.
  apply IHequiv; trivial.
  apply fresh_subst with (C1 := C); trivial.
  apply c_equiv_pi; intros.
  replace (look_up X S) with (([]|.X)|^S).
  apply fresh_subst with (C1 := C); trivial.
  apply fresh_Su. simpl. apply H; trivial.
  simpl. autorewrite with perm; trivial.
  simpl in H. omega.
  simpl in H. omega.
Qed.

Lemma c_equiv_unif: forall C X S pi t,
C|- (pi|.X)|^S ~c (t|^S) -> C |- (|[(X,(!pi) @ t)]| © S) ~:c S.
Proof.
 intros. simpl in H. unfold subs_equiv. intros Y H'. simpl.
 autorewrite with perm. case (var_eqdec X Y); intro H''.
 rewrite subst_perm_comm. apply c_equiv_pi_inv_side.
 rewrite rev_involutive. rewrite <- H''.
 apply c_equiv_sym; trivial.
 apply c_equiv_refl.
Qed.

Lemma c_equiv_look_up : forall C S1 S2 X,
C |- S1 ~:c S2 -> C |- look_up X S1 ~c look_up X S2 .
Proof.
  intros. unfolds in H. simpl in H.
  setoid_rewrite perm_id in H.
  case (In_dom_dec X S1); intro H0.
  apply H. left~.
  case (In_dom_dec X S2); intro H1.
  apply H. right~.
  replace (look_up X S1) with ([]|.X).
  replace (look_up X S2) with ([]|.X).
  apply c_equiv_refl.
  replace (look_up X S2) with (([]|.X)|^S2).
  symmetry. apply not_In_dom; trivial.
  simpl; autorewrite with perm; trivial.
  replace (look_up X S1) with (([]|.X)|^S1).
  symmetry. apply not_In_dom; trivial.
  simpl; autorewrite with perm; trivial.
Qed.

Lemma subst_c_equiv: forall C S1 S2 t,
C |- S1 ~:c S2 -> C|- t|^S1 ~c (t|^S2) .
Proof.
  intros. induction t; simpl; auto.
  apply c_equiv_Fc; trivial.
  apply c_equiv_equivariance.
  apply c_equiv_look_up; trivial.
Qed.

Lemma c_equiv_unif_2: forall C S1 S2 t1 t2, C|- S1 ~:c S2 ->
              C|- t1|^S1 ~c (t2|^S1) -> C |- t1|^S2 ~c (t2|^S2).
Proof.
  intros.
  apply c_equiv_trans with (t2:=t1|^S1).
  apply c_equiv_sym. apply subst_c_equiv; trivial.
  apply c_equiv_trans with (t2:=t2|^S1); trivial.
  apply subst_c_equiv; trivial.
Qed.

Lemma c_equiv_unif_fresh: forall C S1 S2 t a, C|- S1 ~:c S2 ->
               C|- a # (t|^S1) -> C|- a # (t|^S2) .
Proof.
  intros. apply subst_c_equiv with (t:=t) in H.
  apply c_equiv_fresh with (a:=a) in H; trivial.
Qed.

Lemma subst_cancel_left: forall C S1 S2 S,
   C|- S1 ~:c S2 -> C|- (S © S1) ~:c (S © S2) .
Proof.
  intros. unfold subs_equiv. intros.
  rewrite 2 subst_comp_expand.
  apply subst_c_equiv; trivial.
Qed.

Lemma subst_cancel_right: forall C1 C2 S1 S2 S,
   fresh_env C1 C2 S ->
   C1 |- S1 ~:c S2 -> C2|- (S1 © S) ~:c (S2 © S).
Proof.
  intros. unfold subs_equiv. intros.
  rewrite 2 subst_comp_expand.
  apply c_equiv_subst with (C1:=C1); trivial.
  apply subst_c_equiv; trivial.
Qed.

Lemma subst_assoc : forall C S1 S2 S3 S4,
                      C |- (S1 © S2) © S3 ~:c S4 <->
                      C |- S1 © (S2 © S3) ~:c S4.
Proof.
  intros. unfold subs_equiv; split; intros.
  rewrite subst_comp_assoc. apply H.
  destruct H0. left~. unfold In_dom in H0|-*.
  rewrite <- subst_comp_assoc; trivial. right~.
  rewrite <- subst_comp_assoc.
  apply H. destruct H0. left~. unfold In_dom in H0|-*.
  rewrite subst_comp_assoc; trivial. right~.
Qed.

Lemma subst_refl : forall C S, C|- S ~:c S.
Proof.
  intros. unfold subs_equiv; intros.
  apply c_equiv_refl.
Qed.

Lemma subst_sym : forall C S1 S2, C|- S1 ~:c S2 -> C|- S2 ~:c S1.
Proof.
  intros. unfold subs_equiv in *|-*.
  intros. apply c_equiv_sym. apply H.
  destruct H0. right~. left~.
Qed.

Lemma subst_trans: forall C S1 S2 S3,
 C|- S1 ~:c S2 -> C|- S2 ~:c S3 -> C|- S1 ~:c S3 .
Proof.
  intros.
  unfold subs_equiv in *|-*. simpl in *|-*. intros.
  autorewrite with perm.
  setoid_rewrite perm_id in H.
  setoid_rewrite perm_id in H0.
  apply c_equiv_trans with (t2:=look_up X S2); destruct H1.
  apply H. left~.
  case (In_dom_dec X S1); intro H2. apply H. left~.
  case (In_dom_dec X S2); intro H3. apply H. right~.
  replace (look_up X S1) with ([]|.X).
  replace (look_up X S2) with ([]|.X).
  apply c_equiv_refl.
  replace (look_up X S2) with (([]|.X)|^S2).
  symmetry. apply not_In_dom; trivial.
  simpl; autorewrite with perm; trivial.
  replace (look_up X S1) with (([]|.X)|^S1).
  symmetry. apply not_In_dom; trivial.
  simpl; autorewrite with perm; trivial.
  case (In_dom_dec X S2); intro H2. apply H0. left~.
  case (In_dom_dec X S3); intro H3. apply H0. right~.
  replace (look_up X S2) with ([]|.X).
  replace (look_up X S3) with ([]|.X).
  apply c_equiv_refl.
  replace (look_up X S3) with (([]|.X)|^S3).
  symmetry. apply not_In_dom; trivial.
  simpl; autorewrite with perm; trivial.
  replace (look_up X S2) with (([]|.X)|^S2).
  symmetry. apply not_In_dom; trivial.
  simpl; autorewrite with perm; trivial.
  apply H0. right~.
Qed.

(** Substitutions and sets of variables *)

(** Results about the set of variables of a term. *)

Lemma set_In_terms_set_vars : forall St X,
       set_In X (terms_set_vars St) <->
       exists t, set_In t St /\ set_In X (term_vars t).
Proof.
  intros. induction St; simpl.
  split~; intro. contradiction.
  destruct H. destruct H. contradiction.
  split~; intro. apply set_union_elim in H. destruct H.
  exists a. split~.
  apply IHSt in H. case H; clear H; intros t H.
  exists t. destruct H. split~.
  case H; clear H; intros t H. destruct H. destruct H.
  apply set_union_intro1. rewrite H; trivial.
  apply set_union_intro2. apply IHSt.
  exists t. split~.
Qed.

Lemma terms_set_vars_add : forall St t X,
                             set_In X (terms_set_vars (set_add term_eqdec t St)) <->
                             set_In X (set_union var_eqdec (term_vars t) (terms_set_vars St)).
Proof.
  intros. split~; intro.
  apply set_In_terms_set_vars in H.
  case H; clear H; intros s  H.
  destruct H. apply set_add_elim in H. destruct H.
  rewrite H in H0. apply set_union_intro1; trivial.
  apply set_union_intro2. apply set_In_terms_set_vars.
  exists s. split~.
  apply set_In_terms_set_vars.
  apply set_union_elim in H. destruct H.
  exists t. split~. apply set_add_intro2; trivial.
  apply set_In_terms_set_vars in H.
  case H; clear H; intros s H. destruct H.
  exists s. split~. apply set_add_intro1; trivial.
Qed.

Lemma terms_set_vars_subset : forall St0 St1,
                          (forall s, set_In s St0 -> set_In s St1) ->
                          (forall X, set_In X (terms_set_vars St0) -> set_In X (terms_set_vars St1)).
Proof.
  intros. induction St0;
    simpl in *|-*; try contradiction.
  apply set_union_elim in H0. destruct H0.
  assert (Q: set_In a St1). apply H. left~.
  clear H IHSt0 St0. induction St1;
    simpl in *|-*; try contradiction.
  destruct Q. rewrite H.
  apply set_union_intro1; trivial.
  apply set_union_intro2.
  apply IHSt1; trivial.
  apply IHSt0; intros; trivial.
  apply H. right~.
Qed.

Lemma In_terms_vars_set : forall s X St, set_In s St ->
                                        set_In X (term_vars s) -> set_In X (terms_set_vars St).
Proof.
  intros. induction St. simpl in H. contradiction.
  simpl in H|-*. destruct H.
  apply set_union_intro1. rewrite H; trivial.
  apply set_union_intro2. apply IHSt; trivial.
Qed.

(** A lemma about idempotent substitutions. *)

Lemma subst_idem : forall C S1 S2, set_inter var_eqdec (dom_rec S1) (im_vars S1) = [] ->
                               C |- S1 © S1 © S2 ~:c (S1 © S2).
Proof.
  intros. unfold subs_equiv. intros.
  rewrite 3 subst_comp_expand.
  rewrite inter_dom_term_vars with (t:=(([])|.X)|^S1).
  apply c_equiv_refl.
  apply set_inter_nil. intros Y H1.
  apply set_inter_elim in H1. destruct H1.
  apply set_inter_nil with (a:=Y) in H.
  apply H. clear H. apply set_inter_intro; trivial.
  clear H0. case (In_dom_dec X S1); intro H3.
  apply In_dom_to_im_rec in H3.
  unfold im_vars. apply In_terms_vars_set with (s:=(([])|.X)|^S1); trivial.
  replace (([]|.X)|^S1) with ([]|.X) in H1.
  simpl in H1. destruct H1; try contradiction.
  apply In_dom_eq_dom_rec in H2. rewrite <- H in H2. contradiction.
  symmetry. apply not_In_dom; trivial.
Qed.

(** Results about the set of variables that occurs in the image of a substitution. *)

Lemma set_In_im_vars : forall S X,
      set_In X (im_vars S) <->
      exists t, set_In t (im_rec S) /\ set_In X (term_vars t).
Proof.
  intros. apply set_In_terms_set_vars.
Qed.

Lemma set_In_subst_term_im : forall X S t,
      X € S ->
      set_In X (term_vars (t|^S)) ->
      set_In X (im_vars S).
Proof.
 intros. induction t; simpl in *|-*; try contradiction.
 apply IHt; trivial.
 apply set_union_elim in H0. destruct H0.
 apply IHt1; trivial. apply IHt2; trivial.
 apply IHt; trivial.
 replace (look_up v S) with (([]|.v)|^S) in H0;
  simpl; autorewrite with perm; trivial.
 rewrite perm_term_vars in H0.
 case (In_dom_dec v S); intro.
 apply In_terms_vars_set with (s:= ([]|.v)|^S); trivial.
 apply In_dom_to_im_rec; trivial.
 replace (([]|.v)|^S) with ([]|.v) in H0.
 simpl in H0. destruct H0; try contradiction; trivial.
 rewrite H0 in n. contradiction.
 symmetry. apply not_In_dom; trivial.
Qed.

(** Substitutions applied over set of terms *)

Lemma set_subst_element : forall s St S,
      set_In s (set_subst St S) <-> exists t, s = t|^S /\ set_In t St.
Proof.
  intros. induction St; simpl. split~; intro.
  contradiction. destruct H. destruct H. trivial.
  split~; intros.
  apply set_add_elim in H. destruct H.
  exists a. split~.
  apply IHSt in H. case H; clear H; intros u H.
  exists u. destruct H. split~.
  case H; clear H; intros u H. destruct H. destruct H0.
  rewrite H0. apply set_add_intro2; trivial.
  apply set_add_intro1. apply IHSt. exists u. split~.
Qed.

Lemma set_subst_add : forall s t St S,
      set_In s (set_subst (set_add term_eqdec t St) S) <->
      set_In s (set_add term_eqdec (t|^S) (set_subst St S)).
Proof.
  intros. split~; intro.
  apply set_subst_element in H. case H; clear H; intros u H.
  destruct H. apply set_add_elim in H0. destruct H0.
  rewrite H0 in H. apply set_add_intro2; trivial.
  apply set_add_intro1. apply set_subst_element.
  exists u. split~.
  apply set_subst_element. apply set_add_elim in H.
  destruct H. exists t. split~. apply set_add_intro2; trivial.
  apply set_subst_element in H. case H; clear H; intros u H.
  destruct H. exists u. split~. apply set_add_intro1; trivial.
Qed.

(** Technical results about domain, image and variable sets *)

Lemma dom_comp_add1 : forall S t X Y, Y € (S © |[(X,t)]|) -> (Y = X \/ Y € S).
Proof.
  intros. case (var_eqdec Y X); intro H0. left~.
  right~. unfold In_dom in *|-*.
  intro H1. apply H. clear H.
  rewrite subst_comp_expand. rewrite H1.
  rewrite not_occurs; trivial. simpl.
  intro. destruct H; contradiction.
Qed.

Lemma dom_comp_add2 : forall S t X, t <> []|.X -> ~ X € S -> X € (S © |[(X,t)]|).
Proof.
  intros.
  apply not_In_dom with (pi:=[]) in H0.
  unfold In_dom. simpl in *|-*.
  autorewrite with perm in *|-*.
  rewrite look_up_comp_expand.
  rewrite H0. simpl.
  autorewrite with perm.
  case (var_eqdec X X); intro H1; trivial. false.
Qed.

Lemma subst_eq_var : forall X Y s t, s <> []|.Y ->
                                     s|^(|[(X,t)]|) = []|.Y ->
                                    (s = []|.X /\ t = []|.Y).
Proof.
  intros. destruct s; simpl in H0.
  inverts H0. inverts H0. inverts H0. inverts H0. inverts H0.
  gen H0. case (var_eqdec X v); intros. rewrite e.
  destruct t; autorewrite with perm in H0; inverts H0.
  rewrite H2. destruct p0; simpl in H2.
  rewrite H2. split~. inverts H2.
  autorewrite with perm in H0. simpl in H0.
  contradiction.
Qed.

Lemma dom_comp_add3: forall S t X Y,  ~ set_In Y (term_vars t) -> Y € S -> Y € (S © |[(X,t)]|) .
Proof.
  intros. unfold In_dom in *|-*.
  rewrite subst_comp_expand. intro H1.
  apply subst_eq_var in H1; trivial.
  destruct H1. apply H. rewrite H2.
  simpl. left~.
Qed.

Lemma dom_comp_add_gen: forall S t X Y,  t <> []|.X -> ~ X € S -> ~ set_In Y (term_vars t) ->
                                        (Y € (S © |[(X,t)]|) <-> (Y = X \/ Y € S)).
Proof.
  intros. split~; intro.
  apply dom_comp_add1 in H2; trivial.
  destruct H2. rewrite H2 in *|-*.
  apply dom_comp_add2; trivial.
  apply dom_comp_add3; trivial.
Qed.

Lemma var_in_dom_rec_singleton : forall X Y t, set_In Y (dom_rec (|[(X,t)]|)) -> Y = X.
Proof.
  intros X Y t. unfold dom_rec. simpl.
  autorewrite with perm. case (var_eqdec X X).
  case (term_eqdec t (([])|.X)); intros.
  simpl in H. contradiction. simpl in H.
  destruct H; try contradiction.
  symmetry in H. trivial.
  intros. false.
Qed.

(** The composition S © |[(X,t)] is different from S *)

Lemma comp_diff_singleton : forall S X t,
      S <> (S © (|[(X,t)]|)) .
Proof.
  intros. intro H. unfold Subst_comp in H.
  induction S; simpl in H.
  gen H. discriminate.
  destruct a. inverts H.
  apply IHS; trivial.
Qed.

(**  *)

Lemma set_In_subst_term : forall X S t,
      set_In X (term_vars (t|^S)) ->
     (set_In X (term_vars t) \/ set_In X (im_vars S)).
Proof.
  intros. induction t; simpl in *|-*; try contradiction.
  apply IHt; trivial.
  apply set_union_elim in H. destruct H.
   apply IHt1 in H. destruct H.
    left~. apply set_union_intro1; trivial. right~.
   apply IHt2 in H. destruct H.
    left~. apply set_union_intro2; trivial. right~.
  apply IHt in H; trivial.
  replace (look_up v S) with (([]|.v)|^S) in H;
    simpl; autorewrite with perm; trivial.
  rewrite perm_term_vars in H.
  case (In_dom_dec v S); intro.
  right~. apply In_terms_vars_set with (s:= ([]|.v)|^S); trivial.
  apply In_dom_to_im_rec; trivial.
  left~. left~. replace (([]|.v)|^S) with ([]|.v) in H.
  simpl in H. destruct H; try contradiction; trivial.
  symmetry. apply not_In_dom; trivial.
Qed.

Lemma set_In_subst_Problem : forall X S P,
      set_In X (Problem_vars (P|^^S)) ->
     (set_In X (Problem_vars P) \/ set_In X (im_vars S)).
Proof.
  intros. induction P; simpl in H.
  contradiction. destruct a; simpl in *|-*.
  apply set_union_elim in H.
  destruct H. apply set_In_subst_term in H. destruct H.
  left~. apply set_union_intro1; trivial. right~.
  apply IHP in H. destruct H.
  left~. apply set_union_intro2; trivial. right~.
  apply set_union_elim in H. destruct H.
  apply set_In_subst_term in H. destruct H.
  left~. apply set_union_intro1; trivial. right~.
  apply set_union_elim in H. destruct H.
  apply set_In_subst_term in H. destruct H.
  left~. apply set_union_intro2.
  apply set_union_intro1; trivial. right~.
  apply IHP in H. destruct H.
  left~. apply set_union_intro2.
  apply set_union_intro2; trivial. right~.
Qed.

Lemma set_In_set_subst : forall X S St,
      set_In X (terms_set_vars (set_subst St S)) ->
     (set_In X (terms_set_vars St) \/ set_In X (im_vars S)).
Proof.
  intros. apply set_In_terms_set_vars in H.
  case H; clear H; intros t H. destruct H.
  apply set_subst_element in H.
  case H; clear H; intros s H. destruct H.
  rewrite H in H0. clear H. apply set_In_subst_term in H0.
  destruct H0. left~. apply set_In_terms_set_vars.
  exists s. split~. right~.
Qed.

Lemma set_In_subst_set_im : forall X S St,
      X € S ->
      set_In X (terms_set_vars (set_subst St S)) ->
      set_In X (im_vars S).
Proof.
  intros. apply set_In_terms_set_vars in H0.
  case H0; clear H0; intros s H0. destruct H0.
  induction St; simpl in *|-*; try contradiction.
  apply set_add_elim in H0. destruct H0.
  rewrite H0 in H1. apply set_In_subst_term_im in H1; trivial.
  apply IHSt; trivial.
Qed.

Lemma In_im_subst_term : forall X s t,
                            set_In X (term_vars (s|^(|[(X,t)]|))) -> set_In X (term_vars t).
Proof.
  intros. case (In_dom_dec X (|[(X, t)]|)); intro H0.
  apply set_In_subst_term_im in H; trivial.
  apply set_In_im_vars in H.
  case H; clear H; intros u H.
  destruct H. apply im_rec_aux_std in H.
  case H; clear H; intros Y H. destruct H.
  simpl in H2. autorewrite with perm in H2.
  gen H2. case (var_eqdec X Y); intros.
  rewrite H2 in H1; trivial.
  rewrite H2 in H1. simpl in H1. destruct H1; try contradiction.
  symmetry in H1. contradiction.
  rewrite dom_rec_nil in H.
  apply not_In_dom with (pi:=[]) in H0.
  simpl in H0. autorewrite with perm in H0.
  gen H0. case (var_eqdec X X); intros.
  rewrite H0. simpl. left~. false.
  apply singleton_dom_rec_nil; trivial.
Qed.

Lemma In_im_subst_term' : forall X Y s t,   set_In Y (term_vars (s|^(|[(X,t)]|))) ->
                                            set_In Y (set_union var_eqdec (term_vars s) (term_vars t)).
Proof.
  intros. apply set_In_subst_term in H.
  destruct H. apply set_union_intro1; trivial.
  apply set_In_im_vars in H. case H; clear H; intros u H.
  destruct H. apply im_rec_aux_std in H.
  case H; clear H; intros Z H. destruct H.
  apply var_in_dom_rec_singleton in H.
  rewrite H in H1. clear H.
  rewrite subst_var_eq in H1.
  autorewrite with perm in H1.
  rewrite H1 in H0. clear H1.
  apply set_union_intro2; trivial.
Qed.

Lemma In_subst_terms_im_1 : forall X Y s t,
                            set_In Y (set_remove var_eqdec X (term_vars s)) ->
                            set_In Y (term_vars (s|^(|[(X,t)]|)))  .
Proof.
  intros.
  generalize H. intro H'.
  apply set_remove_1 in H.
  apply set_remove_2 in H'.
  induction s; simpl in *|-*; trivial.
  apply IHs; trivial.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1. apply IHs1; trivial.
  apply set_union_intro2. apply IHs2; trivial.
  apply IHs; trivial.
  case (var_eqdec X v); intro H1.
  destruct H; try contradiction.
  rewrite H in H1. symmetry in H1. contradiction.
  rewrite perm_term_vars. simpl; trivial.
  apply NoDup_term_vars.
Qed.

Lemma In_subst_terms_im_2 : forall X Y s t,
                            set_In X (term_vars s) ->
                            set_In Y (term_vars t) ->
                            set_In Y (term_vars (s|^(|[(X,t)]|))).
Proof.
  intros.
  induction s; simpl in *|-*; trivial.
  apply IHs; trivial.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1. apply IHs1; trivial.
  apply set_union_intro2. apply IHs2; trivial.
  apply IHs; trivial.
  destruct H; try contradiction. rewrite H; clear H.
  case (var_eqdec X X); intro H. rewrite perm_term_vars; trivial. false.
Qed.

Lemma In_subst_terms_im : forall X Y s t,
      set_In X (term_vars s) ->
      set_In Y (set_union var_eqdec (set_remove var_eqdec X (term_vars s)) (term_vars t)) ->
      set_In Y (term_vars (s|^(|[(X,t)]|)))  .
Proof.
  intros. apply set_union_elim in H0. destruct H0.
  apply In_subst_terms_im_1; trivial.
  apply In_subst_terms_im_2; trivial.
Qed.

Lemma In_im_subst_terms_set : forall X St t, set_In X (terms_set_vars (set_subst St (|[(X,t)]|))) ->
                                             set_In X (term_vars t).
Proof.
  intros. apply set_In_terms_set_vars in H.
  case H; clear H; intros s H. destruct H.
  apply set_subst_element in H.
  case H; clear H; intros u H. destruct H.
  rewrite H in H0. clear H s.
  apply In_im_subst_term in H0. trivial.
Qed.

Lemma In_im_subst_terms_set' : forall X Y St t,
      set_In Y (terms_set_vars (set_subst St (|[(X,t)]|))) ->
      set_In Y (set_union var_eqdec (terms_set_vars St) (term_vars t)).
Proof.
  intros. apply set_In_terms_set_vars in H.
  case H; clear H; intros s H. destruct H.
  apply set_subst_element in H.
  case H; clear H; intros u H. destruct H.
  rewrite H in H0. clear H s.
  apply In_im_subst_term' in H0.
  apply set_union_elim in H0. destruct H0.
  apply set_union_intro1.
  apply set_In_terms_set_vars.
  exists u. split~.
  apply set_union_intro2; trivial.
Qed.

Lemma In_im_comp_add : forall S X s t, ~ set_In X (dom_rec S) ->
                       set_In s (im_rec (S © |[(X,t)]|)) ->
                       set_In s (set_add term_eqdec t (set_subst (im_rec S) (|[(X,t)]|))).
Proof.
  intros. apply im_rec_to_In_dom in H0.
  case H0; clear H0; intros Y H0. destruct H0.
  apply dom_comp_add1 in H0. destruct H0.
  rewrite subst_comp_expand in H1. rewrite H0 in H1.
  replace (([]|.X)|^S) with ([]|.X) in H1.
  rewrite subst_var_eq in H1.
  autorewrite with perm in H1. apply set_add_intro2; trivial.
  symmetry. apply not_In_dom.
  rewrite In_dom_eq_dom_rec; trivial.
  rewrite In_dom_eq_dom_rec in H0.
  rewrite subst_comp_expand in H1. rewrite H1.
  clear H H1. unfold im_rec.
  apply set_add_intro1. induction (dom_rec S).
  simpl in H0. contradiction. simpl in H0.
  destruct H0. rewrite H. simpl.
  autorewrite with perm. apply set_add_intro2; trivial.
  apply IHs0 in H. clear IHs0.
  simpl. apply set_add_intro1; trivial.
Qed.

Lemma im_vars_comp_add1 : forall S t X Y,
                             ~ set_In X (dom_rec S) ->
                             set_In Y (im_vars (S © |[(X,t)]|)) ->
                             set_In Y (set_union var_eqdec  (im_vars S) (term_vars t)).
Proof.
  intros. unfold im_vars in *|-.
  apply terms_set_vars_subset with
  (St1:= set_add term_eqdec t (set_subst (im_rec S) (|[(X,t)]|))) in H0.
  apply terms_set_vars_add in H0.
  apply set_union_elim in H0. destruct H0.
  apply set_union_intro2; trivial.
  apply In_im_subst_terms_set' in H0.
  unfold im_vars. trivial.
  intros. apply In_im_comp_add; trivial.
Qed.

Lemma im_vars_comp_add2 : forall S t X,
                             ~ set_In X (dom_rec S) ->
                             set_In X (im_vars (S © |[(X,t)]|)) ->
                             set_In X (term_vars t).
Proof.
 intros. apply terms_set_vars_subset with
  (St1:= set_add term_eqdec t (set_subst (im_rec S) (|[(X,t)]|))) in H0.
 apply terms_set_vars_add in H0. apply set_union_elim in H0.
 destruct H0; trivial. apply In_im_subst_terms_set in H0; trivial.
 intros. apply In_im_comp_add; trivial.
Qed.

Lemma subs_fresh_vars_im : forall X C S,
                             set_In X (Problem_vars (C /? S)) ->
                             set_In X (im_vars S).
Proof.
  intros. unfold im_vars. induction C.
  simpl in H. contradiction. simpl in H.
  destruct a. gen H. case (In_dom_dec v S); intros H0 H.
  apply Problem_vars_add in H.
  apply set_union_elim in H. destruct H.
  apply IHC; trivial.
  autorewrite with perm in H. simpl in H.
  clear IHC C a. apply In_dom_eq_dom_rec in H0.
  unfold im_rec. induction (dom_rec S);
  simpl in *|-*; autorewrite with perm in *|-*; trivial.
  destruct H0. rewrite H0 in *|-*.
  apply set_union_intro1; trivial.
  apply set_union_intro2. apply IHs; trivial.
  apply IHC; trivial.
Qed.

Lemma subterms_subs : forall X S t,
                       set_In X (term_vars t) ->
                       exists pi, set_In ((pi|.X)|^S) (subterms (t |^ S)).
Proof.
  intros. induction t; simpl in H; try contradiction.
  apply IHt in H. case H; clear H; intros pi H.
  exists pi. simpl. apply set_add_intro1; trivial.
  apply set_union_elim in H. destruct H.
  apply IHt1 in H. case H; clear H; intros pi H.
  exists pi. simpl. apply set_add_intro1. apply set_union_intro1; trivial.
  apply IHt2 in H. case H; clear H; intros pi H.
  exists pi. simpl. apply set_add_intro1. apply set_union_intro2; trivial.
  apply IHt in H. case H; clear H; intros pi H.
  exists pi. simpl. apply set_add_intro1; trivial.
  destruct H; try contradiction. rewrite H; clear H.
  exists p. apply In_subterms.
Qed.

Lemma psubterms_subs : forall X S t,
                      (forall pi, t <> pi|.X) ->
                       set_In X (term_vars t) ->
                       exists pi, set_In ((pi|.X)|^S) (psubterms (t |^ S)).
Proof.
  intros. generalize H0. intro H1.
  apply subterms_subs with (S:=S) in H1.
  case H1; clear H1; intros pi H1. exists pi.
  unfold psubterms. apply set_remove_3; trivial.
  clear H1. simpl; autorewrite with perm.
  destruct t; simpl in *|-*; try contradiction.
  intro H1.
  assert (Q : term_size (pi @look_up X S) = term_size ([a]^(t|^S))).
   rewrite H1; trivial.
  apply subterms_subs with (S:=S) in H0.
  case H0; clear H0; intros pi' H0. simpl in H0.
  apply subterms_term_size_leq in H0.
  rewrite perm_term_size in *|-. simpl in Q. omega.
  intro H1.
  assert (Q : term_size (pi @look_up X S) = term_size (<| t1 |^ S, t2 |^ S |>)).
   rewrite H1; trivial.
  apply set_union_elim in H0;
  destruct H0; apply subterms_subs with (S:=S) in H0;
  case H0; clear H0; intros pi' H0; simpl in H0;
  apply subterms_term_size_leq in H0;
  rewrite perm_term_size in *|-; simpl in Q; omega.
  intro H1.
  assert (Q : term_size (pi @look_up X S) = term_size (Fc n n0 (t |^ S))).
   rewrite H1; trivial.
  apply subterms_subs with (S:=S) in H0.
  case H0; clear H0; intros pi' H0. simpl in H0.
  apply subterms_term_size_leq in H0.
  rewrite perm_term_size in *|-. simpl in Q. omega.
  inverts H0. false. apply (H p); trivial.
  contradiction.
Qed.

Lemma equ_proj_subs_fresh : forall C S, equ_proj (C /? S) = [] .
Proof.
  intros. induction C; simpl; trivial.
  destruct a. case (In_dom_dec v S); intro H; trivial.
  case (in_dec Constraint_eqdec (a #? (([]) @ look_up v S)) (C /? S)); intro H0.
  rewrite set_add_In; trivial.
  rewrite set_add_not_In; trivial.
  rewrite equ_proj_append.
  rewrite IHC. simpl; trivial.
Qed.

Lemma equ_proj_subs : forall P S, equ_proj (P|^^S) = (equ_proj P)|^^S.
Proof.
  intros. induction P; simpl; trivial.
  destruct a; simpl; trivial. fequals.
Qed.

Lemma equ_subs_fresh : forall C S s t, ~ set_In (s~?t) (C /? S).
Proof.
  intros. induction C; simpl. intro; trivial.
  destruct a. case (In_dom_dec v S); intro H; trivial.
  intro H0. apply set_add_elim in H0.
  destruct H0; try contradiction. inverts H0.
Qed.

Lemma not_occurs_Problem : forall X P t, (~ set_In X (Problem_vars P)) -> P|^^(|[(X,t)]|) = P.
Proof.
  intros. induction P; simpl in *|-*; trivial.
  destruct a. rewrite not_occurs. rewrite IHP; trivial.
  intro H0. apply H. apply set_union_intro2; trivial.
  intro H0. apply H. apply set_union_intro1; trivial.
  rewrite 2 not_occurs. rewrite IHP; trivial.
  intro H0. apply H. apply set_union_intro2.
  apply set_union_intro2; trivial.
  intro H0. apply H. apply set_union_intro2.
  apply set_union_intro1; trivial.
  intro H0. apply H. apply set_union_intro1; trivial.
Qed.

Lemma In_im_subst_term_Problem : forall X P t,
                                    set_In X (Problem_vars (P|^^(|[(X,t)]|))) -> set_In X (term_vars t).
Proof.
  intros. induction P; simpl in H; try contradiction.
  destruct a; simpl in H. apply set_union_elim in H.
  destruct H; [apply In_im_subst_term with (s:=t0) | apply IHP]; trivial.
  apply set_union_elim in H. destruct H.
  apply In_im_subst_term with (s:=t0); trivial.
  apply set_union_elim in H.
  destruct H; [apply In_im_subst_term with (s:=t1) | apply IHP]; trivial.
Qed.

Lemma In_im_subst_term_Problem' : forall X Y P t,  set_In Y (Problem_vars (P|^^(|[(X,t)]|))) ->
                                                   set_In Y (set_union var_eqdec (Problem_vars P) (term_vars t)).
Proof.
  intros. induction P; simpl in H; try contradiction.
  destruct a; simpl in *|-*.
  apply set_union_elim in H. destruct H.
  apply In_im_subst_term' in H; trivial.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1; apply set_union_intro1; trivial.
  apply set_union_intro2; trivial.
  apply IHP in H.  apply set_union_elim in H. destruct H.
  apply set_union_intro1; apply set_union_intro2; trivial.
  apply set_union_intro2; trivial.
  apply set_union_elim in H. destruct H.
  apply In_im_subst_term' in H.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1; apply set_union_intro1; trivial.
  apply set_union_intro2; trivial.
  apply set_union_elim in H. destruct H.
  apply In_im_subst_term' in H.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1; apply set_union_intro2;
  apply set_union_intro1; trivial.
  apply set_union_intro2; trivial.
  apply IHP in H.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1; apply set_union_intro2;
  apply set_union_intro2; trivial.
  apply set_union_intro2; trivial.
Qed.

Lemma In_subst_Problem_im_1 : forall X Y P t,
                            set_In Y (set_remove var_eqdec X (Problem_vars P)) ->
                            set_In Y (Problem_vars (P|^^(|[(X,t)]|)))  .
Proof.
  intros. induction P; simpl in *|-*; trivial.
  destruct a; simpl in *|-*.
  generalize H. intro H'.
  apply set_remove_1 in H.
  apply set_remove_2 in H'.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1.
  apply In_subst_terms_im_1. apply set_remove_3; trivial.
  apply set_union_intro2. apply IHP.
  apply set_remove_3; trivial.
  apply set_union_nodup.
  apply NoDup_term_vars.
  apply NoDup_Problem_vars.
  generalize H. intro H'.
  apply set_remove_1 in H.
  apply set_remove_2 in H'.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1.
  apply In_subst_terms_im_1. apply set_remove_3; trivial.
  apply set_union_intro2.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1.
  apply In_subst_terms_im_1. apply set_remove_3; trivial.
  apply set_union_intro2. apply IHP.
  apply set_remove_3; trivial.
  apply set_union_nodup.
  apply NoDup_term_vars.
  apply set_union_nodup.
  apply NoDup_term_vars.
  apply NoDup_Problem_vars.
Qed.

Lemma In_subst_Problem_im_2 : forall X Y P t,
                            set_In X (Problem_vars P) ->
                            set_In Y (term_vars t) ->
                            set_In Y (Problem_vars (P|^^(|[(X,t)]|))).
Proof.
  intros. induction P; simpl in *|-*; trivial.
  destruct a; simpl in *|-*. apply set_union_elim in H. destruct H.
  apply set_union_intro1. apply In_subst_terms_im_2; trivial.
  apply set_union_intro2. apply IHP; trivial.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1. apply In_subst_terms_im_2; trivial.
  apply set_union_elim in H. destruct H.
  apply set_union_intro2. apply set_union_intro1.
  apply In_subst_terms_im_2; trivial.
  apply set_union_intro2. apply set_union_intro2.
  apply IHP; trivial.
Qed.

Lemma In_subst_Problem_im : forall X Y P t,
                            set_In X (Problem_vars P) ->
                            set_In Y (set_union var_eqdec (set_remove var_eqdec X (Problem_vars P)) (term_vars t)) ->
                            set_In Y (Problem_vars (P|^^(|[(X,t)]|)))  .
Proof.
  intros. apply set_union_elim in H0. destruct H0.
  apply In_subst_Problem_im_1; trivial.
  apply In_subst_Problem_im_2; trivial.
Qed.

Lemma set_In_subs_problem : forall u P S, set_In u P -> set_In (subs_Constraint u S) (P|^^S).
Proof.
  intros. induction P; simpl in H. contradiction.
  destruct a; simpl. destruct H; try rewrite <- H.
  left~. right~. destruct H; try rewrite <- H.
  left~. right~.
Qed.

Lemma set_In_subs_remove_problem  : forall u u' S P,
                                      set_In u ((P\u')|^^S) -> set_In u (P|^^S).
Proof.
  intros. induction P. simpl in H. contradiction.
  simpl in *|-*. gen H. case (Constraint_eqdec u' a); intros H0 H.
  destruct a. simpl. right~. simpl. right~.
  destruct a; simpl in H|-*;
  destruct H. left~. right~. left~. right~.
Qed.

Lemma set_In_subs : forall u S P, set_In u (P|^^S) ->
                                  exists u', u = subs_Constraint u' S /\ set_In u' P.
Proof.
  intros. induction P. simpl in H. contradiction.
  destruct a; simpl in H; destruct H.
  exists (a#?t). unfold subs_Constraint. rewrite H. split~. left~.
  apply IHP in H. case H; clear H; intros u' H. destruct H.
  exists u'. split~. right~.
  exists (t~?t0). unfold subs_Constraint. rewrite H. split~. left~.
  apply IHP in H. case H; clear H; intros u' H. destruct H.
  exists u'. split~. right~.
Qed.

Lemma set_In_subs_fresh_constraints : forall C S a s, set_In (a#?s) (C /? S) ->
                                                      exists X, set_In (a,X) C /\ s = []|.X|^S.
Proof.
  intros. induction C. simpl in H. contradiction.
  destruct a0. simpl in H. gen H.
  case (In_dom_dec v S); intros H0 H.
  apply set_add_elim in H. destruct H.
  exists v. inverts H. simpl. split~.
  apply IHC in H. case H; clear H; intros X H.
  destruct H. exists X. split~. right~.
  apply IHC in H. case H; clear H; intros X H.
  destruct H. exists X. split~. right~.
Qed.

Lemma length_Problem_vars_subs : forall P X t, set_In X (Problem_vars P) ->
                                   length (Problem_vars (P|^^(|[(X,t)]|))) =
                                   length (set_union var_eqdec (set_remove var_eqdec X (Problem_vars P)) (term_vars t)).
Proof.
  intros. apply subset_list_eq; intros.
  apply var_eqdec. apply NoDup_Problem_vars.
  apply set_union_nodup.
  rewrite <- remove_eq_set_remove.
  apply NoDup_remove_3. apply NoDup_Problem_vars.
  apply NoDup_Problem_vars. apply NoDup_term_vars.
  split~; intro H0.
  case (set_In_dec var_eqdec X (term_vars t)); intro H1.
  case (var_eqdec b X); intro H2.
  apply set_union_intro2. rewrite H2; trivial.
  apply In_im_subst_term_Problem' in H0.
  apply set_union_elim in H0. destruct H0.
  apply set_union_intro1. apply set_remove_3; trivial.
  apply set_union_intro2; trivial. generalize H0; intro H0'.
  apply In_im_subst_term_Problem' in H0.
  apply set_union_elim in H0. destruct H0.
  apply set_union_intro1. apply set_remove_3; trivial.
  intro H2. rewrite H2 in H0'. apply In_im_subst_term_Problem in H0'.
  contradiction. apply set_union_intro2; trivial.
  apply In_subst_Problem_im; trivial.
Qed.

(** About substitutions and proper terms *)

Lemma subs_is_Pr : forall s t X, is_Pr s -> is_Pr (s|^(|[(X,t)]|)).
Proof.
  intros. induction s; simpl in *|-*; trivial.
  contradiction.
Qed.

Lemma subs_Proper_term : forall s t X, Proper_term s -> Proper_term t -> Proper_term (s|^(|[(X,t)]|)).
Proof.
  intros. induction s; simpl; trivial.
  unfold Proper_term in *|-*; intros.
  simpl in H1. apply set_add_elim in H1; destruct H1. inverts H1.
  apply IHs with (n:=n); intros; trivial. apply H with (n:=n0); trivial.
  simpl. apply set_add_intro1; trivial.
  unfold Proper_term in *|-*; intros.
  simpl in H1. apply set_add_elim in H1; destruct H1. inverts H1.
  apply set_union_elim in H1. destruct H1.
  apply IHs1 with (n:=n); intros; trivial. apply H with (n:=n0); trivial.
  simpl. apply set_add_intro1. apply set_union_intro1; trivial.
  apply IHs2 with (n:=n); intros; trivial. apply H with (n:=n0); trivial.
  simpl. apply set_add_intro1. apply set_union_intro2; trivial.
  unfold Proper_term in *|-*; intros.
  simpl in H1. apply set_add_elim in H1; destruct H1. inverts H1.
  apply subs_is_Pr. apply H with (n:=n0). simpl. apply set_add_intro2; trivial.
  apply IHs with (n:=n1); intros; trivial. apply H with (n1:=n2); trivial.
  simpl. apply set_add_intro1; trivial.
  case (var_eqdec X v); intro H1; autorewrite with perm; simpl; trivial.
  apply perm_Proper_term; trivial.
Qed.

(** **)

Lemma TPlength_subst : forall S t E n,
      TPlength t E n <= TPlength (t|^S) E n.
Proof.
  intros. induction t; simpl subs; try omega.
  simpl; trivial. simpl; omega.
  case (nat_pair_eqdec (n0, n1) (E, n)); intro H.
  inverts H. autorewrite with tuples; trivial.
  rewrite 2 TPlength_Fc_diff; trivial.
  simpl. assert (Q : TPlength (p @ look_up v S) E n >= 1). auto. omega.
Qed.

Lemma TPlnegth_1_Su_subst : forall pi X t E n S,
      TPlength t E n = 1 ->
      TPith 1 t E n = pi|.X ->
      TPlength ((pi|.X)|^S) E n = TPlength (t|^S) E n .
Proof.
  intros. induction t.
  simpl in H0. inverts H0. simpl in H0. inverts H0.
  simpl in H0. inverts H0.
  simpl in H.
  assert (Q  : TPlength t1 E n >= 1). auto.
  assert (Q' : TPlength t2 E n >= 1). auto. omega.
  case (nat_pair_eqdec (n0, n1) (E, n)); intro H1.
  inverts H1. rewrite TPith_Fc_eq in H0.
  simpl subs. rewrite TPlength_Fc_eq in *|-*.
  apply IHt; trivial.
  rewrite TPith_Fc_diff in H0; trivial. inverts H0.
  simpl in H0. rewrite H0. trivial.
Qed.

Lemma TPlength_1_subst : forall S t E n,
      ~ is_Su (TPith 1 t E n) ->
      TPlength t E n = 1 -> TPlength (t |^ S) E n = 1 .
Proof.
  intros. induction t.
  simpl in *|-*; trivial. simpl in *|-*; trivial.
  simpl in *|-*; trivial. simpl in H0.
  assert (Q0 : TPlength t1 E n >= 1). auto.
  assert (Q1 : TPlength t2 E n >= 1). auto. omega.
  case (nat_pair_eqdec (n0, n1) (E, n)); intros H1.
  inverts H1. simpl subs. autorewrite with tuples in *|-*.
  apply IHt; trivial.
  simpl subs. rewrite TPlength_Fc_diff in *|-*; trivial.
  false. apply H. simpl; trivial.
Qed.

Lemma TPlength_1_TPith_subst : forall i S t E n,
      TPlength t E n = 1 ->
      TPlength (TPith i t E n|^S) E n =
      TPlength (t|^S) E n .
Proof.
  intros. induction t.
  simpl; trivial. simpl; trivial. simpl; trivial.
  assert (Q : TPlength t1 E n >= 1 /\ TPlength t2 E n >= 1).
   split~. destruct Q.
  simpl in H. omega.
  case (nat_pair_eqdec (n0, n1) (E, n)); intro H0.
  inverts H0. autorewrite with tuples in *|-*. simpl subs.
  autorewrite with tuples. apply IHt; trivial.
  rewrite TPith_Fc_diff; trivial.
  simpl; trivial.
Qed.

Lemma TPlength_TPith_subst : forall S i t E n,
      TPlength ((TPith i t E n)|^S) E n <= TPlength (t|^S) E n.
Proof.
  intros. gen i. induction t; intros.
  simpl; omega. simpl; omega. simpl; omega.
  Focus 3.
  (* 3:{ *) simpl; omega. (* } *)
  case (le_dec i (TPlength t1 E n)); intro H.
  rewrite TPith_Pr_le; trivial; simpl subs.
  assert (Q : TPlength (TPith i t1 E n|^S) E n <= TPlength (t1|^S) E n).
   apply IHt1.
  simpl. omega.
  rewrite TPith_Pr_gt; try omega.
  assert (Q : TPlength (TPith (i - TPlength t1 E n) t2 E n|^S) E n <=
              TPlength (t2|^S) E n).
   apply IHt2.
  simpl. omega.
  case (nat_pair_eqdec (n0,n1) (E,n)); intro H. inverts H.
  rewrite TPith_Fc_eq. simpl subs.
  rewrite TPlength_Fc_eq. apply IHt.
  rewrite TPith_Fc_diff; trivial.
Qed.

Lemma TPith_1_subst : forall S t E n,
      ~ is_Su (TPith 1 t E n) -> TPith 1 (t|^S) E n = (TPith 1 t E n)|^S.
Proof.
  intros. induction t.
  simpl; trivial. simpl; trivial. simpl; trivial.
  assert (Q0 : TPlength (t1|^S) E n >= 1). auto.
  assert (Q1 : TPlength t1 E n >= 1). auto. simpl.
  case (le_dec 1 (TPlength (t1|^S) E n)); intro H0; try omega.
  case (le_dec 1 (TPlength t1 E n)); intro H1; try omega.
  simpl. apply IHt1. intro H2. apply H. simpl.
  case (le_dec 1 (TPlength t1 E n)); intro H3; try contradiction; trivial.
  case (nat_pair_eqdec (n0, n1) (E, n)); intro H0.
  inverts H0. autorewrite with tuples. simpl subs.
  autorewrite with tuples. apply IHt; trivial.
  autorewrite with tuples in H. trivial.
  rewrite TPith_Fc_diff; trivial. simpl subs.
  rewrite TPith_Fc_diff; trivial.
  simpl in H. false. apply H; trivial.
Qed.

Lemma TPithdel_1_subst : forall S t E n,
      ~ is_Su (TPith 1 t E n) -> TPithdel 1 (t|^S) E n = (TPithdel 1 t E n)|^S.
Proof.
  intros. induction t.
  simpl; trivial. simpl; trivial. simpl; trivial.
  assert (Q : ~ is_Su (TPith 1 t1 E n)).
   intro H1. apply H. rewrite TPith_Pr_le; try omega; trivial.
  case (nat_eqdec (TPlength t1 E n) 1); intro H0.
  rewrite TPithdel_t1_Pr; trivial.
  simpl subs. rewrite TPithdel_t1_Pr; trivial.
  apply TPlength_1_subst; trivial.
  rewrite TPithdel_Pr_le; auto. simpl subs.
  rewrite TPithdel_Pr_le; auto.
  f_equal. apply IHt1; trivial. intro H1.
  assert (Q' : TPlength t1 E n <= TPlength (t1|^S) E n).
   apply TPlength_subst; trivial.
  assert (Q'' : TPlength t1 E n >= 1). auto. omega.
  case (nat_pair_eqdec (n0, n1) (E, n)); intros H0.
  inverts H0. autorewrite with tuples in H.
  case (nat_eqdec (TPlength t E n) 1); intro H0.
  rewrite 2 TPithdel_TPlength_1; trivial; simpl subs;
    autorewrite with tuples; trivial.
  apply TPlength_1_subst; trivial.
  rewrite TPithdel_Fc_eq; trivial. simpl subs.
  rewrite TPithdel_Fc_eq. rewrite IHt; trivial. intro H1.
  assert (Q' : TPlength t E n <= TPlength (t|^S) E n).
   apply TPlength_subst; trivial.
  assert (Q'' : TPlength t E n >= 1). auto. omega.
  rewrite TPithdel_Fc_diff; trivial.
  simpl subs. rewrite TPithdel_Fc_diff; trivial.
  simpl in H. false. apply H; trivial.
Qed.

Lemma TPith_1_Su_subs : forall E n S t pi X i,
    TPith 1 t E n = pi|.X ->
    i <= TPlength ((pi|.X)|^S) E n ->
    TPith i ((pi|.X)|^S) E n = TPith i (t|^S) E n.
Proof.
  intros. simpl subs in *|-*.
  gen i. induction t; intros.
  simpl in H. inverts H. simpl in H. inverts H.
  simpl in H. inverts H.
  Focus 3.
  (* 3:{ *) simpl in H. inverts H; trivial. (* } *)
  simpl subs.
  case (le_dec i (TPlength (t1|^S) E n)); intro H1.
  rewrite TPith_Pr_le; trivial. apply IHt1; trivial.
  rewrite TPith_Pr_le in H; trivial.
  assert (Q : TPlength ((TPith 1 t1 E n)|^S) E n <=
              TPlength (t1|^S) E n).
   apply TPlength_TPith_subst.
  rewrite TPith_Pr_le in H. rewrite H in Q.
  simpl in Q. omega.
  assert (Q' : TPlength t1 E n >= 1). auto. omega.
  case (nat_pair_eqdec (n0, n1) (E,n)); intro H1. inverts H1.
  simpl subs. rewrite TPith_Fc_eq in *|-*.
  apply IHt; trivial. simpl subs. rewrite TPith_Fc_diff in H; trivial.
  inverts H.
Qed.

Lemma TPlength_TPith_TPithdel_subst : forall i t E n S,
      TPlength t E n <> 1 ->
      TPlength (TPith i t E n|^S) E n +
      TPlength (TPithdel i t E n|^S) E n = TPlength (t|^S) E n.
Proof.
  intros. gen i. induction t; intros.
  simpl in H. false. simpl in H. false. simpl in H. false.
  Focus 3.
  (* 3:{ *)  simpl in H. false. (* } *)
  case (le_dec i (TPlength t1 E n)); intro H0.
  rewrite TPith_Pr_le; trivial.
  case (eq_nat_dec (TPlength t1 E n) 1); intro H1.
  rewrite TPithdel_t1_Pr; trivial. simpl.
  rewrite TPlength_1_TPith_subst; trivial.
  rewrite TPithdel_Pr_le; trivial. simpl.
  apply IHt1 with (i:=i) in H1. omega.
  rewrite TPith_Pr_gt; try omega.
  case (eq_nat_dec (TPlength t2 E n) 1); intro H1.
  rewrite TPithdel_t2_Pr; try omega.
  simpl. rewrite TPlength_1_TPith_subst; omega.
  rewrite TPithdel_Pr_gt; try omega. simpl.
  apply IHt2 with (i:=i - TPlength t1 E n) in H1. omega.
  case (nat_pair_eqdec (n0, n1) (E, n)); intro H0. inverts H0.
  rewrite TPlength_Fc_eq in H.
  rewrite TPith_Fc_eq. rewrite TPithdel_Fc_eq; trivial.
  simpl subs. rewrite 2 TPlength_Fc_eq. apply IHt; trivial.
  rewrite TPlength_Fc_diff in H; trivial. false.
Qed.

Lemma TPith_TPithdel_1_subst : forall i t E n S,
      i > 0 -> TPlength t E n <> 1 ->
      TPith i (TPithdel 1 t E n|^ S) E n =
      TPith (i + TPlength ((TPith 1 t E n)|^S) E n) (t|^S) E n.
Proof.
  intros. gen i. induction t; intros.
  simpl in H0. false. simpl in H0. false. simpl in H0. false.
  assert (Q : TPlength t1 E n >= 1). auto.
  rewrite TPith_Pr_le; try omega.
  replace ((<|t1, t2|>)|^S) with (<|t1|^S, t2|^S|>).
  case (eq_nat_dec (TPlength t1 E n) 1); intro H1.
  rewrite TPithdel_t1_Pr; try omega.
  rewrite TPlength_1_TPith_subst; trivial.
  rewrite TPith_Pr_gt; try omega.
  replace(i + TPlength (t1|^S) E n - TPlength (t1|^S) E n)
         with i; trivial; omega.
  rewrite TPithdel_Pr_le; try omega.
  replace ((<|TPithdel 1 t1 E n, t2|>)|^S) with
          (<|TPithdel 1 t1 E n|^S, t2|^S|>).
  case (le_dec i (TPlength (TPithdel 1 t1 E n|^S) E n)); intro H2.
  rewrite 2 TPith_Pr_le; trivial. apply IHt1; trivial.
  rewrite <- TPlength_TPith_TPithdel_subst
    with (i:=1) (t:=t1); trivial. omega.
  rewrite 2 TPith_Pr_gt; try omega.
  fequals. rewrite <- TPlength_TPith_TPithdel_subst
    with (i:=1) (t:=t1); trivial. omega.
  rewrite <- TPlength_TPith_TPithdel_subst
    with (i:=1) (t:=t1); trivial. omega.
  simpl; trivial. simpl; trivial.
  case (nat_pair_eqdec (n0, n1) (E, n)); intro H1. inverts H1.
  autorewrite with tuples in *|-*.
  rewrite TPithdel_Fc_eq; trivial. simpl subs.
  autorewrite with tuples. apply IHt; trivial.
  rewrite TPlength_Fc_diff in H0; trivial. false.
  simpl in H0. false.
Qed.

(** *)

Lemma rhvars_Prob_subs : forall P X Y t, ~ set_In X (rhvars_Probl P) ->
                                           set_In Y (rhvars_Probl (P|^^(|[(X,t)]|))) ->
                                           set_In Y (rhvars_Probl P).
Proof.
 intros. induction P; simpl in *|-*; trivial.
 destruct a; simpl in *|-. apply IHP; trivial.
 apply set_union_elim in H0. destruct H0.
 rewrite not_occurs in H0. apply set_union_intro1; trivial.
 intro H1. apply H. apply set_union_intro1; trivial.
 apply set_union_intro2. apply IHP; trivial.
 intro H1. apply H. apply set_union_intro2; trivial.
Qed.

Lemma rhvars_Prob_fresh : forall X C S, ~ set_In X (rhvars_Probl (C/?S)).
Proof.
  intros. intro H. induction C; simpl in *|-; trivial.
  destruct a. gen H.
  case (In_dom_dec v S); intros H H0;
   try contradiction.
  apply rhvars_Prob_add in H0. simpl in H0.
  destruct H0; contradiction.
Qed.


Require Import ZArith.
Require Import Arith.
Open Scope Z_scope.

Theorem r_ex : (forall x y:nat, x + y = x + y)%nat.
Admitted.

Theorem r_ex' : forall x y:nat, (x + y = x + y)%nat.
Admitted.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.montgomery64_2e488m17_8limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition opp :
  { opp : feBW_small -> feBW_small
  | forall a, phiM_small (opp a) = F.opp (phiM_small a) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_opp ().
  Show Ltac Profile.
Time Defined.

Print Assumptions opp.


Require Import rt.util.all.
Require Import rt.model.basic.schedule.
Require Import rt.analysis.parallel.workload_bound.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop.

Module InterferenceBoundGeneric.

  Section Definitions.

    Import Schedule WorkloadBound.

    Context {sporadic_task: eqType}.
    Variable task_cost: sporadic_task -> time.
    Variable task_period: sporadic_task -> time.
    Variable task_deadline: sporadic_task -> time.

    (* Let tsk be the task to be analyzed. *)
    Variable tsk: sporadic_task.

    Let task_with_response_time := (sporadic_task * time)%type.

    (* Assume a known response-time bound for each interfering task ... *)
    Variable R_prev: seq task_with_response_time.

    (* ... and an interval length delta. *)
    Variable delta: time.

    Section PerTask.

      Variable tsk_R: task_with_response_time.
      Let tsk_other := fst tsk_R.
      Let R_other := snd tsk_R.

      (* Based on the workload bound, Bertogna and Cirinei define the
         following interference bound for a task. *)
      Definition interference_bound_generic :=
        W task_cost task_period tsk_other R_other delta.

    End PerTask.

  End Definitions.

End InterferenceBoundGeneric.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.montgomery32_2e196m15_7limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition opp :
  { opp : feBW_small -> feBW_small
  | forall a, phiM_small (opp a) = F.opp (phiM_small a) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_opp ().
  Show Ltac Profile.
Time Defined.

Print Assumptions opp.


Add Rec LoadPath "../Combi/LRrule".

Require Import ssreflect ssrbool eqtype ssrnat seq .
Require Import bigop fintype Omega rat ssrint ssralg.
Require Import partition.
Import GRing.Theory.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Lemma ltppSS : forall m n , n<m-1 -> m = (m.-2).+2 .
case => [ltn0 //=|[ltn0 //=|m' //=]].
Save.

Lemma leq_succ : forall m n, (m.+1 <= n.+1) = (m <= n).
move => m n.
rewrite -addn1 -(addn1 n).
apply leq_add2r.
Save.

Lemma part_head_0ltn sh : is_part sh -> 0 < head 1 sh.
Proof.
  elim: sh => [//= | sh0 sh IHsh] /= /andP [] Head.
  move/IHsh; apply: contraLR. rewrite !ltnNge !negbK leqn0 => /eqP Hsh0.
  by move: Head; rewrite Hsh0 leqn0.
Qed.

Lemma nth_part_0ltn sh i : is_part sh -> i < size sh -> 0 < nth 0 sh i.
Proof.
  elim: i sh => [//= | i IHi] [//=| s0 s].
    by move=> /part_head_0ltn.
  move=> /= /andP [] _.
  exact: IHi.
Qed.

Lemma out_corner_ltn_size p i : is_out_corner p i -> i < size p.
apply contraLR.
rewrite /is_out_corner !ltnNge !negbK => Hsize.
by rewrite !nth_default; [rewrite //=|apply (leq_trans Hsize)| ].
Qed.

Fixpoint haut (L : seq nat) j {struct L} : nat :=
 match L with
  |[::] => 0
  |b :: reste => if j<b then (haut reste j).+1 else 0
end.

Lemma haut_nth : forall L j, is_part L -> forall i, (nth 0 L i <= j) = (haut L j <= i).
elim => [|a L IH] j Hpart i; [rewrite nth_default //= |].
case: (leqP a j) => [Haj|Hja].
+ move /is_part_ijP : Hpart.
  case => _ Hdecroissance.
  move : (Hdecroissance 0 i).
  simpl.
  move => H1.
  have: (nth 0 (a :: L) i <= j).
    by rewrite (@leq_trans a (nth 0 (a :: L) i) j (H1 _) Haj).
  move => H2.
  rewrite H2.
  move : Haj.
  rewrite leqNgt.
  case (j<a); by simpl.
+ rewrite /=.
  case: i => [|i'].
  rewrite /=.
  rewrite leqNgt.
  move : Hja.
  by case (j<a) => [_|].
  rewrite /=.
  move : Hja.
  case (j<a); [|rewrite //=].
  apply conj.
  exact (IH j (is_part_tl Hpart) i') .
Qed.

Lemma haut_nth_lt : forall L j, is_part L -> forall i, (j < nth 0 L i) = (i < haut L j).
move => L j HL i; rewrite !ltnNge.
congr negb.
apply haut_nth; trivial.
Save.

Lemma haut_decr (L : seq nat) j1 j2 : is_part L -> j1 <= j2 -> haut L j2 <= haut L j1.
move => Hp Hle.
rewrite -(haut_nth _ Hp).
apply: (leq_trans _ Hle).
by rewrite (haut_nth j1 Hp).
Save.

Definition hook' (L : seq nat) i j := ((nth 0 L i)-j).-1 + ((haut L j)-i).-1.
Definition hook (L : seq nat) i j := (hook' L i j ).+1.
Definition lindex L i := (nth 0 L i).-1.

Definition F_deno (L : seq nat) :=
    \prod_(i < (length L)) ( \prod_(j < (nth 0 L i)) (hook L i j)).

Definition is_in_part L i j := j < nth 0 L i.

Lemma is_in_part_col L i j : is_part L -> is_in_part L i j -> i < size L.
rewrite  /is_in_part.
move => Hpart Hin_part.
case : ltnP => [rewrite //= |  Hi].
have : (nth 0 L i = 0) .
  rewrite nth_default //=.
move  => H.
by rewrite H in Hin_part.
Save.

Lemma in_empty : forall i j, is_in_part [::] i j = false.
move => i j.
rewrite /is_in_part nth_default //=.
Qed.

Definition p0 := [:: 5; 3; 3; 1].

Lemma haut_lindex_ltn p i : i < haut p (lindex p i).
admit.
Qed.

Lemma haut_lindex_out ( p : intpart) i : is_out_corner p i -> haut p (lindex p i) == 1+i .
rewrite /is_out_corner /lindex.
move => His_out_corner.
rewrite eqn_leq.
apply /andP; split.
+ rewrite -haut_nth; last by apply intpartP.
  rewrite -leq_succ.
  rewrite prednK; [apply His_out_corner|apply nth_part_0ltn].
  apply intpartP.
  by apply out_corner_ltn_size.
+ apply haut_lindex_ltn.
Qed.

Lemma hook'0_out_corner L i j : is_part L -> is_in_part L i j -> hook' L i j == 0
                                   -> is_out_corner L i && (j == (nth 0 L i).-1).
move => Hpart.
rewrite /is_in_part => Hin_part.
rewrite /hook' addn_eq0.
move /andP => [Hnth Hhaut].
apply /andP; split.
rewrite /is_out_corner.
apply leq_trans with j.+1; last rewrite //=.
rewrite ltnS haut_nth //=.
by rewrite -subn_eq0 subnS.
rewrite eqn_leq.
apply /andP; split.
rewrite -(leq_add2l 1).
apply leq_trans with (nth 0 L i).
trivial.
apply leqSpred.
rewrite -subn_eq0.
by rewrite -subn1 -subnAC subn1.
Qed.

Lemma negb_simpl : forall b1 b2, ~~ b1= ~~ b2 -> b1=b2.
move => b1 b2; by case b1; case b2.
Save.

Lemma iff_eqb : forall (b1 b2:bool), (b1<->b2) -> b1=b2.
move => b1 b2; case b1; case b2 => //=; intuition.
discriminate H0.
trivial.
Save.

Lemma haut_in_le L i j : is_part L -> ((is_in_part L i j) = (i < haut L j)).
rewrite /is_in_part; move => Hp.
apply haut_nth_lt; trivial.
Save.

Lemma is_in_part_simpl L i j : is_part L -> is_in_part L i j = ((j < nth O L i) && (i < haut L j))%B.
rewrite /is_in_part; move => Hp.
have [Ht | Hf] := (boolP (j < nth 0 L i)) => //=.
rewrite -haut_nth_lt //.
Save.

Lemma out_corner_hook'0 L i : is_out_corner L i -> hook' L i (lindex L i) = 0.
admit.
Save.

Definition F L :=  ((((sumn L )`!)%:Q) / (F_deno L)%:Q)%Q.

Definition F_decr L i := F (decr_nth L i).

Lemma F_decr_over_F L a : is_out_corner L a ->
       (F_decr L a / F L =
        (sumn L)%:Q^-1 * (\prod_(0 <= i < a) (1 + (hook' L i (lindex L a))%:Q^-1))
             * (\prod_(0 <= j < lindex L a) (1 + (hook' L a j)%:Q^-1)))%Q.
admit. Save.

(* Lemma l4311 : F_deno [:: 4;2;1;1] = 448.
unfold F_deno.
rewrite !big_ord_recr !big_ord0.
simpl.
reflexivity.
Qed. *)

Fixpoint mange_nth  (L : seq nat) (n : nat) {struct L} : seq nat :=
  match L with
  | [::] => [::]
  | x :: L' =>
     match n with
     | 0 => (x-1) :: L'
     | n'.+1 => x :: mange_nth L' n'
     end
  end.

Lemma hook_cons a L i j : is_part (a :: L) -> hook' ( a::L ) i.+1 j = hook' L i j.
Proof.
rewrite /hook' /= .
move =>  /andP  [] Hhead _.
case : (ltnP j a) => Hja.
- by rewrite subSS.
- case: L Hhead => [| b L'] //= Hhead.
  have := leq_trans Hhead Hja.
  rewrite leqNgt => /negbTE ->.
  by rewrite !sub0n .
Qed.

Lemma is_out_corner_cons a L i : is_out_corner L i <-> is_out_corner (a :: L) i.+1.
intuition. Qed.

Lemma hook_mange_ligne (L : seq nat) (i j :nat) : (is_part L) -> is_out_corner L i
      -> (i < size L) -> (j < nth 0 L i -1) ->
            hook' L i j = (hook' (decr_nth L i) i j).+1.
elim :  L i => [//= | a l IHl] [|i'] /= Hpart Hcorn Hl1 Hj.
- rewrite {2}(ltppSS Hj) /hook' /nth  /=.
  have -> : (j<a).
    exact: (leq_trans Hj (leq_subr _ _)).
  rewrite prednK -!subn1.
  rewrite Hj.
  succn_to_add.
  rewrite addnA.
  congr addn.
  rewrite addnC.
  rewrite subnK.
    rewrite -!subnDA addnC //=.
  * by rewrite ltn_subRL addn0.
  * rewrite (leq_trans (n := j.+1)) //=.
- rewrite !hook_cons.
  apply IHl.
  * move : Hpart.
    move => /andP [] _ Hpartr //=.
  * rewrite (is_out_corner_cons a l i') //=.
  * move : Hl1.
    by rewrite leq_succ.
  * trivial.
  * rewrite /is_part.
admit.
admit.
Qed.

Lemma hook'_decomp (L : intpart) (a b :nat) (o:nat) :
     is_in_part L a b -> is_out_corner L o -> a <= o -> b <= lindex L o
     -> hook' L a b = hook' L a  (lindex L o) + hook' L o b.
move => Hpart Hc Hl Hr; rewrite /hook'.
have Lpart : is_part L.
by apply intpartP.
have Hnao : (nth O L o <= nth O L a).
have :=(is_part_ijP L Lpart).
move => [_ H2].
by apply H2.
have Hnb : (haut L (lindex L o) <= haut L b).
by apply haut_decr.
have H : (haut L (lindex L o) = o).
rewrite /lindex.
set na:= nth 0 L a.
set hb:= haut L b.
set no:= nth 0 L o.
set ho:= haut L (no.-1).
admit.
admit.
Save.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas64_2e192m2e64m1_4limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition square :
  { square : feBW_loose -> feBW_tight
  | forall a, phiBW_tight (square a) = F.mul (phiBW_loose a) (phiBW_loose a) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_square ().
  Show Ltac Profile.
Time Defined.

Print Assumptions square.


From QuickChick Require Import QuickChick.
Import GenLow GenHigh.
Import QcDefaultNotation. Open Scope qc_scope.

Require Import List ZArith.
Import ListNotations.

Require Import Base.
Require Import BaseShow.

(* 𝔗 *)
Fixpoint gen_𝔗 (size : nat) : G 𝔗 :=
  match size with
  | O => elems [ Unit ; Void ]
  | S size' => oneOf
      [ liftGen2 𝔗mult (gen_𝔗 size') (gen_𝔗 size') ;
        liftGen2 𝔗plus (gen_𝔗 size') (gen_𝔗 size') ;
        liftGen2 𝔗impl (gen_𝔗 size') (gen_𝔗 size') ]
  end.

Sample (gen_𝔗 0).
Sample (gen_𝔗 1).
Sample (gen_𝔗  2).

Instance gen_𝔗_sized : GenSized 𝔗 :=
  {| arbitrarySized n := gen_𝔗 n |}.

(* 𝔄 *)
Fixpoint gen_𝔄 (size : nat) : G 𝔄 :=
  match size with
  | O => elems [ 𝔄0 ; 𝔄1 ]
  | S size' => oneOf
      [ liftGen2 𝔄mult (gen_𝔄 size') (gen_𝔄 size') ;
        liftGen2 𝔄plus (gen_𝔄 size') (gen_𝔄 size') ;
        liftGen2 𝔄impl (gen_𝔄 size') (gen_𝔄 size') ;
        liftGen 𝔄diam (gen_𝔄 size') ]
  end.

Sample (gen_𝔄 0).
Sample (gen_𝔄 1).
Sample (gen_𝔄  2).

Instance gen_𝔄_sized : GenSized 𝔄 :=
  {| arbitrarySized n := gen_𝔄 n |}.

(* 𝔱 *)
Fixpoint gen_𝔱 (size : nat) : G 𝔱 :=
  match size with
  | O => elems [ 𝔱id (𝔵id 0) ; 𝔱hole ]
  | S size' => oneOf
      [ liftGen 𝔱holecase (gen_𝔱 size') ;
        liftGen2 𝔱pair (gen_𝔱 size') (gen_𝔱 size') ;
        liftGen2 𝔱lambda (returnGen (𝔵id 0)) (gen_𝔱 size') ]
  end.

Sample (gen_𝔱 0).
Sample (gen_𝔱 1).
Sample (gen_𝔱 2).

Instance gen_𝔱_sized : GenSized 𝔱 :=
  {| arbitrarySized n := gen_𝔱 n |}.

(* 𝔢 *)
Fixpoint gen_𝔢 (size : nat) : G 𝔢 :=
  match size with
  | O => elems [ 𝔢id (𝔵id 0) ; 𝔢hole ]
  | S size' => oneOf
      [ liftGen 𝔢holecase (gen_𝔢 size') ;
        liftGen2 𝔢pair (gen_𝔢 size') (gen_𝔢 size') ;
        liftGen2 𝔢lambda (returnGen (𝔵id 0)) (gen_𝔢 size') ]
  end.

Sample (gen_𝔢 0).
Sample (gen_𝔢 1).
Sample (gen_𝔢 2).

Instance gen_𝔢_sized : GenSized 𝔢 :=
  {| arbitrarySized n := gen_𝔢 n |}.


Require Import Coq.Relations.Relations.
Require Import MirrorCore.ExprI.

Set Implicit Arguments.
Set Strict Implicit.

Section sem.
  Variable typ : Set.
  Variable RType_typ : RType typ.
  Variable expr : Set.
  Variable Expr_expr : Expr _ expr.

  Definition Sem_equiv' (t : typ) (R : relation (typD t))
             (tus tvs : tenv typ)
  : relation expr :=
    fun x y =>
      match exprD tus tvs t x , exprD tus tvs t y with
      | None , None => True
      | Some l , Some r =>
        forall us vs, R (l us vs) (r us vs)
      | _ , _ => False
      end.

  Instance Reflexive_Sem_equiv' t Rt (Refl_Rt : Reflexive Rt) tus tvs
  : Reflexive (@Sem_equiv' t Rt tus tvs).
  Proof.
    red. red; intros. destruct (exprD tus tvs t x); auto.
  Qed.

  Instance Symmetric_Sem_equiv' t Rt (Refl_Rt : Symmetric Rt) tus tvs
  : Symmetric (@Sem_equiv' t Rt tus tvs).
  Proof.
    red. unfold Sem_equiv'. intros.
    destruct (exprD tus tvs t x);
    destruct (exprD tus tvs t y); intuition.
  Qed.

  Instance Transitive_Sem_equiv' t Rt (Refl_Rt : Transitive Rt) tus tvs
  : Transitive (@Sem_equiv' t Rt tus tvs).
  Proof.
    red. unfold Sem_equiv'; simpl; intros.
    destruct (exprD tus tvs t x);
      destruct (exprD tus tvs t y);
      destruct (exprD tus tvs t z); auto.
    { intros. etransitivity. eapply H. eauto. }
    { intuition. }
  Qed.

  Definition Sem_equiv (t : typ) (R : relation (typD t)) (us vs : env)
  : relation expr :=
    fun x y =>
      match env_exprD us vs t x , env_exprD us vs t y with
      | None , None => True
      | Some l , Some r => R l r
      | _ , _ => False
      end.

  Instance Reflexive_Sem_equiv t Rt (Refl_Rt : Reflexive Rt) us vs
  : Reflexive (@Sem_equiv t Rt us vs).
  Proof.
    red. red; intros.
    destruct (env_exprD us vs t x); auto.
  Qed.

  Instance Symmetric_Sem_equiv t Rt (Refl_Rt : Symmetric Rt) us vs
  : Symmetric (@Sem_equiv t Rt us vs).
  Proof.
    red. unfold Sem_equiv. intros.
    destruct (env_exprD us vs t x);
    destruct (env_exprD us vs t y); intuition.
  Qed.

  Instance Transitive_Sem_equiv t Rt (Refl_Rt : Transitive Rt) us vs
  : Transitive (@Sem_equiv t Rt us vs).
  Proof.
    red. unfold Sem_equiv.
    intros.
    destruct (env_exprD us vs t x);
      destruct (env_exprD us vs t y);
      destruct (env_exprD us vs t z); auto.
    { intros. etransitivity. eapply H. eauto. }
    { intuition. }
  Qed.

  Definition Sem_ext (t : typ) (P : typD t -> Prop) (Q : Prop) us vs
  : expr -> Prop :=
    fun e =>
      match env_exprD us vs t e with
        | Some val => P val
        | None => Q
      end.

  Definition Sem_ext' (t : typ) (P : typD t -> Prop) (Q : Prop) tus tvs
  : expr -> Prop :=
    fun e =>
        match exprD tus tvs t e with
          | Some val =>
            forall us vs, P (val us vs)
          | None => Q
        end.

End sem.