Commit d60affc0 authored by Robbert Krebbers's avatar Robbert Krebbers

Preparation to port the master branch

Major changes:
* A data structure to collect locked addresses in memory.
* Operations to lock and unlock addresses.
* Remove [ctree_Forall] and express it using [Forall] and [ctree_flatten]. This
  saves a lot of lines of code.
* Add a [void] value. This value cannot be typed, but will be used as a dummy
  return value for functions with return type [void].

Minor changes:
* Various deciders in preparation of the executable semantics.
* Improve naming and notations.
* Remove obsolete stuff.
parent 46799584
......@@ -9,11 +9,6 @@ Global Set Automatic Coercions Import.
Require Export Morphisms RelationClasses List Bool Utf8 Program Setoid.
(** * General *)
(** The following coercion allows us to use Booleans as propositions. *)
Coercion Is_true : bool >-> Sortclass.
Notation "(&&)" := andb (only parsing).
Notation "(||)" := orb (only parsing).
(** Zipping lists. *)
Definition zip_with {A B C} (f : A B C) : list A list B list C :=
fix go l1 l2 :=
......@@ -500,14 +495,6 @@ Class Merge (M : Type → Type) :=
Instance: Params (@merge) 4.
Arguments merge _ _ _ _ _ _ !_ !_ / : simpl nomatch.
(** We lift the insert and delete operation to lists of elements. *)
Definition insert_list `{Insert K A M} (l : list (K * A)) (m : M) : M :=
fold_right (λ p, <[p.1:=p.2]>) m l.
Instance: Params (@insert_list) 4.
Definition delete_list `{Delete K M} (l : list K) (m : M) : M :=
fold_right delete m l.
Instance: Params (@delete_list) 3.
(** The function [union_with f m1 m2] is supposed to yield the union of [m1]
and [m2] using the function [f] to combine values of members that are in
both [m1] and [m2]. *)
......@@ -724,8 +711,8 @@ Class FinCollection A C `{ElemOf A C, Empty C, Singleton A C,
Union C, Intersection C, Difference C,
Elements A C, x y : A, Decision (x = y)} : Prop := {
fin_collection :>> Collection A C;
elements_spec X x : x X x elements X;
elements_nodup X : NoDup (elements X)
elem_of_elements X x : x elements X x X;
NoDup_elements X : NoDup (elements X)
}.
Class Size C := size: C nat.
Arguments size {_ _} !_ / : simpl nomatch.
......@@ -763,6 +750,20 @@ Class FreshSpec A C `{ElemOf A C,
is_fresh (X : C) : fresh X X
}.
(** * Booleans *)
(** The following coercion allows us to use Booleans as propositions. *)
Coercion Is_true : bool >-> Sortclass.
Notation "(&&)" := andb (only parsing).
Notation "(||)" := orb (only parsing).
Infix "&&*" := (zip_with (&&)) (at level 40).
Infix "||*" := (zip_with (||)) (at level 50).
Definition bool_le (β1 β2 : bool) : Prop := negb β1 || β2.
Infix "=.>" := bool_le (at level 70).
Infix "=.>*" := (Forall2 bool_le) (at level 70).
Instance: PartialOrder bool_le.
Proof. repeat split; repeat intros [|]; compute; tauto. Qed.
(** * Miscellaneous *)
Class Half A := half: A A.
Notation "½" := half : C_scope.
......@@ -823,14 +824,6 @@ Section prod_relation.
End prod_relation.
(** ** Other *)
Definition proj_eq {A B} (f : B A) : relation B := λ x y, f x = f y.
Global Instance proj_eq_equivalence `(f : B A) : Equivalence (proj_eq f).
Proof. unfold proj_eq. repeat split; red; intuition congruence. Qed.
Notation "x ~{ f } y" := (proj_eq f x y)
(at level 70, format "x ~{ f } y") : C_scope.
Hint Extern 0 (_ ~{_} _) => reflexivity.
Hint Extern 0 (_ ~{_} _) => symmetry; assumption.
Instance: A B (x : B), Commutative (=) (λ _ _ : A, x).
Proof. red. trivial. Qed.
Instance: A (x : A), Associative (=) (λ _ _ : A, x).
......
......@@ -18,10 +18,8 @@ Section simple_collection.
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: BoundedJoinSemiLattice C.
Proof. firstorder auto. Qed.
Lemma elem_of_subseteq X Y : X Y x, x X x Y.
Proof. done. Qed.
Lemma elem_of_equiv X Y : X Y x, x X x Y.
......@@ -31,7 +29,12 @@ Section simple_collection.
Proof. firstorder. Qed.
Lemma elem_of_equiv_empty X : X x, x X.
Proof. firstorder. Qed.
Lemma collection_positive_l X Y : X Y X .
Proof.
rewrite !elem_of_equiv_empty. setoid_rewrite elem_of_union. naive_solver.
Qed.
Lemma collection_positive_l_alt X Y : X X Y .
Proof. eauto using collection_positive_l. Qed.
Lemma elem_of_subseteq_singleton x X : x X {[ x ]} X.
Proof.
split.
......@@ -42,7 +45,6 @@ Section simple_collection.
Proof. by repeat intro; subst. Qed.
Global Instance elem_of_proper: Proper ((=) ==> () ==> iff) () | 5.
Proof. intros ???; subst. firstorder. Qed.
Lemma elem_of_union_list Xs x : x Xs X, X Xs x X.
Proof.
split.
......@@ -51,7 +53,6 @@ Section simple_collection.
* intros [X []]. induction 1; simpl; [by apply elem_of_union_l |].
intros. apply elem_of_union_r; auto.
Qed.
Lemma non_empty_singleton x : {[ x ]} .
Proof. intros [E _]. by apply (elem_of_empty x), E, elem_of_singleton. Qed.
Lemma not_elem_of_singleton x y : x {[ y ]} x y.
......@@ -68,6 +69,10 @@ Section simple_collection.
Proof. unfold_leibniz. apply elem_of_equiv_alt. Qed.
Lemma elem_of_equiv_empty_L X : X = x, x X.
Proof. unfold_leibniz. apply elem_of_equiv_empty. Qed.
Lemma collection_positive_l_L X Y : X Y = X = .
Proof. unfold_leibniz. apply collection_positive_l. Qed.
Lemma collection_positive_l_alt_L X Y : X X Y .
Proof. unfold_leibniz. apply collection_positive_l_alt. Qed.
Lemma non_empty_singleton_L x : {[ x ]} .
Proof. unfold_leibniz. apply non_empty_singleton. Qed.
End leibniz.
......@@ -385,7 +390,7 @@ Section quantifiers.
End quantifiers.
Section more_quantifiers.
Context `{Collection A B}.
Context `{SimpleCollection A B}.
Lemma set_Forall_weaken (P Q : A Prop) (Hweaken : x, P x Q x) X :
set_Forall P X set_Forall Q X.
......
......@@ -6,8 +6,6 @@ principles on finite collections . *)
Require Import Permutation ars listset.
Require Export numbers collections.
Definition collection_choose `{Elements A C} (X : C) : option A :=
head (elements X).
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.
......@@ -18,76 +16,56 @@ Context `{FinCollection A C}.
Global Instance elements_proper: Proper (() ==> ()) elements.
Proof.
intros ?? E. apply NoDup_Permutation.
* apply elements_nodup.
* apply elements_nodup.
* intros. by rewrite <-!elements_spec, E.
* apply NoDup_elements.
* apply NoDup_elements.
* intros. by rewrite !elem_of_elements, E.
Qed.
Global Instance collection_size_proper: Proper (() ==> (=)) size.
Proof. intros ?? E. apply Permutation_length. by rewrite E. Qed.
Lemma size_empty : size ( : C) = 0.
Proof.
unfold size, collection_size. simpl.
rewrite (elem_of_nil_inv (elements )); [done |].
intro. rewrite <-elements_spec. solve_elem_of.
intro. rewrite elem_of_elements. solve_elem_of.
Qed.
Lemma size_empty_inv (X : C) : size X = 0 X .
Proof.
intros. apply equiv_empty. intro. rewrite elements_spec.
intros. apply equiv_empty. intro. rewrite <-elem_of_elements.
rewrite (nil_length_inv (elements X)). by rewrite elem_of_nil. done.
Qed.
Lemma size_empty_iff (X : C) : size X = 0 X .
Proof. split. apply size_empty_inv. intros E. by rewrite E, 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.
change (length (elements {[ x ]}) = length [x]).
apply Permutation_length, NoDup_Permutation.
* apply elements_nodup.
* apply NoDup_elements.
* apply NoDup_singleton.
* intros.
by rewrite <-elements_spec, elem_of_singleton, elem_of_list_singleton.
* intros. by rewrite elem_of_elements,
elem_of_singleton, elem_of_list_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 !elements_spec.
unfold size, collection_size. simpl. rewrite <-!elem_of_elements.
generalize (elements X). intros [|? l]; intro; simplify_equality.
rewrite (nil_length_inv l), !elem_of_list_singleton by done. congruence.
Qed.
Lemma collection_choose_Some X x : collection_choose X = Some x x X.
Proof.
unfold collection_choose. destruct (elements X) eqn:E; intros;
simplify_equality. rewrite elements_spec, E. by left.
Qed.
Lemma collection_choose_None X : collection_choose X = None X .
Proof.
unfold collection_choose.
destruct (elements X) eqn:E; intros; simplify_equality.
apply equiv_empty. intros x. by rewrite elements_spec, E, elem_of_nil.
Qed.
Lemma elem_of_or_empty X : ( x, x X) X .
Proof.
destruct (collection_choose X) eqn:?;
eauto using collection_choose_Some, collection_choose_None.
Qed.
Lemma collection_choose_is_Some X : X is_Some (collection_choose X).
Proof.
destruct (collection_choose X) eqn:?.
* rewrite elem_of_equiv_empty. split; eauto using collection_choose_Some.
* split. intros []; eauto using collection_choose_None. by intros [??].
Qed.
Lemma not_elem_of_equiv_empty X : X ( x, x X).
Lemma collection_choose_or_empty X : ( x, x X) X .
Proof.
destruct (elem_of_or_empty X) as [?|E]; [esolve_elem_of |].
setoid_rewrite E. setoid_rewrite elem_of_empty. naive_solver.
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 E1. apply not_elem_of_equiv_empty. intros E2.
rewrite E2, size_empty in E1. lia.
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.
......@@ -96,27 +74,24 @@ Proof.
* rewrite elem_of_singleton. eauto using size_singleton_inv.
* solve_elem_of.
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 elements_nodup.
* apply NoDup_app; repeat split; try apply elements_nodup.
intros x. rewrite <-!elements_spec. esolve_elem_of.
* intros. rewrite elem_of_app, <-!elements_spec. solve_elem_of.
* apply NoDup_elements.
* apply NoDup_app; repeat split; try apply NoDup_elements.
intros x. rewrite !elem_of_elements. esolve_elem_of.
* intros. rewrite elem_of_app, !elem_of_elements. solve_elem_of.
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 (elements_spec _).
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 with
| left E1 => left _
| right E1 => right _
| left E1 => left _ | right E1 => right _
end.
Next Obligation.
intros x Ex; apply dec_stable; intro. destruct (proj1 (elem_of_empty x)).
......@@ -126,14 +101,12 @@ Next Obligation.
intros 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 solve_elem_of.
setoid_replace (Y X) with ((Y X) X) by esolve_elem_of.
rewrite <-union_difference, (commutative ()); solve_elem_of.
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.
......@@ -143,22 +116,19 @@ Proof.
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 (elem_of_or_empty X) as [[x ?]|HX].
intros X IH. destruct (collection_choose_or_empty X) as [[x ?]|HX].
* rewrite (union_difference {[ x ]} X) by solve_elem_of.
apply Hadd. solve_elem_of. apply IH. esolve_elem_of.
* 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))
......@@ -166,7 +136,8 @@ Lemma collection_fold_ind {B} (P : B → C → Prop) (f : A → B → B) (b : B)
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 elements_nodup. apply elements_spec. }
{ 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. esolve_elem_of.
......@@ -174,25 +145,23 @@ Proof.
rewrite (union_difference {[ x ]} X) by esolve_elem_of.
apply Hadd. solve_elem_of. apply IH. esolve_elem_of.
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).
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 elements_spec;
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 elements_spec;
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 :
......
This diff is collapsed.
......@@ -5,11 +5,11 @@ Obligation Tactic := idtac.
Class Finite A `{ x y : A, Decision (x = y)} := {
enum : list A;
enum_nodup : NoDup enum;
NoDup_enum : NoDup enum;
elem_of_enum x : x enum
}.
Arguments enum _ {_ _} : clear implicits.
Arguments enum_nodup _ {_ _} : clear implicits.
Arguments NoDup_enum _ {_ _} : clear implicits.
Definition card A `{Finite A} := length (enum A).
Program Instance finite_countable `{Finite A} : Countable A := {|
encode := λ x, Pos.of_nat $ S $ from_option 0 $ list_find (x =) (enum A);
......@@ -72,7 +72,7 @@ Qed.
Lemma finite_injective_contains `{finA: Finite A} `{finB: Finite B} (f: A B)
`{!Injective (=) (=) f} : f <$> enum A `contains` enum B.
Proof.
intros. destruct finA, finB. apply NoDup_contains; auto using fmap_nodup_2.
intros. destruct finA, finB. apply NoDup_contains; auto using NoDup_fmap_2.
Qed.
Lemma finite_injective_Permutation `{Finite A} `{Finite B} (f : A B)
`{!Injective (=) (=) f} : card A = card B f <$> enum A enum B.
......@@ -181,7 +181,7 @@ Section bijective_finite.
Context `{!Injective (=) (=) f} `{!Cancel (=) f g}.
Program Instance bijective_finite: Finite B := {| enum := f <$> enum A |}.
Next Obligation. apply (fmap_nodup _), enum_nodup. Qed.
Next Obligation. apply (NoDup_fmap_2 _), NoDup_enum. Qed.
Next Obligation.
intros y. rewrite elem_of_list_fmap. eauto using elem_of_enum.
Qed.
......@@ -192,7 +192,7 @@ Program Instance option_finite `{Finite A} : Finite (option A) :=
Next Obligation.
constructor.
* rewrite elem_of_list_fmap. by intros (?&?&?).
* apply (fmap_nodup _); auto using enum_nodup.
* apply (NoDup_fmap_2 _); auto using NoDup_enum.
Qed.
Next Obligation.
intros ??? [x|]; [right|left]; auto.
......@@ -219,9 +219,9 @@ Program Instance sum_finite `{Finite A} `{Finite B} : Finite (A + B)%type :=
{| enum := (inl <$> enum A) ++ (inr <$> enum B) |}.
Next Obligation.
intros. apply NoDup_app; split_ands.
* apply (fmap_nodup _). by apply enum_nodup.
* apply (NoDup_fmap_2 _). by apply NoDup_enum.
* intro. rewrite !elem_of_list_fmap. intros (?&?&?) (?&?&?); congruence.
* apply (fmap_nodup _). by apply enum_nodup.
* apply (NoDup_fmap_2 _). by apply NoDup_enum.
Qed.
Next Obligation.
intros ?????? [x|y]; rewrite elem_of_app, !elem_of_list_fmap;
......@@ -233,10 +233,10 @@ Proof. unfold card. simpl. by rewrite app_length, !fmap_length. Qed.
Program Instance prod_finite `{Finite A} `{Finite B} : Finite (A * B)%type :=
{| enum := foldr (λ x, (pair x <$> enum B ++)) [] (enum A) |}.
Next Obligation.
intros ??????. induction (enum_nodup A) as [|x xs Hx Hxs IH]; simpl.
intros ??????. induction (NoDup_enum A) as [|x xs Hx Hxs IH]; simpl.
{ constructor. }
apply NoDup_app; split_ands.
* apply (fmap_nodup _). by apply enum_nodup.
* by apply (NoDup_fmap_2 _), NoDup_enum.
* intros [? y]. rewrite elem_of_list_fmap. intros (?&?&?); simplify_equality.
clear IH. induction Hxs as [|x' xs ?? IH]; simpl.
{ rewrite elem_of_nil. tauto. }
......@@ -268,9 +268,9 @@ Program Instance list_finite `{Finite A} n : Finite { l | length l = n } :=
Next Obligation.
intros ????. induction n as [|n IH]; simpl; [apply NoDup_singleton |].
revert IH. generalize (list_enum (enum A) n). intros l Hl.
induction (enum_nodup A) as [|x xs Hx Hxs IH]; simpl; auto; [constructor |].
induction (NoDup_enum A) as [|x xs Hx Hxs IH]; simpl; auto; [constructor |].
apply NoDup_app; split_ands.
* by apply (fmap_nodup _).
* by apply (NoDup_fmap_2 _).
* intros [k1 Hk1]. clear Hxs IH. rewrite elem_of_list_fmap.
intros ([k2 Hk2]&?&?) Hxk2; simplify_equality. destruct Hx. revert Hxk2.
induction xs as [|x' xs IH]; simpl in *; [by rewrite elem_of_nil |].
......
This diff is collapsed.
(* Copyright (c) 2012-2014, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
(** This file implements finite as unordered lists without duplicates
(** This file implements finite set as unordered lists without duplicates
removed. This implementation forms a monad. *)
Require Export base decidable collections list.
......@@ -48,8 +48,8 @@ Global Instance: FinCollection A (listset A).
Proof.
split.
* apply _.
* symmetry. apply elem_of_remove_dups.
* intros. apply remove_dups_nodup.
* intros. apply elem_of_remove_dups.
* intros. apply NoDup_remove_dups.
Qed.
Global Instance: CollectionOps A (listset A).
Proof.
......
......@@ -14,52 +14,34 @@ Arguments listset_nodup_prf {_} _.
Section list_collection.
Context {A : Type} `{ x y : A, Decision (x = y)}.
Notation C := (listset_nodup A).
Notation LS := ListsetNoDup.
Instance listset_nodup_elem_of: ElemOf A C := λ x l, x listset_nodup_car l.
Instance listset_nodup_empty: Empty C := LS [] (@NoDup_nil_2 _).
Instance listset_nodup_empty: Empty C := ListsetNoDup [] (@NoDup_nil_2 _).
Instance listset_nodup_singleton: Singleton A C := λ x,
LS [x] (NoDup_singleton x).
Instance listset_nodup_difference: Difference C := λ l k,
let (l',Hl) := l in let (k',Hk) := k in LS _ (list_difference_nodup _ k' Hl).
Definition listset_nodup_union_raw (l k : list A) : list A :=
list_difference l k ++ k.
Lemma elem_of_listset_nodup_union_raw l k x :
x listset_nodup_union_raw l k x l x k.
Proof.
unfold listset_nodup_union_raw.
rewrite elem_of_app, elem_of_list_difference.
intuition. case (decide (x k)); intuition.
Qed.
Lemma listset_nodup_union_raw_nodup l k :
NoDup l NoDup k NoDup (listset_nodup_union_raw l k).
Proof.
intros. apply NoDup_app. repeat split.
* by apply list_difference_nodup.
* intro. rewrite elem_of_list_difference. intuition.
* done.
Qed.
ListsetNoDup [x] (NoDup_singleton x).
Instance listset_nodup_union: Union C := λ l k,
let (l',Hl) := l in let (k',Hk) := k
in LS _ (listset_nodup_union_raw_nodup _ _ Hl Hk).
in ListsetNoDup _ (NoDup_list_union _ _ Hl Hk).
Instance listset_nodup_intersection: Intersection C := λ l k,
let (l',Hl) := l in let (k',Hk) := k
in LS _ (list_intersection_nodup _ k' Hl).
in ListsetNoDup _ (NoDup_list_intersection _ k' Hl).
Instance listset_nodup_difference: Difference C := λ l k,
let (l',Hl) := l in let (k',Hk) := k
in ListsetNoDup _ (NoDup_list_difference _ k' Hl).
Instance listset_nodup_intersection_with: IntersectionWith A C := λ f l k,
let (l',Hl) := l in let (k',Hk) := k
in LS (remove_dups (list_intersection_with f l' k')) (remove_dups_nodup _).
in ListsetNoDup
(remove_dups (list_intersection_with f l' k')) (NoDup_remove_dups _).
Instance listset_nodup_filter: Filter A C := λ P _ l,
let (l',Hl) := l in LS _ (filter_nodup P _ Hl).
let (l',Hl) := l in ListsetNoDup _ (NoDup_filter P _ Hl).
Instance: Collection A C.
Proof.
split; [split | | ].
* by apply not_elem_of_nil.
* by apply elem_of_list_singleton.
* intros [??] [??] ?. apply elem_of_listset_nodup_union_raw.
* intros [??] [??] ?. apply elem_of_list_union.
* intros [??] [??] ?. apply elem_of_list_intersection.
* intros [??] [??] ?. apply elem_of_list_difference.
Qed.
......
......@@ -17,17 +17,17 @@ Instance mapset_elem_of: ElemOf K (mapset M) := λ x X,
Instance mapset_empty: Empty (mapset M) := Mapset .
Instance mapset_singleton: Singleton K (mapset M) := λ x, Mapset {[ (x,()) ]}.
Instance mapset_union: Union (mapset M) := λ X1 X2,
match X1, X2 with Mapset m1, Mapset m2 => Mapset (m1 m2) end.
let (m1) := X1 in let (m2) := X2 in Mapset (m1 m2).
Instance mapset_intersection: Intersection (mapset M) := λ X1 X2,
match X1, X2 with Mapset m1, Mapset m2 => Mapset (m1 m2) end.
let (m1) := X1 in let (m2) := X2 in Mapset (m1 m2).
Instance mapset_difference: Difference (mapset M) := λ X1 X2,
match X1, X2 with Mapset m1, Mapset m2 => Mapset (m1 m2) end.
let (m1) := X1 in let (m2) := X2 in Mapset (m1 m2).
Instance mapset_elems: Elements K (mapset M) := λ X,
match X with Mapset m => fst <$> map_to_list m end.
let (m) := X in fst <$> map_to_list m.
Lemma mapset_eq (X1 X2 : mapset M) : X1 = X2 x, x X1 x X2.
Proof.
split; [by intros; subst |].
split; [by intros ->|].
destruct X1 as [m1], X2 as [m2]. simpl. intros E.
f_equal. apply map_eq. intros i. apply option_eq. intros []. by apply E.
Qed.
......@@ -61,46 +61,42 @@ Proof.
intros [m1] [m2] ?. simpl. rewrite lookup_difference_Some.
destruct (m2 !! x) as [[]|]; intuition congruence.
Qed.
Global Instance: PartialOrder (@subseteq (mapset M) _).
Proof. split; try apply _. intros ????. apply mapset_eq. intuition. Qed.
Global Instance: FinCollection K (mapset M).
Proof.
split.
* apply _.
* unfold elements, elem_of at 1, mapset_elems, mapset_elem_of.
* unfold elements, elem_of at 2, mapset_elems, mapset_elem_of.
intros [m] x. simpl. rewrite elem_of_list_fmap. split.
+ intros. exists (x, ()). by rewrite elem_of_map_to_list.
+ intros ([y []] &?& Hy). subst. by rewrite <-elem_of_map_to_list.
+ intros. exists (x, ()). by rewrite elem_of_map_to_list.
* unfold elements, mapset_elems. intros [m]. simpl.
apply map_to_list_key_nodup.
apply NoDup_fst_map_to_list.
Qed.
Definition mapset_map_with `(f : bool A B) (X : mapset M) : M A M B :=
match X with
| Mapset m => merge (λ x y,
Definition mapset_map_with {A B} (f: bool A B) (X : mapset M) : M A M B :=
let (m) := X in merge (λ x y,
match x, y with
| Some _, Some a => Some (f true a)
| None, Some a => Some (f false a)
| _, None => None
end) m
end.
Definition mapset_dom_with `(f : A bool) (m : M A) : mapset M :=
end) m.
Definition mapset_dom_with {A} (f : A bool) (m : M A) : mapset M :=
Mapset $ merge (λ x _,
match x with
| Some a => if f a then Some () else None
| None => None
end) m (@empty (M A) _).
Lemma lookup_mapset_map_with `(f : bool A B) X m i :
Lemma lookup_mapset_map_with {A B} (f : bool A B) X m i :
mapset_map_with f X m !! i = f (bool_decide (i X)) <$> m !! i.
Proof.
destruct X as [mX]. unfold mapset_map_with, elem_of, mapset_elem_of.
rewrite lookup_merge by done. simpl.
by case_bool_decide; destruct (mX !! i) as [[]|], (m !! i).
Qed.
Lemma elem_of_mapset_dom_with `(f : A bool) m i :
Lemma elem_of_mapset_dom_with {A} (f : A bool) m i :
i mapset_dom_with f m x, m !! i = Some x f x.
Proof.
unfold mapset_dom_with, elem_of, mapset_elem_of.
......@@ -133,3 +129,4 @@ Hint Extern 1 (Difference (mapset _)) =>
eapply @mapset_difference : typeclass_instances.
Hint Extern 1 (Elements _ (mapset _)) =>
eapply @mapset_elems : typeclass_instances.
Arguments mapset_eq_dec _ _ _ _ : simpl never.
......@@ -197,12 +197,12 @@ Proof.
induction l1 as [|[x|] l1 IH]; intros [|[y|] l2] Hl1 Hl2 E; simpl in *.
+ done.
+ by specialize (E 0).
+ destruct (natmap_wf_lookup (None :: l2)) as [i [??]]; auto with congruence.
+ destruct (natmap_wf_lookup (None :: l2)) as (i&?&?); auto with congruence.
+ by specialize (E 0).
+ f_equal. apply (E 0). apply IH; eauto using natmap_wf_inv.
intros i. apply (E (S i)).
+ by specialize (E 0).
+ destruct (natmap_wf_lookup (None :: l1)) as [i [??]]; auto with congruence.
+ destruct (natmap_wf_lookup (None :: l1)) as (i&?&?); auto with congruence.
+ by specialize (E 0).
+ f_equal. apply IH; eauto using natmap_wf_inv. intros i. apply (E (S i)).
* done.
......@@ -215,16 +215,67 @@ Proof.