(***
 * Oqarina
 * Copyright 2021 Carnegie Mellon University.
 *
 * NO WARRANTY. THIS CARNEGIE MELLON UNIVERSITY AND SOFTWARE ENGINEERING
 * INSTITUTE MATERIAL IS FURNISHED ON AN "AS-IS" BASIS. CARNEGIE MELLON
 * UNIVERSITY MAKES NO WARRANTIES OF ANY KIND, EITHER EXPRESSED OR
 * IMPLIED, AS TO ANY MATTER INCLUDING, BUT NOT LIMITED TO, WARRANTY OF
 * FITNESS FOR PURPOSE OR MERCHANTABILITY, EXCLUSIVITY, OR RESULTS
 * OBTAINED FROM USE OF THE MATERIAL. CARNEGIE MELLON UNIVERSITY DOES NOT
 * MAKE ANY WARRANTY OF ANY KIND WITH RESPECT TO FREEDOM FROM PATENT,
 * TRADEMARK, OR COPYRIGHT INFRINGEMENT.
 *
 * Released under a BSD (SEI)-style license, please see license.txt or
 * contact permission@sei.cmu.edu for full terms.
 *
 * [DISTRIBUTION STATEMENT A] This material has been approved for public
 * release and unlimited distribution.  Please see Copyright notice for
 * non-US Government use and distribution.
 *
 * This Software includes and/or makes use of the following Third-Party
 * Software subject to its own license:
 *
 * 1. Coq theorem prover (https://github.com/coq/coq/blob/master/LICENSE)
 * Copyright 2021 INRIA.
 *
 * 2. Coq JSON (https://github.com/liyishuai/coq-json/blob/comrade/LICENSE)
 * Copyright 2021 Yishuai Li.
 *
 * DM21-0762
***)

Require Export Coq.ZArith.Zmin.
Require Export Coq.ZArith.Zmax.
Require Import Coq.ZArith.ZArith.
Require Import Coq.NArith.Ndist.
Require Import Coq.Arith.PeanoNat.
Require Import Lia.

Scheme Equality for natinf.

Definition ni_lt (d d':natinf) :=
  match d with
  | infty => False
  | ni n => match d' with
            | infty => True
            | ni n' => lt n n'
            end
  end.

Definition compare' (n m :natinf) : comparison :=
  match n, m with
    | infty, infty => Eq
    | _, infty => Lt
    | infty, _ => Gt
    | ni n', ni m' => Nat.compare n' m'
  end.

Lemma cmp_antisym (a b : natinf):
  compare' a b = CompOpp (compare' b a).
Proof.
  unfold compare';
  induction a ;
  induction b ; auto.
  apply Nat.compare_antisym.
Qed.

Lemma compare_helper_gt' (a b : natinf) : compare' a b = Lt ->
  compare' b a = Gt.
Proof.
  rewrite cmp_antisym.
  destruct (compare' b a) ; auto. discriminate.
Qed.

Lemma compare_helper_lt' (a b : natinf) : compare' a b = Gt ->
  compare' b a = Lt.
Proof.
  rewrite cmp_antisym.
  destruct (compare' b a) ; auto. discriminate.
Qed.

Lemma natinf_compare_eq: forall (n m : natinf),
  compare' n m = Eq -> n = m.
Proof.
  unfold compare'.
  simple induction n ; simple induction m.
  - auto.
  - discriminate.
  - discriminate.
  - intros. apply PeanoNat.Nat.compare_eq in H ; auto.
Qed.

Lemma natinf_compare_eq': forall (n m : natinf),
   n = m -> compare' n m = Eq.
Proof.
  intros.
  rewrite H.
  destruct m ; auto.
  simpl. apply Nat.compare_eq_iff ; auto.
Qed.

Lemma ni_min_assoc :
  forall d d' d'':natinf, ni_min (ni_min d d') d'' = ni_min d (ni_min d' d'').
 Proof.
   simple induction d; trivial. simple induction d'; trivial.
   simple induction d''; trivial.
   unfold ni_min. intro.
   enough (min (min n n0) n1 = min n (min n0 n1)) by (rewrite H; reflexivity).
   induction n in n0, n1 |- *; trivial.
   destruct n0; trivial. destruct n1; trivial.
   intros. simpl. auto.
 Qed.

 Lemma ni_min_assoc_r :
 forall d d' d'':natinf, ni_min d (ni_min d' d'')  = ni_min (ni_min d d') d''.
Proof.
  simple induction d; trivial. simple induction d'; trivial.
  simple induction d''; trivial.
  unfold ni_min. intro.
  enough (min (min n n0) n1 = min n (min n0 n1)) by (rewrite H; reflexivity).
  induction n in n0, n1 |- *; trivial.
  destruct n0; trivial. destruct n1; trivial.
  intros. simpl. auto.
Qed.

Section NatinfTotalOrder.

Lemma ni_min_case : forall d d':natinf,
  { ni_min d d' = d } + { ni_min d d' = d'}.
Proof.
  destruct d.
  - right. exact (ni_min_inf_l d').
  - destruct d'.
    + left. exact (ni_min_inf_r (ni n)).
    + unfold ni_min.
      enough ({min n n0 = n} + { min n n0 = n0}) as [-> | ->].
      * left. reflexivity.
      * right. reflexivity.
      * destruct (Nat.min_dec n n0); [left|right]; assumption.
Qed.

Lemma natinf_eq_le_def :
  forall x y, @eq natinf x y <-> ni_le x  y /\ ni_le y x.
Proof.
  intros.
  split.
  intros H; rewrite -> H.
  firstorder using ni_le_refl.
  firstorder using ni_le_antisym.
Qed.

Lemma ni_le_total : forall d d':natinf, { ni_le d d' } + { ni_le d' d}.
Proof.
  unfold ni_le. intros. rewrite (ni_min_comm d' d). apply ni_min_case.
Defined.

Definition ni_max (d d':natinf) :=
  match d with
  | infty => infty
  | ni n => match d' with
            | infty => infty
            | ni n' => ni (max n n')
            end
  end.

Lemma ni_max_split: forall (d d':natinf),
  ni_max d d' = infty \/ ni_max d d' = d \/ ni_max d d' = d'.
Proof.
  intros.
  unfold ni_max.
  destruct d.
  - left. trivial.
  - destruct d'.
    + left. trivial.
    + right.
      assert (H: max n n0 = n \/ max n n0 = n0).
      lia. destruct H ;  rewrite H; auto.
Qed.

Lemma ni_max_idemp : forall d:natinf, ni_max d d = d.
Proof.
  simple induction d; trivial.
  unfold ni_max.
  simple induction n; trivial.
  intros.
  simpl.
  inversion H.
  rewrite H1.
  rewrite H1.
  reflexivity.
Qed.

Lemma ni_max_comm : forall d d':natinf, ni_max d d' = ni_max d' d.
Proof.
  simple induction d.
  - simple induction d'; trivial.
  - simple induction d'; trivial. elim n.
    + simple induction n0; trivial.
    + intros. elim n1; trivial. intros. unfold ni_max in H.
      enough (max n0 n2 = max n2 n0) by (unfold ni_max; simpl; rewrite H1; reflexivity).
      enough (ni (max n0 n2) = ni (max n2 n0)) by (inversion H1; trivial).
      exact (H n2).
Qed.

Lemma ni_max_assoc :
  forall d d' d'':natinf,
    ni_max (ni_max d d') d'' = ni_max d (ni_max d' d'').
Proof.
  simple induction d; trivial. simple induction d'; trivial.
  simple induction d''; trivial.
  unfold ni_max. intro.
  enough (max (max n n0) n1 = max n (max n0 n1)) by (rewrite H; reflexivity).
  induction n in n0, n1 |- *; trivial.
  destruct n0; trivial. destruct n1; trivial.
  intros. simpl. auto.
Qed.

Lemma ni_max_assoc_r :
  forall d d' d'':natinf,
    ni_max d (ni_max d' d'') = ni_max (ni_max d d') d''.
Proof.
  simple induction d; trivial. simple induction d'; trivial.
  simple induction d''; trivial.
  unfold ni_max. intro.
  enough (max (max n n0) n1 = max n (max n0 n1)) by (rewrite H; reflexivity).
  induction n in n0, n1 |- *; trivial.
  destruct n0; trivial. destruct n1; trivial.
  intros. simpl. auto.
Qed.

 Lemma ni_max_inf_l : forall d:natinf, ni_max infty d = infty.
 Proof.
  simple induction d; trivial.
  Qed.

 Lemma ni_max_inf_r : forall d:natinf, ni_max d infty = infty.
 Proof.
  simple induction d; trivial.
 Qed.

 Lemma ni_max_0_l : forall d:natinf, ni_max (ni 0) d = d.
 Proof.
  simple induction d; trivial.
  Qed.

 Lemma ni_max_0_r : forall d:natinf, ni_max d (ni 0) = d.
 Proof.
  intros.
  rewrite ni_max_comm.
  apply ni_max_0_l.
 Qed.

Lemma min_max_distrb:
 forall (n1 n2 n3: natinf),
     ni_min n1 (ni_max n2 n3) =
     ni_max (ni_min n1 n2) (ni_min n1 n3).
Proof.
  intros.
  destruct n1; auto.
  destruct n2; auto ; try rewrite ni_max_inf_l ; try rewrite ni_min_inf_r.
  destruct n3; auto.
  - rewrite ni_min_inf_r ; rewrite ni_max_idemp; trivial.
  - simpl. apply f_equal.  rewrite Nat.min_max_absorption ; reflexivity.
  - destruct n3. rewrite ni_max_inf_r. rewrite ni_min_inf_r.
    * simpl. apply f_equal. rewrite Nat.max_comm. rewrite Nat.min_max_absorption ; reflexivity.
    * simpl. apply f_equal. apply Nat.min_max_distr.
Qed.

Lemma max_min_distrb:
 forall (n1 n2 n3: natinf),
     ni_max n1 (ni_min n2 n3) =
     ni_min (ni_max n1 n2) (ni_max n1 n3).
Proof.
 intros.
 destruct n1; auto.
 destruct n2; auto ; try rewrite ni_max_inf_l ; try rewrite ni_min_inf_r.
 destruct n3; auto. simpl. apply f_equal. apply Nat.max_min_distr.
Qed.

Lemma ni_le_antisym : forall d d':natinf, ni_le d d' -> ni_le d' d -> d = d'.
Proof.
  unfold ni_le. intros d d'. rewrite ni_min_comm. intro H. rewrite H. trivial.
Qed.

Lemma ni_le_min1:
  forall x y : natinf, ni_le x y -> ni_min x y = x.
Proof.
  trivial.
Qed.

Lemma ni_le_min2:
  forall x y : natinf, ni_le y x -> ni_min x y = y.
Proof.
  intros. destruct x, y ; auto.
  apply ni_le_le in H.
  simpl.
  rewrite Nat.min_r ; auto.
Qed.

Lemma ni_le_min3:
  forall x y : natinf, ni_le y x -> ni_max x y = x.
Proof.
  intros. destruct x, y ; auto.
  apply ni_le_le in H.
  simpl.
  rewrite Nat.max_l ; auto.
Qed.

Lemma ni_le_min4:
  forall x y : natinf, ni_le x y -> ni_max x y = y.
Proof.
  intros. destruct x, y ; auto.
  apply ni_le_le in H.
  simpl.
  rewrite Nat.max_r ; auto.
Qed.

Lemma ni_max_max: forall x y : natinf, ni_max (ni_max x y) x = ni_max x y.
Proof.
  intros.
  unfold ni_max.
  destruct x, y ; intuition.
Qed.

End NatinfTotalOrder.


Require Import Le Gt Minus Bool Setoid.
Require Import Program.

Set Implicit Arguments.

Inductive snoclist (A : Type) : Type :=
  | snil : snoclist A
  | snoc : snoclist A -> A -> snoclist A.

Arguments snil {A}.
Arguments snoc {A} _ _.  (* use underscore for argument position that has no name *)

Fixpoint app {A : Type} (l1 l2 : snoclist A) : (snoclist A) :=
  match l2 with
  | snil       => l1
  | snoc l2' x => snoc (app l1 l2') x
  end.

Fixpoint length {A : Type} (l : snoclist A) : nat :=
  match l with
    | snil      => 0
    | snoc l' x => 1 + length l'
  end.

Notation "l ::: x" := (snoc l x)
                     (at level 61, left associativity).
Notation "[ ]" := snil.
Notation "[ x ]" := (snoc snil x).
Notation "[ x ; .. ; y ]" := (snoc .. (snoc snil x) .. y).
Notation "x +++ y" := (app x y)
                     (at level 61, left associativity).

Fixpoint rev {A : Type} (l : snoclist A) : snoclist A :=
  match l with
    | snil => snil
    | snoc l' a => [a] +++ (rev l')
  end.

Section Map.
  Variables A B : Type.
  Variable f : A -> B.

  Fixpoint smap (l : snoclist A) : snoclist B :=
    match l with
      | snil => snil
      | l':::a => snoc (smap l') (f a)
    end.
End Map.

Section Bool.
  Variable A : Type.
  Variable f : A -> bool.

  Fixpoint sfilter (l : snoclist A) : snoclist A :=
    match l with
      | snil => snil
      | l':::x => if f x then (sfilter l'):::x else sfilter l'
    end.
End Bool.

Section Elmts.
  Variable A : Type.

  Fixpoint nth_from_end (default : A) (n : nat) (l : snoclist A) : A :=
    match n, l with
      | O, l':::x    => x
      | S n', l':::x => nth_from_end default n' l'
      | _, []        => default
    end.

  Definition nth default n := (compose (nth_from_end default n) rev).

  Fixpoint last_n (n : nat) (l : snoclist A) : snoclist A :=
    match n, l with
      | 0, _ => snil
      | _, snil => snil
      | S n', snoc l' a => snoc (last_n n' l') a
    end.

  Definition first_n n := (compose rev (compose (last_n n) rev)).

End Elmts.


Inductive t := nil | cons (T : Type) (vs : t).

Fixpoint nth (n : nat) (l : t) (default : Type) {struct l} :=
  match n, l with
  | O, cons x _ => x
  | S m, cons _ l => nth m l default
  | _, _ => default
  end.

Module Export Notations.
  Delimit Scope type_list_scope with type_list.
  Bind Scope type_list_scope with t.
  Notation "[ ]" := nil (format "[ ]") : type_list_scope.
  Notation "[ x ]" := (cons x nil) : type_list_scope.
  Notation "[ x ; y ; .. ; z ]" :=  (cons x (cons y .. (cons z nil) ..)) : type_list_scope.
End Notations.


(* Copyright (c) 2012-2015, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
(** This file collects definitions and theorems on finite collections. Most
importantly, it implements a fold and size function and some useful induction
principles on finite collections . *)
From Coq Require Import Permutation.
From prelude Require Import relations listset.
From prelude Require Export numbers collections.

Instance collection_size `{Elements A C} : Size C := length ∘ elements.
Definition collection_fold `{Elements A C} {B}
  (f : A → B → B) (b : B) : C → B := foldr f b ∘ elements.

Section fin_collection.
Context `{FinCollection A C}.
Implicit Types X Y : C.

Lemma fin_collection_finite X : set_finite X.
Proof. by exists (elements X); intros; rewrite elem_of_elements. Qed.
Global Instance elements_proper: Proper ((≡) ==> (≡ₚ)) (elements (C:=C)).
Proof.
  intros ?? E. apply NoDup_Permutation.
  - apply NoDup_elements.
  - apply NoDup_elements.
  - intros. by rewrite !elem_of_elements, E.
Qed.
Lemma elements_empty : elements (∅ : C) = [].
Proof.
  apply elem_of_nil_inv; intros x.
  rewrite elem_of_elements, elem_of_empty; tauto.
Qed.
Lemma elements_union_singleton (X : C) x :
  x ∉ X → elements ({[ x ]} ∪ X) ≡ₚ x :: elements X.
Proof.
  intros ?; apply NoDup_Permutation.
  { apply NoDup_elements. }
  { by constructor; rewrite ?elem_of_elements; try apply NoDup_elements. }
  intros y; rewrite elem_of_elements, elem_of_union, elem_of_singleton.
  by rewrite elem_of_cons, elem_of_elements.
Qed.
Lemma elements_singleton x : elements {[ x ]} = [x].
Proof.
  apply Permutation_singleton. by rewrite <-(right_id ∅ (∪) {[x]}),
    elements_union_singleton, elements_empty by set_solver.
Qed.
Lemma elements_contains X Y : X ⊆ Y → elements X `contains` elements Y.
Proof.
  intros; apply NoDup_contains; auto using NoDup_elements.
  intros x. rewrite !elem_of_elements; auto.
Qed.

Global Instance collection_size_proper: Proper ((≡) ==> (=)) (@size C _).
Proof. intros ?? E. apply Permutation_length. by rewrite E. Qed.
Lemma size_empty : size (∅ : C) = 0.
Proof. unfold size, collection_size. simpl. by rewrite elements_empty. Qed.
Lemma size_empty_inv (X : C) : size X = 0 → X ≡ ∅.
Proof.
  intros; apply equiv_empty; intros x; rewrite <-elem_of_elements.
  by rewrite (nil_length_inv (elements X)), ?elem_of_nil.
Qed.
Lemma size_empty_iff (X : C) : size X = 0 ↔ X ≡ ∅.
Proof. split. apply size_empty_inv. by intros ->; rewrite size_empty. Qed.
Lemma size_non_empty_iff (X : C) : size X ≠ 0 ↔ X ≢ ∅.
Proof. by rewrite size_empty_iff. Qed.
Lemma size_singleton (x : A) : size {[ x ]} = 1.
Proof. unfold size, collection_size. simpl. by rewrite elements_singleton. Qed.
Lemma size_singleton_inv X x y : size X = 1 → x ∈ X → y ∈ X → x = y.
Proof.
  unfold size, collection_size. simpl. rewrite <-!elem_of_elements.
  generalize (elements X). intros [|? l]; intro; simplify_eq/=.
  rewrite (nil_length_inv l), !elem_of_list_singleton by done; congruence.
Qed.
Lemma collection_choose_or_empty X : (∃ x, x ∈ X) ∨ X ≡ ∅.
Proof.
  destruct (elements X) as [|x l] eqn:HX; [right|left].
  - apply equiv_empty; intros x. by rewrite <-elem_of_elements, HX, elem_of_nil.
  - exists x. rewrite <-elem_of_elements, HX. by left.
Qed.
Lemma collection_choose X : X ≢ ∅ → ∃ x, x ∈ X.
Proof. intros. by destruct (collection_choose_or_empty X). Qed.
Lemma collection_choose_L `{!LeibnizEquiv C} X : X ≠ ∅ → ∃ x, x ∈ X.
Proof. unfold_leibniz. apply collection_choose. Qed.
Lemma size_pos_elem_of X : 0 < size X → ∃ x, x ∈ X.
Proof.
  intros Hsz. destruct (collection_choose_or_empty X) as [|HX]; [done|].
  contradict Hsz. rewrite HX, size_empty; lia.
Qed.
Lemma size_1_elem_of X : size X = 1 → ∃ x, X ≡ {[ x ]}.
Proof.
  intros E. destruct (size_pos_elem_of X); auto with lia.
  exists x. apply elem_of_equiv. split.
  - rewrite elem_of_singleton. eauto using size_singleton_inv.
  - set_solver.
Qed.
Lemma size_union X Y : X ∩ Y ≡ ∅ → size (X ∪ Y) = size X + size Y.
Proof.
  intros [E _]. unfold size, collection_size. simpl. rewrite <-app_length.
  apply Permutation_length, NoDup_Permutation.
  - apply NoDup_elements.
  - apply NoDup_app; repeat split; try apply NoDup_elements.
    intros x; rewrite !elem_of_elements; set_solver.
  - intros. by rewrite elem_of_app, !elem_of_elements, elem_of_union.
Qed.
Instance elem_of_dec_slow (x : A) (X : C) : Decision (x ∈ X) | 100.
Proof.
  refine (cast_if (decide_rel (∈) x (elements X)));
    by rewrite <-(elem_of_elements _).
Defined.
Global Program Instance collection_subseteq_dec_slow (X Y : C) :
    Decision (X ⊆ Y) | 100 :=
  match decide_rel (=) (size (X ∖ Y)) 0 return _ with
  | left _ => left _ | right _ => right _
  end.
Next Obligation.
  intros X Y E1 x ?; apply dec_stable; intro. destruct (proj1(elem_of_empty x)).
  apply (size_empty_inv _ E1). by rewrite elem_of_difference.
Qed.
Next Obligation.
  intros X Y E1 E2; destruct E1. apply size_empty_iff, equiv_empty. intros x.
  rewrite elem_of_difference. intros [E3 ?]. by apply E2 in E3.
Qed.
Lemma size_union_alt X Y : size (X ∪ Y) = size X + size (Y ∖ X).
Proof.
  rewrite <-size_union by set_solver.
  setoid_replace (Y ∖ X) with ((Y ∪ X) ∖ X) by set_solver.
  rewrite <-union_difference, (comm (∪)); set_solver.
Qed.
Lemma subseteq_size X Y : X ⊆ Y → size X ≤ size Y.
Proof. intros. rewrite (union_difference X Y), size_union_alt by done. lia. Qed.
Lemma subset_size X Y : X ⊂ Y → size X < size Y.
Proof.
  intros. rewrite (union_difference X Y) by set_solver.
  rewrite size_union_alt, difference_twice.
  cut (size (Y ∖ X) ≠ 0); [lia |].
  by apply size_non_empty_iff, non_empty_difference.
Qed.
Lemma collection_wf : wf (strict (@subseteq C _)).
Proof. apply (wf_projected (<) size); auto using subset_size, lt_wf. Qed.
Lemma collection_ind (P : C → Prop) :
  Proper ((≡) ==> iff) P →
  P ∅ → (∀ x X, x ∉ X → P X → P ({[ x ]} ∪ X)) → ∀ X, P X.
Proof.
  intros ? Hemp Hadd. apply well_founded_induction with (⊂).
  { apply collection_wf. }
  intros X IH. destruct (collection_choose_or_empty X) as [[x ?]|HX].
  - rewrite (union_difference {[ x ]} X) by set_solver.
    apply Hadd. set_solver. apply IH; set_solver.
  - by rewrite HX.
Qed.
Lemma collection_fold_ind {B} (P : B → C → Prop) (f : A → B → B) (b : B) :
  Proper ((=) ==> (≡) ==> iff) P →
  P b ∅ → (∀ x X r, x ∉ X → P r X → P (f x r) ({[ x ]} ∪ X)) →
  ∀ X, P (collection_fold f b X) X.
Proof.
  intros ? Hemp Hadd.
  cut (∀ l, NoDup l → ∀ X, (∀ x, x ∈ X ↔ x ∈ l) → P (foldr f b l) X).
  { intros help ?. apply help; [apply NoDup_elements|].
    symmetry. apply elem_of_elements. }
  induction 1 as [|x l ?? IH]; simpl.
  - intros X HX. setoid_rewrite elem_of_nil in HX.
    rewrite equiv_empty. done. set_solver.
  - intros X HX. setoid_rewrite elem_of_cons in HX.
    rewrite (union_difference {[ x ]} X) by set_solver.
    apply Hadd. set_solver. apply IH. set_solver.
Qed.
Lemma collection_fold_proper {B} (R : relation B) `{!Equivalence R}
    (f : A → B → B) (b : B) `{!Proper ((=) ==> R ==> R) f}
    (Hf : ∀ a1 a2 b, R (f a1 (f a2 b)) (f a2 (f a1 b))) :
  Proper ((≡) ==> R) (collection_fold f b : C → B).
Proof. intros ?? E. apply (foldr_permutation R f b); auto. by rewrite E. Qed.
Global Instance set_Forall_dec `(P : A → Prop)
  `{∀ x, Decision (P x)} X : Decision (set_Forall P X) | 100.
Proof.
  refine (cast_if (decide (Forall P (elements X))));
    abstract (unfold set_Forall; setoid_rewrite <-elem_of_elements;
      by rewrite <-Forall_forall).
Defined.
Global Instance set_Exists_dec `(P : A → Prop) `{∀ x, Decision (P x)} X :
  Decision (set_Exists P X) | 100.
Proof.
  refine (cast_if (decide (Exists P (elements X))));
    abstract (unfold set_Exists; setoid_rewrite <-elem_of_elements;
      by rewrite <-Exists_exists).
Defined.
Global Instance rel_elem_of_dec `{∀ x y, Decision (R x y)} x X :
  Decision (elem_of_upto R x X) | 100 := decide (set_Exists (R x) X).
End fin_collection.


Set Implicit Arguments.

Require List.
Require Import dec.
Require Ensembles.
Require Import Morphisms.
Require Import Setoid.
Require Import ProofIrrelevance.

Definition uniq {T} (l: list T) :=
  forall l1 l2, app l1 l2 = l -> forall x, List.In x l1 -> not (List.In x l2).

Lemma uniq_tl: forall {T} {a:T} {l: list T},
  uniq (cons a l) -> uniq l.
Proof.
  repeat intro.
  apply (H (cons a l1) l2) with (x:=x); auto.
  simpl.
  rewrite H0; auto.
  right; auto.
Qed.

Lemma uniq_tl_intro: forall {T} {a:T} {l: list T},
  not (List.In a l) -> uniq l -> uniq (cons a l).
Proof.
  repeat intro.
  destruct l1; simpl in *.
  destruct H2.
  injection H1; clear H1; intros.
  subst t.
  destruct H2.
  subst a.
  assert (List.In x l).
  rewrite <-H1.
  apply (proj2 (List.in_app_iff l1 l2 x)); tauto.
  tauto.
  apply (H0 l1 l2 H1 x); auto.
Qed.

Module SV.
  Import List.
  Import ListNotations.

  Instance InPred `(T:EqDec) (l: list T) (x:T): Decidable := {|
     dcPred := In x l;
     dc_dec := in_dec eq_dec x l
  |}.

  Definition set `(T: EqDec) := list T.
  Definition empty `(T: EqDec): set T := [].
  Definition sing `(T: EqDec) (x:T) := [x]. (*single set*)
  Definition pair `{T: EqDec} (x y: T) := if eq_dec x y then [x] else [x;y].
  Definition card `{T: EqDec} (s: set T) := length s.

  Definition set_eq_dec `{T: EqDec} (s1 s2: set T) := List.list_eq_dec eq_dec s1 s2.

  Definition setDec `(T: EqDec): @EqDec (set T) := {| eq_dec := set_eq_dec |}.

  Definition set_In_dec `{T:EqDec} x (l: set T) := in_dec eq_dec x l.

  Fixpoint add `(T : EqDec) (x : T) (s : set T) : set T :=
    match s with
    | [] => sing _ x
    | hd :: tl =>
      if eq_dec x hd then
        hd :: tl
      else
        hd :: add x tl
    end.

  Fixpoint list2set `(T : EqDec) (l: list T): set T :=
    match l with
      [] => []
    | x::r => add x (list2set T r)
    end.

  Fixpoint remove `(T : EqDec) (x : T) (s : set T) : set T :=
    match s with
    | [] => []
    | hd :: tl =>
      if eq_dec x hd then
        remove x tl (* manque hyp pas de duplications *)
      else
        hd :: remove x tl
    end.

  Lemma InRemove_l: forall `{T: EqDec} (x y:T) (s: set T), In x (remove y s) -> x <> y.
  Proof.
    induction s; simpl; intros; auto.
    destruct (eq_dec y a); subst; auto.
    destruct H; auto.
    intro; subst a y; tauto.
  Qed.

  Lemma InRemove_r: forall `{T: EqDec} (x y:T) (s: set T), In x (remove y s) -> In x s.
  Proof.
    induction s; simpl; intros; auto.
    destruct (eq_dec y a); subst; auto.
    destruct H; auto.
  Qed.

  Lemma InRemove: forall `{T: EqDec} (x y:T) (s: set T), x <> y -> In x s -> In x (remove y s).
  Proof.
    induction s; simpl; intros; auto.
    destruct H0.
    subst a.
    destruct (eq_dec y x).
    subst y; tauto.
    left; reflexivity.
    destruct (eq_dec y a); auto.
    destruct (eq_dec x a).
    left; auto.
    right; auto.
  Qed.

  Lemma all_dec `{T: EqDec} (p: T->Decidable) (s: set T): (forall x, In x s -> p x)+{x | In x s /\ not (p x)}.
  Proof.
    induction s; simpl; intros; auto.
    left; intros.
    destruct H.
    destruct (@dc_dec (p a)).
    destruct IHs; [left|right]; intros; auto.
    destruct H.
    subst; easy.
    apply d0; apply H.
    destruct s0.
    exists x.
    split; auto.
    right; easy.
    easy.
    right.
    exists a.
    split; auto.
  Qed.

  Lemma ex_dec `{T: EqDec} (p: T->Decidable) (s: set T): {x | In x s /\ p x} + {forall x, In x s -> not (p x)}.
  Proof.
    induction s; simpl; intros; auto.
    destruct IHs.
    left.
    destruct s0 as [x [h1 h2]].
    exists x.
    split; [right; auto | apply h2].
    destruct (@dc_dec (p a)).
    left; exists a; split; [left; apply eq_refl | apply d].
    right; intros.
    destruct H.
    destruct H; apply n0.
    apply (n x H).
  Defined.

  Fixpoint first_dec `{T: EqDec} (p: T->Decidable) (s: set T): {x | In x s /\ p x} + {forall x, In x s -> not (p x)} :=
    match s with
      [] => inright (fun x h => match (h : In x []) with end)
    | x::s' => match @dc_dec (p x) with
                left d => inleft (exist _ x (conj (or_introl eq_refl) d))
               | right n =>
                  match first_dec p s' with
                    inright no => inright (fun y h =>
                      match h with
                        | or_introl h' => match h' in (_ = y) return (~ p y) with
                                                | eq_refl => n
                                          end
                        | or_intror h' => no y h'
                      end)
                  | inleft (exist _ x (conj hi hp)) => inleft (exist _ x (conj (or_intror hi) hp))
                  end
               end
    end.

  Fixpoint last_dec `{T: EqDec} (p: T->Decidable) (s: set T): {x | In x s /\ p x} + {forall x, In x s -> not (p x)} :=
    match s with
      [] => inright (fun x h => match (h : In x []) with end)
    | x::s' =>
        match last_dec p s' with
        | inleft (exist _ x (conj hi hp)) => inleft (exist _ x (conj (or_intror hi) hp))
        | inright no =>
          match @dc_dec (p x) with
            left d => inleft (exist _ x (conj (or_introl eq_refl) d))
          | right n => inright (fun y h =>
                      match h with
                        | or_introl h' => match h' in (_ = y) return (~ p y) with
                                                | eq_refl => n
                                          end
                        | or_intror h' => no y h'
                      end)
          end
       end
    end.

  Fixpoint Isexist `(T : EqDec) (x : T) (s : set T) : bool :=
    match s with
    | [] => false
    | hd :: tl =>
      if eq_dec x hd then
        true
      else
        Isexist x tl
    end.

  Fixpoint inter `(T : EqDec) (s1 s2 : set T) : set T :=
    match s1 with
    | [] => []
    | hd :: tl =>
      if in_dec eq_dec hd s2 then
        hd :: inter tl s2
      else
        inter tl s2
    end.

  Fixpoint union `(T : EqDec) (s1 s2 : set T) : set T :=
    match s1 with
    | [] => s2
    | hd :: tl => add hd (union tl s2)
    end.

  Fixpoint diff `(T : EqDec) (s1 s2 : set T) : set T :=
    match s1 with
    | [] => []
    | hd :: tl =>
      if in_dec eq_dec hd s2 then
        diff tl s2
      else
        hd :: diff tl s2
    end.

  Definition set_In `(T : EqDec): T -> set T -> Prop := In (A := T).
  (*Definition set_In {U} (T : EqDec U) (x : T) (s : set T) : Prop := List.In x s. *)

  Definition is_empty  `(T: EqDec) (s: set T) : Prop := forall v, ~In v s.
  Definition subset  `(T: EqDec) (s1 s2: set T) : Prop := forall v, In v s1 -> In v s2.
  Definition set_eq  `(T: EqDec) (s1 s2: set T) : Prop := forall v, In v s1 <-> In v s2.
  Definition disjoint  `(T: EqDec) (s1 s2: set T) : Prop := forall v, not (In v s1 /\ In v s2).

  Program Instance emptyDec `(T:EqDec) (s: set T) : Decidable := {|
     dcPred := is_empty s
  |}.
  Next Obligation.
    destruct s; [left | right]; repeat intro; auto.
    apply (H e); left; reflexivity.
  Defined.

  Lemma empty_is_empty: forall `(T:EqDec), is_empty (empty T).
  Proof.
    repeat intro.
    destruct H.
  Qed.

  Definition choose `{T: EqDec} (s: set T) : not (is_empty s) -> T :=
  match s return ~ (is_empty s) -> T with
    [] => fun h => match h (@empty_is_empty _ T) with end
  | x::_ => fun h => x
  end.

  Definition choose_In: forall `{T: EqDec} {s: set T} (h: not (is_empty s)),
    set_In (choose h) s.
  Proof.
    unfold choose; simpl; intros.
    destruct s; auto.
    destruct (h (empty_is_empty (T:=T))).
    left; auto.
  Qed.

  Lemma InSing: forall `{T: EqDec} (x y: T), set_In x (sing T y) <-> x=y.
  Proof.
    intros; split; intros.
    destruct H; auto; destruct H.
    subst x; left; auto.
  Qed.

  Lemma InPair: forall `{T: EqDec} (x y1 y2: T), set_In x (pair y1 y2) <-> x=y1 \/ x=y2.
  Proof.
    intros; split; intros.
    unfold pair in H.
    destruct (eq_dec y1 y2).
    left; destruct H; auto; destruct H.
    destruct H; [left; auto | right].
    destruct H; auto; destruct H.

    unfold pair.
    destruct (eq_dec y1 y2).
    subst y2.
    destruct H; subst x; left; auto.
    destruct H; [left|right]; auto.
    left; auto.
  Qed.

  Lemma InAdd_l : forall `(T : EqDec) (x : T) (s : set T), set_In x (add x s).
  Proof.
    unfold set_In; induction s; simpl; intros; auto.
    destruct (eq_dec x a); auto.
    subst a.
    left; auto.
    right; auto.
  Qed.

  Lemma InAdd_r : forall `(T : EqDec) (x y : T) (s : set T), set_In x s -> set_In x (add y s).
  Proof.
    unfold set_In; simple induction s; simpl.
    intro H; right; assumption.
    intros a l H [H0 | H1].
    elim (eq_dec y a); left; assumption.
    elim (eq_dec y a); right; [assumption | apply H; assumption].
  Qed.

  Lemma InAdd_ne : forall `(T : EqDec) (x y : T) (s : set T), set_In x (add y s) -> y <> x -> set_In x s.
  Proof.
    induction s; simpl; intros; auto.
    destruct H; tauto.

    destruct (eq_dec y a).
    subst y.
    right.
    destruct H; tauto.

    destruct H.
    left; tauto.
    right; tauto.
  Qed.

  Lemma InAdd : forall `(T : EqDec) (x y : T) (s : set T), set_In x (add y s) -> {x = y}+{set_In x s}.
  Proof.
    induction s; simpl; intros; auto.
    elim (eq_dec x y); intros.
    left; auto.
    right.
    apply b; clear b; destruct H; auto.
    destruct H.
    destruct (eq_dec y a).
    subst y.
    destruct (eq_dec x a).
    left; auto.
    right.
    right.
    destruct H; auto.
    subst a; tauto.

    destruct (eq_dec x y).
    left; auto.
    right.
    destruct H.
    left; auto.
    elim (IHs H); intros.
    tauto.
    right; auto.
  Defined.

  Lemma InL2S: forall `{T: EqDec} (l: list T) x,
    In x l <-> In x (SV.list2set T l).
  Proof.
    induction l; simpl; intros; try tauto.
    split; intro.
    destruct H.
    subst a.
    apply InAdd_l.
    apply InAdd_r.
    apply IHl; now auto.

    apply InAdd in H; destruct H.
    left; symmetry; now auto.
    right; apply IHl in s; auto.
  Qed.

  Lemma uniq_empty: forall `{T: EqDec}, uniq (empty T).
  Proof.
    repeat intro.
    destruct l1; simpl in *; try tauto.
    discriminate.
  Qed.

  Lemma uniq_sing: forall `{T: EqDec} (a:T), uniq (sing T a).
  Proof.
    repeat intro.
    destruct l1; simpl in *; try tauto.
    injection H; clear H; simpl; intros; auto.
    destruct l1; simpl in *; try tauto.
    subst l2; destruct H1.
    discriminate.
  Qed.

  Lemma uniq_add: forall `{T: EqDec} {a:T} {l: set T},
    uniq l -> uniq (add a l).
  Proof.
    induction l; simpl; intros; auto.
    apply uniq_sing.

    destruct (eq_dec a a0); auto.
    apply uniq_tl_intro; auto.
    intro.
    apply InAdd in H0; destruct H0; try tauto.
    subst a0; tauto.
    apply (H (cons a0 nil) l eq_refl a0); simpl; now auto.
    apply IHl.
    apply uniq_tl in H; auto.
  Qed.

  Lemma uniq_l2s: forall `{T:EqDec} (l: list T), uniq (list2set T l).
  Proof.
    induction l; simpl; intros; auto.
    apply uniq_empty.
    apply uniq_add.
    apply IHl.
  Qed.

  Lemma InUnion : forall `(T : EqDec) (x : T) (s1 s2 : set T), set_In x (union s1 s2) ->  {set_In x s1}+{set_In x s2}.
  Proof.
    induction s1; intros; auto.
    simpl in H.
    apply InAdd in H.
    destruct H.
    left.
    left.
    symmetry; apply e.

    elim (IHs1 _ s); intros.
    left; right; apply a0.
    right; apply b.
  Defined.

  Lemma InUnion_l : forall `(T : EqDec) (x : T) (s1 s2 : set T), set_In x s1 -> set_In x (union s1 s2).
  Proof.
    induction s1; intros; auto.
    destruct H.
    simpl.
    destruct H.
    subst.
    unfold set_In.
    induction (union s1 s2); simpl; intros; auto.
    destruct (eq_dec x a); simpl; auto.
    apply InAdd_r; auto.
  Qed.

  Lemma InUnion_r : forall `(T : EqDec) (x : T) (s1 s2 : set T), set_In x s2 -> set_In x (union s1 s2).
  Proof.
    induction s1; simpl; intros; auto.
    apply InAdd_r; auto.
  Qed.

  Fixpoint CUnion `(U: EqDec) `(T: EqDec) (P: U -> Decidable) (Q: set U) (f: forall v:U, P v -> set T) : set T :=
    match Q with
      [] => []
    | x::r => match @dc_dec (P x) with left h => f x h ++ CUnion P r f | _ => CUnion P r f end
    end.

  Lemma InCUnion_intro: forall `(U: EqDec) `(T: EqDec) (P: U->Decidable) (Q: set U) (f: forall v:U, P v -> set T) v (u:U),
    set_In u Q -> P u -> (forall h, set_In v (f u h)) -> set_In v (CUnion P Q f).
  Proof.
    intros.
    induction Q; intros; auto.
    simpl in *.
    destruct H; auto.
    subst u.
    destruct (@dc_dec (P a)); simpl.
    apply in_or_app.
    left; apply H1.
    elim (n H0).
    destruct (@dc_dec (P a)).
    apply in_or_app.
    right.
    apply (IHQ H).
    apply (IHQ H).
  Qed.

  Lemma InCUnion_elim: forall `(U: EqDec) `(T: EqDec) (P: U->Decidable) (Q: set U) (f: forall v:U, P v -> set T) v,
      set_In v (CUnion P Q f) -> exists u, List.In u Q  /\ P u /\ (forall h, set_In v (f u h)).
  Proof.
    intros.
    induction Q; intros; auto.
    simpl in *.
    destruct H.
    simpl in H.
    destruct (@dc_dec (P a)); simpl.
    apply in_app_or in H.
    destruct H.
    exists a; repeat split; auto.
    intro.
    rewrite (proof_irrelevance _ h d); now auto.

    destruct (IHQ H); intros.
    exists x; repeat split; auto; try tauto.

    destruct (IHQ H); intros.
    exists x; repeat split; auto; try tauto.
  Qed.

  Lemma CUnion_empty: forall `(U: EqDec) `(T: EqDec) (P: U->Decidable) (Q: set U) (f: forall v:U, P v -> set T),
    (forall v h, is_empty (f v h)) -> is_empty (CUnion P Q f).
  Proof.
    intros.
    induction Q; simpl; intros; auto.
    intros v h; destruct h.
    destruct dc_dec.
    intros v h.
    generalize (H a d); intro.
    destruct (f a d).
    simpl in h; apply IHQ in h; destruct h.
    apply (H0 e); simpl; now auto.
    apply IHQ.
  Qed.

  Definition GUnion `{T1: EqDec} `{T2: EqDec} (d s: set T1) (f: forall v, In v d -> set T2) : set T2 := CUnion (InPred _ d) s f.

  Definition uniq `{T: EqDec} (l: list T): Prop :=
    forall l1 l2, l=l1++l2 -> disjoint l1 l2.

  Lemma set_eq_refl: forall `{T:EqDec} (s: set T), set_eq s s.
  Proof.
    repeat intro; split; intro; auto.
  Qed.
  Global Notation "s1 == s2" := (set_eq s1 s2) (at level 70).

  Lemma set_eq_sym: forall `{T:EqDec} (s1 s2: set T), set_eq s1 s2 -> set_eq s2 s1.
  Proof.
    repeat intro; split; intro; apply H; auto.
  Qed.

  Lemma set_eq_trans: forall `{T:EqDec} (s1 s2 s3: set T), s1 == s2 -> s2 == s3 -> s1 == s3.
  Proof.
    repeat intro; split; intro; auto.
    apply H in H1.
    apply H0 in H1; auto.
    apply H.
    apply H0.
    auto.
  Qed.

Add Parametric Relation T U : (set U) (@set_eq T U)
  reflexivity proved by set_eq_refl
  symmetry proved by set_eq_sym
  transitivity proved by set_eq_trans as set_eq_rel.

  Lemma subset_dec `{T: EqDec} (s1 s2: set T): {subset s1 s2}+{~subset s1 s2}.
  Proof.
    induction s1; intros; simpl; auto.
    left; repeat intro; auto.
    destruct H.
    destruct (@In_dec _ eq_dec a s2); intros.
    destruct IHs1.
    left; simpl; repeat intro.
    destruct H.
    subst a; apply i.
    apply s.
    apply H.
    right; intro.
    apply n; clear n.
    repeat intro.
    apply H.
    right.
    apply H0.

    right; intro.
    apply n.
    apply H.
    left; auto.
  Defined.

  Lemma subset_trans: forall `{T:EqDec} {s1 s2 s3: set T}, subset s1 s2 -> subset s2 s3 -> subset s1 s3.
  Proof.
    repeat intro.
    apply H0.
    apply H.
    apply H1.
  Qed.

  Lemma is_empty_dec `{T: EqDec} (s: set T): {is_empty s}+{~is_empty s}.
  Proof.
    intros.
    destruct s.
    left.
    abstract (repeat intro; destruct H).
    right; intro.
    abstract (destruct (H e); left; apply eq_refl).
  Defined.

  Lemma disjoint_dec: forall `{T: EqDec} (s1 s2: set T), {disjoint s1 s2}+{~disjoint s1 s2}.
  Proof.
    induction s1; intros.
    left.
    repeat intro.
    abstract (destruct (proj1 H)).
    destruct (@In_dec _ eq_dec a s2); intros.
    right; intro.
    destruct (H a); split; auto.
    left; apply eq_refl.
    destruct (IHs1 s2); clear IHs1; intros.
    left.
    repeat intro.
    destruct H.
    destruct H.
    subst; tauto.
    destruct (d v); tauto.
    right; intro.
    apply n0; clear n0.
    repeat intro.
    elim (H v); intros.
    destruct H0.
    split; auto.
    right; auto.
  Defined.

  Lemma IsSubset `(T: EqDec) (s1 s2: set T) : {subset s1 s2}+{~subset s1 s2}.
  Proof.
    unfold subset; generalize dependent s2.
    induction s1.
    -
      intro s2.
      left; intros.
      inversion H.
    -
      intro s2.
      destruct (in_dec eq_dec a s2).
      +
        destruct (IHs1 s2).
        *
          left; intros.
          inversion H.
          subst; assumption.
          apply i0; apply H0.
        *
          right; intros.
          intro H.
          apply n.
          intros.
          apply H.
          right; apply H0.
      +
        right; intro.
        apply n; apply H.
        left; reflexivity.
  Qed.

  Lemma subset_hd: forall `{T:EqDec} x l (s: set T), subset (x::l) s -> In x s.
  Proof.
    intros.
    apply H.
    left; auto.
  Qed.

  Lemma subset_tl: forall `{T:EqDec} x l (s: set T), subset (x::l) s -> subset l s.
  Proof.
    repeat intro.
    apply H.
    right; auto.
  Qed.

  Lemma empty_subset: forall `{T:EqDec} (s: set T), subset [] s.
  Proof.
    repeat intro.
    inversion H.
  Qed.

  Lemma subset_refl: forall `{T:EqDec} (s: set T), subset s s.
  Proof.
    repeat intro; auto.
  Qed.

  Lemma sing_subset: forall `{T: EqDec} x (s:set T), set_In x s -> subset (sing T x) s.
  Proof.
    intros.
    repeat intro.
    destruct H0.
    subst.
    apply H.
    inversion H0.
  Qed.

  Lemma subset_sing: forall `{T: EqDec} x (s:set T), subset (sing T x) s -> set_In x s.
  Proof.
    intros.
    repeat intro.
    apply H.
    left; auto.
  Qed.

  Lemma subset_union_l: forall `{U: EqDec} {s1 s2: set U}, subset s1 (union s1 s2).
  Proof.
    repeat intro.
    apply InUnion_l.
    apply H.
  Qed.

  Lemma subset_union_r: forall `{U: EqDec} {s1 s2: set U}, subset s2 (union s1 s2).
  Proof.
    repeat intro.
    apply InUnion_r.
    apply H.
  Qed.

  Lemma subset_union_mono: forall `{U: EqDec} {s1 s2 t1 t2: set U}, subset s1 t1 -> subset s2 t2 -> subset (union s1 s2) (union t1 t2).
  Proof.
    repeat intro.
    apply InUnion in H1; destruct H1.
    apply H in s.
    apply InUnion_l; auto.
    apply H0 in s.
    apply InUnion_r; auto.
  Qed.

  Lemma subset_CUnion_elim: forall `(U: EqDec) `(T: EqDec) (P: U->Decidable) (Q: set U) (f: forall v:U, P v -> set T) e,
    subset (CUnion P Q f) e -> forall u h, List.In u Q  -> subset (f u h) e.
  Proof.
    repeat intro.
    apply (H v); clear H.
    apply InCUnion_intro with (u0:=u); intros; auto.
    rewrite (proof_irrelevance _ h0 h); auto.
  Qed.

  Lemma subset_add_l: forall `{U: EqDec} {x:U} {s: set U}, subset s (add x s).
  Proof.
    repeat intro.
    apply InAdd_r.
    apply H.
  Qed.

  Lemma subset_add_mono: forall `{U: EqDec} (x:U) {s1 s2: set U},
    subset s1 s2 -> subset (add x s1) (add x s2).
  Proof.
    repeat intro.
    apply InAdd in H0; destruct H0.
    subst x; apply InAdd_l.
    apply InAdd_r.
    apply H; auto.
  Qed.

  Lemma subset_union_empty_r: forall `{U: EqDec} {s:set U},
    subset (union s (empty _)) s.
  Proof.
    repeat intro.
    apply InUnion in H; destruct H; auto.
    destruct s0.
  Qed.

  Lemma subset_union_sing_add_r: forall `{U: EqDec} {v:U} {s:set U},
    subset (union s (sing _ v)) (add v s).
  Proof.
    repeat intro.
    apply InUnion in H; destruct H; auto.
    apply InAdd_r; auto.
    destruct s0.
    subst v0.
    apply InAdd_l.
    destruct H.
  Qed.

  Lemma subset_union_rl: forall `{U:EqDec} (s1 s2 s3: set U),
    SV.subset s1 (SV.union s2 (SV.union s1 s3)).
  Proof.
    repeat intro.
    apply InUnion_r.
    apply InUnion_l.
    auto.
  Qed.

  Lemma subset_union_rr: forall `{U:EqDec} (s1 s2 s3: set U),
    SV.subset s1 (SV.union s2 (SV.union s3 s1)).
  Proof.
    repeat intro.
    apply InUnion_r.
    apply InUnion_r.
    auto.
  Qed.

  Lemma subset_union_r_intro: forall `{U:EqDec} (s1 s2 s: set U),
    subset s1 s -> subset s2 s -> subset (union s1 s2) s.
  Proof.
    repeat intro.
    apply SV.InUnion in H1; destruct H1.
    apply H; auto.
    apply H0; auto.
  Qed.

  Lemma subset_union_l_elim: forall `{U:EqDec} (s1 s2 s: set U),
    subset (union s1 s2) s -> subset s1 s.
  Proof.
    repeat intro.
    apply H.
    apply InUnion_l; auto.
  Qed.

  Lemma subset_union_r_elim: forall `{U:EqDec} (s1 s2 s: set U),
    subset (union s1 s2) s -> subset s2 s.
  Proof.
    repeat intro.
    apply H.
    apply InUnion_r; auto.
  Qed.

  Lemma subset_union_l_mono: forall `{U:EqDec} (s1 s2 s: set U),
    subset s1 s2 -> subset (union s s1) (union s s2).
  Proof.
    repeat intro.
    apply InUnion in H0; destruct H0.
    apply InUnion_l; apply s0.
    apply InUnion_r; apply H; apply s0.
  Qed.

  Definition bset_eq `(T: EqDec) (s1 s2: set T) :=
    if IsSubset s1 s2 then if IsSubset s2 s1 then true else false else false.

  Lemma NotInLRNotInUnion: forall `(T: EqDec) (v: T) s1 s2, ~set_In v s1 -> ~set_In v s2 -> ~In v (union s1 s2).
  Proof.
    simple induction s1; intros.
    -
      simpl.
      intro H1.
      apply H0; assumption.
    -
      simpl.
      intro H2.
      apply InAdd in H2.
      inversion H2.
      +
        subst.
        apply H0; left; reflexivity.
      +
        revert H3.
        (*generalize dependent H3.*)
        apply H.
        intro H3; apply H0; right; assumption.
        apply H1.
  Qed.

 Lemma InInter_l: forall `{T:EqDec} (v:T) s1 s2, set_In v (inter s1 s2) -> set_In v s1.
  Proof.
    unfold set_In; simple induction s1; simpl.
    -
      intros H H0; apply H0.
    -
      do 3 intro.
      intro s2.
      elim (in_dec eq_dec a s2); intros; auto.
      destruct H0.
      left; now auto.
      right; auto.
      apply H with s2; now auto.

      right.
      apply H in H0; auto.
  Qed.

 Lemma InInter_r: forall `{T: EqDec} (v:T) s1 s2, set_In v (inter s1 s2) -> set_In v s2.
  Proof.
    unfold set_In; induction s1; simpl; intros; auto.
    destruct H.

    destruct (in_dec eq_dec a s2).
    destruct H.
    subst a; now auto.
    apply IHs1 in H; now auto.
    apply IHs1 in H; now auto.
  Qed.

  Lemma InInter : forall `{T: EqDec} (v:T) s1 s2,  set_In v s1 ->  set_In v s2 -> set_In v (inter s1 s2).
  Proof.
     induction s1; simpl; intros; auto.
     destruct (in_dec eq_dec a s2).
     simpl.
     destruct H.
     left; auto.
     right.
     apply IHs1; now auto.

     destruct H.
     subst a.
     destruct (n H0).
     apply IHs1; auto.
  Qed.

  Lemma InDiff_l: forall `(T: EqDec) (v:T) s1 s2, set_In v (diff s1 s2) -> set_In v s1.
  Proof.
    unfold set_In; induction s1; simpl; intros; auto.
    destruct (in_dec eq_dec a s2); auto.
    right.
    apply IHs1 in H; now auto.

    destruct H.
    left; now auto.
    apply IHs1 in H; right; auto.
  Qed.

  Lemma InDiff : forall `{T: EqDec} (v:T) s1 s2,  set_In v s1 ->  ~set_In v s2 -> set_In v (diff s1 s2).
  Proof.
     induction s1; simpl; intros; auto.
     destruct (in_dec eq_dec a s2).
     simpl.
     destruct H.
     subst.
     tauto.
     apply IHs1; now auto.

     destruct H.
     subst a.
     left; now auto.
     simpl; right.
     apply IHs1; auto.
  Qed.

  Lemma subset_diff_empty_r: forall `{T: EqDec} (s1 s2: set T),
    subset s1 s2 -> subset s1 (diff s2 (empty _)).
  Proof.
    repeat intro.
    apply SV.InDiff.
    apply H in H0; easy.
    intro e; destruct e.
  Qed.

  Lemma subset_diff_elim: forall `{T: EqDec} (s s1 s2: set T),
    subset (diff s1 s2) s -> subset s1 (union s s2).
  Proof.
    repeat intro.
    destruct (In_dec eq_dec v s2).
    apply InUnion_r; easy.
    apply InUnion_l.
    apply H.
    apply InDiff; auto.
  Qed.

  Lemma no_exist_no_In : forall `(T:EqDec) (v:T) s2,  Isexist v s2 = false <-> ~set_In v s2.
  Proof.
    unfold set_In; simple induction s2; simpl.
    -
      split; auto.
    -
      do 3 intro.
      destruct (eq_dec v a) eqn : H0.
      +
        split.
        *
          intro H1; inversion H1.
        *
          subst.
          intro H1.
          exfalso; apply H1; left; reflexivity.
      +
        split.
        intro H1; intros [H2 | H3].
        *
          subst.
          apply n; reflexivity.
        *
          revert H3.
          rewrite <- H.
          assumption.
        *
          intro H1.
          rewrite -> H.
          intro H2; apply H1.
          right; assumption.
  Qed.

  Lemma InDiff_r: forall `(T: EqDec) (v:T) s1 s2, set_In v (diff s1 s2) -> ~set_In v s2.
  Proof.
    unfold set_In; simple induction s1; simpl.
    -
      intros s2 F; intro; assumption.
    -
      do 3 intro.
      intro s2.
      destruct (in_dec eq_dec a s2) eqn : H0.
      +
        intro;  apply H; assumption.
      +
        intros [H1 | H2].
        subst; auto.
        apply H; auto.
  Qed.

  Lemma In_dec: forall `(T: EqDec) (v:T) s, {set_In v s}+{~set_In  v s}.
  Proof.
   intros.
   apply (in_dec eq_dec).
  Defined.

  Lemma InUnionNotl: forall `(T: EqDec) (v:T) s1 s2, set_In v (union s1 s2) -> ~set_In v s1 -> set_In v s2.
  Proof.
    unfold set_In; simple induction s1; simpl.
    -
      intros; assumption.
    -
      do 3 intro; intros.
      apply InAdd in H0.
      destruct (eq_dec v a).
      +
        subst.
        exfalso; apply H1; left; reflexivity.
      +
        destruct H0.
        *
          tauto.
        *
          apply InUnion in s.
          destruct s.
          exfalso; apply H1; right; assumption.
          assumption.
  Qed.

  Lemma NotInLDiff: forall `(T: EqDec) (v:T) s1 s2, ~set_In v s1 -> ~set_In v (diff s1 s2).
  Proof.
    unfold set_In; simple induction s1; simpl.
    -
      intros; assumption.
    -
      do 3 intro; intros.
      destruct (in_dec eq_dec a s2).
      +
        apply H; intro; apply H0; right; assumption.
      +
        intros [H1 | H2].
        apply H0; left; assumption.
        revert H2; apply H; intro; apply H0; right; assumption.
  Qed.

  Fixpoint image `{T1: EqDec} `{T2: EqDec} (f: T1->T2) (s: set T1): set T2 :=
    match s with
      [] => []
    | x::s' => add (f x) (image f s')
    end.

  Lemma InImage_elim: forall `{T1: EqDec} `{T2: EqDec} (f: T1->T2) (s: set T1) (v:T2), set_In v (image f s) -> {w | v=f w /\ In w s}.
  Proof.
    induction s; intros.
    destruct H.
    simpl in H.
    apply SV.InAdd in H; destruct H.
    exists a.
    split; auto.
    left; apply eq_refl.
    destruct (IHs _ s0); intros.
    exists x.
    destruct a0.
    split; auto.
    right; auto.
  Defined.

  Lemma InImage_intro: forall `{T1: EqDec} `{T2: EqDec} (f: T1->T2) (s: set T1) (v:T2) w, v=f w -> set_In w s -> set_In v (image f s).
  Proof.
    induction s; intros.
    destruct H0.
    subst v.
    simpl in *.
    destruct H0.
    subst a.
    apply InAdd_l.
    apply InAdd_r.
    apply IHs with (w:=w); auto.
  Qed.

  Lemma subset_image_mono: forall `{T1: EqDec} `{T2: EqDec} (f: T1->T2) (s1 s2: set T1),
    subset s1 s2 -> subset (image f s1) (image f s2).
  Proof.
    repeat intro.
    apply InImage_elim in H0.
    destruct H0 as [w [h1 h2]]; subst.
    apply InImage_intro with (w0:=w); auto.
    apply H; auto.
  Qed.

  Definition sProduct `{T1: EqDec} `{T2: EqDec} (s1: set T1) (s2: set T2): set (eProduct T1 T2) :=
    List.flat_map (fun x1 => List.map (fun x2 => (x1,x2)) s2) s1.

  Lemma InsProduct: forall `{T1: EqDec} `{T2: EqDec} (s1: set T1) (s2: set T2) v1 v2,
    set_In v1 s1 -> set_In v2 s2 -> @set_In _ (eProduct T1 T2) (v1,v2) (sProduct s1 s2).
  Proof.
    intros.
    unfold sProduct.
    apply in_flat_map.
    exists v1.
    split; auto.
    apply in_map_iff.
    exists v2.
    split; auto.
  Qed.

  Lemma sProduct_l: forall `{T1: EqDec} `{T2: EqDec} (s1: set T1) (s2: set T2) v1 v2,
    @set_In _ (eProduct T1 T2) (v1,v2) (sProduct s1 s2) -> set_In v1 s1.
  Proof.
    intros.
    unfold sProduct, set_In in H.
    apply in_flat_map in H.
    destruct H as [x [h1 h2]].
    apply in_map_iff in h2.
    destruct h2 as [y [h3 h4]].
    injection  h3; clear h3; intros; subst.
    auto.
  Qed.

  Lemma sProduct_r: forall `{T1: EqDec} `{T2: EqDec} (s1: set T1) (s2: set T2) v1 v2,
    @set_In _ (eProduct T1 T2) (v1,v2) (sProduct s1 s2) -> set_In v2 s2.
  Proof.
    intros.
    unfold sProduct, set_In in H.
    apply in_flat_map in H.
    destruct H as [x [h1 h2]].
    apply in_map_iff in h2.
    destruct h2 as [y [h3 h4]].
    injection  h3; clear h3; intros; subst.
    auto.
  Qed.

  Definition filter `{T: EqDec} (P: T -> bool) (s: set T): set T := List.filter P s.

  Lemma Infilter: forall  `{T: EqDec} (P: T -> bool) (s: set T) x, set_In x s -> P x = true -> set_In x (filter P s).
  Proof.
    induction s; intros; auto.
    destruct H.
    subst.
    simpl.
    rewrite H0.
    left; reflexivity.
    generalize (IHs _ H H0); intro.
    simpl.
    destruct (P a); auto.
    right; auto.
  Qed.

  Lemma filter_l: forall  `{T: EqDec} (P: T -> bool) (s: set T) x, set_In x (filter P s) -> P x = true.
  Proof.
    induction s; intros; auto.
    simpl in H.
    destruct (P a) eqn:e; auto.
    destruct H; auto.
    subst a; auto.
  Qed.

  Lemma filter_r: forall  `{T: EqDec} (P: T -> bool) (s: set T) x, set_In x (filter P s) -> set_In x s.
  Proof.
    induction s; intros; auto.
    simpl in H.
    destruct (P a) eqn:e; auto.
    destruct H; auto.
    subst a; auto.
    left; auto.
    right; auto.
    right; auto.
  Qed.

  Fixpoint Filter `{T: EqDec} (P: T->Decidable) (s: set T): set T :=
  match s with
    [] => []
  | x::s' => if (@dc_dec (P x)) then (x::Filter P s') else Filter P s'
  end.

  Lemma InFilter_P: forall `{T: EqDec} (P: T->Decidable) (s: set T),
    forall x, set_In x (Filter P s) -> P x.
  Proof.
    induction s; simpl; intros; auto; try tauto.
    destruct dc_dec.
    destruct H.
    subst; tauto.
    apply IHs; auto.
    apply IHs; auto.
  Qed.

  Lemma FilterSubset: forall `{T: EqDec} (P: T->Decidable) (s: set T),
    subset (Filter P s) s.
  Proof.
    induction s; simpl; intros; auto; try tauto.
    repeat intro; auto.

    destruct dc_dec.
    repeat intro.
    destruct H.
    subst v; left; auto.
    apply IHs in H.
    right; auto.
    repeat intro.
    apply IHs in H.
    right; auto.
  Qed.

  Lemma InFilter_P_intro: forall `{T: EqDec} (P: T->Decidable) (s: set T),
    forall x, set_In x s -> P x -> set_In x (Filter P s).
  Proof.
    induction s; simpl; intros; auto; try tauto.
    destruct H.
    subst a.
    destruct dc_dec; auto.
    left; auto.
    destruct (n H0).
    destruct (eq_dec x a).
    subst a.
    destruct dc_dec; auto.
    left; auto.
    destruct dc_dec; auto.
    right; auto.
  Qed.

Add Parametric Morphism T U: (@union T U) with signature (@set_eq T U) ==> (@set_eq T U) ==> (@set_eq T U) as union_m.
Proof.
  intros.
  split; intro.
  apply InUnion in H1.
  destruct H1.
  apply InUnion_l.
  apply H; auto.
  apply InUnion_r.
  apply H0; auto.

  apply InUnion in H1.
  destruct H1.
  apply InUnion_l.
  apply H; auto.
  apply InUnion_r.
  apply H0; auto.
Qed.

Add Parametric Morphism T U: (@inter T U) with signature (@set_eq T U) ==> (@set_eq T U) ==> (@set_eq T U) as inter_m.
Proof.
  intros.
  split; intro.
  apply InInter; intros.
  apply H.
  apply InInter_l in H1; auto.
  apply H0.
  apply InInter_r in H1; auto.

  apply InInter; intros.
  apply H.
  apply InInter_l in H1; auto.
  apply H0.
  apply InInter_r in H1; auto.
Qed.

Add Parametric Morphism {T} (U: @EqDec T): (@add T U) with signature (@eq U) ==> (@set_eq T U) ==> (@set_eq T U) as add_m.
Proof.
  intros.
  split; intro.
  apply InAdd in H0.
  destruct H0.
  subst y.
  apply InAdd_l.
  apply InAdd_r.
  apply H; auto.

  apply InAdd in H0.
  destruct H0.
  subst y.
  apply InAdd_l.
  apply InAdd_r.
  apply H; auto.
Qed.

  Lemma Add_Cons_eq: forall `{T:EqDec} a (s: set T), add a s == a::s.
  Proof.
    induction s; simpl; intros; auto.
    split; intro; auto.
    destruct (eq_dec a a0).
    subst a0.
    split; intro; auto.
    destruct H.
    subst.
    left; auto.
    right; right; auto.
    destruct H; auto.
    subst v.
    left; auto.

    split; intro.
    destruct H.
    subst a0.
    right; left; auto.
    apply IHs in H.
    destruct H.
    subst v.
    left; auto.
    right; right; auto.

    destruct H.
    subst a.
    right.
    apply IHs.
    left; auto.
    destruct H.
    subst a0.
    left; auto.
    right.
    apply IHs.
    right; auto.
  Qed.

  Lemma add_comm: forall `{T:EqDec} a1 a2 (s: set T), add a1 (add a2 s) == add a2 (add a1 s).
  Proof.
    intros; split; intro.
    apply InAdd in H.
    destruct H.
    apply InAdd_r.
    subst v.
    apply InAdd_l.
    apply InAdd in s0.
    destruct s0.
    subst v.
    apply InAdd_l.
    apply InAdd_r.
    apply InAdd_r; auto.

    apply InAdd in H.
    destruct H.
    apply InAdd_r.
    subst v.
    apply InAdd_l.
    apply InAdd in s0.
    destruct s0.
    subst v.
    apply InAdd_l.
    apply InAdd_r.
    apply InAdd_r; auto.
  Qed.

  Lemma Union_add_r: forall `{T:EqDec} a s1 s2,
    (union s1 (a :: s2)) == (add a (union s1 s2)).
  Proof.
    induction s1; simpl; intros; auto.
    symmetry.
    apply Add_Cons_eq.
    rewrite IHs1.
    apply add_comm.
  Qed.

  Lemma Union_empty_r: forall `{T:EqDec} (s: set T), union s (empty _) == s.
  Proof.
    repeat intro; split; intro.
    apply InUnion in H.
    destruct H; auto.
    destruct s0.
    apply InUnion_l; auto.
  Qed.

  Lemma Union_Diff: forall `{T:EqDec} (s1 s2: set T), union (diff s1 s2) s2 == union s1 s2.
  Proof.
    repeat intro; split; intro.
    apply InUnion in H.
    destruct H.
    apply InDiff_l in s.
    apply InUnion_l; auto.
    apply InUnion_r; auto.

    apply InUnion in H.
    destruct (in_dec eq_dec v s2).
    apply InUnion_r; auto.
    destruct H; try tauto.
    apply InUnion_l.
    apply InDiff; auto.
  Qed.

  Lemma remove_union: forall `{V: EqDec} v (s1 s2: set V), remove v (union s1 s2) == union (remove v s1) (remove v s2).
  Proof.
    repeat (split || intro).
    generalize (InRemove_l _ H); intro.
    generalize (InRemove_r _ _ _ H); intro.
    apply InUnion in H1; destruct H1.
    apply InUnion_l.
    apply InRemove; auto.

    apply InUnion_r.
    apply InRemove; auto.

    apply InUnion in H; destruct H.
    apply InRemove.
    apply InRemove_l in s; auto.
    apply InUnion_l.
    apply InRemove_r in s; auto.

    apply InRemove.
    apply InRemove_l in s; auto.
    apply InUnion_r.
    apply InRemove_r in s; auto.
  Qed.

  Lemma subset_remove_mono: forall `{U: EqDec} {x: U} {s1 s2: set U}, subset s1 s2 -> subset (remove x s1) (remove x s2).
  Proof.
    repeat intro.
    generalize H0; intro H1.
    apply InRemove_l in H0.
    apply InRemove_r in H1.
    apply InRemove; auto.
  Qed.

  Lemma Exists_union: forall `{V: EqDec} (s1 s2: set V) P, Exists P (union s1 s2) <-> Exists P s1 \/ Exists P s2.
  Proof.
    intros.
    repeat rewrite Exists_exists.
    split; intro.
    destruct H as [x [h1 h2]].
    apply InUnion in h1.
    destruct h1; [left|right]; exists x; auto.
    destruct H; destruct H as [x [h1 h2]]; exists x; split; auto.
    apply InUnion_l; auto.
    apply InUnion_r; auto.
  Qed.

  Fixpoint pow `{T: EqDec} (s: set T): set (setDec T) :=
    match s with
      [] => [[]]
    | x::s' => union (pow s') (image (fun (u: setDec T) => (add x u: setDec T)) (pow s'))
    end.

 Lemma InPow_elim: forall `{T: EqDec} (s: set T) x, set_In x (pow s) -> subset x s.
 Proof.
  induction s; simpl; intros; auto.
  destruct H; try tauto; subst x.
  repeat intro; tauto.

  apply InUnion in H; destruct H.
  apply IHs in s0.
  repeat intro.
  right; apply s0; apply H.
  apply InImage_elim in s0.
  destruct s0 as [w [h1 h2]].
  apply IHs in h2; clear IHs.
  subst x.
  repeat intro.
  apply InAdd in H; destruct H.
  subst v; left; now auto.
  right; apply h2; apply s0.
 Qed.

 Lemma InEmptyPow_intro: forall `{T: EqDec} (s: set T), set_In (T:= setDec T) [] (pow s).
 Proof.
  induction s; simpl; intros; auto.
  apply InUnion_l; auto.
 Qed.

 Lemma InSingPow_intro: forall `{T: EqDec} (s: set T) x, set_In x s -> set_In (T:= setDec T) (sing T x) (pow s).
 Proof.
  intros.
  induction s; simpl; intros.
  destruct H.
  destruct H.
  subst x.
  apply InUnion_r.
  apply InImage_intro with (w:=[]).
  reflexivity.
  apply InEmptyPow_intro.
  apply InUnion_l; auto.
 Qed.

 Lemma InPow_intro: forall `{T: EqDec} (s: set T) x, subset x s -> exists (y: setDec T), set_eq x y /\ set_In y (pow s).
 Proof.
  intros.
  revert s x H; induction s; intros.
  exists [].
  simpl in *; split; auto.
  split; intro; auto.
  destruct H0.

  set (y := remove a x).
  assert (subset y s).
  repeat intro.
  generalize H0; intro H1.
  apply InRemove_l in H0; apply InRemove_r in H1.
  apply H in H1.
  destruct H1; auto; subst; tauto.
  apply IHs in H0; clear IHs.
  destruct H0 as [y1 H0].
  destruct (In_dec a x).
  simpl.
  exists (add a y1).
  split.
  apply proj1 in H0.
  split; repeat intro.
  destruct (eq_dec v a); subst.
  apply InAdd_l.
  apply InAdd_r.
  apply H0.
  apply InRemove; now auto.
  apply InAdd in H1; destruct H1; subst; auto.
  apply H0 in s1.
  apply InRemove_r in s1; now auto.
  apply InUnion_r.
  apply InImage_intro with (w:=y1); now auto.

  exists y1.
  split.
  apply proj1 in H0.
  split; repeat intro.
  apply H0.
  apply InRemove; auto.
  intro; subst; tauto.
  apply H0 in H1.
  apply InRemove_r in H1; now auto.
  simpl.
  apply InUnion_l.
  tauto.
 Qed.

End SV.