Initial commit

theories/collections.v

+Require Export base orders.
+
+Section collection.
+  Context `{Collection A B}.
+
+  Lemma elem_of_empty_iff x : x ∈ ∅ ↔ False.
+  Proof. split. apply elem_of_empty. easy. Qed.
+
+  Lemma elem_of_union_l x X Y : x ∈ X → x ∈ X ∪ Y.
+  Proof. intros. apply elem_of_union. auto. Qed.
+  Lemma elem_of_union_r x X Y : x ∈ Y → x ∈ X ∪ Y.
+  Proof. intros. apply elem_of_union. auto. Qed.
+
+  Global Instance collection_subseteq: SubsetEq B := λ X Y, ∀ x, x ∈ X → x ∈ Y.
+  Global Instance: BoundedJoinSemiLattice B.
+  Proof. firstorder. Qed.
+  Global Instance: MeetSemiLattice B.
+  Proof. firstorder. Qed.
+
+  Lemma elem_of_subseteq X Y : X ⊆ Y ↔ ∀ x, x ∈ X → x ∈ Y.
+  Proof. easy. Qed.
+  Lemma elem_of_equiv X Y : X ≡ Y ↔ ∀ x, x ∈ X ↔ x ∈ Y.
+  Proof. firstorder. Qed.
+  Lemma elem_of_equiv_alt X Y : X ≡ Y ↔ (∀ x, x ∈ X → x ∈ Y) ∧ (∀ x, x ∈ Y → x ∈ X).
+  Proof. firstorder. Qed.
+
+  Global Instance: Proper ((=) ==> (≡) ==> iff) (∈).
+  Proof. intros ???. subst. firstorder. Qed.
+
+  Lemma empty_ne_singleton x :  ∅ ≢ {{ x }}.
+  Proof. intros [_ E]. destruct (elem_of_empty x). apply E. now apply elem_of_singleton. Qed. 
+End collection.
+
+Section cmap.
+  Context `{Collection A C}.
+
+  Lemma elem_of_map_1 (f : A → A) (X : C) (x : A) : x ∈ X → f x ∈ map f X.
+  Proof. intros. apply (elem_of_map _). eauto. Qed.
+  Lemma elem_of_map_1_alt (f : A → A) (X : C) (x : A) y : x ∈ X → y = f x → y ∈ map f X.
+  Proof. intros. apply (elem_of_map _). eauto. Qed.
+  Lemma elem_of_map_2 (f : A → A) (X : C) (x : A) : x ∈ map f X → ∃ y, x = f y ∧ y ∈ X.
+  Proof. intros. now apply (elem_of_map _). Qed.
+End cmap.
+
+Definition fresh_sig `{FreshSpec A C} (X : C) : { x : A | x ∉ X } := exist (∉ X) (fresh X) (is_fresh X).
+
+Lemma elem_of_fresh_iff `{FreshSpec A C} (X : C) : fresh X ∈ X ↔ False.
+Proof. split. apply is_fresh. easy. Qed.
+
+Ltac split_elem_ofs := repeat
+  match goal with
+  | H : context [ _ ⊆ _ ] |- _ => setoid_rewrite elem_of_subseteq in H
+  | H : context [ _ ≡ _ ] |- _ => setoid_rewrite elem_of_equiv_alt in H
+  | H : context [ _ ∈ ∅ ] |- _ => setoid_rewrite elem_of_empty_iff in H
+  | H : context [ _ ∈ {{ _ }} ] |- _ => setoid_rewrite elem_of_singleton in H
+  | H : context [ _ ∈ _ ∪ _ ] |- _ => setoid_rewrite elem_of_union in H
+  | H : context [ _ ∈ _ ∩ _ ] |- _ => setoid_rewrite elem_of_intersection in H
+  | H : context [ _ ∈ _ ∖ _ ] |- _ => setoid_rewrite elem_of_difference in H
+  | H : context [ _ ∈ map _ _ ] |- _ => setoid_rewrite elem_of_map in H
+  | |- context [ _ ⊆ _ ] => setoid_rewrite elem_of_subseteq
+  | |- context [ _ ≡ _ ] => setoid_rewrite elem_of_equiv_alt
+  | |- context [ _ ∈ ∅ ] => setoid_rewrite elem_of_empty_iff
+  | |- context [ _ ∈ {{ _ }} ] => setoid_rewrite elem_of_singleton
+  | |- context [ _ ∈ _ ∪ _ ] => setoid_rewrite elem_of_union
+  | |- context [ _ ∈ _ ∩ _ ] => setoid_rewrite elem_of_intersection
+  | |- context [ _ ∈ _ ∖ _ ] => setoid_rewrite elem_of_difference
+  | |- context [ _ ∈ map _ _ ] => setoid_rewrite elem_of_map
+  end.
+
+Ltac destruct_elem_ofs := repeat
+  match goal with
+  | H : context [ @elem_of (_ * _) _ _ ?x _ ] |- _ => is_var x; destruct x
+  | H : context [ @elem_of (_ + _) _ _ ?x _] |- _ => is_var x; destruct x
+  end.
+
+Tactic Notation "simplify_elem_of" tactic(t) :=
+  intros; (* due to bug #2790 *)
+  simpl in *;
+  split_elem_ofs;
+  destruct_elem_ofs;
+  intuition (simplify_eqs; t).
+Tactic Notation "simplify_elem_of" := simplify_elem_of auto.
+
+Ltac naive_firstorder t :=
+  match goal with
+  (* intros *)
+  | |- ∀ _, _ => intro; naive_firstorder t
+  (* destructs without information loss *)
+  | H : False |- _ => destruct H
+  | H : ?X, Hneg : ¬?X|- _ => now destruct Hneg
+  | H : _ ∧ _ |- _ => destruct H; naive_firstorder t
+  | H : ∃ _, _  |- _ => destruct H; naive_firstorder t
+  (* simplification *)
+  | |- _ => progress (simplify_eqs; simpl in *); naive_firstorder t
+  (* constructs *)
+  | |- _ ∧ _ => split; naive_firstorder t
+  (* solve *)
+  | |- _ => solve [t]
+  (* dirty destructs *)
+  | H : context [ ∃ _, _ ] |- _ => edestruct H; clear H; naive_firstorder t || clear H; naive_firstorder t
+  | H : context [ _ ∧ _ ] |- _ => edestruct H; clear H; naive_firstorder t || clear H; naive_firstorder t
+  | H : context [ _ ∨ _ ] |- _ => edestruct H; clear H; naive_firstorder t || clear H; naive_firstorder t
+  (* dirty constructs *)
+  | |- ∃ x, _ => eexists; naive_firstorder t
+  | |- _ ∨ _ => left; naive_firstorder t || right; naive_firstorder t
+  | H : _ → False |- _ => destruct H; naive_firstorder t
+  end.
+Tactic Notation "naive_firstorder" tactic(t) :=
+  unfold iff, not in *; 
+  naive_firstorder t.
+
+Tactic Notation "esimplify_elem_of" tactic(t) := 
+  (simplify_elem_of t); 
+  try naive_firstorder t.
+Tactic Notation "esimplify_elem_of" := esimplify_elem_of (eauto 5).
+
+Section no_dup.
+  Context `{Collection A B} (R : relation A) `{!Equivalence R}.
+
+  Definition elem_of_upto (x : A) (X : B) := ∃ y, y ∈ X ∧ R x y.
+  Definition no_dup (X : B) := ∀ x y, x ∈ X → y ∈ X → R x y → x = y.
+
+  Global Instance: Proper ((≡) ==> iff) (elem_of_upto x).
+  Proof. firstorder. Qed.
+  Global Instance: Proper (R ==> (≡) ==> iff) elem_of_upto.
+  Proof.
+    intros ?? E1 ?? E2. split; intros [z [??]]; exists z.
+     rewrite <-E1, <-E2; intuition.
+    rewrite E1, E2; intuition.
+  Qed.
+  Global Instance: Proper ((≡) ==> iff) no_dup.
+  Proof. firstorder. Qed.
+
+  Lemma elem_of_upto_elem_of x X : x ∈ X → elem_of_upto x X.
+  Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
+  Lemma elem_of_upto_empty x : ¬elem_of_upto x ∅.
+  Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
+  Lemma elem_of_upto_singleton x y : elem_of_upto x {{ y }} ↔ R x y.
+  Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
+
+  Lemma elem_of_upto_union X Y x : elem_of_upto x (X ∪ Y) ↔ elem_of_upto x X ∨ elem_of_upto x Y.
+  Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
+  Lemma not_elem_of_upto x X : ¬elem_of_upto x X → ∀ y, y ∈ X → ¬R x y.
+  Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
+
+  Lemma no_dup_empty: no_dup ∅.
+  Proof. unfold no_dup. simplify_elem_of. Qed.
+  Lemma no_dup_add x X : ¬elem_of_upto x X → no_dup X → no_dup ({{ x }} ∪ X).
+  Proof. unfold no_dup, elem_of_upto. esimplify_elem_of. Qed.
+  Lemma no_dup_inv_add x X : x ∉ X → no_dup ({{ x }} ∪ X) → ¬elem_of_upto x X.
+  Proof. intros Hin Hnodup [y [??]]. rewrite (Hnodup x y) in Hin; simplify_elem_of. Qed.
+  Lemma no_dup_inv_union_l X Y : no_dup (X ∪ Y) → no_dup X.
+  Proof. unfold no_dup. simplify_elem_of. Qed.
+  Lemma no_dup_inv_union_r X Y : no_dup (X ∪ Y) → no_dup Y.
+  Proof. unfold no_dup. simplify_elem_of. Qed.
+End no_dup.
+
+Section quantifiers.
+  Context `{Collection A B} (P : A → Prop).
+
+  Definition cforall X := ∀ x, x ∈ X → P x.
+  Definition cexists X := ∃ x, x ∈ X ∧ P x.
+
+  Lemma cforall_empty : cforall ∅.
+  Proof. unfold cforall. simplify_elem_of. Qed.
+  Lemma cforall_singleton x : cforall {{ x }} ↔ P x.
+  Proof. unfold cforall. simplify_elem_of. Qed.
+  Lemma cforall_union X Y : cforall X → cforall Y → cforall (X ∪ Y).
+  Proof. unfold cforall. simplify_elem_of. Qed.
+  Lemma cforall_union_inv_1 X Y : cforall (X ∪ Y) → cforall X.
+  Proof. unfold cforall. simplify_elem_of. Qed.
+  Lemma cforall_union_inv_2 X Y : cforall (X ∪ Y) → cforall Y.
+  Proof. unfold cforall. simplify_elem_of. Qed.
+
+  Lemma cexists_empty : ¬cexists ∅.
+  Proof. unfold cexists. esimplify_elem_of. Qed.
+  Lemma cexists_singleton x : cexists {{ x }} ↔ P x.
+  Proof. unfold cexists. esimplify_elem_of. Qed.
+  Lemma cexists_union_1 X Y : cexists X → cexists (X ∪ Y).
+  Proof. unfold cexists. esimplify_elem_of. Qed.
+  Lemma cexists_union_2 X Y : cexists Y → cexists (X ∪ Y).
+  Proof. unfold cexists. esimplify_elem_of. Qed.
+  Lemma cexists_union_inv X Y : cexists (X ∪ Y) → cexists X ∨ cexists Y.
+  Proof. unfold cexists. esimplify_elem_of. Qed.
+End quantifiers.
+
+Lemma cforall_weak `{Collection A B} (P Q : A → Prop) (Hweak : ∀ x, P x → Q x) X :
+  cforall P X → cforall Q X.
+Proof. firstorder. Qed.
+Lemma cexists_weak `{Collection A B} (P Q : A → Prop) (Hweak : ∀ x, P x → Q x) X :
+  cexists P X → cexists Q X.
+Proof. firstorder. Qed.

theories/decidable.v

+Require Export base.
+
+Definition decide_rel {A B} (R : A → B → Prop) 
+  {dec : ∀ x y, Decision (R x y)} (x : A) (y : B) : Decision (R x y) := dec x y.
+
+Ltac case_decide := 
+  match goal with
+  | H : context [@decide ?P ?dec] |- _ => case (@decide P dec) in *
+  | H : context [@decide_rel _ _ ?R ?x ?y ?dec] |- _ => case (@decide_rel _ _ R x y dec) in *
+  | |- context [@decide ?P ?dec] => case (@decide P dec) in *
+  | |- context [@decide_rel _ _ ?R ?x ?y ?dec] => case (@decide_rel _ _ R x y dec) in *
+  end.
+
+Ltac solve_trivial_decision :=
+  match goal with
+  | [ |- Decision (?P) ] => apply _
+  | [ |- sumbool ?P (¬?P) ] => change (Decision P); apply _
+  end.
+Ltac solve_decision :=
+  first [solve_trivial_decision | unfold Decision; decide equality; solve_trivial_decision].
+
+Program Instance True_dec: Decision True := left _.
+Program Instance False_dec: Decision False := right _.
+Program Instance prod_eq_dec `(A_dec : ∀ x y : A, Decision (x = y))
+     `(B_dec : ∀ x y : B, Decision (x = y)) : ∀ x y : A * B, Decision (x = y) := λ x y,
+  match A_dec (fst x) (fst y) with
+  | left _ => match B_dec (snd x) (snd y) with left _ => left _ | right _ => right _ end
+  | right _ => right _
+  end.
+Solve Obligations using (program_simpl; f_equal; firstorder).
+Program Instance and_dec `(P_dec : Decision P) `(Q_dec : Decision Q) : Decision (P ∧ Q) :=
+  match P_dec with
+  | left _ => match Q_dec with left _ => left _ | right _ => right _ end
+  | right _ => right _
+  end.
+Solve Obligations using (program_simpl; tauto).
+Program Instance or_dec `(P_dec : Decision P) `(Q_dec : Decision Q) : Decision (P ∨ Q) :=
+  match P_dec with
+  | left _ => left _
+  | right _ => match Q_dec with left _ => left _ | right _ => right _ end
+  end.
+Solve Obligations using (program_simpl; firstorder).
+
+Definition bool_decide (P : Prop) {dec : Decision P} : bool := if dec then true else false.
+Coercion Is_true : bool >-> Sortclass.
+Lemma bool_decide_unpack (P : Prop) {dec : Decision P} : bool_decide P → P.
+Proof. unfold bool_decide. now destruct dec. Qed.
+Lemma bool_decide_pack (P : Prop) {dec : Decision P} : P → bool_decide P.
+Proof. unfold bool_decide. now destruct dec. Qed.
+
+Definition dsig `(P : A → Prop) `{∀ x : A, Decision (P x)} := { x | bool_decide (P x) }.
+Definition proj2_dsig `{∀ x : A, Decision (P x)} (x : dsig P) : P (`x) := bool_decide_unpack _ (proj2_sig x).
+Definition dexist `{∀ x : A, Decision (P x)} (x : A) (p : P x) : dsig P := x↾bool_decide_pack _ p.
+
+Lemma proj1_dsig_inj {A} (P : A → Prop) x (Px : P x) y (Py : P y) : x↾Px = y↾Py → x = y.
+Proof. now injection 1. Qed.
+Lemma dsig_eq {A} (P : A → Prop) {dec : ∀ x, Decision (P x)} (x y : { x | bool_decide (P x) }) :
+  `x = `y → x = y.
+Proof.
+  intros H1. destruct x as [x Hx], y as [y Hy]. simpl in *. subst.
+  f_equal. revert Hx Hy. case (bool_decide (P y)). simpl. now intros [] []. easy.
+Qed.

theories/fin_collections.v

+Require Import Permutation.
+Require Export collections listset.
+
+Instance collection_size `{Elements A C} : Size C := λ X, length (elements X).
+Definition collection_fold `{Elements A C} {B} (f : A → B → B) (b : B) (X : C) : B := 
+  fold_right f b (elements X).
+
+Section fin_collection.
+Context `{FinCollection A C}.
+
+Global Instance elements_proper: Proper ((≡) ==> Permutation) elements.
+Proof.
+  intros ?? E. apply NoDup_Permutation.
+    apply elements_nodup.
+   apply elements_nodup.
+  intros. now rewrite <-!elements_spec, E.
+Qed.
+Global Instance collection_size_proper: Proper ((≡) ==> (=)) size.
+Proof. intros ?? E. apply Permutation_length. now rewrite E. Qed.
+
+Lemma size_empty : size ∅ = 0.
+Proof.
+  unfold size, collection_size. rewrite (in_nil_inv (elements ∅)).
+   easy.
+  intro. rewrite <-elements_spec. simplify_elem_of.
+Qed.
+Lemma size_empty_inv X : size X = 0 → X ≡ ∅.
+Proof.
+  intros. apply equiv_empty. intro. rewrite elements_spec.
+  rewrite (nil_length (elements X)); intuition.
+Qed.
+Lemma size_empty_iff X : size X = 0 ↔ X ≡ ∅.
+Proof. split. apply size_empty_inv. intros E. now rewrite E, size_empty. Qed.
+
+Lemma size_singleton x : size {{ x }} = 1.
+Proof.
+  change (length (elements {{x}}) = length [x]).
+  apply Permutation_length, NoDup_Permutation.
+    apply elements_nodup.
+   apply NoDup_singleton.
+  intros. rewrite <-elements_spec. esimplify_elem_of firstorder.
+Qed.
+Lemma size_singleton_inv X x y : size X = 1 → x ∈ X → y ∈ X → x = y.
+Proof.
+  unfold size, collection_size. rewrite !elements_spec.
+  generalize (elements X). intros [|? l].
+   discriminate.
+  injection 1. intro. rewrite (nil_length l) by easy.
+  simpl. intuition congruence.
+Qed.
+
+Lemma choose X : X ≢ ∅ → { x | x ∈ X }.
+Proof.
+  case_eq (elements X).
+   intros E. intros []. apply equiv_empty.
+   intros x. rewrite elements_spec, E. contradiction.
+  intros x l E. exists x. rewrite elements_spec, E. now left.
+Qed.
+Lemma size_pos_choose X : 0 < size X → { x | x ∈ X }.
+Proof. 
+  intros E. apply choose.
+  intros E2. rewrite E2, size_empty in E. now destruct (Lt.lt_n_0 0).
+Qed.
+Lemma size_1_choose X : size X = 1 → { x | X ≡ {{ x }} }.
+Proof.
+  intros E. destruct (size_pos_choose X).
+   rewrite E. auto with arith.
+  exists x. simplify_elem_of. eapply size_singleton_inv; eauto.
+Qed.
+
+Program Instance collection_car_eq_dec_slow (x y : A) : Decision (x = y) | 100 :=
+  match Compare_dec.zerop (size ({{ x }} ∩ {{ y }})) with
+  | left _ => right _
+  | right _ => left _
+  end.
+Next Obligation.
+  intro. apply empty_ne_singleton with x.
+  transitivity ({{ x }} ∩ {{ y }}).
+   symmetry. now apply size_empty_iff.
+  simplify_elem_of.
+Qed.
+Next Obligation. edestruct size_pos_choose; esimplify_elem_of. Qed.
+
+Instance elem_of_dec_slow (x : A) (X : C) : Decision (x ∈ X) | 100 :=
+  match decide_rel In x (elements X) with
+  | left Hx => left (proj2 (elements_spec _ _) Hx)
+  | right Hx => right (Hx ∘ proj1 (elements_spec _ _))
+  end.
+
+Lemma union_diff_1 X Y : X ⊆ Y → X ∪ Y ∖ X ≡ Y.
+Proof. split; intros x; destruct (decide (x ∈ X)); simplify_elem_of. Qed.
+Lemma union_diff_2 X Y : X ∪ Y ≡ X ∪ Y ∖ X.
+Proof. split; intros x; destruct (decide (x ∈ X)); simplify_elem_of. Qed.
+
+Lemma size_union X Y : X ∩ Y ≡ ∅ → size (X ∪ Y) = size X + size Y.
+Proof.
+  intros [E _]. unfold size, collection_size. rewrite <-app_length.
+  apply Permutation_length, NoDup_Permutation.
+    apply elements_nodup.
+   apply NoDup_app; try apply elements_nodup.
+   intros x. rewrite <-!elements_spec.
+   intros ??. apply (elem_of_empty x), E. simplify_elem_of.
+  intros. rewrite in_app_iff, <-!elements_spec. simplify_elem_of.
+Qed.
+Lemma size_union_alt X Y : size (X ∪ Y) = size X + size (Y ∖ X).
+Proof. rewrite <-size_union. now rewrite union_diff_2. simplify_elem_of. Qed.
+Lemma size_add X x : x ∉ X → size ({{ x }} ∪ X) = S (size X).
+Proof. intros. rewrite size_union. now rewrite size_singleton. simplify_elem_of. Qed.
+Lemma size_diff X Y : X ⊆ Y → size X + size (Y ∖ X) = size Y.
+Proof. intros. now rewrite <-size_union_alt, subseteq_union_1. Qed.
+Lemma size_remove X x : x ∈ X → S (size (X ∖ {{ x }})) = size X.
+Proof.
+  intros. rewrite <-(size_diff {{ x }} X).
+   rewrite size_singleton. auto with arith.
+  simplify_elem_of.
+Qed.
+
+Lemma subseteq_size X Y : X ⊆ Y → size X ≤ size Y.
+Proof. intros. rewrite <-(union_diff_1 X Y), size_union by simplify_elem_of. auto with arith. Qed. 
+
+Lemma collection_wf_ind (P : C → Prop) :
+  (∀ X, (∀ Y, size Y < size X → P Y) → P X) → ∀ X, P X.
+Proof.
+  intros Hind. assert (∀ n X, size X < n → P X) as help.
+   induction n.
+    intros. now destruct (Lt.lt_n_0 (size X)).
+   intros. apply Hind. intros. apply IHn. eauto with arith.
+  intros. apply help with (S (size X)). auto with arith.
+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 collection_wf_ind.
+  intros X IH. destruct (Compare_dec.zerop (size X)).
+   now rewrite size_empty_inv.
+  destruct (size_pos_choose X); auto.
+  rewrite <-(union_diff_1 {{ x }} X); simplify_elem_of.
+  apply Hadd; simplify_elem_of. apply IH.
+  rewrite <-(size_remove X x); auto with arith.
+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.
+  assert (∀ l, NoDup l → ∀ X, (∀ x, x ∈ X ↔ In x l) → P (fold_right f b l) X) as help.
+   induction 1 as [|x l ?? IHl]; simpl.
+    intros X HX. rewrite equiv_empty; esimplify_elem_of.
+   intros X HX. rewrite <-(union_diff_1 {{ x }} X).
+    apply Hadd. simplify_elem_of. apply IHl.
+    intros y. split.
+     intros. destruct (proj1 (HX y)); simplify_elem_of.
+    esimplify_elem_of.
+   esimplify_elem_of.
+  intros. apply help. apply elements_nodup. apply elements_spec.
+Qed.
+
+Lemma collection_fold_proper {B} (f : A → B → B) (b : B) :
+  (∀ a1 a2 b, f a1 (f a2 b) = f a2 (f a1 b)) → Proper ((≡) ==> (=)) (collection_fold f b).
+Proof. intros ??? E. apply fold_right_permutation. auto. now rewrite E. Qed. 
+
+Global Program Instance cforall_dec `(P : A → Prop) `{∀ x, Decision (P x)} X : Decision (cforall P X) | 100 :=
+  match decide (Forall P (elements X)) with
+  | left Hall => left _
+  | right Hall => right _
+  end.
+Next Obligation. red. setoid_rewrite elements_spec. now apply Forall_forall. Qed. 
+Next Obligation. intro. apply Hall, Forall_forall. setoid_rewrite <-elements_spec. auto. Qed.
+
+Global Program Instance cexists_dec `(P : A → Prop) `{∀ x, Decision (P x)} X : Decision (cexists P X) | 100 :=
+  match decide (Exists P (elements X)) with
+  | left Hex => left _
+  | right Hex => right _
+  end.
+Next Obligation. red. setoid_rewrite elements_spec. now apply Exists_exists. Qed. 
+Next Obligation. intro. apply Hex, Exists_exists. setoid_rewrite <-elements_spec. auto. Qed.
+
+Global Instance rel_elem_of_dec `{∀ x y, Decision (R x y)} x X : Decision (elem_of_upto R x X) | 100 := 
+  decide (cexists (R x) X).
+End fin_collection.

theories/listset.v

+Require Export base decidable list collections.
+
+Definition listset A := sig (@NoDup A).
+
+Section list_collection.
+Context {A : Type} `{∀ x y : A, Decision (x = y)}.
+
+Global Instance listset_elem_of: ElemOf A (listset A) := λ x l, In x (`l).
+Global Instance listset_empty: Empty (listset A) := []↾@NoDup_nil _.
+Global Instance listset_singleton: Singleton A (listset A) := λ x, [x]↾NoDup_singleton x.
+
+Fixpoint listset_diff_raw (l k : list A) :=
+  match l with
+  | [] => []
+  | x :: l => if decide_rel In x k then listset_diff_raw l k else x :: listset_diff_raw l k
+  end.
+Lemma listset_diff_raw_in l k x : In x (listset_diff_raw l k) ↔ In x l ∧ ¬In x k.
+Proof. split; induction l; simpl; try case_decide; simpl; intuition congruence. Qed.
+Lemma listset_diff_raw_nodup l k : NoDup l → NoDup (listset_diff_raw l k).
+Proof. 
+  induction 1; simpl; try case_decide.
+    constructor.
+   easy.
+  constructor. rewrite listset_diff_raw_in; intuition. easy.
+Qed.
+Global Instance listset_diff: Difference (listset A) := λ l k,
+  listset_diff_raw (`l) (`k)↾listset_diff_raw_nodup (`l) (`k) (proj2_sig l).
+
+Definition listset_union_raw (l k : list A) := listset_diff_raw l k ++ k.
+Lemma listset_union_raw_in l k x : In x (listset_union_raw l k) ↔ In x l ∨ In x k.
+Proof. 
+  unfold listset_union_raw. rewrite in_app_iff, listset_diff_raw_in.
+  intuition. case (decide (In x k)); intuition.
+Qed.
+Lemma listset_union_raw_nodup l k : NoDup l → NoDup k → NoDup (listset_union_raw l k).
+Proof.
+  intros. apply NoDup_app.
+    now apply listset_diff_raw_nodup.
+   easy.
+  intro. rewrite listset_diff_raw_in. intuition.
+Qed.
+Global Instance listset_union: Union (listset A) := λ l k,
+  listset_union_raw (`l) (`k)↾listset_union_raw_nodup (`l) (`k) (proj2_sig l) (proj2_sig k).
+
+Fixpoint listset_inter_raw (l k : list A) :=
+  match l with
+  | [] => []
+  | x :: l => if decide_rel In x k then x :: listset_inter_raw l k else listset_inter_raw l k
+  end.
+Lemma listset_inter_raw_in l k x : In x (listset_inter_raw l k) ↔ In x l ∧ In x k.
+Proof. split; induction l; simpl; try case_decide; simpl; intuition congruence. Qed.
+Lemma listset_inter_raw_nodup l k : NoDup l → NoDup (listset_inter_raw l k).
+Proof.
+  induction 1; simpl; try case_decide.
+    constructor.
+   constructor. rewrite listset_inter_raw_in; intuition. easy.
+  easy.
+Qed.
+Global Instance listset_inter: Intersection (listset A) := λ l k,
+  listset_inter_raw (`l) (`k)↾listset_inter_raw_nodup (`l) (`k) (proj2_sig l).
+
+Definition listset_add_raw x (l : list A) : list A := if decide_rel In x l then l else x :: l.
+Lemma listset_add_raw_in x l y : In y (listset_add_raw x l) ↔ y = x ∨ In y l.
+Proof. unfold listset_add_raw. case (decide_rel _); firstorder congruence. Qed.
+Lemma listset_add_raw_nodup x l : NoDup l → NoDup (listset_add_raw x l).
+Proof. unfold listset_add_raw. case (decide_rel _); try constructor; firstorder. Qed. 
+
+Fixpoint listset_map_raw (f : A → A) (l : list A) :=
+  match l with
+  | [] => []
+  | x :: l => listset_add_raw (f x) (listset_map_raw f l)
+  end.
+Lemma listset_map_raw_nodup f l : NoDup (listset_map_raw f l).
+Proof. induction l; simpl. constructor. now apply listset_add_raw_nodup. Qed.
+Lemma listset_map_raw_in f l x : In x (listset_map_raw f l) ↔ ∃ y, x = f y ∧ In y l.
+Proof.
+  split.
+   induction l; simpl. easy. rewrite listset_add_raw_in. firstorder.
+  intros [?[??]]. subst. induction l; simpl in *. easy.
+  rewrite listset_add_raw_in. firstorder congruence.
+Qed.
+Global Instance listset_map: Map A (listset A) := λ f l,
+  listset_map_raw f (`l)↾listset_map_raw_nodup f (`l).
+
+Global Instance: Collection A (listset A).
+Proof.
+  split.
+       easy.
+      compute. intuition.
+     intros. apply listset_union_raw_in.
+    intros. apply listset_inter_raw_in.
+   intros. apply listset_diff_raw_in.
+  intros. apply listset_map_raw_in.
+Qed.
+
+Global Instance listset_elems: Elements A (listset A) := @proj1_sig _ _.
+
+Global Instance: FinCollection A (listset A).
+Proof. split. apply _. easy. now intros [??]. Qed.
+End list_collection.

theories/monads.v

+Require Import base.
+
+Section monad_ops.
+  Context (M : Type → Type).
+
+  Class MRet := mret: ∀ {A}, A → M A.
+  Class MBind := mbind: ∀ {A B}, (A → M B) → M A → M B.
+  Class MJoin := mjoin: ∀ {A}, M (M A) → M A.
+  Class FMap := fmap: ∀ {A B}, (A → B) → M A → M B.
+End monad_ops.
+
+Arguments mret {M MRet A} _.
+Arguments mbind {M MBind A B} _ _.
+Arguments mjoin {M MJoin A} _.
+Arguments fmap {M FMap A B} _ _.
+
+Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : C_scope.
+Notation "x ← y ; z" := (y ≫= (λ x : _, z)) (at level 65, next at level 35, right associativity) : C_scope.
+Infix "<$>" := fmap (at level 65, right associativity, only parsing) : C_scope.

theories/nmap.v

+Require Import pmap.
+Require Export prelude fin_maps.
+
+Local Open Scope N_scope.
+
+Record Nmap A := { Nmap_0 : option A; Nmap_pos : Pmap A }.
+Arguments Nmap_0 {_} _.
+Arguments Nmap_pos {_} _.
+Arguments Build_Nmap {_} _ _.
+
+Global Instance Pmap_dec `{∀ x y : A, Decision (x = y)} : ∀ x y : Nmap A, Decision (x = y).
+Proof. solve_decision. Defined.
+Global Instance Nempty {A} : Empty (Nmap A) := Build_Nmap None ∅.
+Global Instance Nlookup: Lookup N Nmap := λ A i t,
+  match i with
+  | N0 => Nmap_0 t
+  | Npos p => Nmap_pos t !! p
+  end.
+Global Instance Npartial_alter: PartialAlter N Nmap := λ A f i t,
+  match i, t with
+  | N0, Build_Nmap o t => Build_Nmap (f o) t
+  | Npos p, Build_Nmap o t => Build_Nmap o (partial_alter f p t)
+  end.
+Global Instance Ndom {A} : Dom N (Nmap A) := λ A _ _ _ t,
+  match t with
+  | Build_Nmap o t => option_case (λ _,