Commit 5cb675da authored by Robbert Krebbers's avatar Robbert Krebbers

Merge branch 'robbert/model'

parents 36f40743 270596d4
Pipeline #25956 canceled with stage
in 1 minute and 15 seconds
...@@ -5,6 +5,7 @@ theories/utils/llist.v ...@@ -5,6 +5,7 @@ theories/utils/llist.v
theories/utils/compare.v theories/utils/compare.v
theories/utils/contribution.v theories/utils/contribution.v
theories/utils/group.v theories/utils/group.v
theories/utils/cofe_solver_2.v
theories/channel/proto_model.v theories/channel/proto_model.v
theories/channel/proto.v theories/channel/proto.v
theories/channel/channel.v theories/channel/channel.v
......
...@@ -174,6 +174,21 @@ Section channel. ...@@ -174,6 +174,21 @@ Section channel.
by apply iProto_message_proper=> /= -[]. by apply iProto_message_proper=> /= -[].
Qed. Qed.
Lemma iProto_le_branch a P1 P2 p1 p2 p1' p2' :
(P1 - P1 iProto_le p1 p1') (P2 - P2 iProto_le p2 p2') -
iProto_le (iProto_branch a P1 P2 p1 p2) (iProto_branch a P1 P2 p1' p2').
Proof.
iIntros "H". rewrite /iProto_branch. destruct a.
- iApply iProto_le_send'; iIntros "!>" (b) "HP /=".
iExists b; iSplit; [done|]. destruct b.
+ iDestruct "H" as "[H _]". by iApply "H".
+ iDestruct "H" as "[_ H]". by iApply "H".
- iApply iProto_le_recv'; iIntros "!>" (b) "HP /=".
iExists b; iSplit; [done|]. destruct b.
+ iDestruct "H" as "[H _]". by iApply "H".
+ iDestruct "H" as "[_ H]". by iApply "H".
Qed.
(** ** Specifications of [send] and [recv] *) (** ** Specifications of [send] and [recv] *)
Lemma new_chan_spec p : Lemma new_chan_spec p :
{{{ True }}} {{{ True }}}
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
...@@ -86,6 +86,24 @@ Definition prog_lock : val := λ: <>, ...@@ -86,6 +86,24 @@ Definition prog_lock : val := λ: <>,
acquire "l";; send "c'" #21;; release "l") in acquire "l";; send "c'" #21;; release "l") in
recv "c" + recv "c". recv "c" + recv "c".
(** Swapping of sends *)
Definition prog_swap : val := λ: <>,
let: "c" := start_chan (λ: "c'",
send "c'" #20;;
let: "y" := recv "c'" in
send "c'" "y") in
send "c" #22;;
recv "c" + recv "c".
Definition prog_swap_twice : val := λ: <>,
let: "c" := start_chan (λ: "c'",
send "c'" #20;;
let: "y1" := recv "c'" in
let: "y2" := recv "c'" in
send "c'" ("y1" + "y2")) in
send "c" #11;; send "c" #11;;
recv "c" + recv "c".
Section proofs. Section proofs.
Context `{heapG Σ, chanG Σ}. Context `{heapG Σ, chanG Σ}.
...@@ -142,6 +160,17 @@ Fixpoint prot_lock (n : nat) : iProto Σ := ...@@ -142,6 +160,17 @@ Fixpoint prot_lock (n : nat) : iProto Σ :=
| S n' => <?> MSG #21; prot_lock n' | S n' => <?> MSG #21; prot_lock n'
end%proto. end%proto.
Definition prot_swap : iProto Σ :=
(<!> x : Z, MSG #x;
<?> MSG #20;
<?> MSG #x; END)%proto.
Definition prot_swap_twice : iProto Σ :=
(<!> x : Z, MSG #x;
<!> y : Z, MSG #y;
<?> MSG #20;
<?> MSG #(x+y); END)%proto.
(** Specs and proofs of the respective programs *) (** Specs and proofs of the respective programs *)
Lemma prog_spec : {{{ True }}} prog #() {{{ RET #42; True }}}. Lemma prog_spec : {{{ True }}} prog #() {{{ RET #42; True }}}.
Proof. Proof.
...@@ -270,4 +299,23 @@ Proof. ...@@ -270,4 +299,23 @@ Proof.
by wp_apply "Hhelp". by wp_apply "Hhelp".
- wp_recv as "_". wp_recv as "_". wp_pures. by iApply "HΦ". - wp_recv as "_". wp_recv as "_". wp_pures. by iApply "HΦ".
Qed. Qed.
Lemma prog_swap_spec : {{{ True }}} prog_swap #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_spec prot_swap); iIntros (c) "Hc".
- wp_send with "[//]". wp_recv (x) as "_". by wp_send with "[//]".
- wp_send with "[//]". wp_recv as "_". wp_recv as "_".
wp_pures. by iApply "HΦ".
Qed.
Lemma prog_swap_twice_spec : {{{ True }}} prog_swap_twice #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_spec prot_swap_twice); iIntros (c) "Hc".
- wp_send with "[//]". wp_recv (x1) as "_". wp_recv (x2) as "_".
by wp_send with "[//]".
- wp_send with "[//]". wp_send with "[//]". wp_recv as "_". wp_recv as "_".
wp_pures. by iApply "HΦ".
Qed.
End proofs. End proofs.
From iris.algebra Require Import cofe_solver.
(** Composition of [oFunctor]. Move to Iris. Fix name [oFunctor_compose] which
is already in use. *)
Program Definition oFunctor_compose (F1 F2 : oFunctor)
`{! `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} : oFunctor := {|
oFunctor_car A _ B _ := oFunctor_car F1 (oFunctor_car F2 B A) (oFunctor_car F2 A B);
oFunctor_map A1 _ A2 _ B1 _ B2 _ 'fg :=
oFunctor_map F1 (oFunctor_map F2 (fg.2,fg.1),oFunctor_map F2 fg)
|}.
Next Obligation.
intros F1 F2 ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] [??]; simpl in *.
apply oFunctor_ne; split; apply oFunctor_ne; by split.
Qed.
Next Obligation.
intros F1 F2 ? A ? B ? x; simpl in *. rewrite -{2}(oFunctor_id F1 x).
apply equiv_dist=> n. apply oFunctor_ne. split=> y /=; by rewrite !oFunctor_id.
Qed.
Next Obligation.
intros F1 F2 ? A1 ? A2 ? A3 ? B1 ? B2 ? B3 ? f g f' g' x; simpl in *.
rewrite -oFunctor_compose. apply equiv_dist=> n. apply oFunctor_ne.
split=> y /=; by rewrite !oFunctor_compose.
Qed.
Instance oFunctor_compose_contractive1 (F1 F2 : oFunctor)
`{! `{Cofe A, Cofe B}, Cofe (oFunctor_car F2 A B)} :
oFunctorContractive F1 oFunctorContractive (oFunctor_compose F1 F2).
Proof.
intros ? A1 ? A2 ? B1 ? B2 ? n [f1 g1] [f2 g2] Hfg; simpl in *.
f_contractive; destruct Hfg; split; simpl in *; apply oFunctor_ne; by split.
Qed.
(** Version of the cofe_solver for a parametrized functor. Generalize and move
to Iris. *)
Record solution_2 (F : ofeT oFunctor) := Solution2 {
solution_2_car :> An `{!Cofe An} A `{!Cofe A}, ofeT;
solution_2_cofe `{!Cofe An, !Cofe A} : Cofe (solution_2_car An A);
solution_2_iso `{!Cofe An, !Cofe A} :>
ofe_iso (F A (solution_2_car A An) _) (solution_2_car An A);
}.
Existing Instance solution_2_cofe.
Section cofe_solver_2.
Context (F : ofeT oFunctor).
Context `{Fcontr : ! T, oFunctorContractive (F T)}.
Context `{Fcofe : ! `{!Cofe T, Cofe Bn, !Cofe B}, Cofe (oFunctor_car (F T) Bn B)}.
Context `{Finh : ! `{!Cofe T, Cofe Bn, !Cofe B}, Inhabited (oFunctor_car (F T) Bn B)}.
Notation map := (oFunctor_map (F _)).
Definition F_2 (An : ofeT) `{!Cofe An} (A : ofeT) `{!Cofe A} : oFunctor :=
oFunctor_compose (F A) (F An).
Definition T_result `{!Cofe An, !Cofe A} : solution (F_2 An A) := solver.result _.
Definition T (An : ofeT) `{!Cofe An} (A : ofeT) `{!Cofe A} : ofeT :=
T_result (An:=An) (A:=A).
Instance T_cofe `{!Cofe An, !Cofe A} : Cofe (T An A) := _.
Instance T_inhabited `{!Cofe An, !Cofe A} : Inhabited (T An A) :=
populate (ofe_iso_1 T_result inhabitant).
Definition T_iso_fun_aux `{!Cofe An, !Cofe A}
(rec : prodO (F An (T An A) _ -n> T A An) (T A An -n> F An (T An A) _)) :
prodO (F A (T A An) _ -n> T An A) (T An A -n> F A (T A An) _) :=
(ofe_iso_1 T_result map (rec.1,rec.2), map (rec.2,rec.1) ofe_iso_2 T_result).
Instance T_iso_aux_fun_contractive `{!Cofe An, !Cofe A} :
Contractive (T_iso_fun_aux (An:=An) (A:=A)).
Proof. solve_contractive. Qed.
Definition T_iso_fun_aux_2 `{!Cofe An, !Cofe A}
(rec : prodO (F A (T A An) _ -n> T An A) (T An A -n> F A (T A An) _)) :
prodO (F A (T A An) _ -n> T An A) (T An A -n> F A (T A An) _) :=
T_iso_fun_aux (T_iso_fun_aux rec).
Instance T_iso_fun_aux_2_contractive `{!Cofe An, !Cofe A} :
Contractive (T_iso_fun_aux_2 (An:=An) (A:=A)).
Proof.
intros n rec1 rec2 Hrec. rewrite /T_iso_fun_aux_2.
f_equiv. by apply T_iso_aux_fun_contractive.
Qed.
Definition T_iso_fun `{!Cofe An, !Cofe A} :
prodO (F A (T A An) _ -n> T An A) (T An A -n> F A (T A An) _) :=
fixpoint T_iso_fun_aux_2.
Definition T_iso_fun_unfold_1 `{!Cofe An, !Cofe A} y :
T_iso_fun (An:=An) (A:=A).1 y (T_iso_fun_aux (T_iso_fun_aux T_iso_fun)).1 y.
Proof. apply (fixpoint_unfold T_iso_fun_aux_2). Qed.
Definition T_iso_fun_unfold_2 `{!Cofe An, !Cofe A} y :
T_iso_fun (An:=An) (A:=A).2 y (T_iso_fun_aux (T_iso_fun_aux T_iso_fun)).2 y.
Proof. apply (fixpoint_unfold T_iso_fun_aux_2). Qed.
Lemma result_2 : solution_2 F.
Proof using Fcontr Fcofe Finh.
apply (Solution2 F T _)=> An Hcn A Hc.
apply (OfeIso (T_iso_fun.1) (T_iso_fun.2)).
- intros y. apply equiv_dist=> n. revert An Hcn A Hc y.
induction (lt_wf n) as [n _ IH]; intros An ? A ? y.
rewrite T_iso_fun_unfold_1 T_iso_fun_unfold_2 /=.
rewrite -{2}(ofe_iso_12 T_result y). f_equiv.
rewrite -(oFunctor_id (F _) (ofe_iso_2 T_result y)) -!ofe.oFunctor_compose.
f_equiv; apply Fcontr; destruct n as [|n]; simpl; [done|].
split => x /=; rewrite ofe_iso_21 -{2}(oFunctor_id (F _) x)
-!ofe.oFunctor_compose; do 2 f_equiv; split=> z /=; auto.
- intros y. apply equiv_dist=> n. revert An Hcn A Hc y.
induction (lt_wf n) as [n _ IH]; intros An ? A ? y.
rewrite T_iso_fun_unfold_1 T_iso_fun_unfold_2 /= ofe_iso_21.
rewrite -(oFunctor_id (F _) y) -!ofe.oFunctor_compose.
f_equiv; apply Fcontr; destruct n as [|n]; simpl; [done|].
split => x /=; rewrite -{2}(ofe_iso_12 T_result x); f_equiv;
rewrite -{2}(oFunctor_id (F _) (ofe_iso_2 T_result x)) -!ofe.oFunctor_compose;
do 2 f_equiv; split=> z /=; auto.
Qed.
End cofe_solver_2.
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