Load LFindLoad.
From lfind Require Import LFind.
Unset Printing Notations.
Set Printing Implicit.

From QuickChick Require Import QuickChick.
Inductive natural : Type := Succ : natural -> natural |  Zero : natural.
Derive Show for natural. Derive Arbitrary for natural.  Instance Dec_Eq_natural : Dec_Eq natural. Proof. dec_eq. Qed.
Inductive lst : Type :=  Nil : lst | Cons : natural -> lst -> lst .

Inductive tree : Type := Node : natural -> tree -> tree -> tree |  Leaf : tree.

Inductive Pair : Type := mkpair : natural -> natural -> Pair
with Zlst : Type := zcons : Pair -> Zlst -> Zlst |  znil : Zlst.

Fixpoint append (append_arg0 : lst) (append_arg1 : lst) : lst
           := match append_arg0, append_arg1 with
              | Nil, x => x
              | Cons x y, z => Cons x (append y z)
              end.

Fixpoint rev (rev_arg0 : lst) : lst
           := match rev_arg0 with
              | Nil => Nil
              | Cons x y => append (rev y) (Cons x Nil)
              end.

Lemma append_nil : forall (x : lst), append x Nil = x.
Proof.
   intros.
   induction x.
   - reflexivity.
   - simpl. rewrite IHx. reflexivity.
Qed.

Lemma append_assoc : forall (x y z : lst), append (append x y) z = append x (append y z).
Proof.
   intros.
   induction x.
   - reflexivity.
   - simpl. rewrite IHx. reflexivity.
Qed.

Theorem theorem0 : forall (x : lst) (y : lst), eq (rev (append (rev x) y)) (append (rev y) x).
Proof.
   induction x.
   - intros.  simpl. lfind.  reflexivity.
Admitted.


(**
============================================================================
 Project     : Nominal A, AC and C Unification
 File        : Problems.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 contains the definitions and basic lemmas related to
               unification problems.

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

Require Export C_Equiv.

Close Scope nat_scope.

(** Definitions *)

(** A constraint is inductive defined as being
    an equation or a freshness constraint *)

Inductive Constraint : Set :=
  | fresh_constraint : Atom -> term -> Constraint
  | equ_constraint : term -> term -> Constraint
.

(** A substitution, a problem and a triple are respectively
    a set of pairs of variables and terms, a set of constraints
    and a triple of freshness contexts, substitutions and problems. *)

Definition Subst := set (Var * term) .
Definition Problem := set (Constraint).
Definition Triple := (Context * Subst * Problem) .

(** Decidability between constraints *)

Lemma Constraint_eqdec : forall x y : Constraint, {x = y} + {x <> y}.
Proof.
  intros. destruct x; destruct y.
  case (atom_eqdec a a0); intro H.
  case (term_eqdec t t0); intro H0.
  rewrite H. rewrite H0. left~.
  right~. intro. inverts H1. apply H0; trivial.
  right~. intro. inverts H0. apply H; trivial.
  right~. discriminate. right~. discriminate.
  case (term_eqdec t t1); intro H.
  case (term_eqdec t0 t2); intro H0.
  rewrite H. rewrite H0. left~.
  right~. intro. inverts H1. apply H0; trivial.
  right~. intro. inverts H0. apply H; trivial.
Qed.

(** Decidability between constraints pairs of atoms and variables (elements of a
    freshness context). *)

Lemma Context_eqdec : forall x y : (Atom * Var), {x = y} + {x <> y}.
Proof.
  intros. destruct x; destruct y.
  case (atom_eqdec a a0); intro H.
  case (var_eqdec v v0); intro H0.
  rewrite H. rewrite H0. left~.
  right~. intro. inverts H1. apply H0; trivial.
  right~. intro. inverts H0. apply H; trivial.
Qed.

(** Some notations *)

Notation "a #? t" := (fresh_constraint a t) (at level 67).
Notation "s ~? t" := (equ_constraint s t) (at level 67).

Notation "P \ u" := (set_remove Constraint_eqdec u P) (at level 67).
Notation "P |+ u" := (set_add Constraint_eqdec u P) (at level 67).
Notation "C |++ u" := (set_add Context_eqdec u C) (at level 67).
Notation "P0 \cup P1" := (set_union Constraint_eqdec P0 P1) (at level 67).

(** Variables of a problem *)

Fixpoint Problem_vars (P : Problem) : set Var :=
  match P with
    | [] => []
    | (a#?t)::P0 => set_union var_eqdec (term_vars t) (Problem_vars P0)
    | (s~?t)::P0 => set_union var_eqdec (term_vars s)
                   (set_union var_eqdec (term_vars t) (Problem_vars P0))
  end.

(** Subsets of equations and freshness contexts of a problem *)

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

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

(** Fixpoint equations are defined as pi|.X ~? []|.X, where
    pi <> [] *)

Definition fixpoint_equ (u : Constraint) :=
  exists pi, exists X, pi <> [] /\ u = pi|.X ~? []|.X.

(** Fixpoint problems are composed only by fixpoint equations *)

Definition fixpoint_Problem (P : Problem) := forall u, set_In u P -> fixpoint_equ u.

(** Proper problems contais only proper terms in its equations. *)

Definition Proper_Problem (P : Problem) :=
  (forall s t, set_In (s~?t) P -> ((Proper_term s) /\ (Proper_term t))) .

(** Right-hand vars of a problem *)

Fixpoint rhvars_Probl (P : Problem) :=
  match P with
  | [] => []
  | (a#?s) :: P0 => rhvars_Probl P0
  | (s~?t) :: P0 => set_union var_eqdec (term_vars t) (rhvars_Probl P0)
  end.

(** Building freshness contexts over a variable *)

Fixpoint fresh_context (S : set Atom) (X : Var) :=
  match S with
    | [] => []
    | a :: S0 => (a, X) :: fresh_context S0 X
  end.

(** Lemmas *)

(** Decidability of existence of equations and freshness constraints
  in a problem *)

Lemma  set_In_equ_Problem_eqdec : forall P, {exists s, exists t, set_In (s~?t) P} + {forall s t, ~ set_In (s~?t) P}.
Proof.
  intros. induction P.
  right~. destruct IHP.
  left~.  destruct e. destruct H.
  exists x. exists x0. right~.
  destruct a. right~; intros. intro H.
  simpl in H. destruct H. inverts H.
  apply (n s t0); trivial.
  left~. exists t. exists t0. left~.
Qed.

Lemma set_In_fresh_Problem_eqdec : forall P, {exists a, exists s, set_In (a#?s) P} + {forall a s, ~ set_In (a#?s) P}.
Proof.
  intros. induction P.
  right~. destruct IHP.
  left~.  destruct e. destruct H.
  exists x. exists x0. right~.
  destruct a. left~. exists a. exists t. left~.
  right~; intros. intro H. simpl in H.
  destruct H. inverts H. apply (n a s); trivial.
Qed.

(** Basic results about fixpoint equations and fixpoint problems *)

Lemma fixpoint_equ_eqdec : forall u, {fixpoint_equ u} + {~ fixpoint_equ u}.
Proof.
  intros. unfold fixpoint_equ. destruct u.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  destruct t.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  destruct t0.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  destruct p0.
  case (perm_eqdec p ([])); intro H'.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
  symmetry in H1; contradiction.
  case (var_eqdec v v0); intro H. rewrite H.
  left~. exists p. exists v0. split~.
  right~. intro H''. destruct H''. destruct H0. destruct H0. inverts H1.
  apply H; trivial.
  right~. intro H. destruct H. destruct H. destruct H. inverts H0.
Qed.

Lemma fixpoint_Problem_nil : fixpoint_Problem ([]).
Proof.
  unfold fixpoint_Problem; intros. simpl in H. contradiction.
Qed.

Lemma fixpoint_Problem_eqdec : forall P, {fixpoint_Problem P} + {~ fixpoint_Problem P}.
Proof.
  intro. induction P. left~. apply fixpoint_Problem_nil.
  destruct IHP. case (fixpoint_equ_eqdec a); intro H.
  left~. unfold fixpoint_Problem in *|-*; intros.
  simpl in H0. destruct H0. rewrite <- H0; trivial.
  apply f; trivial.
  right~. intro H'. apply H.
  unfold fixpoint_Problem in H'. apply H'. left~.
  right~. intro H. apply n. clear n.
  unfold fixpoint_Problem in *|-*; intros.
  apply H. right~.
Qed.

Lemma non_fixpoint_equ_proj : forall P, ~ fixpoint_Problem (equ_proj P) ->
                              exists s t, set_In (s~?t) P /\ ~ fixpoint_equ (s~?t).
Proof.
  intros. induction P.
  false. apply H; intros. simpl.
  apply fixpoint_Problem_nil.
  destruct a. simpl in *|-*.
  apply IHP in H. destruct H. destruct H.
  exists x. exists x0. destruct H. split~.
  simpl in H. case (fixpoint_equ_eqdec (t ~? t0)); intro H0.
  destruct IHP. intro H1. apply H.
  unfold fixpoint_Problem; intros.
  simpl in H2. destruct H2. rewrite <- H2; trivial. apply H1; trivial.
  destruct H1. destruct H1. exists x. exists x0. split~. simpl. right~.
  exists t. exists t0. split~. left~.
Qed.

Lemma set_In_fixpoint_eq_proj : forall P,  (forall s t,  set_In (s ~? t) P -> fixpoint_equ (s ~? t)) ->
                                            fixpoint_Problem (equ_proj P).
Proof.
  intros. case (fixpoint_Problem_eqdec (equ_proj P)); intro H1; trivial.
  apply non_fixpoint_equ_proj in H1.
  case H1; clear H1; intros s H1. case H1; clear H1; intros t H1.
  destruct H1. apply H in H0. contradiction.
Qed.

Lemma fixpoint_not_In_fresh : forall P, fixpoint_Problem (equ_proj P) ->
                                        (forall (a : Atom) (s : term), ~ set_In (a #? s) P) ->
                                        fixpoint_Problem P.
Proof.
  intros. induction P.
  apply fixpoint_Problem_nil. destruct a.
  false. apply (H0 a t). left~.
  simpl in H. unfold fixpoint_Problem; intros.
  simpl in H1. destruct H1. rewrite <- H1.
  apply H. left~. apply IHP; intros; trivial.
  unfold fixpoint_Problem; intros. apply H. right~.
  assert (Q : ~ set_In (a #? s) ((t ~? t0) :: P)). apply H0.
  intro H2. apply Q. right~.
Qed.

(** Basic results about subsets of equations and freshness constraints *)

Lemma fresh_not_In_equ_proj : forall a s P, ~ set_In (a #? s) (equ_proj P).
Proof.
  intros. intro H. induction P.
  simpl in H; trivial. destruct a0; simpl in H; try contradiction.
  destruct H. inverts H. contradiction.
Qed.

Lemma equ_proj_append : forall P P',  equ_proj (P ++ P') =
                                     (equ_proj P)++(equ_proj P').
Proof.
  intros. induction P; simpl; trivial.
  destruct a; trivial. simpl. fequals.
Qed.

Lemma fresh_proj_append : forall P P',  fresh_proj (P ++ P') =
                                       (fresh_proj P)++(fresh_proj P').
Proof.
  intros. induction P; simpl; trivial.
  destruct a; trivial. simpl. fequals.
Qed.

Lemma equ_proj_set_In_eq : forall P s t, set_In (s~?t) P <-> set_In (s~?t) (equ_proj P).
Proof.
  intros. induction P; simpl. split~; intro; trivial.
  destruct a. split~; intro. destruct H. inverts H.
  apply IHP; trivial. right~. apply IHP; trivial.
  simpl. split~; intro. destruct H.
  left~. right~. apply IHP; trivial.
  destruct H. left~. right~.
  apply IHP; trivial.
Qed.

Lemma equ_proj_rem_eq : forall P u, equ_proj (P\u) = (equ_proj P)\u .
Proof.
  intros. induction P; simpl; trivial.
  destruct a. case (Constraint_eqdec u (a #? t)); intro H.
  rewrite H. clear IHP H. induction P; simpl; trivial.
  destruct a0; trivial. rewrite IHP; trivial.
  simpl. case (Constraint_eqdec (a #? t) (t0 ~? t1)); intro H. inverts H.
  rewrite <- 2 IHP; trivial. simpl; trivial.
  case (Constraint_eqdec u (t ~? t0)); intro H.
  rewrite H. simpl. case (Constraint_eqdec (t ~? t0) (t ~? t0)); intro H0; trivial.
  false. simpl. case (Constraint_eqdec u (t ~? t0)); intro H0; try contradiction.
  rewrite IHP. trivial.
Qed.

Lemma equ_proj_add_fresh : forall P a s, equ_proj (P|+(a#?s)) = equ_proj P .
Proof.
  intros. case (in_dec Constraint_eqdec (a#?s) P); intro H.
  rewrite set_add_In; trivial. rewrite set_add_not_In; trivial.
  rewrite equ_proj_append; trivial. simpl.
  rewrite app_nil_r; trivial.
Qed.

Lemma fresh_proj_add_equ : forall P s t, fresh_proj (P|+(s~?t)) = fresh_proj P.
Proof.
  intros. case (in_dec Constraint_eqdec (s~?t) P); intro H.
  rewrite set_add_In; trivial. rewrite set_add_not_In; trivial.
  rewrite fresh_proj_append. simpl.
  rewrite app_nil_r; trivial.
Qed.

Lemma equ_proj_rem_fresh : forall P a s, equ_proj (P\(a#?s)) = equ_proj P .
Proof.
  intros. induction P; simpl; trivial.
  destruct a0.
  case (Constraint_eqdec (a #? s) (a0 #? t)); intro H0; trivial.
  case (Constraint_eqdec (a #? s) (t ~? t0)); intro H1; trivial.
  inverts H1. simpl. rewrite IHP; trivial.
Qed.

Lemma fresh_proj_rem_equ : forall P s t, fresh_proj (P\(s~?t)) = fresh_proj P .
Proof.
  intros. induction P; simpl; trivial. destruct a.
  case (Constraint_eqdec (s ~? t) (a #? t0)); intro H0. inverts H0.
  simpl. rewrite IHP. trivial.
  case (Constraint_eqdec (s ~? t) (t0 ~? t1)); intro H1; trivial.
Qed.

Lemma equ_proj_add_eq : forall P s t, equ_proj (P|+(s~?t)) = (equ_proj P)|+(s~?t).
Proof.
  intros. case (in_dec Constraint_eqdec (s~?t) P); intro H.
  rewrite 2 set_add_In; trivial. apply -> equ_proj_set_In_eq; trivial.
  rewrite 2 set_add_not_In; trivial.
  rewrite equ_proj_append; trivial.
  intro. apply H. apply equ_proj_set_In_eq; trivial.
Qed.

Lemma equ_proj_union : forall P P', equ_proj (P \cup P') = (equ_proj P) \cup (equ_proj P').
Proof.
  intros. induction P'; simpl; trivial.
  destruct a. rewrite equ_proj_add_fresh; trivial.
  simpl. rewrite equ_proj_add_eq. rewrite IHP'; trivial.
Qed.

Lemma Problem_vars_equ_proj : forall X P,
                              set_In X (Problem_vars (equ_proj P)) -> set_In X (Problem_vars P).
Proof.
  intros. induction P; simpl in *|-*; trivial.
  destruct a. apply set_union_intro2. apply IHP; trivial.
  simpl in H. apply set_union_elim in H. destruct H.
  apply set_union_intro1; trivial.
  apply set_union_elim in H. destruct H.
  apply set_union_intro2. apply set_union_intro1; trivial.
  apply set_union_intro2. apply set_union_intro2. apply IHP; trivial.
Qed.

Lemma Problem_exists_equ : forall P, equ_proj P <> [] <-> exists s t, set_In (s~?t) P.
Proof.
  split~; intro.
  induction P.
  simpl in H. false.
  destruct a. simpl in H. apply IHP in H.
  case H; clear H; intros s0 H. case H; clear H; intros t0 H.
  exists s0. exists t0. simpl. right~.
  simpl. exists t. exists t0. left~.
  case H; clear H; intros s H.
  case H; clear H; intros t H.
  induction P; simpl in H. false.
  destruct H.
  rewrite H. simpl. discriminate.
  apply IHP in H. clear IHP.
  destruct a; simpl; trivial.
  intro H'. inverts H'.
Qed.

(** Basic results about adding and removing constraints and also the operation of union of problems *)

Lemma Problem_add_fresh_rem_equ : forall P a s t u,
                                 (P|+(a#?s))\(t~?u) = (P\(t~?u))|+(a#?s).
Proof.
  intros. induction P; simpl.
  case (Constraint_eqdec (t~?u) (a#?s)); intro H; trivial. inverts H.
  case (Constraint_eqdec (a#?s) a0); case (Constraint_eqdec (t~?u) a0); intros H H0; simpl;
   try rewrite IHP; trivial.
  rewrite <- H in H0. inverts H0.
  case (Constraint_eqdec (a#?s) a0); case (Constraint_eqdec (t~?u) a0); intros H1 H2;
   try contradiction; trivial.
  case (Constraint_eqdec (t ~? u) a0); intro H1; try contradiction; trivial.
  case (Constraint_eqdec (a#?s) a0); case (Constraint_eqdec (t~?u) a0); intros H1 H2;
   try contradiction; trivial.
Qed.

Lemma Problem_vars_remove : forall P X u, set_In X (Problem_vars (P \ u)) ->
                                          set_In X (Problem_vars P).
Proof.
  intros.
  induction P. simpl in H. contradiction.
  simpl in *|-*. gen H. case (Constraint_eqdec u a); destruct a; intros H0 H.
  apply set_union_intro2; trivial.
  apply set_union_intro2; apply set_union_intro2; trivial.
  simpl in H. apply set_union_elim in H. destruct H.
  apply set_union_intro1; trivial. apply set_union_intro2; apply IHP; trivial.
  simpl in H. apply set_union_elim in H. destruct H.
  apply set_union_intro1; trivial.
  simpl in H. apply set_union_elim in H. destruct H.
  apply set_union_intro2; apply set_union_intro1; trivial.
  apply set_union_intro2; apply set_union_intro2; apply IHP; trivial.
Qed.

Lemma Problem_vars_set_In : forall u X P, set_In u P ->
                                          set_In X (Problem_vars (|[u]|)) -> set_In X (Problem_vars P).
Proof.
  intros. induction P; simpl in H; try contradiction.

  destruct H; destruct a; try rewrite <- H in H0; simpl in *|-*.
  apply set_union_intro1; trivial.

  apply set_union_elim in H0. destruct H0.
  apply set_union_intro1; trivial.
  apply set_union_intro2; apply set_union_intro1; trivial.

  destruct u.
  apply set_union_intro2; apply IHP; trivial.
  apply set_union_intro2; apply IHP; trivial.

  destruct u.
  apply set_union_intro2;
  apply set_union_intro2; apply IHP; trivial.
  apply set_union_intro2;
  apply set_union_intro2; apply IHP; trivial.
Qed.

Lemma Problem_vars_set_In_app : forall X P P',
                                set_In X (Problem_vars (P ++ P'))  <->
                                set_In X (set_union var_eqdec (Problem_vars P) (Problem_vars P')).
Proof.
  intros. induction P; simpl; split~; intros.
  apply set_union_intro2; trivial.
  apply set_union_elim in H. destruct H; trivial.
  simpl in H; contradiction.
  destruct a.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1; apply set_union_intro1; 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 set_union_intro1; apply set_union_intro1; trivial.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1; apply set_union_intro2;
   apply set_union_intro1; 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.
  destruct a.
  apply set_union_elim in H. destruct H.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1; trivial.
  apply set_union_intro2. apply IHP.
  apply set_union_intro1; trivial.
  apply set_union_intro2. apply IHP.
  apply set_union_intro2; trivial.
  apply set_union_elim in H. destruct H.
  apply set_union_elim in H. destruct H.
  apply set_union_intro1; trivial.
  apply set_union_elim in H. destruct H.
  apply set_union_intro2; apply set_union_intro1; trivial.
  apply set_union_intro2; apply set_union_intro2. apply IHP.
  apply set_union_intro1; trivial.
  apply set_union_intro2; apply set_union_intro2. apply IHP.
  apply set_union_intro2; trivial.
Qed.

Lemma Problem_vars_add : forall P u X, set_In X (Problem_vars (P|+u)) <->
                         set_In X (set_union var_eqdec (Problem_vars P) (Problem_vars (|[u]|))).
Proof.
  intros. case (in_dec Constraint_eqdec u P); intro H.
  rewrite set_add_In; trivial. split~; intro.
  apply set_union_intro1; trivial.
  apply set_union_elim in H0. destruct H0; trivial.
  apply Problem_vars_set_In with (u:=u); trivial.
  rewrite set_add_not_In; trivial.
  apply Problem_vars_set_In_app.
Qed.

Lemma Problem_vars_union : forall P P' X, set_In X (Problem_vars (P \cup P')) <->
                                          set_In X (set_union var_eqdec (Problem_vars P) (Problem_vars P')).
Proof.
  intros. induction P'; simpl. split~; intro; trivial.
  split~; intro. apply Problem_vars_add in H.
  apply set_union_elim in H. destruct H.
  apply IHP' in H. apply set_union_elim in H.
  destruct H. apply set_union_intro1; trivial.
  destruct a. apply set_union_intro2;
    apply set_union_intro2; trivial.
  apply set_union_intro2;
  apply set_union_intro2;
  apply set_union_intro2; trivial.
  destruct a. simpl in H.
  apply set_union_intro2;
    apply set_union_intro1; trivial.
  simpl in H. apply set_union_elim in H.
  destruct H. apply set_union_intro2;
    apply set_union_intro1; trivial.
  apply set_union_intro2;
  apply set_union_intro2;
  apply set_union_intro1; trivial.
  apply set_union_elim in H.
  apply Problem_vars_add. destruct H; simpl.
  apply set_union_intro1. apply IHP'.
  apply set_union_intro1; trivial.
  destruct a; apply set_union_elim in H; destruct H.
  apply set_union_intro2; trivial.
  apply set_union_intro1. apply IHP'.
  apply set_union_intro2; trivial.
  apply set_union_intro2;
    apply set_union_intro1; trivial.
  apply set_union_elim in H; destruct H.
  apply set_union_intro2;
    apply set_union_intro2; trivial.
  apply set_union_intro1. apply IHP'.
  apply set_union_intro2; trivial.
Qed.

(** Sets of variables have no repeated elements *)

Lemma NoDup_term_vars : forall t, NoDup (term_vars t).
Proof.
  intros. induction t; simpl;
  try apply NoDup_nil; trivial.
  apply set_union_nodup; trivial.
  apply NoDup_cons. intro H. simpl in H; trivial.
  apply NoDup_nil; trivial.
Qed.

Lemma NoDup_Problem_vars : forall P, NoDup (Problem_vars P).
Proof.
  intros. induction P; intros.
  apply NoDup_nil.
  destruct a; simpl.
  apply set_union_nodup; trivial.
  apply NoDup_term_vars.
  apply set_union_nodup.
  apply NoDup_term_vars.
  apply set_union_nodup; trivial.
  apply NoDup_term_vars.
Qed.

Open Scope nat_scope.

(** Sizes of sets of variables} % *)

Lemma length_Problem_vars_rem : forall P u,  length (Problem_vars P) >= length (Problem_vars (P\u)).
Proof.
  intros.
  apply nat_leq_inv. apply subset_list; intros.
  apply var_eqdec. apply NoDup_Problem_vars.
  apply Problem_vars_remove in H. trivial.
Qed.

Lemma length_Problem_vars_add : forall P u,  length (Problem_vars (P|+u)) =
                                             length (set_union var_eqdec (Problem_vars P) (Problem_vars (|[u]|))).
Proof.
  intros. apply subset_list_eq; intros.
  apply var_eqdec. apply NoDup_Problem_vars.
  apply set_union_nodup; apply NoDup_Problem_vars.
  apply Problem_vars_add.
Qed.

(**  Auxiliary definitions and lemmas to
    prove termination of fresh\_sys and equ\_sys *)

Fixpoint fresh_Problem_size (P : Problem) {struct P} : nat :=
  match P with
    | [] => 0
    | (a#?s)::P0 => (term_size s) + (fresh_Problem_size P0)
    | (s~?t)::P0 => (fresh_Problem_size P0)
  end.

Fixpoint equ_Problem_size (P : Problem) {struct P} : nat :=
  match P with
    | [] => 0
    | (a#?s)::P0 => (equ_Problem_size P0)
    | (s~?t)::P0 => (term_size s) + (term_size t) + (equ_Problem_size P0)
  end.

Fixpoint non_fixpoint_equ (P : Problem) {struct P} : nat :=
  match P with
    | [] => 0
    | (a#?s)::P0 => non_fixpoint_equ P0
    | (s~?t)::P0 => if (fixpoint_equ_eqdec (s~?t)) then (non_fixpoint_equ P0) else
                  (1 + (non_fixpoint_equ P0))
  end.

(** Basic results about the size of problems *)

Lemma equ_Problem_size_term : forall s t,
      equ_Problem_size (|[s~?t]|) = term_size s + term_size t.
Proof.
  intros. simpl. omega.
Qed.

Lemma fresh_Problem_size_remove : forall P a s, set_In (a#?s) P ->
                         fresh_Problem_size (P\(a#?s)) = fresh_Problem_size P - (term_size s).
Proof.
  intros. induction P. simpl in H. contradiction.
  simpl in H. destruct H. rewrite H. clear H.
  simpl. case (Constraint_eqdec (a #? s) (a #? s)); intro H. clear H. omega. false.
  destruct a0. simpl. case (Constraint_eqdec (a #? s) (a0 #? t)); intro H'.
  inverts H'. omega.
  simpl. rewrite IHP; trivial. clear IHP H'.
  assert (Q : fresh_Problem_size P >= term_size s).
   induction P. simpl in H. contradiction. destruct a1.
   simpl in *|-*. destruct H. inverts H. omega.
   apply IHP in H. omega. simpl in H. destruct H.
   inverts H. simpl. apply IHP; trivial.
  omega.
  simpl in *|-*. case (Constraint_eqdec (a #? s) (t ~? t0)); intro H'.
  inverts H'. simpl. rewrite IHP; trivial.
Qed.

Lemma fresh_Problem_size_add : forall P a s,
                               fresh_Problem_size (P|+(a#?s)) <= fresh_Problem_size P + term_size s.
Proof.
  intros. induction P. simpl. omega.
  destruct a0. simpl.
  case (Constraint_eqdec (a #? s) (a0 #? t)); intro H; simpl; try omega.
  simpl. case (Constraint_eqdec (a #? s) (t ~? t0)); intro H.
  inverts H. simpl. trivial.
Qed.

Lemma fresh_Problem_size_gt_0 : forall a s P, set_In (a#?s) P -> fresh_Problem_size P > 0.
Proof.
  intros. induction P. simpl in H. contradiction.
  destruct a0. simpl in *|-*. destruct H.
  assert (Q : term_size t > 0).
   apply term_size_gt_0.
  omega. apply IHP in H. omega.
  simpl in *|-*. destruct H.
  inverts H. apply IHP; trivial.
Qed.

Lemma equ_Problem_size_neq_nil : forall u P, set_In u P -> equ_Problem_size P >= equ_Problem_size (|[u]|).
Proof.
  intros. induction P; intros. simpl in H. contradiction.
  simpl in H. destruct H. rewrite H. destruct u. simpl. omega.
  simpl. assert (Q : term_size t > 0). apply term_size_gt_0. omega.
  apply IHP in H. clear IHP. simpl in *|-*. destruct u; destruct a; trivial.
  assert (Q : term_size t0 > 0). apply term_size_gt_0. omega.
  omega.
Qed.

Lemma equ_Problem_size_remove : forall P s t, set_In (s~?t) P ->
                                equ_Problem_size (P\(s~?t)) =  equ_Problem_size P - ((term_size s) + (term_size t)).
Proof.
  intros. induction P. simpl in H. contradiction.
  simpl in H. destruct H. rewrite H. clear H.
  simpl. case (Constraint_eqdec (s ~? t) (s ~? t)); intro H. clear H.
  omega. false.
  simpl. destruct a. case (Constraint_eqdec (s ~? t) (a #? t0)); intro H0.
  inverts H0. simpl. apply IHP; trivial.
  case (Constraint_eqdec (s ~? t) (t0 ~? t1)); intro H0.
  inverts H0. omega. simpl. rewrite IHP; trivial.
  assert (Q : equ_Problem_size P >= equ_Problem_size (|[s ~? t]|)).
    apply equ_Problem_size_neq_nil; trivial.
  simpl in Q. omega.
Qed.

Lemma equ_Problem_size_gt_0 : forall s t P, set_In (s~?t) P -> equ_Problem_size P > 0.
Proof.
  intros. induction P. simpl in H. contradiction.
  destruct a. simpl in *|-*. destruct H. inverts H.
  apply IHP in H. clear IHP. trivial.
  simpl in *|-*. assert (Q : term_size t0 > 0). apply term_size_gt_0.
  omega.
Qed.

Lemma equ_Problem_size_add : forall P u, equ_Problem_size P + (equ_Problem_size (|[u]|)) >= equ_Problem_size (P|+u).
Proof.
  intros. induction P. simpl; omega.
  simpl in *|-*. destruct u; destruct a.

  case (Constraint_eqdec (a0 #? t) (a #? t0)); intro H; simpl; try omega.
  case (Constraint_eqdec (a0 #? t) (t0 ~? t1)); intro H; simpl; try omega.
  case (Constraint_eqdec (t ~? t0) (a #? t1)); intro H; simpl; try omega.
  case (Constraint_eqdec (t ~? t0) (t1 ~? t2)); intro H; simpl; try omega.
Qed.

Lemma equ_Problem_size_add' : forall P u,
      ~ set_In u P ->
      equ_Problem_size (P|+u) =
      equ_Problem_size P + equ_Problem_size (|[u]|).
Proof.
  intros. rewrite set_add_not_In; trivial.
  induction P; trivial; simpl in *|-*.
  destruct a; destruct u; rewrite IHP; try omega;
  intro H0; apply H; right~.
Qed.

Lemma equ_Problem_size_add'' : forall P u,
      set_In u P -> equ_Problem_size (P|+u) = equ_Problem_size P.
Proof.
  intros. rewrite set_add_In; trivial.
Qed.

Lemma equ_Problem_size_add_fresh : forall P a s,
                                   equ_Problem_size (P|+(a#?s)) = equ_Problem_size P.
Proof.
 intros. induction P; simpl; trivial.
 destruct a0.
 case (Constraint_eqdec (a #? s) (a0 #? t)); intro H0; simpl; trivial.
 case (Constraint_eqdec (a #? s) (t ~? t0)); intro H0; simpl; trivial.
 rewrite IHP; trivial.
Qed.

Lemma equ_Problem_size_rem_fresh : forall P a s,
                                   equ_Problem_size (P\(a#?s)) = equ_Problem_size P.
Proof.
 intros. induction P; simpl; trivial.
 destruct a0.
 case (Constraint_eqdec (a #? s) (a0 #? t)); intro H0; simpl; trivial.
 case (Constraint_eqdec (a #? s) (t ~? t0)); intro H0; simpl; trivial.
 inverts H0. rewrite IHP; trivial.
Qed.

Lemma non_fixpoint_equ_gt_0 : forall P s t, set_In (s~?t) P -> ~ fixpoint_equ (s~?t) ->
                                          non_fixpoint_equ P > 0.
Proof.
  intros. induction P; simpl in *|-*; try contradiction.
  destruct a. destruct H. inverts H.
  apply IHP; trivial.
  case (fixpoint_equ_eqdec (t0 ~? t1)); intro H1.
  destruct H. inverts H. contradiction.
  apply IHP; trivial. omega.
Qed.

Lemma non_fixpoint_equ_remove : forall P s t, set_In (s~?t) P -> ~ fixpoint_equ (s~?t) ->
                                non_fixpoint_equ (P\(s~?t)) =  non_fixpoint_equ P - 1.
Proof.
  intros. induction P; simpl in *|-*; trivial.
  destruct a. case (Constraint_eqdec (s ~? t) (a #? t0)); intro H1. inverts H1.
  simpl. destruct H. inverts H. apply IHP; trivial.
  case (Constraint_eqdec (s ~? t) (t0 ~? t1)); intro H1.
  case (fixpoint_equ_eqdec (t0 ~? t1)); intro H2.
  inverts H1. contradiction. omega.
  simpl. case (fixpoint_equ_eqdec (t0 ~? t1)); intro H2.
  destruct H. inverts H. contradiction. apply IHP; trivial.
  destruct H. inverts H. false.
  generalize H. intro H3. apply IHP in H3.
  assert (Q : non_fixpoint_equ P > 0).
   apply non_fixpoint_equ_gt_0 with (s := s) (t:=t); trivial.
  omega.
Qed.

Lemma non_fixpoint_equ_add : forall P pi X, pi <> [] -> non_fixpoint_equ (P|+(pi|.X~?([]|.X))) =
                                            non_fixpoint_equ P.
Proof.
  intros. induction P; simpl.
  case (fixpoint_equ_eqdec ((pi|.X) ~? (([])|.X))); intro H0; trivial.
  false. apply H0. unfold fixpoint_equ. exists pi. exists X. split~.
  destruct a.
  case (Constraint_eqdec ((pi|.X) ~? (([])|.X)) (a #? t)); intro H0.
  inverts H0. simpl. rewrite IHP; trivial.
  case (Constraint_eqdec ((pi|.X) ~? (([])|.X)) (t ~? t0)); intro H0; simpl; trivial.
  case (fixpoint_equ_eqdec (t ~? t0)); intro H1; trivial.
  omega.
Qed.

Lemma non_fixpoint_equ_add_fresh : forall P a s,
                                   non_fixpoint_equ (P|+(a#?s)) = non_fixpoint_equ P.
Proof.
  intros. induction P; simpl; trivial.
  destruct a0.
  case (Constraint_eqdec (a #? s) (a0 #? t)); intro H0; simpl; trivial.
  case (Constraint_eqdec (a #? s) (t ~? t0)); intro H0; simpl; trivial.
  rewrite IHP; trivial.
Qed.

Lemma non_fixpoint_equ_rem_fresh : forall P a s,
                                   non_fixpoint_equ (P\(a#?s)) = non_fixpoint_equ P.
Proof.
 intros. induction P; simpl; trivial.
 destruct a0.
 case (Constraint_eqdec (a #? s) (a0 #? t)); intro H0; simpl; trivial.
 case (Constraint_eqdec (a #? s) (t ~? t0)); intro H0; simpl; trivial.
 inverts H0. rewrite IHP; trivial.
Qed.

(** Characterising the memebers of the set (fresh_context St X)  *)

Lemma fresh_context_mem : forall a X Y St, set_In (a, Y) (fresh_context St X) <->
                                           (X = Y /\ set_In a St).
Proof.
  intros. induction St;
    simpl; split~; intros; try contradiction.
  destruct H; trivial.
  destruct H. inverts H. split~.
  apply IHSt in H. destruct H. split~.
  destruct H. rewrite H in *|-*. destruct H0.
  rewrite H0. left~. right~.
  apply <- IHSt. split~.
Qed.

(* If a term is an right-hand position of a problem P, its
   varialbes are in the set rhvars_Probl *)

Lemma rh_term_Probl_vars : forall s t P, set_In (s~?t) P ->
                           (forall X, set_In X (term_vars t) -> set_In X (rhvars_Probl P)).
Proof.
  intros. induction P; simpl in *|-*; trivial.
  destruct H. rewrite H. apply set_union_intro1; trivial.
  apply IHP in H. clear IHP H0.
  destruct a; trivial. apply set_union_intro2; trivial.
Qed.

(* If X is a right-hand var in (P\u) then it is in P *)

Lemma rhvars_Prob_rem : forall X P u, set_In X (rhvars_Probl (P\u)) ->
                                      set_In X (rhvars_Probl P).
Proof.
  intros. induction P; simpl in *|-*; auto.
  gen H. case (Constraint_eqdec u a); intros H H0.
  rewrite H in *|-*. clear H. destruct a; simpl in *|-*; auto.
  apply set_union_intro2; trivial.
  simpl in H0. destruct a; auto.
  apply set_union_elim in H0. apply set_union_intro.
  destruct H0; auto.
Qed.

Lemma rhvars_Prob_add : forall X P u, set_In X (rhvars_Probl (P|+u)) ->
                                      (set_In X (rhvars_Probl (|[u]|)) \/ set_In X (rhvars_Probl P)).
Proof.
  intros. induction P; simpl in *|-*; auto.
  gen H. case (Constraint_eqdec u a); intros H H0.
  rewrite H in *|-*. clear H. destruct a; simpl in *|-*; auto.
  destruct u; destruct a; simpl in *|-*; auto.
  apply set_union_elim in H0. right~. destruct H0.
  apply set_union_intro1; trivial.
  apply IHP in H0. destruct H0; try contradiction.
  apply set_union_intro2; trivial.
  apply set_union_elim in H0. destruct H0.
  right~. apply set_union_intro1; trivial.
  apply IHP in H0. destruct H0; auto.
  right~. apply set_union_intro2; trivial.
Qed.

Lemma rhvars_Prob_union : forall P P' X, set_In X (rhvars_Probl (P \cup P')) ->
                                         (set_In X (rhvars_Probl P) \/ set_In X (rhvars_Probl P')).
Proof.
  intros. induction P'; simpl in *|-*; auto.
  apply rhvars_Prob_add in H. destruct a; simpl in *|-*.
  destruct H; try contradiction. apply IHP'; trivial.
  destruct H. right~. apply set_union_intro1; trivial.
  apply IHP' in H. destruct H; auto.
  right~. apply set_union_intro2; trivial.
Qed.


(**************************************************************)
(* FSetDecide.v                                               *)
(*                                                            *)
(* Author: Aaron Bohannon                                     *)
(**************************************************************)

(** This file implements a decision procedure for a certain
    class of statements involving finite sets.  *)

Require Import FSets.
Require Import Negation.

Module Decide (Import M : S).

(** * Overview
    This module defines the tactic [decideFSet], which will
    solve any valid goal of the form
    [ forall s1 ... sn,
      forall x1 ... xm,
      P1 -> ... -> Pk -> P ]
    where [P]'s are defined by the grammar:
<<

P ::=
| Q
| Empty F
| Subset F F'
| Equal F F'

Q ::=
| E.eq X X'
| In X F
| Q /\ Q'
| Q \/ Q'
| Q -> Q'
| Q <-> Q'
| ~ Q
| True
| False

F ::=
| S
| empty
| singleton X
| add X F
| remove X F
| union F F'
| inter F F'
| diff F F'

X ::= x1 | ... | xm
S ::= s1 | ... | sn

>>

The tactic will also work on some goals that vary slightly from
the above form:
- The variables and hypotheses may be mixed in any order and
  may have already been introduced into the context.  Moreover,
  there may be additional, unrelated hypotheses mixed in
  (these will be ignored).
- A conjunction of hypotheses will work equally well as
  separated hypotheses, i.e., [P1 /\ P2 -> P] can be solved
  if [P1 -> P2 -> P] can be solved.
- [decideFSet] should solve any goal if the FSet-related
  hypotheses are contradictory.
- [decideFSet] will first perform any necessary zeta and beta
  reductions and will invoke [subst] to eliminate any Coq
  equalities between finite sets or their elements.
- If [E.eq] is convertible with Coq's equality, it will not
  matter which one you use.
- The tactic can solve goals where the finite sets or set
  elements are expressed by Coq terms other than variables.
  However, non-local definitions are not expanded, and Coq
  equalities between non-variable terms are not used.
  For example, this goal can be solved:
  [ forall (f : t -> t),
    forall (g : elt -> elt),
    forall (s1 s2 : t),
    forall (x1 x2 : elt),
    Equal s1 (f s2) ->
    E.eq x1 (g (g x2)) ->
    In x1 s1 ->
    In (g (g x2)) (f s2) ]
  This one cannot be solved:
  [ forall (f : t -> t),
    forall (g : elt -> elt),
    forall (s1 s2 : t),
    forall (x1 x2 : elt),
    Equal s1 (f s2) ->
    E.eq x1 (g x2) ->
    In x1 s1 ->
    g x2 = g (g x2) ->
    In (g (g x2)) (f s2) ]
*)

  (** * Generic Tactics
      We begin by defining a few generic, useful tactics. *)

  (** [if t then t1 else t2] executes [t] and, if it does not
      fail, then [t1] will be applied to all subgoals produced.
      If [t] fails, then [t2] is executed. *)
  Tactic Notation
    "if" tactic(t)
    "then" tactic(t1)
    "else" tactic(t2) :=
    first [ t; first [ t1 | fail 2 ] | t2 ].

  (** [prop P holds by t] succeeds (but does not modify the goal
      or context) if the proposition [P] can be proved by [t] in
      the current context.  Otherwise, the tactic fails. *)
  Tactic Notation "prop" constr(P) "holds" "by" tactic(t) :=
    let H := fresh in
    assert P as H by t;
    clear H.

  (** This tactic acts just like [assert ... by ...] but will
      fail if the context already contains the proposition. *)
  Tactic Notation "assert" "new" constr(e) "by" tactic(t) :=
    match goal with
    | H: e |- _ => fail 1
    | _ => assert e by t
    end.

  (** [subst++] is similar to [subst] except that
      - it never fails (as [subst] does on recursive equations),
      - it substitutes locally defined variable for their
        definitions,
      - it performs beta reductions everywhere, which may arise
        after substituting a locally defined function for its
        definition.
      *)
  Tactic Notation "subst" "++" :=
    repeat (
      match goal with
      | x : _ |- _ => subst x
      end);
    cbv zeta beta in *.

  (** If you have a negated goal and [H] is a negated
      hypothesis, then [contra H] exchanges your goal and [H],
      removing the negations. *)
  Ltac contra H :=
    let J := fresh in
    unfold not;
    unfold not in H;
    intros J;
    apply H;
    clear H;
    rename J into H.

  (** [decompose records] calls [decompose record H] on every
      relevant hypothesis [H]. *)
  Tactic Notation "decompose" "records" :=
    repeat (
      match goal with
      | H: _ |- _ => progress (decompose record H); clear H
      end).

  (** * Auxiliary FSet Tactics *)

  (** ** Discarding Irrelevant Hypotheses
      We will want to clear the context of any non-FSet-related
      hypotheses in order to increase the speed of the tactic.
      To do this, we will need to be able to decide which are
      relevant.  We do this by making a simple inductive
      definition classifying the propositions of interest. *)

  Inductive FSet_elt_Prop : Prop -> Prop :=
  | eq_Prop : forall (S : Set) (x y : S),
      FSet_elt_Prop (x = y)
  | eq_elt_prop : forall x y,
      FSet_elt_Prop (E.eq x y)
  | In_elt_prop : forall x s,
      FSet_elt_Prop (In x s)
  | True_elt_prop :
      FSet_elt_Prop True
  | False_elt_prop :
      FSet_elt_Prop False
  | conj_elt_prop : forall P Q,
      FSet_elt_Prop P ->
      FSet_elt_Prop Q ->
      FSet_elt_Prop (P /\ Q)
  | disj_elt_prop : forall P Q,
      FSet_elt_Prop P ->
      FSet_elt_Prop Q ->
      FSet_elt_Prop (P \/ Q)
  | impl_elt_prop : forall P Q,
      FSet_elt_Prop P ->
      FSet_elt_Prop Q ->
      FSet_elt_Prop (P -> Q)
  | not_elt_prop : forall P,
      FSet_elt_Prop P ->
      FSet_elt_Prop (~ P).

  Inductive FSet_Prop : Prop -> Prop :=
  | elt_FSet_Prop : forall P,
      FSet_elt_Prop P ->
      FSet_Prop P
  | Empty_FSet_Prop : forall s,
      FSet_Prop (Empty s)
  | Subset_FSet_Prop : forall s1 s2,
      FSet_Prop (Subset s1 s2)
  | Equal_FSet_Prop : forall s1 s2,
      FSet_Prop (Equal s1 s2).

  (** Here is the tactic that will throw away hypotheses that
      are not useful (for the intended scope of the [decideFSet]
      tactic). *)
  Hint Constructors FSet_elt_Prop FSet_Prop : FSet_Prop.
  Ltac discard_non_FSet :=
    decompose records;
    repeat (
      match goal with
      | H : ?P |- _ =>
        if prop (FSet_Prop P) holds by (auto 100 with FSet_Prop)
        then fail
        else clear H
      end).

  (** ** Replacing Set Operators with Propositional Connectives
      The lemmas from [FSetFacts] will be used to break down set
      operations into propositional formulas built over the
      predicates [In] and [E.eq] applied only to variables.  We
      are going to use them with [autorewrite]. *)
  Module F := FSetFacts.Facts M.
  Hint Rewrite
    F.empty_iff F.singleton_iff F.add_iff F.remove_iff
    F.union_iff F.inter_iff F.diff_iff
  : set_simpl.

  (** ** Decidability of FSet Propositions *)

  (** [In] is decidable. *)
  Module D := DepOfNodep M.
  Lemma dec_In : forall x s,
    decidable (In x s).
  Proof.
    intros x s. red. destruct (D.mem x s); auto.
  Qed.

  (** [E.eq] is decidable. *)
  Lemma dec_eq : forall (x y : E.t),
    decidable (E.eq x y).
  Proof.
    intros x y. red. destruct (E.compare x y); auto.
  Qed.

  (** The hint database [FSet_decidability] will be given to the
      [push_neg] tactic from the module [Negation]. *)
  Hint Resolve dec_In dec_eq : FSet_decidability.

  (** ** Normalizing Propositions About Equality
      We have to deal with the fact that [E.eq] may be
      convertible with Coq's equality.  Thus, we will find the
      following tactics useful to replace one form with the
      other everywhere. *)

  (** The next tactic, [Logic_eq_to_E_eq], mentions the term
      [E.t]; thus, we must ensure that [E.t] is used in favor of
      any other convertible but syntactically distinct term. *)
  Ltac change_to_E_t :=
    repeat (
      match goal with
      | H : ?T |- _ =>
        progress (change T with E.t in H);
        repeat (
          match goal with
          | J : _ |- _ => progress (change T with E.t in J)
          | |- _ => progress (change T with E.t)
          end )
      end).

  (** These two tactics take us from Coq's built-in equality to
      [E.eq] (and vice versa) when possible. *)

  Ltac Logic_eq_to_E_eq :=
    repeat (
      match goal with
      | H: _ |- _ =>
        progress (change (@Logic.eq E.t) with E.eq in H)
      | |- _ =>
        progress (change (@Logic.eq E.t) with E.eq)
      end).

  Ltac E_eq_to_Logic_eq :=
    repeat (
      match goal with
      | H: _ |- _ =>
        progress (change E.eq with (@Logic.eq E.t) in H)
      | |- _ =>
        progress (change E.eq with (@Logic.eq E.t))
      end).

  (** This tactic works like the built-in tactic [subst], but at
      the level of set element equality (which may not be the
      convertible with Coq's equality). *)
  Ltac substFSet :=
    repeat (
      match goal with
      | H: E.eq ?x ?y |- _ => rewrite H in *; clear H
      end).

  (** ** Taking Decidability into Account
      This tactic adds assertions about the decidability of
      [E.eq] and [In] to the context.  This is necessary for the
      completeness of the [decideFSet] tactic.  However, in
      order to minimize the cost of proof search, we should be
      careful to not add more than we need.  Once negations have
      been pushed to the leaves of the propositions, we only
      need to worry about decidability for those atomic
      propositions that appear in a negated form.  (Well, at
      least that is what I believe, but I have not tried to
      prove it in any formal sense.) *)
  Ltac assert_decidability :=
    (** We actually don't want these rules to fire if the
        syntactic context in the patterns below is trivially
        empty, but we'll just do some clean-up at the afterward.
        *)
    repeat (
      match goal with
      | H: context [~ E.eq ?x ?y] |- _ =>
        assert new (E.eq x y \/ ~ E.eq x y) by (apply dec_eq)
      | H: context [~ In ?x ?s] |- _ =>
        assert new (In x s \/ ~ In x s) by (apply dec_In)
      | |- context [~ E.eq ?x ?y] =>
        assert new (E.eq x y \/ ~ E.eq x y) by (apply dec_eq)
      | |- context [~ In ?x ?s] =>
        assert new (In x s \/ ~ In x s) by (apply dec_In)
      end);
    (** Now we eliminate the useless facts we added (because
        they would likely be very harmful to performance). *)
    repeat (
      match goal with
      | _: ~ ?P, H : ?P \/ ~ ?P |- _ => clear H
      end).

  (** ** Handling [Empty], [Subset], and [Equal]
      This tactic instantiates universally quantified hypotheses
      (which arise from the unfolding of [Empty], [Subset], and
      [Equal]) for each of the set element expressions that is
      involved in some membership or equality fact.  Then it
      throws away those hypotheses, which should no longer be
      needed. *)
  Ltac inst_FSet_hypotheses :=
    repeat (
      match goal with
      | H : forall a : E.t, _,
        _ : context [ In ?x _ ] |- _ =>
        let P := type of (H x) in
        assert new P by (exact (H x))
      | H : forall a : E.t, _
        |- context [ In ?x _ ] =>
        let P := type of (H x) in
        assert new P by (exact (H x))
      | H : forall a : E.t, _,
        _ : context [ E.eq ?x _ ] |- _ =>
        let P := type of (H x) in
        assert new P by (exact (H x))
      | H : forall a : E.t, _
        |- context [ E.eq ?x _ ] =>
        let P := type of (H x) in
        assert new P by (exact (H x))
      | H : forall a : E.t, _,
        _ : context [ E.eq _ ?x ] |- _ =>
        let P := type of (H x) in
        assert new P by (exact (H x))
      | H : forall a : E.t, _
        |- context [ E.eq _ ?x ] =>
        let P := type of (H x) in
        assert new P by (exact (H x))
      end);
    repeat (
      match goal with
      | H : forall a : E.t, _ |- _ =>
        clear H
      end).

  (** * The [decideFSet] Tactic *)

  (** Here is the crux of the proof search.  Recursion
      through [intuition]!  (This will terminate unless I am
      rather mistaken about the behavior of [intuition].) *)
  Ltac decideFSet_rec :=
    try (match goal with
    | H: E.eq ?x ?x -> False |- _ => destruct H
    end);
    (reflexivity ||
     contradiction ||
     (progress substFSet; intuition decideFSet_rec)).

  (** If we add [unfold Empty, Subset, Equal in *; intros;] to
      the beginning of this tactic, it will satisfy the same
      specification as the [decideFSet] tactic; however, it will
      be much slower than necessary without the pre-processing
      done by the wrapper tactic [decideFSet]. *)
  Ltac decideFSet_body :=
    inst_FSet_hypotheses;
    autorewrite with set_simpl in *;
    push not in * using FSet_decidability;
    substFSet;
    assert_decidability;
    auto using E.eq_refl;
    (intuition decideFSet_rec) ||
    fail 1
      "because the goal is beyond the scope of this tactic".

  (** Here is the top-level tactic (the only one intended for
      clients of this library).  It's specification is given at
      the top of the file. *)
  Ltac decideFSet :=
    (** We fold occurrences of [not] because it is better for
        [intros] to leave us with a goal of [~ P] than a goal of
        [False].  [fold_nots] is defined in [Negation].
        *)
    unfold iff in *; fold any not in *; intros;
    (** Now we decompose conjunctions, which will allow the
        [discard_non_FSet] and [assert_decidability] tactics to
        do a much better job. *)
    decompose records;
    discard_non_FSet;
    unfold Empty, Subset, Equal in *;
    (** If our goal was [Empty], [Subset], or [Equal], then we
        have one more item to introduce now. *)
    intros;
    (** We now want to get rid of all uses of [=] in favor of
        [E.eq].  However, the best way to eliminate an [=] is
        with [subst], so we will try that first.  In fact, we
        may as well convert uses of [E.eq] into [=] before we do
        [subst] so that we can even more mileage out of it.
        Also, we use [change_to_E_t] to ensure that we have a
        canonical name for set elements, so that
        [Logic_eq_to_E_eq] will work properly.  *)
    change_to_E_t; E_eq_to_Logic_eq; subst++; Logic_eq_to_E_eq;
    (** The next optimization is to swap a negated goal with a
        negated hypothesis when possible.  Any swap will improve
        performance, but we will get the maximum benefit if we
        swap the goal with a hypotheses mentioning the same set
        element, so we try that first.  Of course, to maintain
        completeness of this tactic, we can only perform such a
        swap with a decidable proposition; hence, we first test
        whether the hypothesis is an [FSet_elt_Prop] in the
        fourth branch (any [FSet_elt_Prop] is decidable). *)
    pull not using FSet_decidability;
    unfold not in *;
    match goal with
    | H: (In ?x ?r) -> False |- (In ?x ?s) -> False =>
      contra H; decideFSet_body
    | H: (In ?x ?r) -> False |- (E.eq ?x ?y) -> False =>
      contra H; decideFSet_body
    | H: (In ?x ?r) -> False |- (E.eq ?y ?x) -> False =>
      contra H; decideFSet_body
    | H: ?P -> False |- ?Q -> False =>
      if prop (FSet_elt_Prop P) holds by
        (auto 100 with FSet_Prop)
      then (contra H; decideFSet_body)
      else decideFSet_body
    | |- _ =>
      decideFSet_body
    end.

  (** * Examples *)

  Lemma test_eq_trans_1 : forall x y z s,
    E.eq x y ->
    ~ ~ E.eq z y ->
    In x s ->
    In z s.
  Proof. decideFSet. Qed.

  Lemma test_eq_trans_2 : forall x y z r s,
    In x (singleton y) ->
    ~ In z r ->
    ~ ~ In z (add y r) ->
    In x s ->
    In z s.
  Proof. decideFSet. Qed.

  Lemma test_eq_neq_trans_1 : forall w x y z s,
    E.eq x w ->
    ~ ~ E.eq x y ->
    ~ E.eq y z ->
    In w s ->
    In w (remove z s).
  Proof. decideFSet. Qed.

  Lemma test_eq_neq_trans_2 : forall w x y z r1 r2 s,
    In x (singleton w) ->
    ~ In x r1 ->
    In x (add y r1) ->
    In y r2 ->
    In y (remove z r2) ->
    In w s ->
    In w (remove z s).
  Proof. decideFSet. Qed.

  Lemma test_In_singleton : forall x,
    In x (singleton x).
  Proof. decideFSet. Qed.

  Lemma test_Subset_add_remove : forall x s,
    s [<=] (add x (remove x s)).
  Proof. decideFSet. Qed.

  Lemma test_eq_disjunction : forall w x y z,
    In w (add x (add y (singleton z))) ->
    E.eq w x \/ E.eq w y \/ E.eq w z.
  Proof. decideFSet. Qed.

  Lemma test_not_In_disj : forall x y s1 s2 s3 s4,
    ~ In x (union s1 (union s2 (union s3 (add y s4)))) ->
    ~ (In x s1 \/ In x s4 \/ E.eq y x).
  Proof. decideFSet. Qed.

  Lemma test_not_In_conj : forall x y s1 s2 s3 s4,
    ~ In x (union s1 (union s2 (union s3 (add y s4)))) ->
    ~ In x s1 /\ ~ In x s4 /\ ~ E.eq y x.
  Proof. decideFSet. Qed.

  Lemma test_iff_conj : forall a x s s',
   (In a s' <-> E.eq x a \/ In a s) ->
   (In a s' <-> In a (add x s)).
  Proof. decideFSet. Qed.

  Lemma test_set_ops_1 : forall x q r s,
    (singleton x) [<=] s ->
    Empty (union q r) ->
    Empty (inter (diff s q) (diff s r)) ->
    ~ In x s.
  Proof. decideFSet. Qed.

  Lemma eq_chain_test : forall x1 x2 x3 x4 s1 s2 s3 s4,
    Empty s1 ->
    In x2 (add x1 s1) ->
    In x3 s2 ->
    ~ In x3 (remove x2 s2) ->
    ~ In x4 s3 ->
    In x4 (add x3 s3) ->
    In x1 s4 ->
    Subset (add x4 s4) s4.
  Proof. decideFSet. Qed.

  Lemma test_too_complex : forall x y z r s,
    E.eq x y ->
    (In x (singleton y) -> r [<=] s) ->
    In z r ->
    In z s.
  Proof.
    (** decideFSet is not intended to solve this directly. *)
    intros until s; intros Heq H Hr; lapply H; decideFSet.
  Qed.

  Lemma function_test_1 :
    forall (f : t -> t),
    forall (g : elt -> elt),
    forall (s1 s2 : t),
    forall (x1 x2 : elt),
    Equal s1 (f s2) ->
    E.eq x1 (g (g x2)) ->
    In x1 s1 ->
    In (g (g x2)) (f s2).
  Proof. decideFSet. Qed.

  Lemma function_test_2 :
    forall (f : t -> t),
    forall (g : elt -> elt),
    forall (s1 s2 : t),
    forall (x1 x2 : elt),
    Equal s1 (f s2) ->
    E.eq x1 (g x2) ->
    In x1 s1 ->
    g x2 = g (g x2) ->
    In (g (g x2)) (f s2).
  Proof.
    (** decideFSet is not intended to solve this directly. *)
    intros until 3. intros g_eq. rewrite <- g_eq. decideFSet.
  Qed.

End Decide.


Require Import Coq.Lists.List.

Module List.
  Definition enumerate {A} (ls : list A) : list (nat * A)
    := combine (seq 0 (length ls)) ls.

  Definition find_index {A} (f : A -> bool) (xs : list A) : option nat
    := option_map (@fst _ _) (find (fun v => f (snd v)) (enumerate xs)).
End List.


Add LoadPath "C:\Users\21692\ParcoursRecherche\dossier_final\coq_parcours_recherche\znaidi22\dev\final" as lp.

Require Import  String.

Load Verbose vecteurs.

Load Verbose alphabets.

Definition masquage{d : nat}(c : (Modulo d) * (Modulo d)) : Modulo d.
Proof.
  exact (modulo_somme (fst c) (snd c)).
Defined.

Definition chiffrement{d n : nat} :
  (Vecteur (Modulo d) n) * (Vecteur (Modulo d) n) -> (Vecteur (Modulo d) n)
  := vecteur_biApplication masquage.

Definition demasquage{d : nat}(c : (Modulo d) * (Modulo d)) : Modulo d.
Proof.
  exact (modulo_somme (fst c) (modulo_opposeSomme (snd c))).
Defined.

Definition dechiffrement{d n : nat} :
  (Vecteur (Modulo d) n) * (Vecteur (Modulo d) n) -> (Vecteur (Modulo d) n)
  := vecteur_biApplication demasquage.

(* Lemme : le masquage suivi du démasquage produit la première projection (soit le
nombre modulo en entrée).  *)
Theorem masquage_correction :
  forall d,
    @fonction_egalite
      ((Modulo d) * (Modulo d)) (Modulo d)
      (produitCartesien_produitFonctionnel masquage snd ;; demasquage)
      fst.
Proof.
  intros d [m k].
  unfold fonction_sequence.
  unfold masquage.
  unfold demasquage.
  cbn.
  rewrite modulo_somme_associativite_gaucheADroite.
  rewrite modulo_opposeSomme_correction.
  rewrite modulo_somme_neutraliteDroite.
  reflexivity.
Qed.

(* Thèorème fondamental : la correction du chiffrement.
Le chiffrement suivi du déchiffrement produit la première projection
(soit le message en entrée).
Démonstration longue utilisant des propriétés abstraites élémentaires.
Une automatisation de la preuve en utilisant le langage de tactiques serait
bienvenu. L'associativité pose cependant problème puisqu'elle impose de recombiner
la composition fonctionnelle de manière à faire apparaître le terme à traiter.
En Mathématiques, ce raisonnement est oublié, étant évident.*)
Theorem chiffrement_masquage_correction :
  forall (d n : nat),
    @fonction_egalite
      ((Vecteur (Modulo d) n) * (Vecteur (Modulo d) n))
      (Vecteur (Modulo d) n)
      ((produitCartesien_produitFonctionnel chiffrement snd)
       ;; dechiffrement)
      fst.
Proof.
  intros d n.
  apply fonction_egalite_transitivite with
    ((produitCartesien_produitFonctionnel chiffrement (vecteur_biApplication snd))
     ;; dechiffrement).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply produitCartesien_produitFonctionnel_compatibiliteEgaliteFonctionnelle.
    apply fonction_egalite_reflexivite.
    apply fonction_egalite_symetrie.
    apply vecteur_biApplicationProjection2.
    apply fonction_egalite_reflexivite.
  }
  unfold chiffrement.
  apply fonction_egalite_transitivite with
    ((produitCartesien_produitFonctionnel
        (vecteur_preservationProduit_vecteurCouples ;;
         vecteur_application masquage)
        (vecteur_preservationProduit_vecteurCouples ;;
         vecteur_application snd))
     ;; dechiffrement).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply produitCartesien_produitFonctionnel_compatibiliteEgaliteFonctionnelle.
    apply vecteur_biApplication_equivalenceApplication.
    apply vecteur_biApplication_equivalenceApplication.
    apply fonction_egalite_reflexivite.
  }
  apply fonction_egalite_transitivite with
    ((vecteur_preservationProduit_vecteurCouples
     ;;
     (produitCartesien_produitFonctionnel
        (vecteur_application masquage)
        (vecteur_application snd)))
     ;;
     dechiffrement).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply fonction_egalite_symetrie.
    apply fonction_distributionSequenceSurProduit.
    apply fonction_egalite_reflexivite.
  }
  unfold dechiffrement.
  (* Plutôt que récrire le terme intermédiaire en entier, on
     peut le décrire partiellement en utilisant '_'.
   Utiliser alors la tactique 'eapply' (existential apply). *)
  eapply fonction_egalite_transitivite with
    (_ ;; (vecteur_preservationProduit_vecteurCouples ;;
           vecteur_application demasquage)).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply fonction_egalite_reflexivite.
    apply vecteur_biApplication_equivalenceApplication.
  }
  eapply fonction_egalite_transitivite with
    (( _ ;;
       ((vecteur_application (produitCartesien_produitFonctionnel masquage snd)) ;;
       vecteur_preservationProduit_coupleVecteurs)
     ) ;; _ ;; _ ).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply fonction_egalite_reflexivite.
    apply fonction_egalite_symetrie.
    apply vecteur_application_distributionSurProduitFonctionnel.
    apply fonction_egalite_reflexivite.
  }
  eapply fonction_egalite_transitivite with
    ((_ ;; _ ) ;; _).
  {
    rewrite fonction_sequence_associativitePosterieurAAnterieur.
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle;
      apply fonction_egalite_reflexivite.
  }
  eapply fonction_egalite_transitivite with
    ((((_ ;; _) ;; _) ;; _) ;; _).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    rewrite fonction_sequence_associativitePosterieurAAnterieur.
    apply fonction_egalite_reflexivite.
    apply fonction_egalite_reflexivite.
    apply fonction_egalite_reflexivite.
  }
  eapply fonction_egalite_transitivite with
    ((_ ;; (_ ;; _)) ;; _).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    rewrite fonction_sequence_associativiteAnterieurAPosterieur.
    apply fonction_egalite_reflexivite.
    apply fonction_egalite_reflexivite.
  }
  eapply fonction_egalite_transitivite with
    ((_ ;; id) ;; _).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply fonction_egalite_reflexivite.
    apply vecteur_preservationProduit_deVecteurAVecteur.
    apply fonction_egalite_reflexivite.
  }
  eapply fonction_egalite_transitivite with
    (_ ;; _).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    rewrite fonction_sequence_neutralitePosterieure.
    apply fonction_egalite_reflexivite.
    apply fonction_egalite_reflexivite.
  }
  rewrite fonction_sequence_associativiteAnterieurAPosterieur.
  eapply fonction_egalite_transitivite with
    (_ ;; _).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply fonction_egalite_reflexivite.
    apply fonction_egalite_symetrie.
    apply vecteur_application_preservationSequence.
  }
  eapply fonction_egalite_transitivite with
    (_ ;; (vecteur_application fst)).
  {
    apply fonction_sequence_compatibiliteEgaliteFonctionnelle.
    apply fonction_egalite_reflexivite.
    apply vecteur_application_compatibiliteEgaliteFonctionnelle.
    apply masquage_correction.
  }
  eapply fonction_egalite_transitivite with
    (vecteur_biApplication fst).
  apply fonction_egalite_symetrie.
  apply vecteur_biApplication_equivalenceApplication.
  apply vecteur_biApplicationProjection1.
Qed.


Require Import Omega.
Require Import RelationClasses.

From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Loc.

Require Import Event.
Require Import Time.

Set Implicit Arguments.

Definition loc_ts_eq_dec (lhs rhs:Loc.t * Time.t):
  {lhs.(fst) = rhs.(fst) /\ lhs.(snd) = rhs.(snd)} +
  {lhs.(fst) <> rhs.(fst) \/ lhs.(snd) <> rhs.(snd)}.
Proof.
  destruct lhs, rhs.
  destruct (Loc.eq_dec t t1), (Time.eq_dec t0 t2); subst; auto.
Defined.
Global Opaque loc_ts_eq_dec.

Module TimeMap <: JoinableType.
  Definition t := Loc.t -> Time.t.

  Definition eq := @eq t.

  Definition le (lhs rhs:t): Prop :=
    forall loc, Time.le (lhs loc) (rhs loc).

  Global Program Instance le_PreOrder: PreOrder le.
  Next Obligation. ii. refl. Qed.
  Next Obligation. ii. etrans; eauto. Qed.

  Definition bot: t := fun _ => Time.bot.

  Lemma bot_spec (tm:t): le bot tm.
  Proof. ii. apply Time.bot_spec. Qed.

  Definition get (loc:Loc.t) (c:t) := c loc.

  Definition add (l:Loc.t) (ts:Time.t) (tm:t): t :=
    fun l' =>
      if Loc.eq_dec l' l
      then ts
      else get l' tm.

  Definition add_spec l' l ts tm:
    get l' (add l ts tm) =
    if Loc.eq_dec l' l
    then ts
    else get l' tm.
  Proof. auto. Qed.

  Lemma add_spec_eq l ts tm:
    get l (add l ts tm) = ts.
  Proof.
    rewrite add_spec.
    destruct (Loc.eq_dec l l); auto.
    congruence.
  Qed.

  Lemma add_spec_neq l' l ts tm (NEQ: l' <> l):
    get l' (add l ts tm) = get l' tm.
  Proof.
    rewrite add_spec.
    destruct (Loc.eq_dec l' l); auto.
    congruence.
  Qed.

  Definition join (lhs rhs:t): t :=
    fun loc => Time.join (lhs loc) (rhs loc).

  Lemma join_comm lhs rhs: join lhs rhs = join rhs lhs.
  Proof. apply LocFun.ext. i. apply Time.join_comm. Qed.

  Lemma join_assoc a b c: join (join a b) c = join a (join b c).
  Proof.
    apply LocFun.ext. i. apply Time.join_assoc.
  Qed.

  Lemma join_l lhs rhs: le lhs (join lhs rhs).
  Proof. ii. apply Time.join_l. Qed.

  Lemma join_r lhs rhs: le rhs (join lhs rhs).
  Proof. ii. apply Time.join_r. Qed.

  Lemma join_spec lhs rhs o
        (LHS: le lhs o)
        (RHS: le rhs o):
    le (join lhs rhs) o.
  Proof. unfold join. ii. apply Time.join_spec; auto. Qed.

  Definition singleton loc ts :=
    LocFun.add loc ts (LocFun.init Time.bot).

  Lemma singleton_spec loc ts c
        (LOC: Time.le ts (c loc)):
    le (singleton loc ts) c.
  Proof.
    ii. unfold singleton, LocFun.add, LocFun.find.
    condtac; subst; ss. apply Time.bot_spec.
  Qed.

  Lemma singleton_inv loc ts c
        (LE: le (singleton loc ts) c):
    Time.le ts (c loc).
  Proof.
    generalize (LE loc). unfold singleton, LocFun.add, LocFun.find.
    condtac; [|congr]. auto.
  Qed.

  Lemma le_join_l l r
        (LE: le r l):
    join l r = l.
  Proof.
    apply LocFun.ext. i.
    unfold join, Time.join, LocFun.find. condtac; auto.
    apply TimeFacts.antisym; auto.
  Qed.

  Lemma le_join_r l r
        (LE: le l r):
    join l r = r.
  Proof.
    apply LocFun.ext. i.
    unfold join, Time.join, LocFun.find. condtac; auto.
    exfalso. eapply Time.lt_strorder. eapply TimeFacts.lt_le_lt; eauto.
  Qed.

  Lemma antisym l r
        (LR: le l r)
        (RL: le r l):
    l = r.
  Proof.
    extensionality loc. apply TimeFacts.antisym; auto.
  Qed.
End TimeMap.

Module View <: JoinableType.
  Structure t_ := mk {
    pln: TimeMap.t;
    rlx: TimeMap.t;
  }.
  Definition t := t_.

  Inductive wf (view:t): Prop :=
  | wf_intro
      (PLN_RLX: TimeMap.le view.(pln) view.(rlx))
  .

  Inductive opt_wf: forall (view:option View.t), Prop :=
  | opt_wf_some
      view
      (WF: wf view):
      opt_wf (Some view)
  | opt_wf_none:
      opt_wf None
  .

  Definition eq := @eq t.

  Inductive le_ (lhs rhs:t): Prop :=
  | le_intro
      (PLN: TimeMap.le lhs.(pln) rhs.(pln))
      (RLX: TimeMap.le lhs.(rlx) rhs.(rlx))
  .
  Definition le := le_.

  Global Program Instance le_PreOrder: PreOrder le.
  Next Obligation.
    ii. econs; refl.
  Qed.
  Next Obligation.
    ii. inv H. inv H0. econs; etrans; eauto.
  Qed.

  Inductive opt_le: forall (lhs rhs:option t), Prop :=
  | opt_le_none
      rhs:
      opt_le None rhs
  | opt_le_some
      lhs rhs
      (LE: le lhs rhs):
      opt_le (Some lhs) (Some rhs)
  .

  Global Program Instance opt_le_PreOrder: PreOrder opt_le.
  Next Obligation.
    ii. destruct x; econs. refl.
  Qed.
  Next Obligation.
    ii. inv H; inv H0; econs. etrans; eauto.
  Qed.

  Lemma ext l r
        (PLN: l.(pln) = r.(pln))
        (RLX: l.(rlx) = r.(rlx))
    : l = r.
  Proof.
    destruct l, r. f_equal; auto.
  Qed.

  Definition bot: t := mk TimeMap.bot TimeMap.bot.

  Lemma bot_wf: wf bot.
  Proof. econs; refl. Qed.

  Lemma bot_spec (c:t): le bot c.
  Proof. econs; apply TimeMap.bot_spec. Qed.

  Definition join (lhs rhs:t): t :=
    mk (TimeMap.join lhs.(pln) rhs.(pln))
       (TimeMap.join lhs.(rlx) rhs.(rlx)).

  Lemma join_comm lhs rhs: join lhs rhs = join rhs lhs.
  Proof. unfold join. f_equal; apply TimeMap.join_comm. Qed.

  Lemma join_assoc a b c: join (join a b) c = join a (join b c).
  Proof.
    unfold join. ss. f_equal.
    - apply TimeMap.join_assoc.
    - apply TimeMap.join_assoc.
  Qed.

  Lemma join_l lhs rhs: le lhs (join lhs rhs).
  Proof. econs; apply TimeMap.join_l. Qed.

  Lemma join_r lhs rhs: le rhs (join lhs rhs).
  Proof. econs; apply TimeMap.join_r. Qed.

  Lemma join_spec lhs rhs o
        (LHS: le lhs o)
        (RHS: le rhs o):
    le (join lhs rhs) o.
  Proof.
    inv LHS. inv RHS.
    econs; apply TimeMap.join_spec; eauto.
  Qed.

  Lemma join_wf
        lhs rhs
        (LHS: wf lhs)
        (RHS: wf rhs):
    wf (join lhs rhs).
  Proof.
    econs.
    - apply TimeMap.join_spec.
      + etrans; [apply LHS|]. apply TimeMap.join_l.
      + etrans; [apply RHS|]. apply TimeMap.join_r.
  Qed.

  Definition bot_unless (cond:bool) (c:t): t :=
    if cond then c else bot.

  Lemma bot_unless_wf
        cond c
        (WF: wf c):
    wf (bot_unless cond c).
  Proof.
    destruct cond; ss. apply bot_wf.
  Qed.

  Definition singleton_ur loc ts :=
    mk (TimeMap.singleton loc ts)
       (TimeMap.singleton loc ts).

  Lemma singleton_ur_wf
        loc ts:
    wf (singleton_ur loc ts).
  Proof.
    econs; ss; refl.
  Qed.

  Lemma singleton_ur_spec loc ts c
        (WF: wf c)
        (TS: Time.le ts (c.(pln) loc)):
    le (singleton_ur loc ts) c.
  Proof.
    econs; s;
      try apply TimeMap.bot_spec;
      try apply TimeMap.singleton_spec; auto.
    - etrans; eauto. apply WF.
  Qed.

  Lemma singleton_ur_inv loc ts c
        (LE: le (singleton_ur loc ts) c):
    Time.le ts (c.(pln) loc).
  Proof.
    apply TimeMap.singleton_inv. apply LE.
  Qed.

  Definition singleton_rw loc ts :=
    mk TimeMap.bot
       (TimeMap.singleton loc ts).

  Lemma singleton_rw_wf
        loc ts:
    wf (singleton_rw loc ts).
  Proof.
    econs; ss; try refl. apply TimeMap.bot_spec.
  Qed.

  Lemma singleton_rw_spec loc ts c
        (WF: wf c)
        (TS: Time.le ts (c.(rlx) loc)):
    le (singleton_rw loc ts) c.
  Proof.
    econs; s;
      try apply TimeMap.bot_spec;
      try apply TimeMap.singleton_spec; auto.
  Qed.

  Lemma singleton_rw_inv loc ts c
        (LE: le (singleton_rw loc ts) c):
    Time.le ts (c.(rlx) loc).
  Proof.
    apply TimeMap.singleton_inv. apply LE.
  Qed.

  Definition singleton_ur_if (cond:bool) loc ts :=
    (if cond then singleton_ur else singleton_rw) loc ts.

  Lemma singleton_ur_if_wf
        cond loc ts:
    wf (singleton_ur_if cond loc ts).
  Proof.
    destruct cond; ss.
    - apply singleton_ur_wf.
    - apply singleton_rw_wf.
  Qed.

  Lemma singleton_ur_if_spec (cond:bool) loc ts c
        (WF: wf c)
        (TS: Time.le ts ((if cond then c.(pln) else c.(rlx)) loc)):
    le (singleton_ur_if cond loc ts) c.
  Proof.
    destruct cond; ss.
    - apply singleton_ur_spec; ss.
    - apply singleton_rw_spec; ss.
  Qed.

  Lemma singleton_ur_if_inv cond loc ts c
        (LE: le (singleton_ur_if cond loc ts) c):
    Time.le ts ((if cond then c.(pln) else c.(rlx)) loc).
  Proof.
    destruct cond; ss.
    - apply singleton_ur_inv. ss.
    - apply singleton_rw_inv. ss.
  Qed.

  Lemma le_join_l l r
        (LE: le r l):
    join l r = l.
  Proof.
    unfold join. destruct l. ss.
    f_equal; apply TimeMap.le_join_l; apply LE.
  Qed.

  Lemma le_join_r l r
        (LE: le l r):
    join l r = r.
  Proof.
    unfold join. destruct r. ss.
    f_equal; apply TimeMap.le_join_r; apply LE.
  Qed.

  Lemma antisym l r
        (LR: le l r)
        (RL: le r l):
    l = r.
  Proof.
    destruct l, r. inv LR. inv RL. ss. f_equal.
    - apply TimeMap.antisym; auto.
    - apply TimeMap.antisym; auto.
  Qed.

  Lemma opt_antisym l r
        (LR: opt_le l r)
        (RL: opt_le r l):
    l = r.
  Proof.
    inv LR; inv RL; ss. f_equal.
    apply antisym; ss.
  Qed.

  Lemma timemap_le_le tm1 tm2
        (LE: TimeMap.le tm1 tm2):
    le (mk tm1 tm1) (mk tm2 tm2).
  Proof. econs; eauto. Qed.

  Definition unwrap (view:option t): t :=
    match view with
    | Some view => view
    | None => bot
    end.

  Lemma unwrap_opt_wf
        view
        (WF: opt_wf view):
    wf view.(unwrap).
  Proof.
    inv WF; ss. apply bot_wf.
  Qed.

  Lemma unwrap_opt_le
        view1 view2
        (WF: opt_le view1 view2):
    le view1.(unwrap) view2.(unwrap).
  Proof.
    inv WF; ss. apply bot_spec.
  Qed.

  Lemma opt_None_spec rhs:
    opt_le None rhs.
  Proof. econs. Qed.

  Lemma join_bot_l rhs:
    join bot rhs = rhs.
  Proof.
    apply antisym.
    - apply join_spec.
      + apply bot_spec.
      + refl.
    - apply join_r.
  Qed.
End View.


Require Export A4_Droite.

Section CIRCLE.

Inductive Circle : Figure -> Type :=
	| Compass : forall C A B : Point, A <> B -> Circle (fun M : Point => (Distance C M) = (Distance A B))
	| SuperimposedCircle : forall F1 F2 : Figure, Superimposed F1 F2 -> Circle F1 -> Circle F2.

Definition Center : forall F : Figure, forall G : Circle F, Point.
Proof.
	intros F G; induction G.
	 exact C.
	 exact IHG.
Defined.

Definition RadiusA : forall F : Figure, forall G : Circle F, Point.
Proof.
	intros F G; induction G.
	 exact A.
	 exact IHG.
Defined.

Definition RadiusB : forall F : Figure, forall G : Circle F, Point.
Proof.
	intros F G; induction G.
	 exact B.
	 exact IHG.
Defined.

Definition RadiusH : forall F : Figure, forall G : Circle F, RadiusA F G <> RadiusB F G.
Proof.
	intros F G; induction G.
	 exact n.
	 exact IHG.
Defined.

Definition Radius := fun (F : Figure) (G : Circle F) => Distance (RadiusA F G) (RadiusB F G).

Definition SecantCircles := fun (F1 F2 : Figure) (G1 : Circle F1) (G2 : Circle F2) =>
	TriangleSpec (Distance (Center F1 G1) (Center F2 G2)) (Radius F1 G1) (Radius F2 G2).

Definition SecantDiameterCircle := fun (F1 F2 : Figure) (D : Line F1) (G : Circle F2) =>
		F1 (Center F2 G).

End CIRCLE.

Ltac setCircle C A B H F G :=
	pose (F := fun M => (Distance C M) = (Distance A B));
	pose (G := Compass C A B H).

Ltac simplCircle :=
	unfold SecantDiameterCircle, SecantCircles, Radius, RadiusH, RadiusB, RadiusA, Center in *; simpl in *.


(* This file is generated by Why3's Coq driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.
Require list.List.
Require list.Length.
Require list.Mem.
Require list.Nth.
Require option.Option.
Require list.Append.
Require list.Reverse.

Parameter m: Z.

Axiom m_positive : (0%Z < m)%Z.

Parameter n: Z.

Axiom n_nonnegative : (0%Z <= n)%Z.

(* Why3 assumption *)
Inductive shuffle {a:Type} {a_WT:WhyType a} : (list a) -> (list a)
  -> (list a) -> Prop :=
  | Shuffle_nil_left : forall (l:(list a)), ((@shuffle _ _) l nil l)
  | Shuffle_nil_right : forall (l:(list a)), ((@shuffle _ _) nil l l)
  | Shuffle_cons_left : forall (x:a) (a1:(list a)) (b:(list a)) (c:(list a)),
      ((@shuffle _ _) a1 b c) -> ((@shuffle _ _) (cons x a1) b (cons x c))
  | Shuffle_cons_right : forall (x:a) (a1:(list a)) (b:(list a))
      (c:(list a)), ((@shuffle _ _) a1 b c) -> ((@shuffle _ _) a1 (cons x b)
      (cons x c)).

Axiom shuffle_nil_nil_nil : forall {a:Type} {a_WT:WhyType a}, (shuffle nil
  nil nil).

Axiom shuffle_sym : forall {a:Type} {a_WT:WhyType a}, forall (a1:(list a))
  (b:(list a)) (c:(list a)), (shuffle a1 b c) -> (shuffle b a1 c).

(* Why3 goal *)
Theorem shuffle_length : forall {a:Type} {a_WT:WhyType a},
  forall (a1:(list a)) (b:(list a)) (c:(list a)), (shuffle a1 b c) ->
  (((list.Length.length a1) + (list.Length.length b))%Z = (list.Length.length c)).
(* Why3 intros a a_WT a1 b c h1. *)
induction 1; unfold Length.length; fold @Length.length; omega.
Qed.


(**
Internal equivalences in bicategories can be refined to adjoint equivalences.

Authors: Dan Frumin, Niels van der Weide

Ported from: https://github.com/nmvdw/groupoids
*)

Require Import UniMath.Foundations.All.
Require Import UniMath.MoreFoundations.All.
Require Import UniMath.CategoryTheory.Core.Categories.
Local Open Scope cat.
Require Import UniMath.Bicategories.Core.Bicat. Import Bicat.Notations.
Require Import UniMath.Bicategories.Core.Unitors.
Require Import UniMath.Bicategories.Core.Invertible_2cells.
Require Import UniMath.Bicategories.Core.BicategoryLaws.
Require Import UniMath.Bicategories.Morphisms.Adjunctions.
Require Import UniMath.Bicategories.Core.Univalence.
Local Open Scope bicategory_scope.

Lemma representable_faithful
           {C : bicat}
           {X Y Z : C}
           {f : C⟦X,Y⟧} {g : C⟦Y,X⟧}
           (η : id₁ X ==> g ∘ f)
           (k₁ k₂ : C⟦Z,X⟧)
           (α β : k₁ ==> k₂)
           (Hη : is_invertible_2cell η)
  : f ◅ α = f ◅ β -> α = β.
Proof.
  intros Hαβ.
  rewrite (whisker_l_iso_id₁ η _ _ α Hη).
  rewrite (whisker_l_iso_id₁ η _ _ β Hη).
  do 2 apply maponpaths.
  apply (maponpaths (fun z => _ o z)).
  apply (whisker_l_eq k₁ k₂ α β Hαβ).
Qed.

Definition representable_full
           {C : bicat}
           {X Y Z : C}
           {f : C⟦X,Y⟧} {g : C⟦Y,X⟧}
           (η : id₁ X ==> g ∘ f)
           (θ : f ∘ g ==> id₁ Y)
           (Hη : is_invertible_2cell η)
           (k₁ k₂ : C⟦Z,X⟧)
           (α : f ∘ k₁ ==> f ∘ k₂)
  : k₁ ==> k₂.
Proof.
  refine (_ o rinvunitor _).
  refine (_ o η ▻ _).
  refine (_ o lassociator _ _ _).
  refine (_ o g ◅ α).
  refine (_ o rassociator _ _ _).
  refine (_ o Hη^-1 ▻ k₂).
  apply runitor.
Defined.

Lemma full_spec
           {C : bicat}
           {X Y Z : C}
           {f : C⟦X,Y⟧} {g : C⟦Y,X⟧}
           (η : id₁ X ==> g ∘ f)
           (θ : f ∘ g ==> id₁ Y)
           (Hη : is_invertible_2cell η)
           (Hθ : is_invertible_2cell θ)
           (k₁ k₂ : C⟦Z,X⟧)
           (α : f ∘ k₁ ==> f ∘ k₂)
  : f ◅ (representable_full η θ Hη k₁ k₂ α) = α.
Proof.
  refine (representable_faithful (Hθ^-1) (f ∘ k₁) (f ∘ k₂) _ α _ _).
  { is_iso. }
  apply (vcomp_lcancel (lassociator _ _ _)).
  { is_iso. }
  rewrite <- whisker_l_hcomp.
  apply (vcomp_rcancel (rassociator _ _ _)).
  { is_iso. }
  rewrite <- !vassocr.
  rewrite lassociator_rassociator, id2_right.
  apply (vcomp_rcancel (Hη^-1 ▻ k₂)).
  { is_iso. }
  apply (vcomp_rcancel (runitor k₂)).
  { is_iso. }
  apply (vcomp_lcancel (η ▻ k₁)).
  { is_iso. }
  apply (vcomp_lcancel (rinvunitor k₁)).
  { is_iso. }
  rewrite <- !vassocr.
  rewrite <- (whisker_l_iso_id₁ η k₁ k₂ (representable_full η θ Hη k₁ k₂ α) Hη).
  apply idpath.
Qed.

Section EquivToAdjEquiv.
  Context {C : bicat}
          {X Y : C}.
  Variable (f : C⟦X,Y⟧)
           (Hf : left_equivalence f).

  Local Definition g : C⟦Y,X⟧ := left_adjoint_right_adjoint Hf.
  Local Definition η : id₁ X ==> g ∘ f := left_adjoint_unit Hf.
  Local Definition θ : f ∘ g ==> id₁ Y := left_adjoint_counit Hf.
  Local Definition ηiso := left_equivalence_unit_iso Hf.
  Local Definition θiso := left_equivalence_counit_iso Hf.

  Local Definition ε : f ∘ g ==> id₁ Y.
  Proof.
    refine (representable_full (θiso^-1) (ηiso^-1) _ (f ∘ g) (id₁ Y) _).
    { is_iso. }
    exact ((linvunitor g)
             o runitor g
             o ηiso^-1 ▻ g
             o rassociator _ _ _).
  Defined.

  Definition εiso : is_invertible_2cell ε.
  Proof.
    unfold ε, representable_full.
    is_iso.
  Defined.

  Definition equiv_to_adjequiv_d : left_adjoint_data f.
  Proof.
    refine (g ,, _).
    split.
    - exact η.
    - exact ε.
  Defined.

  Local Lemma first_triangle_law
    : (lunitor g)
        o g ◅ ε
        o lassociator g f g
        o η ▻ g
        o rinvunitor _
      = id₂ g.
  Proof.
    rewrite !vassocr.
    unfold ε.
    rewrite (full_spec (θiso^-1) (ηiso^-1) _ (is_invertible_2cell_inv _) (f ∘ g) (id₁ Y) _).
    rewrite <- !vassocr.
    rewrite linvunitor_lunitor, id2_right.
    rewrite !vassocr.
    rewrite !(maponpaths (fun z => _ o (_ o z)) (!(vassocr _ _ _))).
    rewrite lassociator_rassociator, id2_right.
    rewrite !(maponpaths (fun z => _ o z) (!(vassocr _ _ _))).
    rewrite lwhisker_vcomp.
    rewrite vcomp_rinv.
    rewrite lwhisker_id2.
    rewrite id2_right.
    apply rinvunitor_runitor.
  Qed.

  Local Definition whisker_ηg_type
    : Type.
  Proof.
    refine (η ▻ g = inv_cell (η := (lunitor g o g ◅ ε o lassociator g f g)) _ o runitor g).
    unfold ε, representable_full.
    is_iso.
  Defined.

  Local Lemma whisker_ηg
    : whisker_ηg_type.
  Proof.
    use vcomp_move_L_Mp.
    { cbn.
      is_iso.
      - apply Hf.
      - apply Hf.
    }
    cbn.
    refine (_ @ id2_right _).
    use vcomp_move_L_pM.
    { is_iso. }
    cbn.
    apply first_triangle_law.
  Qed.

  Local Lemma η_natural
    : η ▻ (g ∘ f) o rinvunitor (g ∘ f) o η
      =
      (g ∘ f) ◅ η o linvunitor (g ∘ f) o η.
  Proof.
    rewrite !vassocr.
    rewrite rinvunitor_natural.
    rewrite linvunitor_natural.
    rewrite <- !vassocr.
    rewrite lwhisker_hcomp, rwhisker_hcomp.
    rewrite <- !interchange.
    rewrite !id2_left, !id2_right.
    apply (maponpaths (fun z => z • _)).
    apply pathsinv0.
    apply lunitor_V_id_is_left_unit_V_id.
  Qed.

  Local Definition η_natural_help
    : η ▻ (g ∘ f) o rinvunitor (g ∘ f)
      =
      (g ∘ f) ◅ η o linvunitor (g ∘ f)
    := vcomp_lcancel η ηiso η_natural.

  Local Lemma η_whisker_l_hcomp
    : (g ∘ f) ◅ η = rassociator (g ∘ f) f g o g ◅ (f ◅ η) o lassociator (id₁ X) f g.
  Proof.
    rewrite !vassocr.
    use vcomp_move_L_Mp.
    { is_iso. }
    cbn.
    apply pathsinv0.
    apply rwhisker_rwhisker.
  Qed.

  Local Lemma η_whisker_r_hcomp
    : η ▻ (g ∘ f) = lassociator f g(g ∘ f) o η ▻ g ▻ f o rassociator f g (id₁ X).
  Proof.
    use vcomp_move_L_pM.
    { is_iso. }
    cbn.
    apply pathsinv0.
    apply lwhisker_lwhisker.
  Qed.

  Local Lemma help1
    : lassociator f g (g ∘ f) o (η ▻ g o rinvunitor _) ▻ f
      =
      (rassociator (g ∘ f) f g)
        o g ◅ (f ◅ η)
        o lassociator (id₁ X) f g
        o linvunitor (g ∘ f).
  Proof.
    rewrite <- η_whisker_l_hcomp.
    rewrite <- lwhisker_vcomp.
    rewrite left_unit_inv_assoc.
    rewrite <- !vassocr.
    rewrite lwhisker_lwhisker.
    rewrite !vassocr.
    rewrite !(maponpaths (fun z => _ o z) (!(vassocr _ _ _))).
    rewrite rassociator_lassociator, id2_right.
    exact η_natural_help.
  Qed.

  Local Lemma help2
    : g ◅ (lassociator f g f o εiso^-1 ▻ f o rinvunitor _)
      =
      g ◅ (f ◅ η o linvunitor f).
  Proof.
    rewrite <- !rwhisker_vcomp.
    rewrite !vassocr.
    rewrite lwhisker_hcomp, rwhisker_hcomp.
    rewrite <- triangle_l_inv.
    rewrite !(maponpaths (fun z => _ o z) (!(vassocr _ _ _))).
    unfold assoc.
    rewrite <- !lwhisker_hcomp.
    rewrite <- rwhisker_lwhisker.
    pose help1 as p.
    rewrite whisker_ηg in p.
    cbn in p.
    rewrite !vassocr in p.
    rewrite rinvunitor_runitor, id2_left in p.
    rewrite <- !lwhisker_vcomp in p.
    rewrite linvunitor_assoc in p.
    rewrite <- !vassocr in p.
    rewrite !vassocr in p.
    rewrite !(maponpaths (fun z => _ o (_ o z)) (!(vassocr _ _ _))) in p.
    rewrite rassociator_lassociator, id2_right in p.
    rewrite rwhisker_vcomp in p.
    rewrite <- !vassocr in p.
    pose @inverse_pentagon_5 as q.
    rewrite !lwhisker_hcomp in p.
    rewrite q in p ; clear q.
    rewrite !vassocr in p.
    use vcomp_rcancel. 2: exact (rassociator (f · g) f g).
    { is_iso. }
    rewrite rwhisker_vcomp.
    refine (_ @ p) ; clear p.
    cbn.
    rewrite !vassocr, !lwhisker_hcomp, !rwhisker_hcomp.
    apply idpath.
  Qed.

  Local Lemma help3
    : lassociator f g f o εiso^-1 ▻ f o rinvunitor f
      =
      f ◅ η o linvunitor f.
  Proof.
    use (representable_faithful _ _ _ _ _ _ help2).
    - exact f.
    - exact (εiso^-1).
    - is_iso.
  Qed.

  Lemma equiv_to_adjequiv_isadj : left_adjoint_axioms equiv_to_adjequiv_d.
  Proof.
    split ; cbn.
    - refine (maponpaths (fun z => ((z • _) • _) • _) (!help3) @ _).
      rewrite !vassocr.
      rewrite !(maponpaths (fun z => _ o (_ o z)) (!(vassocr _ _ _))).
      rewrite lassociator_rassociator, id2_right.
      rewrite !(maponpaths (fun z => _ o z) (!(vassocr _ _ _))).
      rewrite lwhisker_vcomp.
      rewrite vcomp_linv.
      rewrite lwhisker_id2.
      rewrite id2_right.
      rewrite rinvunitor_runitor.
      reflexivity.
    - rewrite <- !vassocr.
      exact first_triangle_law.
  Qed.

  Definition equiv_to_isadjequiv : left_adjoint_equivalence f.
  Proof.
    use tpair.
    - exact equiv_to_adjequiv_d.
    - cbn.
      split.
      + exact equiv_to_adjequiv_isadj.
      + split.
        * exact ηiso.
        * exact εiso.
  Defined.

  Definition equiv_to_adjequiv : adjoint_equivalence X Y
    := (f ,, equiv_to_isadjequiv).
End EquivToAdjEquiv.

Definition inv_equiv
           {C : bicat}
           {X Y : C}
           {f : X --> Y}
           (Hf : left_equivalence f)
  : left_equivalence (pr11 Hf).
Proof.
  use tpair.
  - use tpair.
    + exact f.
    + split.
      * exact ((left_equivalence_counit_iso Hf)^-1).
      * exact ((left_equivalence_unit_iso Hf)^-1).
  - split ; cbn ; is_iso.
Defined.

Definition inv_adjequiv
           {C : bicat}
           {X Y : C}
  : adjoint_equivalence X Y → adjoint_equivalence Y X.
Proof.
  intro f.
  use equiv_to_adjequiv.
  - exact (left_adjoint_right_adjoint f).
  - exact (inv_equiv (left_equivalence_of_left_adjoint_equivalence f)).
Defined.


Add LoadPath "somePath".

Require Export propForm.

(*----------propForm cons----------*)

Definition propForm_cons (f g:propForm):Prop :=
  forall theta:environment, [[f]]theta -> [[g]]theta.

Definition propForm_eqv (f g:propForm):Prop :=
  forall theta:environment, [[f]] theta <-> [[g]] theta.

(*bot*)
Lemma propForm_eqv_bot : forall f:propForm, (forall theta:environment, ~[[f]]theta) <-> propForm_eqv f bot.
Proof.
intros.
split;intro.
induction f;simpl in *.
specialize (H full_environment).
simpl in H.
exfalso;apply H;auto.
split;simpl;auto.
specialize (H full_environment).
exfalso.
apply H.
simpl;auto.
split;intro.
specialize (H theta).
contradiction.
simpl in H0.
inversion H0.
split.
intro.
specialize (H theta).
contradiction.
intro.
simpl in H0.
inversion H0.
intros.
intro.
destruct (H theta).
apply H1.
assumption.
Qed.

Lemma eqv_bot_dec : forall f:propForm,
  ((forall theta:environment, ~[[f]]theta) \/ exists theta:environment, [[f]]theta).
Proof.
intros.
induction f.
right;exists empty_environment;simpl;auto.
left;simpl;intros;auto.
right;exists full_environment;simpl;auto.
destruct IHf1.
destruct IHf2.
left;intros.
intro.
destruct H1.
apply (H theta H1).
apply (H0 theta H1).
destruct H0.
right;exists x;right;assumption.
destruct H.
right;exists x;left;assumption.
destruct IHf1.
left;intros.
intro.
destruct H0.
apply (H theta);auto.
destruct IHf2.
left;intros.
intro.
destruct H1.
apply (H0 theta);auto.
destruct H as [theta1 H].
destruct H0 as [theta2 H0].
right.
exists (environment_union theta1 theta2).
apply (environment_union_distributes theta1 theta2 f1 f2).
auto.
Qed.

Lemma eqv_propForm_bot_decidable : forall g:propForm, propForm_eqv g bot \/ ~propForm_eqv g bot.
Proof.
intros.
destruct (eqv_bot_dec g);auto.
left;split;intro.
simpl;apply (H theta);auto.
inversion H0.
right.
intro.
destruct H as [theta H].
destruct (H0 theta).
simpl in *;auto.
Qed.

Lemma neqv_bot_full_true : forall f:propForm, (~propForm_eqv f bot) -> [[f]]full_environment.
Proof.
intros;simpl in *.
destruct (propForm_solution_decidable f full_environment).
assumption.
exfalso.
apply H.
split;intro;simpl;auto.
specialize (full_environment_maximal f theta H1);intro;auto.
inversion H1.
Qed.

Lemma full_false_eqv_bot : forall f:propForm, ~[[f]]full_environment -> propForm_eqv f bot.
Proof.
intros;split;intro;simpl in *.
induction f;simpl in *;auto.
destruct H0.
apply IHf1;auto.
apply IHf2;auto.
destruct H0.
destruct (propForm_solution_decidable f1 full_environment).
destruct (propForm_solution_decidable f2 full_environment).
apply H;split;auto.
apply IHf2;auto.
apply IHf1;auto.
inversion H0.
Qed.

Lemma neq_var_bot : forall x:propVar, ~(propForm_eqv (var x) bot).
Proof.
intros.
unfold propForm_eqv.
intro.
specialize (H full_environment).
unfold full_environment in H.
simpl in H.
destruct H.
apply H.
auto.
Qed.

Lemma eqv_bot_full_false : forall f:propForm, propForm_eqv f bot -> ~[[f]]full_environment.
Proof.
intros;intro;induction f;simpl in *;auto.
destruct (H full_environment);simpl in *;auto.
apply (neq_var_bot p);auto.
destruct H0.
apply IHf1;auto.
split;intro;simpl in *;auto.
destruct (H theta);simpl in *;auto.
inversion H1.
apply IHf2;auto.
split;intro;simpl in *;auto.
destruct (H theta);simpl in *;auto.
inversion H1.
destruct (H full_environment);simpl in *;auto.
Qed.

(*top*)
Lemma propForm_eqv_top : forall f:propForm, (forall theta:environment, [[f]]theta) <-> propForm_eqv f top.
Proof.
intros.
split;intro.
split;intro.
simpl;auto.
apply H;auto.
induction f;simpl in *;intros;auto.
destruct (H theta);simpl in *;auto.
destruct (H empty_environment).
unfold empty_environment in H1;simpl in H1.
assert false;auto.
inversion H2.
destruct (H theta).
apply H1;simpl;auto.
destruct (H theta).
apply H1;simpl;auto.
Qed.

Lemma empty_true_eqv_top : forall f:propForm, [[f]]empty_environment -> propForm_eqv f top.
Proof.
induction f;intro;split;intro;simpl;auto.
inversion H0.
simpl in H.
unfold empty_environment in H.
inversion H.
simpl in H.
unfold empty_environment in H.
inversion H.
simpl in *.
left.
apply IHf1;auto.
right.
apply IHf2;auto.
destruct H.
split;auto.
apply IHf1;auto.
apply IHf2;auto.
Qed.

Lemma not_top_get_not_true : forall f:propForm,
  (~(propForm_eqv top f)) -> exists theta:environment, ~[[f]]theta.
Proof.
induction f;intros;auto.
exfalso;apply H;split;intro;auto.
exists empty_environment;intro.
inversion H0.
exists empty_environment;intro.
unfold empty_environment in H0.
inversion H0.
assert (~ propForm_eqv top f1).
intro.
apply H.
split;intro.
left;apply H0;auto.
simpl;auto.
assert (~ propForm_eqv top f2).
intro.
apply H.
split;intro.
right;apply H1;auto.
simpl;auto.
destruct (IHf1 H0) as [theta1 Hf1].
destruct (IHf2 H1) as [theta2 Hf2].
assert (~[[f1]]empty_environment).
apply (empty_environment_minimal f1 theta1).
auto.
assert (~[[f2]]empty_environment).
apply (empty_environment_minimal f2 theta2).
auto.
exists empty_environment.
intro.
destruct H4;auto.
exists empty_environment.
intro.
destruct H0.
apply H.
split;simpl;intro;auto.
split.
apply (empty_true_eqv_top f1 H0);simpl;auto.
apply (empty_true_eqv_top f2 H1);simpl;auto.
Qed.

Lemma eqv_top_decidable : forall f:propForm, propForm_eqv f top \/ ~(propForm_eqv f top).
Proof.
induction f;simpl in *;auto.
left;split;intro;auto.
right;intro.
destruct (H empty_environment);simpl in *;auto.
right;intro;destruct (H empty_environment);simpl in *.
unfold empty_environment in H1.
assert True;auto.
assert false;auto.
inversion H3.
destruct IHf1.
left;split;intro;simpl;auto.
left;apply H;auto.
destruct IHf2.
left;split;intro;simpl;auto.
right;apply H0;auto.
right;intro.
assert (~propForm_eqv top f1).
intro;apply H.
split;simpl;apply H2;auto.
destruct (not_top_get_not_true f1 H2).
assert (~propForm_eqv top f2).
intro;apply H0.
split;simpl;apply H4;auto.
destruct (not_top_get_not_true f2 H4).
clear H2 H4.
assert (~[[f1]]empty_environment).
intro.
specialize (empty_true_eqv_top f1 H2).
intro;contradiction.
assert (~[[f2]]empty_environment).
intro.
specialize (empty_true_eqv_top f2 H4).
intro;contradiction.
destruct (H1 empty_environment).
simpl in *.
assert True;auto.
destruct (H7 H8);auto.
destruct IHf1.
destruct IHf2.
left;split;intro;simpl;auto.
split.
apply H;auto.
apply H0;auto.
right;intro.
assert (propForm_eqv f2 top).
split;intro;simpl;auto.
destruct (H1 theta).
destruct (H4 H2);auto.
contradiction.
right;intro.
assert (propForm_eqv f1 top).
split;intro;simpl;auto.
destruct (H0 theta).
destruct (H3 H1);auto.
contradiction.
Qed.

Lemma neq_var_top : forall x:propVar, ~(propForm_eqv (var x) top).
Proof.
intros.
intro.
specialize (H empty_environment).
unfold empty_environment in H.
simpl in H.
destruct H.
absurd (~false).
intro.
unfold not in H1.
apply H1.
apply H0;auto.
intro.
inversion H1.
Qed.

Lemma cons_var_propForm : forall f:propForm, forall x:propVar,
  (forall theta:environment, theta x -> [[f]]theta) \/ (exists theta : environment, theta x /\ ~[[f]]theta).
Proof.
intros.
induction f.
left;simpl;auto.

right.
exists full_environment.
simpl.
unfold full_environment.
split;auto.

simpl.
destruct (eq_nat_decide x p).
rewrite (eq_nat_eq x p e) in *.
left.
intros.
auto.
destruct (beq_nat_false_iff x p).
assert (x<>p).
intro.
apply (eq_nat_is_eq) in H1.
contradiction.
specialize (H0 H1).
right.
exists (environment_point x).
unfold environment_point.
split.
rewrite<- (beq_nat_refl x).
auto.
rewrite H0.
intro.
inversion H2.

destruct IHf1.
left;intros;left;auto.
destruct IHf2.
left;intros;right;auto.
destruct H as [theta1 H].
destruct H0 as [theta2 H0].
destruct H;destruct H0.
right.
exists (environment_point x).
split.
unfold environment_point.
rewrite<- (beq_nat_refl x).
auto.
intro.
destruct H3.
apply (environment_point_minimal f1 x theta1);auto.
apply (environment_point_minimal f2 x theta2);auto.

destruct IHf1.
destruct IHf2.
left;intros;split;auto.
destruct H0 as [theta1 H0].
destruct H0.
right.
exists theta1.
split;auto.
intro.
destruct H2.
contradiction.
destruct H as [theta1 H].
destruct H.
right.
exists theta1.
split;auto.
intro.
destruct H1.
contradiction.
Qed.

Lemma cons_propForm_var : forall f:propForm, forall x:propVar,
  (forall theta:environment, [[f]]theta -> theta x) \/ (exists theta:environment, [[f]]theta /\ ~theta x).
Proof.
intros.
induction f.
right.
exists empty_environment.
simpl.
unfold empty_environment.
split.
auto.
intro.
inversion H.

left.
simpl.
intros.
inversion H.

destruct (eq_nat_decide p x).
rewrite (eq_nat_eq p x e) in *.
left.
intros.
simpl in *.
assumption.
destruct (beq_nat_false_iff p x).
assert (p<>x).
intro.
apply (eq_nat_is_eq) in H1.
contradiction.
specialize (H0 H1).
simpl.
right.
exists (environment_point p).
unfold environment_point.
split.
rewrite<- (beq_nat_refl p).
auto.
rewrite H0.
intro.
inversion H2.

destruct IHf1.
destruct IHf2.
left.
intros.
destruct H1.
apply H;auto.
apply H0;auto.

destruct H0 as [theta2 H0].
destruct H0.
right.
exists theta2.
split.
right;assumption.
assumption.
destruct H as [theta1 H].
destruct H.
right.
exists theta1.
split.
left;assumption.
assumption.

destruct IHf1.
left.
intros.
destruct H0.
apply H;assumption.
destruct H as [theta1 H].
destruct H.
destruct IHf2.
left.
intros.
destruct H2.
apply H1.
assumption.
destruct H1 as [theta2 H1].
destruct H1.
right.
exists (environment_union theta1 theta2).
split.
specialize (environment_union_distributes theta1 theta2 f1 f2).
intros.
apply H3.
auto.
intro.
unfold environment_union in H3.
destruct (orb_prop (theta1 x) (theta2 x) H3).
rewrite H4 in H0.
apply H0.
auto.
rewrite H4 in H2.
apply H2.
auto.
Qed.

Lemma var_cons_propForm_decidable:
  forall (f : propForm) (x : propVar),
  propForm_cons f (var x) \/ ~ propForm_cons f (var x).
Proof.
intros.
destruct (cons_propForm_var f x).
left;intro;intros;apply H;auto.
right;intro.
destruct H as [theta H].
destruct H.
apply H1.
apply H0;auto.
Qed.