Commit 5446fba3 authored by Robbert Krebbers's avatar Robbert Krebbers

Initial commit

parents
This diff is collapsed.
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.
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 := xbool_decide_pack _ p.
Lemma proj1_dsig_inj {A} (P : A Prop) x (Px : P x) y (Py : P y) : xPx = yPy 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.
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.
This diff is collapsed.
This diff is collapsed.
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.
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.
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 (λ _, {{ 0 }}) o (Pdom_raw Npos (`t))
end.
Global Instance Nmerge: Merge Nmap := λ A f t1 t2,
match t1, t2 with
| Build_Nmap o1 t1, Build_Nmap o2 t2 => Build_Nmap (f o1 o2) (merge f t1 t2)
end.
Global Instance Nfmap: FMap Nmap := λ A B f t,
match t with
| Build_Nmap o t => Build_Nmap (fmap f o) (fmap f t)
end.
Global Instance: FinMap N Nmap.
Proof