Commit 9997d0ef authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Many STS tweaks:

* Clearly separate the file algebra/sts in three parts:
  1.) The definition of an STS, step relations, and closure stuff
  2.) The construction as a disjoint RA (this module should never be used)
  3.) The construction as a CMRA with many derived properties
* Turn stsT into a canonical structure so that we can make more of its arguments
  implicit.
* Rename the underlying step relation of STSs to prim_step (similar naming as
  for languages, but here in a module to avoid ambiguity)
* Refactor program_logic/sts by moving general properties of the STS CMRA to
  algebra/sts.v
* Make naming and use of modules in program_logic/sts more consistent with
  program_logic/auth and program_logic/saved_prop
* Prove setoid properties of all definitions in program_logic/sts
parent 4e8725f3
...@@ -23,6 +23,7 @@ Class DRA A `{Equiv A, Valid A, Unit A, Disjoint A, Op A, Minus A} := { ...@@ -23,6 +23,7 @@ Class DRA A `{Equiv A, Valid A, Unit A, Disjoint A, Op A, Minus A} := {
dra_equivalence :> Equivalence (() : relation A); dra_equivalence :> Equivalence (() : relation A);
dra_op_proper :> Proper (() ==> () ==> ()) (); dra_op_proper :> Proper (() ==> () ==> ()) ();
dra_unit_proper :> Proper (() ==> ()) unit; dra_unit_proper :> Proper (() ==> ()) unit;
dra_valid_proper :> Proper (() ==> impl) valid;
dra_disjoint_proper :> x, Proper (() ==> impl) (disjoint x); dra_disjoint_proper :> x, Proper (() ==> impl) (disjoint x);
dra_minus_proper :> Proper (() ==> () ==> ()) minus; dra_minus_proper :> Proper (() ==> () ==> ()) minus;
(* validity *) (* validity *)
...@@ -61,7 +62,10 @@ Proof. ...@@ -61,7 +62,10 @@ Proof.
* intros [x px ?] [y py ?] [z pz ?] [? Hxy] [? Hyz]; simpl in *. * intros [x px ?] [y py ?] [z pz ?] [? Hxy] [? Hyz]; simpl in *.
split; [|intros; transitivity y]; tauto. split; [|intros; transitivity y]; tauto.
Qed. Qed.
Instance dra_valid_proper' : Proper (() ==> iff) (valid : A Prop).
Proof. by split; apply dra_valid_proper. Qed.
Instance to_validity_proper : Proper (() ==> ()) to_validity.
Proof. by intros x1 x2 Hx; split; rewrite /= Hx. Qed.
Instance: Proper (() ==> () ==> iff) (). Instance: Proper (() ==> () ==> iff) ().
Proof. Proof.
intros x1 x2 Hx y1 y2 Hy; split. intros x1 x2 Hx y1 y2 Hy; split.
......
...@@ -5,144 +5,104 @@ Local Arguments valid _ _ !_ /. ...@@ -5,144 +5,104 @@ Local Arguments valid _ _ !_ /.
Local Arguments op _ _ !_ !_ /. Local Arguments op _ _ !_ !_ /.
Local Arguments unit _ _ !_ /. Local Arguments unit _ _ !_ /.
(** * Definition of STSs *)
Module sts. Module sts.
Structure stsT := STS {
Record stsT := STS {
state : Type; state : Type;
token : Type; token : Type;
trans : relation state; prim_step : relation state;
tok : state set token; tok : state set token;
}. }.
Arguments STS {_ _} _ _. Arguments STS {_ _} _ _.
Arguments prim_step {_} _ _.
Arguments tok {_} _.
Notation states sts := (set (state sts)).
Notation tokens sts := (set (token sts)).
(* The type of bounds we can give to the state of an STS. This is the type (** * Theory and definitions *)
that we equip with an RA structure. *) Section sts.
Inductive bound (sts : stsT) := Context {sts : stsT}.
| bound_auth : state sts set (token sts) bound sts
| bound_frag : set (state sts) set (token sts ) bound sts.
Arguments bound_auth {_} _ _.
Arguments bound_frag {_} _ _.
Section sts_core. (** ** Step relations *)
Context (sts : stsT). Inductive step : relation (state sts * tokens sts) :=
Infix "≼" := dra_included.
Notation state := (state sts).
Notation token := (token sts).
Notation trans := (trans sts).
Notation tok := (tok sts).
Inductive equiv : Equiv (bound sts) :=
| auth_equiv s T1 T2 : T1 T2 bound_auth s T1 bound_auth s T2
| frag_equiv S1 S2 T1 T2 : T1 T2 S1 S2
bound_frag S1 T1 bound_frag S2 T2.
Global Existing Instance equiv.
Inductive step : relation (state * set token) :=
| Step s1 s2 T1 T2 : | Step s1 s2 T1 T2 :
trans s1 s2 tok s1 T1 tok s2 T2 prim_step s1 s2 tok s1 T1 tok s2 T2
tok s1 T1 tok s2 T2 step (s1,T1) (s2,T2). tok s1 T1 tok s2 T2 step (s1,T1) (s2,T2).
Hint Resolve Step. Inductive frame_step (T : tokens sts) (s1 s2 : state sts) : Prop :=
Inductive frame_step (T : set token) (s1 s2 : state) : Prop :=
| Frame_step T1 T2 : | Frame_step T1 T2 :
T1 (tok s1 T) step (s1,T1) (s2,T2) frame_step T s1 s2. T1 (tok s1 T) step (s1,T1) (s2,T2) frame_step T s1 s2.
Hint Resolve Frame_step.
Record closed (S : set state) (T : set token) : Prop := Closed { (** ** Closure under frame steps *)
Record closed (S : states sts) (T : tokens sts) : Prop := Closed {
closed_ne : S ; closed_ne : S ;
closed_disjoint s : s S tok s T ; closed_disjoint s : s S tok s T ;
closed_step s1 s2 : s1 S frame_step T s1 s2 s2 S closed_step s1 s2 : s1 S frame_step T s1 s2 s2 S
}. }.
Lemma closed_disjoint' S T s : Definition up (s : state sts) (T : tokens sts) : states sts :=
closed S T s S tok s T .
Proof.
move=>Hcl Hin. move:(closed_disjoint _ _ Hcl _ Hin).
solve_elem_of+.
Qed.
Lemma closed_steps S T s1 s2 :
closed S T s1 S rtc (frame_step T) s1 s2 s2 S.
Proof. induction 3; eauto using closed_step. Qed.
Global Instance valid : Valid (bound sts) := λ x,
match x with
| bound_auth s T => tok s T | bound_frag S' T => closed S' T
end.
Definition up (s : state) (T : set token) : set state :=
mkSet (rtc (frame_step T) s). mkSet (rtc (frame_step T) s).
Definition up_set (S : set state) (T : set token) : set state := Definition up_set (S : states sts) (T : tokens sts) : states sts :=
S = λ s, up s T. S = λ s, up s T.
Global Instance unit : Unit (bound sts) := λ x,
match x with
| bound_frag S' _ => bound_frag (up_set S' )
| bound_auth s _ => bound_frag (up s )
end.
Inductive disjoint : Disjoint (bound sts) :=
| frag_frag_disjoint S1 S2 T1 T2 :
S1 S2 T1 T2 bound_frag S1 T1 bound_frag S2 T2
| auth_frag_disjoint s S T1 T2 : s S T1 T2
bound_auth s T1 bound_frag S T2
| frag_auth_disjoint s S T1 T2 : s S T1 T2
bound_frag S T1 bound_auth s T2.
Global Existing Instance disjoint.
Global Instance op : Op (bound sts) := λ x1 x2,
match x1, x2 with
| bound_frag S1 T1, bound_frag S2 T2 => bound_frag (S1 S2) (T1 T2)
| bound_auth s T1, bound_frag _ T2 => bound_auth s (T1 T2)
| bound_frag _ T1, bound_auth s T2 => bound_auth s (T1 T2)
| bound_auth s T1, bound_auth _ T2 =>
bound_auth s (T1 T2)(* never happens *)
end.
Global Instance minus : Minus (bound sts) := λ x1 x2,
match x1, x2 with
| bound_frag S1 T1, bound_frag S2 T2 => bound_frag
(up_set S1 (T1 T2)) (T1 T2)
| bound_auth s T1, bound_frag _ T2 => bound_auth s (T1 T2)
| bound_frag _ T2, bound_auth s T1 =>
bound_auth s (T1 T2) (* never happens *)
| bound_auth s T1, bound_auth _ T2 => bound_frag (up s (T1 T2)) (T1 T2)
end.
Hint Extern 10 (base.equiv (A:=set _) _ _) => solve_elem_of : sts. (** Tactic setup *)
Hint Extern 10 (¬(base.equiv (A:=set _) _ _)) => solve_elem_of : sts. Hint Resolve Step.
Hint Extern 10 (equiv (A:=set _) _ _) => solve_elem_of : sts.
Hint Extern 10 (¬equiv (A:=set _) _ _) => solve_elem_of : sts.
Hint Extern 10 (_ _) => solve_elem_of : sts. Hint Extern 10 (_ _) => solve_elem_of : sts.
Hint Extern 10 (_ _) => solve_elem_of : sts. Hint Extern 10 (_ _) => solve_elem_of : sts.
Instance: Equivalence (() : relation (bound sts)).
Proof. (** ** Setoids *)
split. Instance framestep_proper' : Proper (() ==> (=) ==> (=) ==> impl) frame_step.
* by intros []; constructor.
* by destruct 1; constructor.
* destruct 1; inversion_clear 1; constructor; etransitivity; eauto.
Qed.
Instance framestep_proper : Proper (() ==> (=) ==> (=) ==> impl) frame_step.
Proof. intros ?? HT ?? <- ?? <-; destruct 1; econstructor; eauto with sts. Qed. Proof. intros ?? HT ?? <- ?? <-; destruct 1; econstructor; eauto with sts. Qed.
Global Instance framestep_proper : Proper (() ==> (=) ==> (=) ==> iff) frame_step.
Proof. by intros ?? [??] ??????; split; apply framestep_proper'. Qed.
Instance closed_proper' : Proper (() ==> () ==> impl) closed. Instance closed_proper' : Proper (() ==> () ==> impl) closed.
Proof. Proof.
intros ?? HT ?? HS; destruct 1; intros ?? HT ?? HS; destruct 1;
constructor; intros until 0; rewrite -?HS -?HT; eauto. constructor; intros until 0; rewrite -?HS -?HT; eauto.
Qed. Qed.
Instance closed_proper : Proper (() ==> () ==> iff) closed. Global Instance closed_proper : Proper (() ==> () ==> iff) closed.
Proof. by split; apply closed_proper'. Qed. Proof. by split; apply closed_proper'. Qed.
Lemma closed_op T1 T2 S1 S2 : Global Instance up_preserving : Proper ((=) ==> flip () ==> ()) up.
closed S1 T1 closed S2 T2
T1 T2 S1 S2 closed (S1 S2) (T1 T2).
Proof.
intros [_ ? Hstep1] [_ ? Hstep2] ?; split; [done|solve_elem_of|].
intros s3 s4; rewrite !elem_of_intersection; intros [??] [T3 T4 ?]; split.
* apply Hstep1 with s3, Frame_step with T3 T4; auto with sts.
* apply Hstep2 with s3, Frame_step with T3 T4; auto with sts.
Qed.
Instance up_preserving : Proper ((=) ==> flip () ==> ()) up.
Proof. Proof.
intros s ? <- T T' HT ; apply elem_of_subseteq. intros s ? <- T T' HT ; apply elem_of_subseteq.
induction 1 as [|s1 s2 s3 [T1 T2]]; [constructor|]. induction 1 as [|s1 s2 s3 [T1 T2]]; [constructor|].
eapply rtc_l; [eapply Frame_step with T1 T2|]; eauto with sts. eapply rtc_l; [eapply Frame_step with T1 T2|]; eauto with sts.
Qed. Qed.
Instance up_proper : Proper ((=) ==> () ==> ()) up. Global Instance up_proper : Proper ((=) ==> () ==> ()) up.
Proof. by intros ??? ?? [??]; split; apply up_preserving. Qed. Proof. by intros ??? ?? [??]; split; apply up_preserving. Qed.
Instance up_set_preserving : Proper (() ==> flip () ==> ()) up_set. Global Instance up_set_preserving : Proper (() ==> flip () ==> ()) up_set.
Proof. Proof.
intros S1 S2 HS T1 T2 HT. rewrite /up_set. 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. f_equiv; last done. move =>s1 s2 Hs. simpl in HT. by apply up_preserving.
Qed. Qed.
Instance up_set_proper : Proper (() ==> () ==> ()) up_set. Global Instance up_set_proper : Proper (() ==> () ==> ()) up_set.
Proof. by intros S1 S2 [??] T1 T2 [??]; split; apply up_set_preserving. Qed. Proof. by intros S1 S2 [??] T1 T2 [??]; split; apply up_set_preserving. Qed.
(** ** Properties of closure under frame steps *)
Lemma closed_disjoint' S T s : closed S T s S tok s T .
Proof. intros [_ ? _]; solve_elem_of. Qed.
Lemma closed_steps S T s1 s2 :
closed S T s1 S rtc (frame_step T) s1 s2 s2 S.
Proof. induction 3; eauto using closed_step. Qed.
Lemma closed_op T1 T2 S1 S2 :
closed S1 T1 closed S2 T2
T1 T2 S1 S2 closed (S1 S2) (T1 T2).
Proof.
intros [_ ? Hstep1] [_ ? Hstep2] ?; split; [done|solve_elem_of|].
intros s3 s4; rewrite !elem_of_intersection; intros [??] [T3 T4 ?]; split.
* apply Hstep1 with s3, Frame_step with T3 T4; auto with sts.
* apply Hstep2 with s3, Frame_step with T3 T4; auto with sts.
Qed.
Lemma step_closed s1 s2 T1 T2 S Tf :
step (s1,T1) (s2,T2) closed S Tf s1 S T1 Tf
s2 S T2 Tf tok s2 T2 .
Proof.
inversion_clear 1 as [???? HR Hs1 Hs2]; intros [?? Hstep]??; split_ands; auto.
* eapply Hstep with s1, Frame_step with T1 T2; auto with sts.
* solve_elem_of -Hstep Hs1 Hs2.
Qed.
(** ** Properties of the closure operators *)
Lemma elem_of_up s T : s up s T. Lemma elem_of_up s T : s up s T.
Proof. constructor. Qed. Proof. constructor. Qed.
Lemma subseteq_up_set S T : S up_set S T. Lemma subseteq_up_set S T : S up_set S T.
...@@ -176,12 +136,82 @@ Proof. ...@@ -176,12 +136,82 @@ Proof.
unfold up_set; rewrite elem_of_bind; intros (s'&Hstep&?). unfold up_set; rewrite elem_of_bind; intros (s'&Hstep&?).
induction Hstep; eauto using closed_step. induction Hstep; eauto using closed_step.
Qed. Qed.
Global Instance dra : DRA (bound sts). End sts. End sts.
Notation stsT := sts.stsT.
Notation STS := sts.STS.
(** * STSs form a disjoint RA *)
(* This module should never be imported, uses the module [sts] below. *)
Module sts_dra.
Import sts.
(* The type of bounds we can give to the state of an STS. This is the type
that we equip with an RA structure. *)
Inductive car (sts : stsT) :=
| auth : state sts set (token sts) car sts
| frag : set (state sts) set (token sts ) car sts.
Arguments auth {_} _ _.
Arguments frag {_} _ _.
Section sts_dra.
Context {sts : stsT}.
Infix "≼" := dra_included.
Implicit Types S : states sts.
Implicit Types T : tokens sts.
Inductive sts_equiv : Equiv (car sts) :=
| 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.
Existing Instance sts_equiv.
Instance sts_valid : Valid (car sts) := λ x,
match x with auth s T => tok s T | frag S' T => closed S' T end.
Instance sts_unit : Unit (car sts) := λ x,
match x with
| frag S' _ => frag (up_set S' )
| auth s _ => frag (up s )
end.
Inductive sts_disjoint : Disjoint (car sts) :=
| frag_frag_disjoint S1 S2 T1 T2 :
S1 S2 T1 T2 frag S1 T1 frag S2 T2
| auth_frag_disjoint s S T1 T2 :
s S T1 T2 auth s T1 frag S T2
| frag_auth_disjoint s S T1 T2 :
s S T1 T2 frag S T1 auth s T2.
Existing Instance sts_disjoint.
Instance sts_op : Op (car sts) := λ x1 x2,
match x1, x2 with
| frag S1 T1, frag S2 T2 => frag (S1 S2) (T1 T2)
| auth s T1, frag _ 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 *)
end.
Instance sts_minus : Minus (car sts) := λ x1 x2,
match x1, x2 with
| frag S1 T1, frag S2 T2 => frag (up_set S1 (T1 T2)) (T1 T2)
| auth s T1, frag _ T2 => auth s (T1 T2)
| frag _ T2, auth s T1 => auth s (T1 T2) (* never happens *)
| auth s T1, auth _ T2 => frag (up s (T1 T2)) (T1 T2)
end.
Hint Extern 10 (equiv (A:=set _) _ _) => solve_elem_of : sts.
Hint Extern 10 (¬equiv (A:=set _) _ _) => solve_elem_of : sts.
Hint Extern 10 (_ _) => solve_elem_of : sts.
Hint Extern 10 (_ _) => solve_elem_of : sts.
Instance sts_equivalence: Equivalence (() : relation (car sts)).
Proof.
split.
* by intros []; constructor.
* by destruct 1; constructor.
* destruct 1; inversion_clear 1; constructor; etransitivity; eauto.
Qed.
Global Instance sts_dra : DRA (car sts).
Proof. Proof.
split. split.
* apply _. * apply _.
* by do 2 destruct 1; constructor; setoid_subst. * by do 2 destruct 1; constructor; setoid_subst.
* by destruct 1; constructor; setoid_subst. * by destruct 1; constructor; setoid_subst.
* by destruct 1; simpl; intros ?; setoid_subst.
* by intros ? [|]; destruct 1; inversion_clear 1; constructor; setoid_subst. * by intros ? [|]; destruct 1; inversion_clear 1; constructor; setoid_subst.
* by do 2 destruct 1; constructor; setoid_subst. * by do 2 destruct 1; constructor; setoid_subst.
* assert ( T T' S s, * assert ( T T' S s,
...@@ -233,50 +263,104 @@ Proof. ...@@ -233,50 +263,104 @@ Proof.
unfold up_set; rewrite elem_of_bind; intros (?&s1&?&?&?). unfold up_set; rewrite elem_of_bind; intros (?&s1&?&?&?).
apply closed_steps with T2 s1; auto with sts. apply closed_steps with T2 s1; auto with sts.
Qed. Qed.
Lemma step_closed s1 s2 T1 T2 S Tf : Canonical Structure RA : cmraT := validityRA (car sts).
step (s1,T1) (s2,T2) closed S Tf s1 S T1 Tf End sts_dra. End sts_dra.
s2 S T2 Tf tok s2 T2 .
(** * The STS Resource Algebra *)
(** Finally, the general theory of STS that should be used by users *)
Notation stsRA := (@sts_dra.RA).
Section sts_definitions.
Context {sts : stsT}.
Definition sts_auth (s : sts.state sts) (T : sts.tokens sts) : stsRA sts :=
to_validity (sts_dra.auth s T).
Definition sts_frag (S : sts.states sts) (T : sts.tokens sts) : stsRA sts :=
to_validity (sts_dra.frag S T).
Definition sts_frag_up (s : sts.state sts) (T : sts.tokens sts) : stsRA sts :=
sts_frag (sts.up s T) T.
End sts_definitions.
Instance: Params (@sts_auth) 2.
Instance: Params (@sts_frag) 1.
Instance: Params (@sts_frag_up) 2.
Section stsRA.
Import sts.
Context {sts : stsT}.
Implicit Types s : state sts.
Implicit Types S : states sts.
Implicit Types T : tokens sts.
(** Setoids *)
Global Instance sts_auth_proper s : Proper (() ==> ()) (sts_auth s).
Proof. (* this proof is horrible *)
intros T1 T2 HT. rewrite /sts_auth.
by eapply to_validity_proper; try apply _; constructor.
Qed.
Global Instance sts_frag_proper : Proper (() ==> () ==> ()) (@sts_frag sts).
Proof. Proof.
inversion_clear 1 as [???? HR Hs1 Hs2]; intros [?? Hstep]??; split_ands; auto. intros S1 S2 ? T1 T2 HT; rewrite /sts_auth.
* eapply Hstep with s1, Frame_step with T1 T2; auto with sts. by eapply to_validity_proper; try apply _; constructor.
* solve_elem_of -Hstep Hs1 Hs2.
Qed. Qed.
End sts_core. Global Instance sts_frag_up_proper s : Proper (() ==> ()) (sts_frag_up s).
Proof. intros T1 T2 HT. by rewrite /sts_frag_up HT. Qed.
Section stsRA. (** Validity *)
Context (sts : stsT). Lemma sts_auth_valid s T : sts_auth s T tok s T .
Proof. split. by move=> /(_ 0). by intros ??. Qed.
Lemma sts_frag_valid S T : sts_frag S T closed S T.
Proof. split. by move=> /(_ 0). by intros ??. Qed.
Lemma sts_frag_up_valid s T : tok s T sts_frag_up s T.
Proof. intros; by apply sts_frag_valid, closed_up. Qed.
Canonical Structure RA := validityRA (bound sts). Lemma sts_auth_frag_valid_inv s S T1 T2 :
Definition auth (s : state sts) (T : set (token sts)) : RA := (sts_auth s T1 sts_frag S T2) s S.
to_validity (bound_auth s T). Proof. by move=> /(_ 0) [? [? Hdisj]]; inversion Hdisj. Qed.
Definition frag (S : set (state sts)) (T : set (token sts)) : RA :=
to_validity (bound_frag S T).
Lemma update_auth s1 s2 T1 T2 : (** Op *)
step sts (s1,T1) (s2,T2) auth s1 T1 ~~> auth s2 T2. Lemma sts_op_auth_frag s S T :
s S closed S T sts_auth s sts_frag S T sts_auth s T.
Proof.
intros; split; [split|constructor; solve_elem_of]; simpl.
- intros (?&?&?); by apply closed_disjoint' with S.
- intros; split_ands. solve_elem_of+. done. constructor; solve_elem_of.
Qed.
Lemma sts_op_auth_frag_up s T :
tok s T sts_auth s sts_frag_up s T sts_auth s T.
Proof. intros; apply sts_op_auth_frag; auto using elem_of_up, closed_up. Qed.
(** Frame preserving updates *)
Lemma sts_update_auth s1 s2 T1 T2 :
step (s1,T1) (s2,T2) sts_auth s1 T1 ~~> sts_auth s2 T2.
Proof. Proof.
intros ?; apply validity_update; inversion 3 as [|? S ? Tf|]; subst. intros ?; apply validity_update; inversion 3 as [|? S ? Tf|]; subst.
destruct (step_closed sts s1 s2 T1 T2 S Tf) as (?&?&?); auto. destruct (step_closed s1 s2 T1 T2 S Tf) as (?&?&?); auto.
repeat (done || constructor). repeat (done || constructor).
Qed. Qed.
Lemma sts_update_frag S1 S2 (T : set (token sts)) : Lemma sts_update_frag S1 S2 T :
S1 S2 closed sts S2 T closed S2 T S1 S2 sts_frag S1 T ~~> sts_frag S2 T.
frag S1 T ~~> frag S2 T.
Proof. Proof.
move=>HS Hcl. eapply validity_update; inversion 3 as [|? S ? Tf|]; subst. rewrite /sts_frag=> HS Hcl. apply validity_update.
- split; first done. constructor; last done. solve_elem_of. inversion 3 as [|? S ? Tf|]; simplify_equality'.
- split; first done. constructor; [solve_elem_of|done].
- split; first done. constructor; solve_elem_of. - split; first done. constructor; solve_elem_of.
Qed. Qed.
Lemma frag_included S1 S2 T1 T2 : Lemma sts_update_frag_up s1 S2 T :
closed sts S2 T2 closed S2 T s1 S2 sts_frag_up s1 T ~~> sts_frag S2 T.
frag S1 T1 frag S2 T2
(closed sts S1 T1 Tf, T2 T1 Tf T1 Tf
S2 (S1 up_set sts S2 Tf)).
Proof. Proof.
intros; by apply sts_update_frag; [|intros ?; eauto using closed_steps].
Qed.
(** Inclusion *)
Lemma sts_frag_included S1 S2 T1 T2 :
closed 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).
Proof. (* This should use some general properties of DRAs. To be improved
when we have RAs back *)
move=>Hcl2. split. move=>Hcl2. split.
- intros [xf EQ]. destruct xf as [xf vf Hvf]. destruct xf as [Sf Tf|Sf Tf]. - intros [[[Sf Tf|Sf Tf] vf Hvf] EQ].
{ exfalso. inversion_clear EQ as [Hv EQ']. apply EQ' in Hcl2. simpl in Hcl2. { exfalso. inversion_clear EQ as [Hv EQ']. apply EQ' in Hcl2. simpl in Hcl2.
inversion Hcl2. } inversion Hcl2. }
inversion_clear EQ as [Hv EQ']. inversion_clear EQ as [Hv EQ'].
...@@ -286,31 +370,27 @@ Proof. ...@@ -286,31 +370,27 @@ Proof.
inversion_clear Hdisj. split; last (exists Tf; split_ands); [done..|]. inversion_clear Hdisj. split; last (exists Tf; split_ands); [done..|].
apply (anti_symm ()). apply (anti_symm ()).
+ move=>s HS2. apply elem_of_intersection. split; first by apply HS. + move=>s HS2. apply elem_of_intersection. split; first by apply HS.
by apply sts.subseteq_up_set. by apply subseteq_up_set.
+ move=>s /elem_of_intersection [HS1 Hscl]. apply HS. split; first done. + move=>s /elem_of_intersection [HS1 Hscl]. apply HS. split; first done.
destruct Hscl as [s' [Hsup Hs']]. destruct Hscl as [s' [Hsup Hs']].
eapply sts.closed_steps; last (hnf in Hsup; eexact Hsup); first done. eapply closed_steps; last (hnf in Hsup; eexact Hsup); first done.
solve_elem_of +HS Hs'. solve_elem_of +HS Hs'.
- intros (Hcl1 & Tf & Htk & Hf & Hs). - intros (Hcl1 & Tf & Htk & Hf &