Commit 9c5a95d3 authored by Janno's avatar Janno Committed by Robbert Krebbers

Make validity of STS fragments require a witness.

Initial proof by Jan-Oliver Kaiser, adapted by Robbert Krebbers.
parent 9aa9b311
Pipeline #2810 passed with stage
in 9 minutes and 26 seconds
...@@ -122,6 +122,8 @@ Lemma elem_of_up s T : s ∈ up s T. ...@@ -122,6 +122,8 @@ 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.
Proof. intros s ?; apply elem_of_bind; eauto using elem_of_up. Qed. Proof. intros s ?; apply elem_of_bind; eauto using elem_of_up. Qed.
Lemma elem_of_up_set S T s : s S s up_set S T.
Proof. apply subseteq_up_set. Qed.
Lemma up_up_set s T : up s T up_set {[ s ]} T. Lemma up_up_set s T : up s T up_set {[ s ]} T.
Proof. by rewrite /up_set collection_bind_singleton. Qed. Proof. by rewrite /up_set collection_bind_singleton. Qed.
Lemma closed_up_set S T : ( s, s S tok s T) closed (up_set S T) T. Lemma closed_up_set S T : ( s, s S tok s T) closed (up_set S T) T.
...@@ -143,12 +145,6 @@ Lemma closed_up_set_empty S : closed (up_set S ∅) ∅. ...@@ -143,12 +145,6 @@ Lemma closed_up_set_empty S : closed (up_set S ∅) ∅.
Proof. eauto using closed_up_set with sts. Qed. Proof. eauto using closed_up_set with sts. Qed.
Lemma closed_up_empty s : closed (up s ) . Lemma closed_up_empty s : closed (up s ) .
Proof. eauto using closed_up with sts. Qed. Proof. eauto using closed_up with sts. Qed.
Lemma up_set_empty S T : up_set S T S .
Proof. move:(subseteq_up_set S T). set_solver. Qed.
Lemma up_set_non_empty S T : S up_set S T .
Proof. by move=>? /up_set_empty. Qed.
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. Lemma up_closed S T : closed S T up_set S T S.
Proof. Proof.
intros ?; apply collection_equiv_spec; split; auto using subseteq_up_set. intros ?; apply collection_equiv_spec; split; auto using subseteq_up_set.
...@@ -190,7 +186,7 @@ Existing Instance sts_equiv. ...@@ -190,7 +186,7 @@ Existing Instance sts_equiv.
Instance sts_valid : Valid (car sts) := λ x, 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' | frag S' T => closed S' T s, s S'
end. end.
Instance sts_core : Core (car sts) := λ x, Instance sts_core : Core (car sts) := λ x,
match x with match x with
...@@ -199,7 +195,7 @@ Instance sts_core : Core (car sts) := λ x, ...@@ -199,7 +195,7 @@ Instance sts_core : Core (car sts) := λ x,
end. end.
Inductive sts_disjoint : Disjoint (car sts) := Inductive sts_disjoint : Disjoint (car sts) :=
| frag_frag_disjoint S1 S2 T1 T2 : | frag_frag_disjoint S1 S2 T1 T2 :
S1 S2 T1 T2 frag S1 T1 frag S2 T2 ( s, s 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 | 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. | frag_auth_disjoint s S T1 T2 : s S T1 T2 frag S T1 auth s T2.
Existing Instance sts_disjoint. Existing Instance sts_disjoint.
...@@ -212,7 +208,7 @@ Instance sts_op : Op (car sts) := λ x1 x2, ...@@ -212,7 +208,7 @@ Instance sts_op : Op (car sts) := λ x1 x2,
end. end.
Hint Extern 50 (equiv (A:=set _) _ _) => set_solver : sts. Hint Extern 50 (equiv (A:=set _) _ _) => set_solver : sts.
Hint Extern 50 (¬equiv (A:=set _) _ _) => set_solver : sts. Hint Extern 50 ( s : state sts, _) => set_solver : sts.
Hint Extern 50 (_ _) => set_solver : sts. Hint Extern 50 (_ _) => set_solver : sts.
Hint Extern 50 (_ _) => set_solver : sts. Hint Extern 50 (_ _) => set_solver : sts.
Hint Extern 50 (_ _) => set_solver : sts. Hint Extern 50 (_ _) => set_solver : sts.
...@@ -236,27 +232,26 @@ Proof. ...@@ -236,27 +232,26 @@ Proof.
- 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 destruct 1; simpl; intros ?; setoid_subst.
- by intros ? [|]; destruct 1; inversion_clear 1; constructor; setoid_subst. - by intros ? [|]; destruct 1; inversion_clear 1; econstructor; setoid_subst.
- destruct 3; simpl in *; destruct_and?; eauto using closed_op; - destruct 3; simpl in *; destruct_and?; eauto using closed_op;
match goal with H : closed _ _ |- _ => destruct H end; set_solver. match goal with H : closed _ _ |- _ => destruct H end; set_solver.
- intros []; simpl; intros; destruct_and?; split; - intros []; naive_solver eauto using closed_up, closed_up_set,
eauto using closed_up, up_non_empty, closed_up_set, up_set_empty with sts. elem_of_up, elem_of_up_set with sts.
- intros [] [] []; constructor; rewrite ?assoc; auto with sts. - intros [] [] []; constructor; rewrite ?assoc; auto with sts.
- destruct 4; inversion_clear 1; constructor; auto with sts. - destruct 4; inversion_clear 1; constructor; auto with sts.
- destruct 4; inversion_clear 1; constructor; auto with sts. - destruct 4; inversion_clear 1; constructor; auto with sts.
- destruct 1; constructor; auto with sts. - destruct 1; constructor; auto with sts.
- destruct 3; constructor; auto with sts. - destruct 3; constructor; auto with sts.
- intros [|S T]; constructor; auto using elem_of_up with sts. - intros []; constructor; eauto with sts.
- intros [|S T]; constructor; auto with sts. - intros []; constructor; auto with sts.
- intros [s T|S T]; constructor; auto with sts. - intros [s T|S T]; constructor; auto with sts.
+ rewrite (up_closed (up _ _)); auto using closed_up with sts. + rewrite (up_closed (up _ _)); auto using closed_up with sts.
+ rewrite (up_closed (up_set _ _)); eauto using closed_up_set with sts. + rewrite (up_closed (up_set _ _)); eauto using closed_up_set with sts.
- intros x y. exists (core (x y))=> ?? Hxy; split_and?. - intros x y. exists (core (x y))=> ?? Hxy; split_and?.
+ destruct Hxy; constructor; unfold up_set; set_solver. + destruct Hxy; constructor; unfold up_set; set_solver.
+ destruct Hxy; simpl; split_and?; + destruct Hxy; simpl;
auto using closed_up_set_empty, closed_up_empty, up_non_empty; []. eauto using closed_up_set_empty, closed_up_empty with sts.
apply up_set_non_empty. set_solver. + destruct Hxy; econstructor;
+ destruct Hxy; constructor;
repeat match goal with repeat match goal with
| |- context [ up_set ?S ?T ] => | |- context [ up_set ?S ?T ] =>
unless (S up_set S T) by done; pose proof (subseteq_up_set S T) unless (S up_set S T) by done; pose proof (subseteq_up_set S T)
...@@ -304,10 +299,10 @@ Proof. solve_proper. Qed. ...@@ -304,10 +299,10 @@ Proof. solve_proper. Qed.
(** Validity *) (** Validity *)
Lemma sts_auth_valid s T : sts_auth s T tok s T. Lemma sts_auth_valid s T : sts_auth s T tok s T.
Proof. done. Qed. Proof. done. Qed.
Lemma sts_frag_valid S T : sts_frag S T closed S T S . Lemma sts_frag_valid S T : sts_frag S T closed S T s, s S.
Proof. done. Qed. Proof. done. Qed.
Lemma sts_frag_up_valid s T : tok s T sts_frag_up s T. Lemma sts_frag_up_valid s T : tok s T sts_frag_up s T.
Proof. intros. by apply sts_frag_valid; auto using closed_up, up_non_empty. Qed. Proof. intros. apply sts_frag_valid; split. by apply closed_up. set_solver. Qed.
Lemma sts_auth_frag_valid_inv s S T1 T2 : Lemma sts_auth_frag_valid_inv s S T1 T2 :
(sts_auth s T1 sts_frag S T2) s S. (sts_auth s T1 sts_frag S T2) s S.
...@@ -329,7 +324,7 @@ Proof. ...@@ -329,7 +324,7 @@ Proof.
- intros; split_and?. - intros; split_and?.
+ set_solver+. + set_solver+.
+ by apply closed_up. + by apply closed_up.
+ apply up_non_empty. + exists s. set_solver.
+ constructor; last set_solver. apply elem_of_up. + constructor; last set_solver. apply elem_of_up.
Qed. Qed.
...@@ -338,7 +333,7 @@ Lemma sts_op_frag S1 S2 T1 T2 : ...@@ -338,7 +333,7 @@ Lemma sts_op_frag S1 S2 T1 T2 :
sts_frag (S1 S2) (T1 T2) sts_frag S1 T1 sts_frag S2 T2. sts_frag (S1 S2) (T1 T2) sts_frag S1 T1 sts_frag S2 T2.
Proof. Proof.
intros HT HS1 HS2. rewrite /sts_frag -to_validity_op //. intros HT HS1 HS2. rewrite /sts_frag -to_validity_op //.
move=>/=[??]. split_and!; [auto; set_solver..|by constructor]. move=>/=[?[? ?]]. split_and!; [set_solver..|constructor; set_solver].
Qed. Qed.
(** Frame preserving updates *) (** Frame preserving updates *)
...@@ -356,8 +351,8 @@ Lemma sts_update_frag S1 S2 T1 T2 : ...@@ -356,8 +351,8 @@ Lemma sts_update_frag S1 S2 T1 T2 :
Proof. Proof.
rewrite /sts_frag=> ? HS HT. apply validity_update. rewrite /sts_frag=> ? HS HT. apply validity_update.
inversion 3 as [|? S ? Tf|]; simplify_eq/=. inversion 3 as [|? S ? Tf|]; simplify_eq/=.
- split_and!; first done; first set_solver. constructor; set_solver. - split_and!. done. set_solver. constructor; set_solver.
- split_and!; first done; first set_solver. constructor; set_solver. - split_and!. done. set_solver. constructor; set_solver.
Qed. Qed.
Lemma sts_update_frag_up s1 S2 T1 T2 : Lemma sts_update_frag_up s1 S2 T1 T2 :
......
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