Commit 3f3ca628 authored by Robbert Krebbers's avatar Robbert Krebbers

Update to match the article.

The development now corresponds exactly to the FoSSaCS 2013 paper.
Also, the prelude is updated to the one of the master branch.
parent 4cda26dd
......@@ -4,6 +4,7 @@
These are particularly useful as we define the operational semantics as a
small step semantics. This file defines a hint database [ars] containing
some theorems on abstract rewriting systems. *)
Require Import Wf_nat.
Require Export tactics base.
(** * Definitions *)
......@@ -47,13 +48,13 @@ Hint Constructors rtc nsteps bsteps tc : ars.
Section rtc.
Context `{R : relation A}.
Global Instance: Reflexive (rtc R).
Proof rtc_refl R.
Global Instance rtc_trans: Transitive (rtc R).
Proof. red; induction 1; eauto with ars. Qed.
Global Instance rtc_reflexive: Reflexive (rtc R).
Proof. red. apply rtc_refl. Qed.
Global Instance rtc_transitive: Transitive (rtc R).
Proof. red. induction 1; eauto with ars. Qed.
Lemma rtc_once x y : R x y rtc R x y.
Proof. eauto with ars. Qed.
Global Instance: subrelation R (rtc R).
Instance rtc_once_subrel: subrelation R (rtc R).
Proof. exact @rtc_once. Qed.
Lemma rtc_r x y z : rtc R x y R y z rtc R x z.
Proof. intros. etransitivity; eauto with ars. Qed.
......@@ -62,8 +63,9 @@ Section rtc.
Proof. inversion_clear 1; eauto. Qed.
Lemma rtc_ind_r (P : A A Prop)
(Prefl : x, P x x) (Pstep : x y z, rtc R x y R y z P x y P x z) :
y z, rtc R y z P y z.
(Prefl : x, P x x)
(Pstep : x y z, rtc R x y R y z P x y P x z) :
x z, rtc R x z P x z.
Proof.
cut ( y z, rtc R y z x, rtc R x y P x y P x z).
{ eauto using rtc_refl. }
......@@ -99,7 +101,7 @@ Section rtc.
bsteps R n x y bsteps R (m + n) x y.
Proof. apply bsteps_weaken. auto with arith. Qed.
Lemma bsteps_S n x y : bsteps R n x y bsteps R (S n) x y.
Proof. apply bsteps_weaken. auto with arith. Qed.
Proof. apply bsteps_weaken. lia. Qed.
Lemma bsteps_trans n m x y z :
bsteps R n x y bsteps R m y z bsteps R (n + m) x z.
Proof. induction 1; simpl; eauto using bsteps_plus_l with ars. Qed.
......@@ -108,7 +110,31 @@ Section rtc.
Lemma bsteps_rtc n x y : bsteps R n x y rtc R x y.
Proof. induction 1; eauto with ars. Qed.
Lemma rtc_bsteps x y : rtc R x y n, bsteps R n x y.
Proof. induction 1. exists 0. auto with ars. firstorder eauto with ars. Qed.
Proof.
induction 1.
* exists 0. constructor.
* naive_solver eauto with ars.
Qed.
Lemma bsteps_ind_r (P : nat A Prop) (x : A)
(Prefl : n, P n x)
(Pstep : n y z, bsteps R n x y R y z P n y P (S n) z) :
n z, bsteps R n x z P n z.
Proof.
cut ( m y z, bsteps R m y z n,
bsteps R n x y
( m', n m' m' n + m P m' y)
P (n + m) z).
{ intros help ?. change n with (0 + n). eauto with ars. }
induction 1 as [|m x' y z p2 p3 IH]; [by eauto with arith|].
intros n p1 H. rewrite <-plus_n_Sm.
apply (IH (S n)); [by eauto using bsteps_r |].
intros [|m'] [??]; [lia |].
apply Pstep with x'.
* apply bsteps_weaken with n; intuition lia.
* done.
* apply H; intuition lia.
Qed.
Global Instance tc_trans: Transitive (tc R).
Proof. red; induction 1; eauto with ars. Qed.
......@@ -116,7 +142,7 @@ Section rtc.
Proof. intros. etransitivity; eauto with ars. Qed.
Lemma tc_rtc x y : tc R x y rtc R x y.
Proof. induction 1; eauto with ars. Qed.
Global Instance: subrelation (tc R) (rtc R).
Instance tc_once_subrel: subrelation (tc R) (rtc R).
Proof. exact @tc_rtc. Qed.
Lemma looping_red x : looping R x red R x.
......@@ -137,23 +163,73 @@ Section rtc.
Qed.
End rtc.
Hint Resolve rtc_once rtc_r tc_r : ars.
(* Avoid too eager type class resolution *)
Hint Extern 5 (subrelation _ (rtc _)) =>
eapply @rtc_once_subrel : typeclass_instances.
Hint Extern 5 (subrelation _ (tc _)) =>
eapply @tc_once_subrel : typeclass_instances.
Hint Resolve
rtc_once rtc_r
tc_r
bsteps_once bsteps_r bsteps_refl bsteps_trans : ars.
(** * Theorems on sub relations *)
Section subrel.
Context {A} (R1 R2 : relation A) (Hsub : subrelation R1 R2).
Lemma red_subrel x : red R1 x red R2 x.
Proof. intros [y ?]. exists y. now apply Hsub. Qed.
Proof. intros [y ?]. exists y. by apply Hsub. Qed.
Lemma nf_subrel x : nf R2 x nf R1 x.
Proof. intros H1 H2. destruct H1. now apply red_subrel. Qed.
Global Instance rtc_subrel: subrelation (rtc R1) (rtc R2).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed.
Global Instance nsteps_subrel: subrelation (nsteps R1 n) (nsteps R2 n).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed.
Global Instance bsteps_subrel: subrelation (bsteps R1 n) (bsteps R2 n).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed.
Global Instance tc_subrel: subrelation (tc R1) (tc R2).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed.
Proof. intros H1 H2. destruct H1. by apply red_subrel. Qed.
Instance rtc_subrel: subrelation (rtc R1) (rtc R2).
Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
Instance nsteps_subrel: subrelation (nsteps R1 n) (nsteps R2 n).
Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
Instance bsteps_subrel: subrelation (bsteps R1 n) (bsteps R2 n).
Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
Instance tc_subrel: subrelation (tc R1) (tc R2).
Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
End subrel.
Hint Extern 5 (subrelation (rtc _) (rtc _)) =>
eapply @rtc_subrel : typeclass_instances.
Hint Extern 5 (subrelation (nsteps _) (nsteps _)) =>
eapply @nsteps_subrel : typeclass_instances.
Hint Extern 5 (subrelation (bsteps _) (bsteps _)) =>
eapply @bsteps_subrel : typeclass_instances.
Hint Extern 5 (subrelation (tc _) (tc _)) =>
eapply @tc_subrel : typeclass_instances.
Notation wf := well_founded.
Section wf.
Context `{R : relation A}.
(** A trick by Thomas Braibant to compute with well-founded recursions:
it lazily adds [2^n] [Acc_intro] constructors in front of a well foundedness
proof, so that the actual proof is never reached in practise. *)
Fixpoint wf_guard (n : nat) (wfR : wf R) : wf R :=
match n with
| 0 => wfR
| S n => λ x, Acc_intro x (λ y _, wf_guard n (wf_guard n wfR) y)
end.
Lemma wf_projected `(R2 : relation B) (f : A B) :
( x y, R x y R2 (f x) (f y))
wf R2 wf R.
Proof.
intros Hf Hwf.
cut ( y, Acc R2 y x, y = f x Acc R x).
{ intros aux x. apply (aux (f x)); auto. }
induction 1 as [y _ IH]. intros x ?. subst.
constructor. intros. apply (IH (f y)); auto.
Qed.
End wf.
(* Generally we do not want [wf_guard] to be expanded (neither by tactics,
nor by conversion tests in the kernel), but in some cases we do need it for
computation (that is, we cannot make it opaque). We use the [Strategy]
command to make its expanding behavior less eager. *)
Strategy 100 [wf_guard].
This diff is collapsed.
This diff is collapsed.
......@@ -3,7 +3,12 @@
(** This file collects theorems, definitions, tactics, related to propositions
with a decidable equality. Such propositions are collected by the [Decision]
type class. *)
Require Export base.
Require Export base tactics.
Hint Extern 200 (Decision _) => progress (lazy beta) : typeclass_instances.
Lemma dec_stable `{Decision P} : ¬¬P P.
Proof. firstorder. Qed.
(** We introduce [decide_rel] to avoid inefficienct computation due to eager
evaluation of propositions by [vm_compute]. This inefficiency occurs if
......@@ -14,10 +19,10 @@ Definition decide_rel {A B} (R : A → B → Prop) {dec : ∀ x y, Decision (R x
(x : A) (y : B) : Decision (R x y) := dec x y.
Lemma decide_rel_correct {A B} (R : A B Prop) `{ x y, Decision (R x y)}
(x : A) (y : B) : decide_rel R x y = decide (R x y).
Proof. easy. Qed.
Proof. done. Qed.
(** The tactic [case_decide] performs case analysis on an arbitrary occurrence
of [decide] or [decide_rel] in the conclusion or assumptions. *)
of [decide] or [decide_rel] in the conclusion or hypotheses. *)
Ltac case_decide :=
match goal with
| H : context [@decide ?P ?dec] |- _ =>
......@@ -34,21 +39,21 @@ Ltac case_decide :=
with instance resolution to automatically generate decision procedures. *)
Ltac solve_trivial_decision :=
match goal with
| [ |- Decision (?P) ] => apply _
| [ |- sumbool ?P (¬?P) ] => change (Decision P); apply _
| |- Decision (?P) => apply _
| |- sumbool ?P (¬?P) => change (Decision P); apply _
end.
Ltac solve_decision :=
intros; first [ solve_trivial_decision
| unfold Decision; decide equality; solve_trivial_decision ].
Ltac solve_decision := intros; first
[ solve_trivial_decision
| unfold Decision; decide equality; solve_trivial_decision ].
(** We can convert decidable propositions to booleans. *)
Definition bool_decide (P : Prop) {dec : Decision P} : bool :=
if dec then true else false.
Lemma bool_decide_unpack (P : Prop) {dec : Decision P} : bool_decide P P.
Proof. unfold bool_decide. now destruct dec. Qed.
Proof. unfold bool_decide. by destruct dec. Qed.
Lemma bool_decide_pack (P : Prop) {dec : Decision P} : P bool_decide P.
Proof. unfold bool_decide. now destruct dec. Qed.
Proof. unfold bool_decide. by destruct dec. Qed.
(** * Decidable Sigma types *)
(** Leibniz equality on Sigma types requires the equipped proofs to be
......@@ -70,38 +75,57 @@ Proof.
* intro. destruct x as [x Hx], y as [y Hy].
simpl in *. subst. f_equal.
revert Hx Hy. case (bool_decide (P y)).
+ now intros [] [].
+ easy.
+ by intros [] [].
+ done.
Qed.
(** The following combinators are useful to create Decision proofs in
combination with the [refine] tactic. *)
Notation cast_if S := (if S then left _ else right _).
Notation cast_if_and S1 S2 := (if S1 then cast_if S2 else right _).
Notation cast_if_and3 S1 S2 S3 := (if S1 then cast_if_and S2 S3 else right _).
Notation cast_if_and4 S1 S2 S3 S4 :=
(if S1 then cast_if_and3 S2 S3 S4 else right _).
Notation cast_if_or S1 S2 := (if S1 then left _ else cast_if S2).
Notation cast_if_not S := (if S then right _ else left _).
(** * Instances of Decision *)
(** Instances of [Decision] for operators of propositional logic. *)
Program Instance True_dec: Decision True := left _.
Program Instance False_dec: Decision False := right _.
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 intuition.
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 intuition.
Instance True_dec: Decision True := left I.
Instance False_dec: Decision False := right (False_rect False).
Section prop_dec.
Context `(P_dec : Decision P) `(Q_dec : Decision Q).
Global Instance not_dec: Decision (¬P).
Proof. refine (cast_if_not P_dec); intuition. Defined.
Global Instance and_dec: Decision (P Q).
Proof. refine (cast_if_and P_dec Q_dec); intuition. Defined.
Global Instance or_dec: Decision (P Q).
Proof. refine (cast_if_or P_dec Q_dec); intuition. Defined.
Global Instance impl_dec: Decision (P Q).
Proof. refine (if P_dec then cast_if Q_dec else left _); intuition. Defined.
End prop_dec.
(** Instances of [Decision] for common data types. *)
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) :=
match A_dec (fst x) (fst y) with
| left _ =>
match B_dec (snd x) (snd y) with
| left _ => left _
| right _ => right _
end
| right _ => right _
Instance bool_eq_dec (x y : bool) : Decision (x = y).
Proof. solve_decision. Defined.
Instance unit_eq_dec (x y : unit) : Decision (x = y).
Proof. refine (left _); by destruct x, y. Defined.
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).
Proof.
refine (cast_if_and (A_dec (fst x) (fst y)) (B_dec (snd x) (snd y)));
abstract (destruct x, y; simpl in *; congruence).
Defined.
Instance sum_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).
Proof. solve_decision. Defined.
Instance curry_dec `(P_dec : (x : A) (y : B), Decision (P x y)) p :
Decision (curry P p) :=
match p as p return Decision (curry P p) with
| (x,y) => P_dec x y
end.
Solve Obligations using intuition (simpl;congruence).
Instance uncurry_dec `(P_dec : (p : A * B), Decision (P p)) x y :
Decision (uncurry P x y) := P_dec (x,y).
This diff is collapsed.
This diff is collapsed.
(* Copyright (c) 2012, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
(** Given a finite set of binary naturals [N], we generate a fresh element by
taking the maximum, and adding one to it. We declare this operation as an
instance of the type class [Fresh]. *)
Require Export numbers fin_collections.
Definition Nmax `{Elements N C} : C N := collection_fold Nmax 0%N.
Instance Nmax_proper `{FinCollection N C} : Proper (() ==> (=)) Nmax.
Proof.
apply (collection_fold_proper (=)).
* solve_proper.
* intros. rewrite !N.max_assoc. f_equal. apply N.max_comm.
Qed.
Lemma Nmax_max `{FinCollection N C} X x : x X (x Nmax X)%N.
Proof.
apply (collection_fold_ind (λ b X, x X (x b)%N)).
* solve_proper.
* solve_elem_of.
* solve_elem_of (eauto using N.le_max_l, N.le_max_r, N.le_trans).
Qed.
Instance Nfresh `{FinCollection N C} : Fresh N C := λ l, (1 + Nmax l)%N.
Instance Nfresh_spec `{FinCollection N C} : FreshSpec N C.
Proof.
split.
* apply _.
* intros. unfold fresh, Nfresh.
setoid_replace X with Y; [done |].
by apply elem_of_equiv.
* intros X E. assert (1 0)%N as []; [| done].
apply N.add_le_mono_r with (Nmax X).
by apply Nmax_max.
Qed.
This diff is collapsed.
(* Copyright (c) 2012, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
(** This file implements finite as unordered lists without duplicates.
Although this implementation is slow, it is very useful as decidable equality
is the only constraint on the carrier set. *)
Require Export base decidable list collections.
(** This file implements finite as unordered lists without duplicates
removed. This implementation forms a monad. *)
Require Export base decidable collections list.
Definition listset A := sig (@NoDup A).
Record listset A := Listset {
listset_car: list A
}.
Arguments listset_car {_} _.
Arguments Listset {_} _.
Section list_collection.
Context {A : Type} `{ x y : A, Decision (x = y)}.
Section listset.
Context {A : Type}.
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_difference_raw (l k : list A) :=
match l with
| [] => []
| x :: l =>
if decide_rel In x k
then listset_difference_raw l k
else x :: listset_difference_raw l k
Instance listset_elem_of: ElemOf A (listset A) := λ x l,
x listset_car l.
Instance listset_empty: Empty (listset A) :=
Listset [].
Instance listset_singleton: Singleton A (listset A) := λ x,
Listset [x].
Instance listset_union: Union (listset A) := λ l k,
match l, k with
| Listset l', Listset k' => Listset (l' ++ k')
end.
Lemma listset_difference_raw_in l k x :
In x (listset_difference_raw l k) In x l ¬In x k.
Proof.
split; induction l; simpl; try case_decide; simpl; intuition congruence.
Qed.
Lemma listset_difference_raw_nodup l k :
NoDup l NoDup (listset_difference_raw l k).
Proof.
induction 1; simpl; try case_decide.
* constructor.
* easy.
* constructor. rewrite listset_difference_raw_in; intuition. easy.
Qed.
Global Instance listset_difference: Difference (listset A) := λ l k,
listset_difference_raw (`l) (`k)
listset_difference_raw_nodup (`l) (`k) (proj2_sig l).
Definition listset_union_raw (l k : list A) := listset_difference_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_difference_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).
Global Instance: SimpleCollection A (listset A).
Proof.
intros. apply NoDup_app.
* now apply listset_difference_raw_nodup.
* easy.
* intro. rewrite listset_difference_raw_in. intuition.
split.
* by apply not_elem_of_nil.
* by apply elem_of_list_singleton.
* intros [?] [?]. apply elem_of_app.
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_intersection_raw (l k : list A) :=
Context `{ x y : A, Decision (x = y)}.
Instance listset_intersection: Intersection (listset A) := λ l k,
match l, k with
| Listset l', Listset k' => Listset (list_intersection l' k')
end.
Instance listset_difference: Difference (listset A) := λ l k,
match l, k with
| Listset l', Listset k' => Listset (list_difference l' k')
end.
Instance listset_intersection_with: IntersectionWith A (listset A) := λ f l k,
match l, k with
| Listset l', Listset k' => Listset (list_intersection_with f l' k')
end.
Instance listset_filter: Filter A (listset A) := λ P _ l,
match l with
| [] => []
| x :: l =>
if decide_rel In x k
then x :: listset_intersection_raw l k
else listset_intersection_raw l k
| Listset l' => Listset (filter P l')
end.
Lemma listset_intersection_raw_in l k x :
In x (listset_intersection_raw l k) In x l In x k.
Proof.
split; induction l; simpl; try case_decide; simpl; intuition congruence.
Qed.
Lemma listset_intersection_raw_nodup l k :
NoDup l NoDup (listset_intersection_raw l k).
Global Instance: Collection A (listset A).
Proof.
induction 1; simpl; try case_decide.
* constructor.
* constructor. rewrite listset_intersection_raw_in; intuition. easy.
* easy.
split.
* apply _.
* intros [?] [?]. apply elem_of_list_intersection.
* intros [?] [?]. apply elem_of_list_difference.
* intros ? [?] [?]. apply elem_of_list_intersection_with.
Qed.
Global Instance listset_intersection: Intersection (listset A) := λ l k,
listset_intersection_raw (`l) (`k)
listset_intersection_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; firstorder congruence. Qed.
Lemma listset_add_raw_nodup x l : NoDup l NoDup (listset_add_raw x l).
Instance listset_elems: Elements A (listset A) :=
remove_dups listset_car.
Global Instance: FinCollection A (listset A).
Proof.
unfold listset_add_raw. case_decide; try constructor; firstorder.
split.
* apply _.
* intros [?] ??. apply elem_of_list_filter.
* symmetry. apply elem_of_remove_dups.
* intros. apply remove_dups_nodup.
Qed.
End listset.
(** These instances are declared using [Hint Extern] to avoid too
eager type class search. *)
Hint Extern 1 (ElemOf _ (listset _)) =>
eapply @listset_elem_of : typeclass_instances.
Hint Extern 1 (Empty (listset _)) =>
eapply @listset_empty : typeclass_instances.
Hint Extern 1 (Singleton _ (listset _)) =>
eapply @listset_singleton : typeclass_instances.
Hint Extern 1 (Union (listset _)) =>
eapply @listset_union : typeclass_instances.
Hint Extern 1 (Intersection (listset _)) =>
eapply @listset_intersection : typeclass_instances.
Hint Extern 1 (IntersectionWith _ (listset _)) =>
eapply @listset_intersection_with : typeclass_instances.
Hint Extern 1 (Difference (listset _)) =>
eapply @listset_difference : typeclass_instances.
Hint Extern 1 (Elements _ (listset _)) =>
eapply @listset_elems : typeclass_instances.
Hint Extern 1 (Filter _ (listset _)) =>
eapply @listset_filter : typeclass_instances.
Fixpoint listset_map_raw (f : A A) (l : list A) :=
Instance listset_ret: MRet listset := λ A x,
{[ x ]}.
Instance listset_fmap: FMap listset := λ A B f l,
match l with
| [] => []
| x :: l => listset_add_raw (f x) (listset_map_raw f l)
| Listset l' => Listset (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).
Instance listset_bind: MBind listset := λ A B f l,
match l with
| Listset l' => Listset (mbind (listset_car f) l')
end.
Instance listset_join: MJoin listset := λ A, mbind id.
Global Instance: Collection A (listset A).
Instance: CollectionMonad listset.
Proof.
split.
* easy.
* compute. intuition.
* intros. apply listset_union_raw_in.
* intros. apply listset_intersection_raw_in.
* intros. apply listset_difference_raw_in.
* intros. apply listset_map_raw_in.
* intros. apply _.
* intros ??? [?] ?. apply elem_of_list_bind.
* intros. apply elem_of_list_ret.
* intros ??? [?]. apply elem_of_list_fmap.
* intros ? [?] ?.
unfold mjoin, listset_join, elem_of, listset_elem_of.
simpl. by rewrite elem_of_list_bind.
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.
(* Copyright (c) 2012, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
(** This file implements finite as unordered lists without duplicates.
Although this implementation is slow, it is very useful as decidable equality
is the only constraint on the carrier set. *)
Require Export base decidable collections list.
Record listset_nodup A := ListsetNoDup {
listset_nodup_car : list A;
listset_nodup_prf : NoDup listset_nodup_car
}.
Arguments ListsetNoDup {_} _ _.
Arguments listset_nodup_car {_} _.
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_singleton: Singleton A C := λ x,
LS [x] (NoDup_singleton x).
Instance listset_nodup_difference: Difference C := λ l k,
LS _ (list_difference_nodup _ (listset_nodup_car k) (listset_nodup_prf l)).
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.
Instance listset_nodup_union: Union C := λ l k,
LS _ (listset_nodup_union_raw_nodup _ _
(listset_nodup_prf l) (listset_nodup_prf k)).
Instance listset_nodup_intersection: Intersection C := λ l k,
LS _ (list_intersection_nodup _
(listset_nodup_car k) (listset_nodup_prf l)).