Commit 18669b92 authored by Robbert Krebbers's avatar Robbert Krebbers

Major revision of the whole development.

The main changes are:

* Function calls in the operational semantics
* Mutually recursive function calls in the axiomatic semantics
* A general definition of the interpretation of the axiomatic semantics  so as
  to improve reusability (useful for function calls, and also for expressions
  in future versions)
* Type classes for stack independent, memory independent, and memory extensible
  assertions, and a lot of instances to automatically derive these properties.
* Many additional lemmas on the memory and more robust tactics to simplify
  goals involving is_free and mem_disjoint
* Proof of preservation of statements in the smallstep semantics

* Some new tactics: feed, feed destruct, feed inversion, etc...
* More robust tactic scripts using bullets and structured scripts
* Truncate most lines at 80 characters
parent a97de42f
This diff is collapsed.
......@@ -21,28 +21,36 @@ Section collection.
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).
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.
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.
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.
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.
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).
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.
......@@ -52,7 +60,7 @@ Ltac split_elem_ofs := repeat
| 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_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
......@@ -60,7 +68,7 @@ Ltac split_elem_ofs := repeat
| |- 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_singleton
| |- context [ _ _ _ ] => setoid_rewrite elem_of_union
| |- context [ _ _ _ ] => setoid_rewrite elem_of_intersection
| |- context [ _ _ _ ] => setoid_rewrite elem_of_difference
......@@ -97,9 +105,12 @@ Ltac 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
| H : context [ _, _ ] |- _ =>
edestruct H; clear H;naive_firstorder t || clear H; naive_firstorder t
| H : context [ _ _ ] |- _ =>
destruct 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
......@@ -125,8 +136,8 @@ Section no_dup.
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.
* rewrite <-E1, <-E2; intuition.
* rewrite E1, E2; intuition.
Qed.
Global Instance: Proper (() ==> iff) no_dup.
Proof. firstorder. Qed.
......@@ -135,20 +146,24 @@ Section no_dup.
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.
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.
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).
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_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.
......@@ -163,7 +178,7 @@ Section quantifiers.
Lemma cforall_empty : cforall .
Proof. unfold cforall. simplify_elem_of. Qed.
Lemma cforall_singleton x : cforall {{ x }} P x.
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.
......@@ -174,7 +189,7 @@ Section quantifiers.
Lemma cexists_empty : ¬cexists .
Proof. unfold cexists. esimplify_elem_of. Qed.
Lemma cexists_singleton x : cexists {{ x }} P x.
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.
......@@ -184,9 +199,43 @@ Section quantifiers.
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 :
Section more_quantifiers.
Context `{Collection A B}.
Lemma cforall_weak (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 :
Proof. firstorder. Qed.
Lemma cexists_weak (P Q : A Prop) (Hweak : x, P x Q x) X :
cexists P X cexists Q X.
Proof. firstorder. Qed.
Proof. firstorder. Qed.
End more_quantifiers.
Section fresh.
Context `{Collection A C} `{Fresh A C} `{!FreshSpec A C} .
Fixpoint fresh_list (n : nat) (X : C) : list A :=
match n with
| 0 => []
| S n => let x := fresh X in x :: fresh_list n ({[ x ]} X)
end.
Lemma fresh_list_length n X : length (fresh_list n X) = n.
Proof. revert X. induction n; simpl; auto. Qed.
Lemma fresh_list_is_fresh n X x : In x (fresh_list n X) x X.
Proof.
revert X. induction n; simpl.
* easy.
* intros X [?| Hin]. subst.
+ apply is_fresh.
+ apply IHn in Hin. simplify_elem_of.
Qed.
Lemma fresh_list_nodup n X : NoDup (fresh_list n X).
Proof.
revert X.
induction n; simpl; constructor; auto.
intros Hin. apply fresh_list_is_fresh in Hin.
simplify_elem_of.
Qed.
End fresh.
......@@ -6,9 +6,11 @@ Definition decide_rel {A B} (R : A → B → Prop)
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 *
| 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 *
| |- context [@decide_rel _ _ ?R ?x ?y ?dec] =>
case (@decide_rel _ _ R x y dec) in *
end.
Ltac solve_trivial_decision :=
......@@ -17,7 +19,8 @@ Ltac solve_trivial_decision :=
| [ |- sumbool ?P (¬?P) ] => change (Decision P); apply _
end.
Ltac solve_decision :=
first [solve_trivial_decision | unfold Decision; decide equality; solve_trivial_decision].
intros; 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 _.
......@@ -28,13 +31,15 @@ Program Instance prod_eq_dec `(A_dec : ∀ x y : A, Decision (x = y))
| 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) :=
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) :=
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
......@@ -48,15 +53,22 @@ 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.
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.
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.
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.
intros H1. 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.
Qed.
......@@ -11,9 +11,9 @@ 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.
* 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.
......@@ -21,8 +21,8 @@ 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.
* easy.
* intro. rewrite <-elements_spec. simplify_elem_of.
Qed.
Lemma size_empty_inv X : size X = 0 X .
Proof.
......@@ -32,52 +32,54 @@ 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.
Lemma size_singleton x : size {[ x ]} = 1.
Proof.
change (length (elements {{x}}) = length [x]).
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.
* 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.
* 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 E. intros []. apply equiv_empty.
intros x. rewrite elements_spec, E. contradiction.
intros x l E. exists x. rewrite elements_spec, E. now left.
* 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).
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 }} }.
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.
* 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
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.
transitivity ({[ x ]} {[ y ]}).
* symmetry. now apply size_empty_iff.
* simplify_elem_of.
Qed.
Next Obligation. edestruct size_pos_choose; esimplify_elem_of. Qed.
......@@ -87,9 +89,7 @@ Instance elem_of_dec_slow (x : A) (X : C) : Decision (x ∈ X) | 100 :=
| 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.
Lemma union_difference X Y : X Y X X Y.
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.
......@@ -103,80 +103,98 @@ Proof.
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. rewrite <-size_union. now rewrite union_difference. 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.
Lemma size_difference 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.
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.
intros. rewrite <-(size_difference {[ 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.
Proof.
intros. rewrite <-(subseteq_union_1 X Y) by easy.
rewrite <-(union_difference 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.
intros Hind. cut ( n X, size X < n P X).
{ intros help X. apply help with (S (size X)). auto with arith. }
induction n; intros.
* now destruct (Lt.lt_n_0 (size X)).
* apply Hind. intros. apply IHn. eauto 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.
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.
* now rewrite size_empty_inv.
* destruct (size_pos_choose X); auto.
rewrite <-(subseteq_union_1 {[ x ]} X) by simplify_elem_of.
rewrite <-union_difference.
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.
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.
cut ( l, NoDup l X, ( x, x X In x l) P (fold_right f b l) X).
{ intros help ?. apply help. apply elements_nodup. apply elements_spec. }
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).
* intros X HX. rewrite equiv_empty. easy. intros ??. firstorder.
* intros X HX.
rewrite <-(subseteq_union_1 {[ x ]} X) by esimplify_elem_of.
rewrite <-union_difference.
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.
+ intros. destruct (proj1 (HX y)); simplify_elem_of.
+ esimplify_elem_of.
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 :=
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.
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 :=
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.
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).
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.
......@@ -7,59 +7,71 @@ 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.
Global Instance listset_singleton: Singleton A (listset A) := λ x,
[x]NoDup_singleton x.
Fixpoint listset_diff_raw (l k : list A) :=
Fixpoint listset_difference_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
| x :: l =>
if decide_rel In x k
then listset_difference_raw l k
else x :: listset_difference_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.
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_diff_raw_nodup l k : NoDup l NoDup (listset_diff_raw l k).
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_diff_raw_in; intuition. easy.
* constructor.
* easy.
* constructor. rewrite listset_difference_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).
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_diff_raw l k ++ k.
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_diff_raw_in.
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.
intros. apply NoDup_app.
now apply listset_diff_raw_nodup.
easy.
intro. rewrite listset_diff_raw_in. intuition.
* now apply listset_difference_raw_nodup.
* easy.
* intro. rewrite listset_difference_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) :=
Fixpoint listset_intersection_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
| x :: l =>
if decide_rel In x k
then x :: listset_intersection_raw l k
else listset_intersection_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).
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).
Proof.
induction 1; simpl; try case_decide.
constructor.
constructor. rewrite listset_inter_raw_in; intuition. easy.
easy.
* constructor.
* constructor. rewrite listset_intersection_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).
Global Instance listset_intersection: Intersection (listset A) := λ l k,
listset_intersection_raw (`l) (`k)listset_intersection_raw_nodup (`l) (`k) (proj2_sig l).