Commit e080934d authored by Ralf Jung's avatar Ralf Jung
Browse files

establish a general lemma for inclusion of DRAs

This is all still pretty ad hoc, but oh well. Also, I have no idea why I had to make those instances in sta_dra global, but it complained about missing instances. Actually, I wonder how they could *not* be global previously...
parent 2c0f9c99
...@@ -141,6 +141,7 @@ Qed. ...@@ -141,6 +141,7 @@ Qed.
Lemma to_validity_valid (x : A) : Lemma to_validity_valid (x : A) :
to_validity x x. to_validity x x.
Proof. intros. done. Qed. Proof. intros. done. Qed.
Lemma to_validity_op (x y : A) : Lemma to_validity_op (x y : A) :
( (x y) x y x y) ( (x y) x y x y)
to_validity (x y) to_validity x to_validity y. to_validity (x y) to_validity x to_validity y.
...@@ -151,4 +152,22 @@ Proof. ...@@ -151,4 +152,22 @@ Proof.
auto using dra_op_valid, to_validity_valid. auto using dra_op_valid, to_validity_valid.
Qed. Qed.
Lemma to_validity_included x y:
( y to_validity x to_validity y)%C ( x x y).
Proof.
split.
- move=>[Hvl [z [Hvxz EQ]]]. move:(Hvl)=>Hvl'. apply Hvxz in Hvl'.
destruct Hvl' as [? [? ?]].
split; first by apply to_validity_valid.
exists (validity_car z). split_and!; last done.
+ apply EQ. assumption.
+ by apply validity_valid_car_valid.
- intros (Hvl & z & EQ & ? & ?).
assert ( y) by (rewrite EQ; apply dra_op_valid; done).
split; first done. exists (to_validity z). split; first split.
+ intros _. simpl. split_and!; done.
+ intros _. setoid_subst. by apply dra_op_valid.
+ intros _. rewrite /= EQ //.
Qed.
End dra. End dra.
...@@ -189,12 +189,12 @@ Implicit Types T : tokens sts. ...@@ -189,12 +189,12 @@ Implicit Types T : tokens sts.
Inductive sts_equiv : Equiv (car sts) := Inductive sts_equiv : Equiv (car sts) :=
| auth_equiv s T1 T2 : T1 T2 auth s T1 auth s T2 | auth_equiv s T1 T2 : T1 T2 auth s T1 auth s T2
| frag_equiv S1 S2 T1 T2 : T1 T2 S1 S2 frag S1 T1 frag S2 T2. | frag_equiv S1 S2 T1 T2 : T1 T2 S1 S2 frag S1 T1 frag S2 T2.
Existing Instance sts_equiv. Global Existing Instance sts_equiv.
Instance sts_valid : Valid (car sts) := λ x, Global Instance sts_valid : Valid (car sts) := λ x,
match x with match x with
| auth s T => tok s T | auth s T => tok s T
| frag S' T => closed S' T S' end. | frag S' T => closed S' T S' end.
Instance sts_unit : Unit (car sts) := λ x, Global Instance sts_unit : Unit (car sts) := λ x,
match x with match x with
| frag S' _ => frag (up_set S' ) | frag S' _ => frag (up_set S' )
| auth s _ => frag (up s ) | auth s _ => frag (up s )
...@@ -206,15 +206,15 @@ Inductive sts_disjoint : Disjoint (car sts) := ...@@ -206,15 +206,15 @@ Inductive sts_disjoint : Disjoint (car sts) :=
s S T1 T2 auth s T1 frag S T2 s S T1 T2 auth s T1 frag S T2
| frag_auth_disjoint s S T1 T2 : | frag_auth_disjoint s S T1 T2 :
s S T1 T2 frag S T1 auth s T2. s S T1 T2 frag S T1 auth s T2.
Existing Instance sts_disjoint. Global Existing Instance sts_disjoint.
Instance sts_op : Op (car sts) := λ x1 x2, Global Instance sts_op : Op (car sts) := λ x1 x2,
match x1, x2 with match x1, x2 with
| frag S1 T1, frag S2 T2 => frag (S1 S2) (T1 T2) | frag S1 T1, frag S2 T2 => frag (S1 S2) (T1 T2)
| auth s T1, frag _ T2 => auth s (T1 T2) | auth s T1, frag _ T2 => auth s (T1 T2)
| frag _ T1, auth s T2 => auth s (T1 T2) | frag _ T1, auth s T2 => auth s (T1 T2)
| auth s T1, auth _ T2 => auth s (T1 T2)(* never happens *) | auth s T1, auth _ T2 => auth s (T1 T2)(* never happens *)
end. end.
Instance sts_minus : Minus (car sts) := λ x1 x2, Global Instance sts_minus : Minus (car sts) := λ x1 x2,
match x1, x2 with match x1, x2 with
| frag S1 T1, frag S2 T2 => frag (up_set S1 (T1 T2)) (T1 T2) | frag S1 T1, frag S2 T2 => frag (up_set S1 (T1 T2)) (T1 T2)
| auth s T1, frag _ T2 => auth s (T1 T2) | auth s T1, frag _ T2 => auth s (T1 T2)
...@@ -226,7 +226,7 @@ Hint Extern 10 (equiv (A:=set _) _ _) => set_solver : sts. ...@@ -226,7 +226,7 @@ Hint Extern 10 (equiv (A:=set _) _ _) => set_solver : sts.
Hint Extern 10 (¬equiv (A:=set _) _ _) => set_solver : sts. Hint Extern 10 (¬equiv (A:=set _) _ _) => set_solver : sts.
Hint Extern 10 (_ _) => set_solver : sts. Hint Extern 10 (_ _) => set_solver : sts.
Hint Extern 10 (_ _) => set_solver : sts. Hint Extern 10 (_ _) => set_solver : sts.
Instance sts_equivalence: Equivalence (() : relation (car sts)). Global Instance sts_equivalence: Equivalence (() : relation (car sts)).
Proof. Proof.
split. split.
- by intros []; constructor. - by intros []; constructor.
...@@ -414,47 +414,56 @@ Proof. ...@@ -414,47 +414,56 @@ Proof.
rewrite <-HT. eapply up_subseteq; done. rewrite <-HT. eapply up_subseteq; done.
Qed. Qed.
Lemma 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; first by apply HS1.
by apply subseteq_up_set.
+ move=>s [HS1 Hscl]. split; first done.
destruct Hscl as [s' [Hsup Hs']].
eapply closed_steps; last (hnf in Hsup; eexact Hsup); first done.
set_solver +Hs'.
Qed.
(** Inclusion *) (** Inclusion *)
(* (* This is surprisingly different from to_validity_included. I am not sure
whether this is because to_validity_included is non-canonical, or this
one here is non-canonical - but I suspect both. *)
Lemma sts_frag_included S1 S2 T1 T2 : Lemma sts_frag_included S1 S2 T1 T2 :
closed S2 T2 → S2 ≢ ∅ closed S2 T2 S2
sts_frag S1 T1 ≼ sts_frag S2 T2 ↔ (sts_frag S1 T1 sts_frag S2 T2)
(closed S1 T1 ∧ ∃ Tf, T2 ≡ T1 ∪ Tf ∧ T1 ∩ Tf ≡ ∅ ∧ S2 ≡ S1 ∩ up_set S2 Tf). (closed S1 T1 S1 Tf, T2 T1 Tf T1 Tf
Proof. (* This should use some general properties of DRAs. To be improved S2 S1 up_set S2 Tf).
when we have RAs back *) Proof.
move=>Hcl2. split. destruct (to_validity_included (sts_dra.car sts) (sts_dra.frag S1 T1) (sts_dra.frag S2 T2)) as [Hfincl Htoincl].
- intros [[[Sf Tf|Sf Tf] vf Hvf] EQ]. intros Hcl2 HS2ne. split.
{ exfalso. inversion_clear EQ as [Hv EQ']. apply EQ' in Hcl2. simpl in Hcl2. - intros Hincl. destruct Hfincl as ((Hcl1 & ?) & (z & EQ & Hval & Hdisj)).
inversion Hcl2. } { split; last done. split; done. }
inversion_clear EQ as [Hv EQ']. clear Htoincl. split_and!; try done; [].
move:(EQ' Hcl2)=>{EQ'} EQ. inversion_clear EQ as [|? ? ? ? HT HS]. destruct z as [sf Tf|Sf Tf].
destruct Hv as [Hv _]. move:(Hv Hcl2)=>{Hv} [/= Hcl1 [Hclf Hdisj]]. { exfalso. inversion_clear EQ. }
apply Hvf in Hclf. simpl in Hclf. clear Hvf. exists Tf. inversion_clear EQ as [|? ? ? ? HT2 HS2].
inversion_clear Hdisj. split; last (exists Tf; split_and?); [done..|]. inversion_clear Hdisj as [? ? ? ? _ HTdisj | |]. split_and!; [done..|].
apply (anti_symm (⊆)). rewrite HS2. apply up_set_intersection. apply Hval.
+ move=>s HS2. apply elem_of_intersection. split; first by apply HS. - intros (Hcl & Hne & (Tf & HT & HTdisj & HS)). destruct Htoincl as ((Hcl' & ?) & (z & EQ)); last first.
by apply subseteq_up_set. { exists z. exact EQ. } clear Hfincl.
+ move=>s /elem_of_intersection [HS1 Hscl]. apply HS. split; first done. split; first (split; done). exists (sts_dra.frag (up_set S2 Tf) Tf). split_and!.
destruct Hscl as [s' [Hsup Hs']]. + constructor; done.
eapply closed_steps; last (hnf in Hsup; eexact Hsup); first done. + simpl. split.
set_solver +HS Hs'. * apply closed_up_set. move=>s Hs2. move:(closed_disjoint _ _ Hcl2 _ Hs2).
- intros (Hcl1 & Tf & Htk & Hf & Hs). set_solver +HT.
exists (sts_frag (up_set S2 Tf) Tf). * by apply up_set_nonempty.
split; first split; simpl;[|done|]. + constructor; last done. by rewrite -HS.
+ intros _. split_and?; first done.
* apply closed_up_set; last by eapply closed_ne.
move=>s Hs2. move:(closed_disjoint _ _ Hcl2 _ Hs2).
set_solver +Htk.
* constructor; last done. rewrite -Hs. by eapply closed_ne.
+ intros _. constructor; [ set_solver +Htk | done].
Qed. Qed.
Lemma sts_frag_included' S1 S2 T : Lemma sts_frag_included' S1 S2 T :
closed S2 T → closed S1 T → S2 ≡ S1 ∩ up_set S2 ∅ → closed S2 T closed S1 T S2 S1 S2 S1 up_set S2
sts_frag S1 T sts_frag S2 T. sts_frag S1 T sts_frag S2 T.
Proof. Proof.
intros. apply sts_frag_included; split_and?; auto. intros. apply sts_frag_included; split_and?; auto.
exists ; split_and?; done || set_solver+. exists ; split_and?; done || set_solver+.
Qed. Qed.
*)
End stsRA. End stsRA.
Supports Markdown
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