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. ...@@ -21,28 +21,36 @@ Section collection.
Proof. easy. Qed. Proof. easy. Qed.
Lemma elem_of_equiv X Y : X Y x, x X x Y. Lemma elem_of_equiv X Y : X Y x, x X x Y.
Proof. firstorder. Qed. 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. Proof. firstorder. Qed.
Global Instance: Proper ((=) ==> () ==> iff) (). Global Instance: Proper ((=) ==> () ==> iff) ().
Proof. intros ???. subst. firstorder. Qed. Proof. intros ???. subst. firstorder. Qed.
Lemma empty_ne_singleton x : {{ x }}. Lemma empty_ne_singleton x : {[ x ]}.
Proof. intros [_ E]. destruct (elem_of_empty x). apply E. now apply elem_of_singleton. Qed. Proof.
intros [_ E]. destruct (elem_of_empty x).
apply E. now apply elem_of_singleton.
Qed.
End collection. End collection.
Section cmap. Section cmap.
Context `{Collection A C}. 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. 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. 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. Proof. intros. now apply (elem_of_map _). Qed.
End cmap. 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. Lemma elem_of_fresh_iff `{FreshSpec A C} (X : C) : fresh X X False.
Proof. split. apply is_fresh. easy. Qed. Proof. split. apply is_fresh. easy. Qed.
...@@ -52,7 +60,7 @@ Ltac split_elem_ofs := repeat ...@@ -52,7 +60,7 @@ Ltac split_elem_ofs := repeat
| H : context [ _ _ ] |- _ => setoid_rewrite elem_of_subseteq in H | 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_equiv_alt in H
| H : context [ _ ] |- _ => setoid_rewrite elem_of_empty_iff 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_union in H
| H : context [ _ _ _ ] |- _ => setoid_rewrite elem_of_intersection in H | H : context [ _ _ _ ] |- _ => setoid_rewrite elem_of_intersection in H
| H : context [ _ _ _ ] |- _ => setoid_rewrite elem_of_difference in H | H : context [ _ _ _ ] |- _ => setoid_rewrite elem_of_difference in H
...@@ -60,7 +68,7 @@ Ltac split_elem_ofs := repeat ...@@ -60,7 +68,7 @@ Ltac split_elem_ofs := repeat
| |- context [ _ _ ] => setoid_rewrite elem_of_subseteq | |- context [ _ _ ] => setoid_rewrite elem_of_subseteq
| |- context [ _ _ ] => setoid_rewrite elem_of_equiv_alt | |- context [ _ _ ] => setoid_rewrite elem_of_equiv_alt
| |- context [ _ ] => setoid_rewrite elem_of_empty_iff | |- 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_union
| |- context [ _ _ _ ] => setoid_rewrite elem_of_intersection | |- context [ _ _ _ ] => setoid_rewrite elem_of_intersection
| |- context [ _ _ _ ] => setoid_rewrite elem_of_difference | |- context [ _ _ _ ] => setoid_rewrite elem_of_difference
...@@ -97,9 +105,12 @@ Ltac naive_firstorder t := ...@@ -97,9 +105,12 @@ Ltac naive_firstorder t :=
(* solve *) (* solve *)
| |- _ => solve [t] | |- _ => solve [t]
(* dirty destructs *) (* dirty destructs *)
| H : context [ _, _ ] |- _ => edestruct H; clear H; naive_firstorder t || clear H; naive_firstorder t | H : context [ _, _ ] |- _ =>
| H : context [ _ _ ] |- _ => edestruct H; clear H; naive_firstorder t || clear H; naive_firstorder t 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 *) (* dirty constructs *)
| |- x, _ => eexists; naive_firstorder t | |- x, _ => eexists; naive_firstorder t
| |- _ _ => left; naive_firstorder t || right; naive_firstorder t | |- _ _ => left; naive_firstorder t || right; naive_firstorder t
...@@ -125,8 +136,8 @@ Section no_dup. ...@@ -125,8 +136,8 @@ Section no_dup.
Global Instance: Proper (R ==> () ==> iff) elem_of_upto. Global Instance: Proper (R ==> () ==> iff) elem_of_upto.
Proof. Proof.
intros ?? E1 ?? E2. split; intros [z [??]]; exists z. 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. Qed.
Global Instance: Proper (() ==> iff) no_dup. Global Instance: Proper (() ==> iff) no_dup.
Proof. firstorder. Qed. Proof. firstorder. Qed.
...@@ -135,20 +146,24 @@ Section no_dup. ...@@ -135,20 +146,24 @@ Section no_dup.
Proof. unfold elem_of_upto. esimplify_elem_of. Qed. Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
Lemma elem_of_upto_empty x : ¬elem_of_upto x . Lemma elem_of_upto_empty x : ¬elem_of_upto x .
Proof. unfold elem_of_upto. esimplify_elem_of. Qed. 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. 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. 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. 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. Proof. unfold elem_of_upto. esimplify_elem_of. Qed.
Lemma no_dup_empty: no_dup . Lemma no_dup_empty: no_dup .
Proof. unfold no_dup. simplify_elem_of. Qed. 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. 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. 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. 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. Lemma no_dup_inv_union_l X Y : no_dup (X Y) no_dup X.
Proof. unfold no_dup. simplify_elem_of. Qed. Proof. unfold no_dup. simplify_elem_of. Qed.
Lemma no_dup_inv_union_r X Y : no_dup (X Y) no_dup Y. Lemma no_dup_inv_union_r X Y : no_dup (X Y) no_dup Y.
...@@ -163,7 +178,7 @@ Section quantifiers. ...@@ -163,7 +178,7 @@ Section quantifiers.
Lemma cforall_empty : cforall . Lemma cforall_empty : cforall .
Proof. unfold cforall. simplify_elem_of. Qed. 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. Proof. unfold cforall. simplify_elem_of. Qed.
Lemma cforall_union X Y : cforall X cforall Y cforall (X Y). Lemma cforall_union X Y : cforall X cforall Y cforall (X Y).
Proof. unfold cforall. simplify_elem_of. Qed. Proof. unfold cforall. simplify_elem_of. Qed.
...@@ -174,7 +189,7 @@ Section quantifiers. ...@@ -174,7 +189,7 @@ Section quantifiers.
Lemma cexists_empty : ¬cexists . Lemma cexists_empty : ¬cexists .
Proof. unfold cexists. esimplify_elem_of. Qed. 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. Proof. unfold cexists. esimplify_elem_of. Qed.
Lemma cexists_union_1 X Y : cexists X cexists (X Y). Lemma cexists_union_1 X Y : cexists X cexists (X Y).
Proof. unfold cexists. esimplify_elem_of. Qed. Proof. unfold cexists. esimplify_elem_of. Qed.
...@@ -184,9 +199,43 @@ Section quantifiers. ...@@ -184,9 +199,43 @@ Section quantifiers.
Proof. unfold cexists. esimplify_elem_of. Qed. Proof. unfold cexists. esimplify_elem_of. Qed.
End quantifiers. End quantifiers.
Lemma cforall_weak `{Collection A B} (P Q : A Prop) (Hweak : x, P x Q x) X : Section more_quantifiers.
cforall P X cforall Q X. Context `{Collection A B}.
Proof. firstorder. Qed.
Lemma cexists_weak `{Collection A B} (P Q : A Prop) (Hweak : x, P x Q x) X : Lemma cforall_weak (P Q : A Prop) (Hweak : x, P x Q x) X :
cexists P X cexists Q X. cforall P X cforall Q X.
Proof. firstorder. Qed. 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.
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) ...@@ -6,9 +6,11 @@ Definition decide_rel {A B} (R : A → B → Prop)
Ltac case_decide := Ltac case_decide :=
match goal with match goal with
| H : context [@decide ?P ?dec] |- _ => case (@decide P dec) in * | 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 ?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. end.
Ltac solve_trivial_decision := Ltac solve_trivial_decision :=
...@@ -16,25 +18,28 @@ Ltac solve_trivial_decision := ...@@ -16,25 +18,28 @@ Ltac solve_trivial_decision :=
| [ |- 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 :=
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 True_dec: Decision True := left _.
Program Instance False_dec: Decision False := right _. Program Instance False_dec: Decision False := right _.
Program Instance prod_eq_dec `(A_dec : x y : A, Decision (x = y)) Program Instance prod_eq_dec `(A_dec : x y : A, Decision (x = y))
`(B_dec : x y : B, Decision (x = y)) : x y : A * B, Decision (x = y) := λ x y, `(B_dec : x y : B, Decision (x = y)) : x y : A * B, Decision (x = y) := λ x y,
match A_dec (fst x) (fst y) with match A_dec (fst x) (fst y) with
| left _ => match B_dec (snd x) (snd y) with left _ => left _ | right _ => right _ end | left _ => match B_dec (snd x) (snd y) with left _ => left _ | right _ => right _ end
| right _ => right _ | right _ => right _
end. end.
Solve Obligations using (program_simpl; f_equal; firstorder). 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 match P_dec with
| left _ => match Q_dec with left _ => left _ | right _ => right _ end | left _ => match Q_dec with left _ => left _ | right _ => right _ end
| right _ => right _ | right _ => right _
end. end.
Solve Obligations using (program_simpl; tauto). 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 match P_dec with
| left _ => left _ | left _ => left _
| right _ => match Q_dec with left _ => left _ | right _ => right _ end | right _ => match Q_dec with left _ => left _ | right _ => right _ end
...@@ -48,15 +53,22 @@ Proof. unfold bool_decide. now destruct dec. Qed. ...@@ -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. 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. now destruct dec. Qed.
Definition dsig `(P : A Prop) `{ x : A, Decision (P x)} := { x | bool_decide (P x) }. Definition dsig `(P : A Prop) `{ x : A, Decision (P x)} :=
Definition proj2_dsig `{ x : A, Decision (P x)} (x : dsig P) : P (`x) := bool_decide_unpack _ (proj2_sig x). { x | bool_decide (P x) }.
Definition dexist `{ x : A, Decision (P x)} (x : A) (p : P x) : dsig P := xbool_decide_pack _ p. 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. Proof. now injection 1. Qed.
Lemma dsig_eq {A} (P : A Prop) {dec : x, Decision (P x)} (x y : { x | bool_decide (P x) }) : Lemma dsig_eq {A} (P : A Prop) {dec : x, Decision (P x)}
`x = `y x = y. (x y : { x | bool_decide (P x) }) : `x = `y x = y.
Proof. Proof.
intros H1. destruct x as [x Hx], y as [y Hy]. simpl in *. subst. intros H1. destruct x as [x Hx], y as [y Hy].
f_equal. revert Hx Hy. case (bool_decide (P y)). simpl. now intros [] []. easy. simpl in *. subst. f_equal.
revert Hx Hy. case (bool_decide (P y)).
* now intros [] [].
* easy.
Qed. Qed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
...@@ -7,59 +7,71 @@ Context {A : Type} `{∀ x y : A, Decision (x = y)}. ...@@ -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_elem_of: ElemOf A (listset A) := λ x l, In x (`l).
Global Instance listset_empty: Empty (listset A) := []@NoDup_nil _. 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 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. 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. 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. Proof.
induction 1; simpl; try case_decide. induction 1; simpl; try case_decide.
constructor. * constructor.
easy. * easy.
constructor. rewrite listset_diff_raw_in; intuition. easy. * constructor. rewrite listset_difference_raw_in; intuition. easy.
Qed. Qed.
Global Instance listset_diff: Difference (listset A) := λ l k, Global Instance listset_difference: Difference (listset A) := λ l k,
listset_diff_raw (`l) (`k)listset_diff_raw_nodup (`l) (`k) (proj2_sig l). 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. Lemma listset_union_raw_in l k x : In x (listset_union_raw l k) In x l In x k.
Proof. 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. intuition. case (decide (In x k)); intuition.
Qed. Qed.
Lemma listset_union_raw_nodup l k : NoDup l NoDup k NoDup (listset_union_raw l k). Lemma listset_union_raw_nodup l k : NoDup l NoDup k NoDup (listset_union_raw l k).
Proof. Proof.
intros. apply NoDup_app. intros. apply NoDup_app.
now apply listset_diff_raw_nodup. * now apply listset_difference_raw_nodup.
easy. * easy.
intro. rewrite listset_diff_raw_in. intuition. * intro. rewrite listset_difference_raw_in. intuition.
Qed. Qed.
Global Instance listset_union: Union (listset A) := λ l k, 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). 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 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. end.
Lemma listset_inter_raw_in l k x : In x (listset_inter_raw l k) In x l In x k. Lemma listset_intersection_raw_in l k x :
Proof. split; induction l; simpl; try case_decide; simpl; intuition congruence. Qed. In x (listset_intersection_raw l k) In x l In x k.
Lemma listset_inter_raw_nodup l k : NoDup l NoDup (listset_inter_raw l 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. Proof.
induction 1; simpl; try case_decide. induction 1; simpl; try case_decide.
constructor. * constructor.
constructor. rewrite listset_inter_raw_in; intuition. easy. * constructor. rewrite listset_intersection_raw_in; intuition. easy.
easy. * easy.
Qed. Qed.
Global Instance listset_inter: Intersection (listset A) := λ l k, Global Instance listset_intersection: Intersection (listset A) := λ l k,
listset_inter_raw (`l) (`k)listset_inter_raw_nodup (`l) (`k) (proj2_sig l). 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. 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. Lemma listset_add_raw_in x l y : In y (listset_add_raw x l) y = x In y l.
Proof. unfold listset_add_raw. case (decide_rel _); firstorder congruence. Qed. Proof. unfold listset_add_raw. case (decide_rel _); firstorder congruence. Qed.
Lemma listset_add_raw_nodup x l : NoDup l NoDup (listset_add_raw x l). Lemma listset_add_raw_nodup x l : NoDup l NoDup (listset_add_raw x l).
...@@ -75,9 +87,10 @@ Proof. induction l; simpl. constructor. now apply listset_add_raw_nodup. Qed. ...@@ -75,9 +87,10 @@ 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. Lemma listset_map_raw_in f l x : In x (listset_map_raw f l) y, x = f y In y l.
Proof. Proof.
split. split.
induction l; simpl. easy. rewrite listset_add_raw_in. firstorder. * induction l; simpl; [easy |].
intros [?[??]]. subst. induction l; simpl in *. easy. rewrite listset_add_raw_in. firstorder.
rewrite listset_add_raw_in. firstorder congruence. * intros [?[??]]. subst. induction l; simpl in *; [easy |].
rewrite listset_add_raw_in. firstorder congruence.
Qed. Qed.
Global Instance listset_map: Map A (listset A) := λ f l, Global Instance listset_map: Map A (listset A) := λ f l,
listset_map_raw f (`l)listset_map_raw_nodup f (`l). listset_map_raw f (`l)listset_map_raw_nodup f (`l).
...@@ -85,12 +98,12 @@ Global Instance listset_map: Map A (listset A) := λ f l, ...@@ -85,12 +98,12 @@ Global Instance listset_map: Map A (listset A) := λ f l,
Global Instance: Collection A (listset A). Global Instance: Collection A (listset A).
Proof. Proof.
split. split.
easy. * easy.
compute. intuition. * compute. intuition.
intros. apply listset_union_raw_in. * intros. apply listset_union_raw_in.
intros. apply listset_inter_raw_in. * intros. apply listset_intersection_raw_in.
intros. apply listset_diff_raw_in. * intros. apply listset_difference_raw_in.
intros. apply listset_map_raw_in. * intros. apply listset_map_raw_in.
Qed. Qed.
Global Instance listset_elems: Elements A (listset A) := @proj1_sig _ _. Global Instance listset_elems: Elements A (listset A) := @proj1_sig _ _.
......
...@@ -15,5 +15,6 @@ Arguments mjoin {M MJoin A} _. ...@@ -15,5 +15,6 @@ Arguments mjoin {M MJoin A} _.
Arguments fmap {M FMap A B} _ _. Arguments fmap {M FMap A B} _ _.
Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : C_scope. Notation "m ≫= f" := (mbind f m) (at level 60, right associativity) : C_scope.
Notation "x ← y ; z" := (y = (λ x : _, z)) (at level 65, next at level 35, right associativity) : C_scope. Notation "x ← y ; z" := (y = (λ x : _, z))
(at level 65, next at level 35, right associativity) : C_scope.
Infix "<$>" := fmap (at level 65, right associativity, only parsing) : C_scope. Infix "<$>" := fmap (at level 65, right associativity, only parsing) : C_scope.
...@@ -23,7 +23,7 @@ Global Instance Npartial_alter: PartialAlter N Nmap := λ A f i t, ...@@ -23,7 +23,7 @@ Global Instance Npartial_alter: PartialAlter N Nmap := λ A f i t,
end. end.
Global Instance Ndom {A} : Dom N (Nmap A) := λ A _ _ _ t, Global Instance Ndom {A} : Dom N (Nmap A) := λ A _ _ _ t,
match t with match t with
| Build_Nmap o t => option_case (λ _, {{ 0 }}) o (Pdom_raw Npos (`t)) | Build_Nmap o t => option_case (λ _, {[ 0 ]}) o (Pdom_raw Npos (`t))
end. end.
Global Instance Nmerge: Merge Nmap := λ A f t1 t2, Global Instance Nmerge: Merge Nmap := λ A f t1 t2,
match t1, t2 with match t1, t2 with
...@@ -37,16 +37,20 @@ Global Instance Nfmap: FMap Nmap := λ A B f t, ...@@ -37,16 +37,20 @@ Global Instance Nfmap: FMap Nmap := λ A B f t,
Global Instance: FinMap N Nmap. Global Instance: FinMap N Nmap.
Proof. Proof.
split. split.
intros ? [??] [??] H. f_equal. * intros ? [??] [??] H. f_equal.
now apply (H 0). + now apply (H 0).
apply finmap_eq. intros i. now apply (H (Npos i)). + apply finmap_eq. intros i. now apply (H (Npos i)).
now intros ? [|?]. * now intros ? [|?].
intros ? f [? t] [|i]. easy. now apply (lookup_partial_alter f t i). * intros ? f [? t] [|i].
intros ? f [? t] [|i] [|j]; try intuition congruence. + easy.
intros. apply (lookup_partial_alter_ne f t i j). congruence. + now apply (lookup_partial_alter f t i).
intros ??? [??] []. easy. apply lookup_fmap. * intros ? f [? t] [|i] [|j]; try intuition congruence.
intros ?? ???????? [o t] n; unfold dom, lookup, Ndom, Nlookup; simpl. intros. apply (lookup_partial_alter_ne f t i j). congruence.
rewrite elem_of_union, Plookup_raw_dom. * intros ??? [??] []. easy. apply lookup_fmap.
destruct o, n; esimplify_elem_of (simplify_is_Some; eauto). * intros ?? ???????? [o t] n; unfold dom, lookup, Ndom, Nlookup; simpl.
intros ? f ? [o1 t1] [o2 t2] [|?]. easy. apply (merge_spec f t1 t2). rewrite elem_of_union, Plookup_raw_dom.
destruct o, n; esimplify_elem_of (simplify_is_Some; eauto).
* intros ? f ? [o1 t1] [o2 t2] [|?].
+ easy.
+ apply (merge_spec f t1 t2).
Qed. Qed.
Require Export PArith NArith ZArith. Require Export PArith NArith ZArith.
Require Export base decidable fin_collections. Require Export base decidable fin_collections.
Infix "≤" := le : nat_scope.
Instance nat_eq_dec: x y : nat, Decision (x = y) := eq_nat_dec. Instance nat_eq_dec: x y : nat, Decision (x = y) := eq_nat_dec.
Instance positive_eq_dec: x y : positive, Decision (x = y) := Pos.eq_dec. Instance positive_eq_dec: x y : positive, Decision (x = y) := Pos.eq_dec.
Notation "(~0)" := xO (only parsing) : positive_scope. Notation "(~0)" := xO (only parsing) : positive_scope.
...@@ -41,18 +43,19 @@ Lemma Nmax_max `{FinCollection N C} X x : x ∈ X → (x ≤ Nmax X)%N. ...@@ -41,18 +43,19 @@ Lemma Nmax_max `{FinCollection N C} X x : x ∈ X → (x ≤ Nmax X)%N.
Proof. Proof.
change ((λ b X, x X (x b)%N) (collection_fold N.max 0%N X) X). change ((λ b X, x X (x b)%N) (collection_fold N.max 0%N X) X).
apply collection_fold_ind. apply collection_fold_ind.
solve_proper. * solve_proper.
simplify_elem_of. * simplify_elem_of.
simplify_elem_of. apply N.le_max_l. apply N.max_le_iff; auto. * simplify_elem_of. apply N.le_max_l. apply N.max_le_iff; auto.