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 @@ ...@@ -4,6 +4,7 @@
These are particularly useful as we define the operational semantics as a These are particularly useful as we define the operational semantics as a
small step semantics. This file defines a hint database [ars] containing small step semantics. This file defines a hint database [ars] containing
some theorems on abstract rewriting systems. *) some theorems on abstract rewriting systems. *)
Require Import Wf_nat.
Require Export tactics base. Require Export tactics base.
(** * Definitions *) (** * Definitions *)
...@@ -47,13 +48,13 @@ Hint Constructors rtc nsteps bsteps tc : ars. ...@@ -47,13 +48,13 @@ Hint Constructors rtc nsteps bsteps tc : ars.
Section rtc. Section rtc.
Context `{R : relation A}. Context `{R : relation A}.
Global Instance: Reflexive (rtc R). Global Instance rtc_reflexive: Reflexive (rtc R).
Proof rtc_refl R. Proof. red. apply rtc_refl. Qed.
Global Instance rtc_trans: Transitive (rtc R). Global Instance rtc_transitive: Transitive (rtc R).
Proof. red; induction 1; eauto with ars. Qed. Proof. red. induction 1; eauto with ars. Qed.
Lemma rtc_once x y : R x y rtc R x y. Lemma rtc_once x y : R x y rtc R x y.
Proof. eauto with ars. Qed. Proof. eauto with ars. Qed.
Global Instance: subrelation R (rtc R). Instance rtc_once_subrel: subrelation R (rtc R).
Proof. exact @rtc_once. Qed. Proof. exact @rtc_once. Qed.
Lemma rtc_r x y z : rtc R x y R y z rtc R x z. Lemma rtc_r x y z : rtc R x y R y z rtc R x z.
Proof. intros. etransitivity; eauto with ars. Qed. Proof. intros. etransitivity; eauto with ars. Qed.
...@@ -62,8 +63,9 @@ Section rtc. ...@@ -62,8 +63,9 @@ Section rtc.
Proof. inversion_clear 1; eauto. Qed. Proof. inversion_clear 1; eauto. Qed.
Lemma rtc_ind_r (P : A A Prop) 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) : (Prefl : x, P x x)
y z, rtc R y z P y z. (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. Proof.
cut ( y z, rtc R y z x, rtc R x y P x y P x z). cut ( y z, rtc R y z x, rtc R x y P x y P x z).
{ eauto using rtc_refl. } { eauto using rtc_refl. }
...@@ -99,7 +101,7 @@ Section rtc. ...@@ -99,7 +101,7 @@ Section rtc.
bsteps R n x y bsteps R (m + n) x y. bsteps R n x y bsteps R (m + n) x y.
Proof. apply bsteps_weaken. auto with arith. Qed. 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. 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 : Lemma bsteps_trans n m x y z :
bsteps R n x y bsteps R m y z bsteps R (n + m) x 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. Proof. induction 1; simpl; eauto using bsteps_plus_l with ars. Qed.
...@@ -108,7 +110,31 @@ Section rtc. ...@@ -108,7 +110,31 @@ Section rtc.
Lemma bsteps_rtc n x y : bsteps R n x y rtc R x y. Lemma bsteps_rtc n x y : bsteps R n x y rtc R x y.
Proof. induction 1; eauto with ars. Qed. Proof. induction 1; eauto with ars. Qed.
Lemma rtc_bsteps x y : rtc R x y n, bsteps R n x y. 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). Global Instance tc_trans: Transitive (tc R).
Proof. red; induction 1; eauto with ars. Qed. Proof. red; induction 1; eauto with ars. Qed.
...@@ -116,7 +142,7 @@ Section rtc. ...@@ -116,7 +142,7 @@ Section rtc.
Proof. intros. etransitivity; eauto with ars. Qed. Proof. intros. etransitivity; eauto with ars. Qed.
Lemma tc_rtc x y : tc R x y rtc R x y. Lemma tc_rtc x y : tc R x y rtc R x y.
Proof. induction 1; eauto with ars. Qed. 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. Proof. exact @tc_rtc. Qed.
Lemma looping_red x : looping R x red R x. Lemma looping_red x : looping R x red R x.
...@@ -137,23 +163,73 @@ Section rtc. ...@@ -137,23 +163,73 @@ Section rtc.
Qed. Qed.
End rtc. 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 *) (** * Theorems on sub relations *)
Section subrel. Section subrel.
Context {A} (R1 R2 : relation A) (Hsub : subrelation R1 R2). Context {A} (R1 R2 : relation A) (Hsub : subrelation R1 R2).
Lemma red_subrel x : red R1 x red R2 x. 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. Lemma nf_subrel x : nf R2 x nf R1 x.
Proof. intros H1 H2. destruct H1. now apply red_subrel. Qed. Proof. intros H1 H2. destruct H1. by apply red_subrel. Qed.
Global Instance rtc_subrel: subrelation (rtc R1) (rtc R2). Instance rtc_subrel: subrelation (rtc R1) (rtc R2).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed. Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
Global Instance nsteps_subrel: subrelation (nsteps R1 n) (nsteps R2 n). Instance nsteps_subrel: subrelation (nsteps R1 n) (nsteps R2 n).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed. Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
Global Instance bsteps_subrel: subrelation (bsteps R1 n) (bsteps R2 n). Instance bsteps_subrel: subrelation (bsteps R1 n) (bsteps R2 n).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed. Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
Global Instance tc_subrel: subrelation (tc R1) (tc R2). Instance tc_subrel: subrelation (tc R1) (tc R2).
Proof. induction 1; [left|eright]; eauto; now apply Hsub. Qed. Proof. induction 1; [left|eright]; eauto; by apply Hsub. Qed.
End subrel. 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 @@ ...@@ -3,7 +3,12 @@
(** This file collects theorems, definitions, tactics, related to propositions (** This file collects theorems, definitions, tactics, related to propositions
with a decidable equality. Such propositions are collected by the [Decision] with a decidable equality. Such propositions are collected by the [Decision]
type class. *) 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 (** We introduce [decide_rel] to avoid inefficienct computation due to eager
evaluation of propositions by [vm_compute]. This inefficiency occurs if 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 ...@@ -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. (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)} 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). (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 (** 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 := Ltac case_decide :=
match goal with match goal with
| H : context [@decide ?P ?dec] |- _ => | H : context [@decide ?P ?dec] |- _ =>
...@@ -34,21 +39,21 @@ Ltac case_decide := ...@@ -34,21 +39,21 @@ Ltac case_decide :=
with instance resolution to automatically generate decision procedures. *) with instance resolution to automatically generate decision procedures. *)
Ltac solve_trivial_decision := Ltac solve_trivial_decision :=
match goal with match goal with
| [ |- Decision (?P) ] => apply _ | |- Decision (?P) => apply _
| [ |- sumbool ?P (¬?P) ] => change (Decision P); apply _ | |- sumbool ?P (¬?P) => change (Decision P); apply _
end. end.
Ltac solve_decision := Ltac solve_decision := intros; first
intros; first [ solve_trivial_decision [ solve_trivial_decision
| unfold Decision; decide equality; solve_trivial_decision ]. | unfold Decision; decide equality; solve_trivial_decision ].
(** We can convert decidable propositions to booleans. *) (** We can convert decidable propositions to booleans. *)
Definition bool_decide (P : Prop) {dec : Decision P} : bool := Definition bool_decide (P : Prop) {dec : Decision P} : bool :=
if dec then true else false. if dec then true else false.
Lemma bool_decide_unpack (P : Prop) {dec : Decision P} : bool_decide P P. 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. 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 *) (** * Decidable Sigma types *)
(** Leibniz equality on Sigma types requires the equipped proofs to be (** Leibniz equality on Sigma types requires the equipped proofs to be
...@@ -70,38 +75,57 @@ Proof. ...@@ -70,38 +75,57 @@ Proof.
* intro. destruct x as [x Hx], y as [y Hy]. * intro. destruct x as [x Hx], y as [y Hy].
simpl in *. subst. f_equal. simpl in *. subst. f_equal.
revert Hx Hy. case (bool_decide (P y)). revert Hx Hy. case (bool_decide (P y)).
+ now intros [] []. + by intros [] [].
+ easy. + done.
Qed. 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 *)
(** Instances of [Decision] for operators of propositional logic. *) (** Instances of [Decision] for operators of propositional logic. *)
Program Instance True_dec: Decision True := left _. Instance True_dec: Decision True := left I.
Program Instance False_dec: Decision False := right _. Instance False_dec: Decision False := right (False_rect False).
Program Instance and_dec `(P_dec : Decision P) `(Q_dec : Decision Q) :
Decision (P Q) := Section prop_dec.
match P_dec with Context `(P_dec : Decision P) `(Q_dec : Decision Q).
| left _ => match Q_dec with left _ => left _ | right _ => right _ end
| right _ => right _ Global Instance not_dec: Decision (¬P).
end. Proof. refine (cast_if_not P_dec); intuition. Defined.
Solve Obligations using intuition. Global Instance and_dec: Decision (P Q).
Program Instance or_dec `(P_dec : Decision P) `(Q_dec : Decision Q) : Proof. refine (cast_if_and P_dec Q_dec); intuition. Defined.
Decision (P Q) := Global Instance or_dec: Decision (P Q).
match P_dec with Proof. refine (cast_if_or P_dec Q_dec); intuition. Defined.
| left _ => left _ Global Instance impl_dec: Decision (P Q).
| right _ => match Q_dec with left _ => left _ | right _ => right _ end Proof. refine (if P_dec then cast_if Q_dec else left _); intuition. Defined.
end. End prop_dec.
Solve Obligations using intuition.
(** Instances of [Decision] for common data types. *) (** Instances of [Decision] for common data types. *)
Program Instance prod_eq_dec `(A_dec : x y : A, Decision (x = y)) Instance bool_eq_dec (x y : bool) : Decision (x = y).
`(B_dec : x y : B, Decision (x = y)) (x y : A * B) : Decision (x = y) := Proof. solve_decision. Defined.
match A_dec (fst x) (fst y) with Instance unit_eq_dec (x y : unit) : Decision (x = y).
| left _ => Proof. refine (left _); by destruct x, y. Defined.
match B_dec (snd x) (snd y) with Instance prod_eq_dec `(A_dec : x y : A, Decision (x = y))
| left _ => left _ `(B_dec : x y : B, Decision (x = y)) (x y : A * B) : Decision (x = y).
| right _ => right _ Proof.
end refine (cast_if_and (A_dec (fst x) (fst y)) (B_dec (snd x) (snd y)));
| right _ => right _ 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. 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. *) (* Copyright (c) 2012, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *) (* This file is distributed under the terms of the BSD license. *)
(** This file implements finite as unordered lists without duplicates. (** This file implements finite as unordered lists without duplicates
Although this implementation is slow, it is very useful as decidable equality removed. This implementation forms a monad. *)
is the only constraint on the carrier set. *) Require Export base decidable collections list.
Require Export base decidable list collections.
Definition listset A := sig (@NoDup A). Record listset A := Listset {
listset_car: list A
}.
Arguments listset_car {_} _.
Arguments Listset {_} _.
Section list_collection. Section listset.
Context {A : Type} `{ x y : A, Decision (x = y)}. Context {A : Type}.
Global Instance listset_elem_of: ElemOf A (listset A) := λ x l, In x (`l). Instance listset_elem_of: ElemOf A (listset A) := λ x l,
Global Instance listset_empty: Empty (listset A) := []@NoDup_nil _. x listset_car l.
Global Instance listset_singleton: Singleton A (listset A) := λ x, Instance listset_empty: Empty (listset A) :=
[x]NoDup_singleton x. Listset [].
Instance listset_singleton: Singleton A (listset A) := λ x,
Fixpoint listset_difference_raw (l k : list A) := Listset [x].
match l with Instance listset_union: Union (listset A) := λ l k,
| [] => [] match l, k with
| x :: l => | Listset l', Listset k' => Listset (l' ++ k')
if decide_rel In x k
then listset_difference_raw l k
else x :: listset_difference_raw l k
end. 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. Global Instance: SimpleCollection A (listset A).
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).
Proof. Proof.
intros. apply NoDup_app. split.
* now apply listset_difference_raw_nodup. * by apply not_elem_of_nil.
* easy. * by apply elem_of_list_singleton.
* intro. rewrite listset_difference_raw_in. intuition. * intros [?] [?]. apply elem_of_app.
Qed. 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 match l with
| [] => [] | Listset l' => Listset (filter P l')
| x :: l =>
if decide_rel In x k
then x :: listset_intersection_raw l k
else listset_intersection_raw l k
end. end.
Lemma listset_intersection_raw_in l k x :
In x (listset_intersection_raw l k) In x l In x k. Global Instance: Collection A (listset A).
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).
Proof. Proof.
induction 1; simpl; try case_decide. split.
* constructor. * apply _.
* constructor. rewrite listset_intersection_raw_in; intuition. easy. * intros [?] [?]. apply elem_of_list_intersection.
* easy. * intros [?] [?]. apply elem_of_list_difference.
* intros ? [?] [?]. apply elem_of_list_intersection_with.
Qed. 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 := Instance listset_elems: Elements A (listset A) :=
if decide_rel In x l then l else x :: l. remove_dups listset_car.
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. Global Instance: FinCollection A (listset A).
Lemma listset_add_raw_nodup x l : NoDup l NoDup (listset_add_raw x l).
Proof. 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. 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 match l with
| [] => [] | Listset l' => Listset (f <$> l')
| x :: l => listset_add_raw (f x) (listset_map_raw f l)
end. end.
Lemma listset_map_raw_nodup f l : NoDup (listset_map_raw f l). Instance listset_bind: MBind listset := λ A B f l,
Proof. induction l; simpl. constructor. now apply listset_add_raw_nodup. Qed. match l with
Lemma listset_map_raw_in f l x : | Listset l' => Listset (mbind (listset_car f) l')
In x (listset_map_raw f l) y, x = f y In y l. end.
Proof. Instance listset_join: MJoin listset := λ A, mbind id.
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). Instance: CollectionMonad listset.
Proof. Proof.
split. split.
* easy. * intros. apply _.
* compute. intuition. * intros ??? [?] ?. apply elem_of_list_bind.
* intros. apply listset_union_raw_in. * intros. apply elem_of_list_ret.
* intros. apply listset_intersection_raw_in. * intros ??? [?]. apply elem_of_list_fmap.