Commit 0ef28164 authored by Robbert Krebbers's avatar Robbert Krebbers

Use multiple files for barrier.

parent 0ea44879
......@@ -84,4 +84,7 @@ heap_lang/notation.v
heap_lang/tests.v
heap_lang/substitution.v
barrier/barrier.v
barrier/specification.v
barrier/protocol.v
barrier/proof.v
barrier/client.v
This diff is collapsed.
From barrier Require Import barrier.
From barrier Require Import proof.
From program_logic Require Import auth sts saved_prop hoare ownership.
Import uPred.
......
This diff is collapsed.
From algebra Require Export sts.
From program_logic Require Import ghost_ownership.
(** The STS describing the main barrier protocol. Every state has an index-set
associated with it. These indices are actually [gname], because we use them
with saved propositions. *)
Inductive phase := Low | High.
Record state := State { state_phase : phase; state_I : gset gname }.
Add Printing Constructor state.
Inductive token := Change (i : gname) | Send.
Global Instance stateT_inhabited: Inhabited state := populate (State Low ).
Global Instance Change_inj : Inj (=) (=) Change.
Proof. by injection 1. Qed.
Inductive prim_step : relation state :=
| ChangeI p I2 I1 : prim_step (State p I1) (State p I2)
| ChangePhase I : prim_step (State Low I) (State High I).
Definition change_tok (I : gset gname) : set token :=
mkSet (λ t, match t with Change i => i I | Send => False end).
Definition send_tok (p : phase) : set token :=
match p with Low => | High => {[ Send ]} end.
Definition tok (s : state) : set token :=
change_tok (state_I s) send_tok (state_phase s).
Global Arguments tok !_ /.
Canonical Structure sts := sts.STS prim_step tok.
(* The set of states containing some particular i *)
Definition i_states (i : gname) : set state :=
mkSet (λ s, i state_I s).
(* The set of low states *)
Definition low_states : set state :=
mkSet (λ s, if state_phase s is Low then True else False).
Lemma i_states_closed i : sts.closed (i_states i) {[ Change i ]}.
Proof.
split.
- move=>[p I]. rewrite /= !mkSet_elem_of /= =>HI.
destruct p; set_solver by eauto.
- (* If we do the destruct of the states early, and then inversion
on the proof of a transition, it doesn't work - we do not obtain
the equalities we need. So we destruct the states late, because this
means we can use "destruct" instead of "inversion". *)
move=>s1 s2. rewrite !mkSet_elem_of.
intros Hs1 [T1 T2 Hdisj Hstep'].
inversion_clear Hstep' as [? ? ? ? Htrans _ _ Htok].
destruct Htrans; simpl in *; last done.
move: Hs1 Hdisj Htok. rewrite elem_of_equiv_empty elem_of_equiv.
move=> ? /(_ (Change i)) Hdisj /(_ (Change i)); move: Hdisj.
rewrite elem_of_intersection elem_of_union !mkSet_elem_of.
intros; apply dec_stable.
destruct p; set_solver.
Qed.
Lemma low_states_closed : sts.closed low_states {[ Send ]}.
Proof.
split.
- move=>[p I]. rewrite /= /tok !mkSet_elem_of /= =>HI.
destruct p; set_solver.
- move=>s1 s2. rewrite !mkSet_elem_of.
intros Hs1 [T1 T2 Hdisj Hstep'].
inversion_clear Hstep' as [? ? ? ? Htrans _ _ Htok].
destruct Htrans; simpl in *; first by destruct p.
set_solver.
Qed.
(* Proof that we can take the steps we need. *)
Lemma signal_step I : sts.steps (State Low I, {[Send]}) (State High I, ).
Proof. apply rtc_once. constructor; first constructor; set_solver. Qed.
Lemma wait_step i I :
i I
sts.steps (State High I, {[ Change i ]}) (State High (I {[ i ]}), ).
Proof.
intros. apply rtc_once.
constructor; first constructor; simpl; [set_solver by eauto..|].
(* TODO this proof is rather annoying. *)
apply elem_of_equiv=>t. rewrite !elem_of_union.
rewrite !mkSet_elem_of /change_tok /=.
destruct t as [j|]; last set_solver.
rewrite elem_of_difference elem_of_singleton.
destruct (decide (i = j)); set_solver.
Qed.
Lemma split_step p i i1 i2 I :
i I i1 I i2 I i1 i2
sts.steps
(State p I, {[ Change i ]})
(State p ({[i1]} ({[i2]} (I {[i]}))), {[ Change i1; Change i2 ]}).
Proof.
intros. apply rtc_once.
constructor; first constructor; simpl.
- destruct p; set_solver.
(* This gets annoying... and I think I can see a pattern with all these proofs. Automatable? *)
- apply elem_of_equiv=>t. destruct t; last set_solver.
rewrite !mkSet_elem_of !not_elem_of_union !not_elem_of_singleton
not_elem_of_difference elem_of_singleton !(inj_iff Change).
destruct p; naive_solver.
- apply elem_of_equiv=>t. destruct t as [j|]; last set_solver.
rewrite !mkSet_elem_of !not_elem_of_union !not_elem_of_singleton
not_elem_of_difference elem_of_singleton !(inj_iff Change).
destruct (decide (i1 = j)) as [->|]; first tauto.
destruct (decide (i2 = j)) as [->|]; intuition.
Qed.
From program_logic Require Export hoare.
From barrier Require Export barrier.
From barrier Require Import proof.
Import uPred.
Section spec.
Context {Σ : iFunctorG} `{!heapG Σ} `{!barrierG Σ}.
Local Notation iProp := (iPropG heap_lang Σ).
(* TODO: Maybe notation for LocV (and Loc)? *)
Lemma barrier_spec (heapN N : namespace) :
heapN N
recv send : loc -> iProp -n> iProp,
( P, heap_ctx heapN {{ True }} newchan '() {{ λ v, l, v = LocV l recv l P send l P }})
( l P, {{ send l P P }} signal (LocV l) {{ λ _, True }})
( l P, {{ recv l P }} wait (LocV l) {{ λ _, P }})
( l P Q, {{ recv l (P Q) }} Skip {{ λ _, recv l P recv l Q }})
( l P Q, (P - Q) (recv l P - recv l Q)).
Proof.
intros HN.
exists (λ l, CofeMor (recv heapN N l)), (λ l, CofeMor (send heapN N l)).
split_and?; simpl.
- intros P. apply: always_intro. apply impl_intro_r.
rewrite -(newchan_spec heapN N P) // always_and_sep_r.
apply sep_mono_r, forall_intro=>l; apply wand_intro_l.
by rewrite right_id -(exist_intro l) const_equiv // left_id.
- intros l P. apply ht_alt. by rewrite -signal_spec right_id.
- intros l P. apply ht_alt.
by rewrite -(wait_spec heapN N l P) wand_diag right_id.
- intros l P Q. apply ht_alt. rewrite -(recv_split heapN N l P Q).
apply sep_intro_True_r; first done. apply wand_intro_l. eauto with I.
- intros l P Q. apply recv_strengthen.
Qed.
End spec.
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