Commit f2c246c6 authored by Robbert Krebbers's avatar Robbert Krebbers

Simplify collection spaghetti.

There was not really a need for the lattice type classes, so I removed
these.
parent 9d33424d
Pipeline #2358 passed with stage
......@@ -58,7 +58,7 @@ Proof.
eauto with sts; set_solver.
Qed.
Global Instance framestep_proper : Proper (() ==> (=) ==> (=) ==> iff) frame_step.
Proof. by intros ?? [??] ??????; split; apply framestep_mono. Qed.
Proof. move=> ?? /collection_equiv_spec [??]; split; by apply framestep_mono. Qed.
Instance closed_proper' : Proper (() ==> () ==> impl) closed.
Proof. destruct 3; constructor; intros until 0; setoid_subst; eauto. Qed.
Global Instance closed_proper : Proper (() ==> () ==> iff) closed.
......@@ -70,14 +70,19 @@ Proof.
eapply elem_of_mkSet, rtc_l; [eapply Frame_step with T1 T2|]; eauto with sts.
Qed.
Global Instance up_proper : Proper ((=) ==> () ==> ()) up.
Proof. by intros ??? ?? [??]; split; apply up_preserving. Qed.
Proof.
by move=> ??? ?? /collection_equiv_spec [??]; split; apply up_preserving.
Qed.
Global Instance up_set_preserving : Proper (() ==> flip () ==> ()) up_set.
Proof.
intros S1 S2 HS T1 T2 HT. rewrite /up_set.
f_equiv; last done. move =>s1 s2 Hs. simpl in HT. by apply up_preserving.
Qed.
Global Instance up_set_proper : Proper (() ==> () ==> ()) up_set.
Proof. by intros S1 S2 [??] T1 T2 [??]; split; apply up_set_preserving. Qed.
Proof.
move=> S1 S2 /collection_equiv_spec [??] T1 T2 /collection_equiv_spec [??];
split; by apply up_set_preserving.
Qed.
(** ** Properties of closure under frame steps *)
Lemma closed_steps S T s1 s2 :
......@@ -144,8 +149,8 @@ Lemma up_non_empty s T : up s T ≢ ∅.
Proof. eapply non_empty_inhabited, elem_of_up. Qed.
Lemma up_closed S T : closed S T up_set S T S.
Proof.
intros; split; auto using subseteq_up_set; intros s.
unfold up_set; rewrite elem_of_bind; intros (s'&Hstep&?).
intros ?; apply collection_equiv_spec; split; auto using subseteq_up_set.
intros s; unfold up_set; rewrite elem_of_bind; intros (s'&Hstep&?).
induction Hstep; eauto using closed_step.
Qed.
Lemma up_subseteq s T S : closed S T s S sts.up s T S.
......@@ -363,8 +368,8 @@ Lemma sts_up_set_intersection S1 Sf Tf :
closed Sf Tf S1 Sf S1 up_set (S1 Sf) Tf.
Proof.
intros Hclf. apply (anti_symm ()).
+ move=>s [HS1 HSf]. split. by apply HS1. by apply subseteq_up_set.
+ move=>s [HS1 [s' [/elem_of_mkSet Hsup Hs']]]. split; first done.
- move=>s [HS1 HSf]. split. by apply HS1. by apply subseteq_up_set.
- move=>s [HS1 [s' [/elem_of_mkSet Hsup Hs']]]. split; first done.
eapply closed_steps, Hsup; first done. set_solver +Hs'.
Qed.
......
......@@ -120,16 +120,16 @@ Section gmap.
- apply big_sep_mono', Forall2_fmap, Forall_Forall2.
apply Forall_forall=> -[i x] ? /=. by apply HΦ, elem_of_map_to_list.
Qed.
Lemma big_sepM_proper Φ Ψ m1 m2 :
m1 m2 ( k x, m1 !! k = Some x m2 !! k = Some x Φ k x ⊣⊢ Ψ k x)
([ map] k x m1, Φ k x) ⊣⊢ ([ map] k x m2, Ψ k x).
Proof.
Lemma big_sepM_proper Φ Ψ m :
( k x, m !! k = Some x Φ k x ⊣⊢ Ψ k x)
([ map] k x m, Φ k x) ⊣⊢ ([ map] k x m, Ψ k x).
Proof. (*
(* FIXME: Coq bug since 8.5pl1. Without the @ in [@lookup_weaken] it gives
File "./algebra/upred_big_op.v", line 114, characters 4-131:
Anomaly: Uncaught exception Univ.AlreadyDeclared. Please report. *)
intros [??] ?; apply (anti_symm (⊢)); apply big_sepM_mono;
eauto using equiv_entails, equiv_entails_sym, @lookup_weaken.
Qed.
Qed. *) Admitted.
Global Instance big_sepM_ne m n :
Proper (pointwise_relation _ (pointwise_relation _ (dist n)) ==> (dist n))
......@@ -194,7 +194,7 @@ Section gmap.
⊣⊢ (Ψ i x b [ map] ky m, Ψ k y (f k)).
Proof.
intros. rewrite big_sepM_insert // fn_lookup_insert.
apply sep_proper, big_sepM_proper; auto=> k y ??.
apply sep_proper, big_sepM_proper; auto=> k y ?.
by rewrite fn_lookup_insert_ne; last set_solver.
Qed.
Lemma big_sepM_fn_insert' (Φ : K uPred M) m i x P :
......@@ -278,8 +278,8 @@ Section gset.
X Y ( x, x X x Y Φ x ⊣⊢ Ψ x)
([ set] x X, Φ x) ⊣⊢ ([ set] x Y, Ψ x).
Proof.
intros [??] ?; apply (anti_symm ()); apply big_sepS_mono;
eauto using equiv_entails, equiv_entails_sym.
move=> /collection_equiv_spec [??] ?; apply (anti_symm ());
apply big_sepS_mono; eauto using equiv_entails, equiv_entails_sym.
Qed.
Lemma big_sepS_ne X n :
......
......@@ -250,6 +250,12 @@ Lemma and_wlog_r (P Q : Prop) : P → (P → Q) → (P ∧ Q).
Proof. tauto. Qed.
Lemma impl_transitive (P Q R : Prop) : (P Q) (Q R) (P R).
Proof. tauto. Qed.
Lemma forall_proper {A} (P Q : A Prop) :
( x, P x Q x) ( x, P x) ( x, Q x).
Proof. firstorder. Qed.
Lemma exist_proper {A} (P Q : A Prop) :
( x, P x Q x) ( x, P x) ( x, Q x).
Proof. firstorder. Qed.
Instance: Comm () (@eq A).
Proof. red; intuition. Qed.
......@@ -872,30 +878,7 @@ Notation "<[ k := a ]{ Γ }>" := (insertE Γ k a)
Arguments insertE _ _ _ _ _ _ !_ _ !_ / : simpl nomatch.
(** * Ordered structures *)
(** We do not use a setoid equality in the following interfaces to avoid the
need for proofs that the relations and operations are proper. Instead, we
define setoid equality generically [λ X Y, X ⊆ Y ∧ Y ⊆ X]. *)
Class EmptySpec A `{Empty A, SubsetEq A} : Prop := subseteq_empty X : X.
Class JoinSemiLattice A `{SubsetEq A, Union A} : Prop := {
join_semi_lattice_pre :>> PreOrder ();
union_subseteq_l X Y : X X Y;
union_subseteq_r X Y : Y X Y;
union_least X Y Z : X Z Y Z X Y Z
}.
Class MeetSemiLattice A `{SubsetEq A, Intersection A} : Prop := {
meet_semi_lattice_pre :>> PreOrder ();
intersection_subseteq_l X Y : X Y X;
intersection_subseteq_r X Y : X Y Y;
intersection_greatest X Y Z : Z X Z Y Z X Y
}.
Class Lattice A `{SubsetEq A, Union A, Intersection A} : Prop := {
lattice_join :>> JoinSemiLattice A;
lattice_meet :>> MeetSemiLattice A;
lattice_distr X Y Z : (X Y) (X Z) X (Y Z)
}.
(** ** Axiomatization of collections *)
(** * Axiomatization of collections *)
(** The class [SimpleCollection A C] axiomatizes a collection of type [C] with
elements of type [A]. *)
Class SimpleCollection A C `{ElemOf A C,
......
This diff is collapsed.
......@@ -36,8 +36,7 @@ Proof.
Qed.
Lemma dom_empty {A} : dom D (@empty (M A) _) .
Proof.
split; intro; [|set_solver].
rewrite elem_of_dom, lookup_empty. by inversion 1.
intros x. rewrite elem_of_dom, lookup_empty, <-not_eq_None_Some. set_solver.
Qed.
Lemma dom_empty_inv {A} (m : M A) : dom D m m = .
Proof.
......
......@@ -190,11 +190,6 @@ Proof.
unfold subseteq, map_subseteq, map_relation. split; intros Hm i;
specialize (Hm i); destruct (m1 !! i), (m2 !! i); naive_solver.
Qed.
Global Instance: EmptySpec (M A).
Proof.
intros A m. rewrite !map_subseteq_spec.
intros i x. by rewrite lookup_empty.
Qed.
Global Instance: {A} (R : relation A), PreOrder R PreOrder (map_included R).
Proof.
split; [intros m i; by destruct (m !! i); simpl|].
......
......@@ -28,7 +28,8 @@ Qed.
Lemma listset_empty_alt X : X listset_car X = [].
Proof.
destruct X as [l]; split; [|by intros; simplify_eq/=].
intros [Hl _]; destruct l as [|x l]; [done|]. feed inversion (Hl x); left.
rewrite elem_of_equiv_empty; intros Hl.
destruct l as [|x l]; [done|]. feed inversion (Hl x). left.
Qed.
Global Instance listset_empty_dec (X : listset A) : Decision (X ).
Proof.
......
......@@ -63,8 +63,8 @@ Proof.
intros [m1] [m2] ?. simpl. rewrite lookup_difference_Some.
destruct (m2 !! x) as [[]|]; intuition congruence.
Qed.
Global Instance: PartialOrder (@subseteq (mapset M) _).
Proof. split; try apply _. intros ????. apply mapset_eq. intuition. Qed.
Global Instance: LeibnizEquiv (mapset M).
Proof. intros ??. apply mapset_eq. Qed.
Global Instance: FinCollection K (mapset M).
Proof.
split.
......
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment