Skip to content
Snippets Groups Projects
Commit 5ee73302 authored by Jonas Kastberg's avatar Jonas Kastberg
Browse files

Better spec for lock example, and polish

parent fce3e267
No related branches found
No related tags found
No related merge requests found
Pipeline #45262 passed
...@@ -12,29 +12,30 @@ Section example. ...@@ -12,29 +12,30 @@ Section example.
Definition pizza_to_val (p : pizza) := Definition pizza_to_val (p : pizza) :=
match p with match p with
| Margherita => #true | Margherita => #0
| Calzone => #false | Calzone => #1
end. end.
Fixpoint list_to_val {T} (f : T -> val) (xs : list T) := Fixpoint list_to_val {T} (f : T val) (xs : list T) :=
match xs with match xs with
| [] => NONEV | [] => NONEV
| x::xs => SOMEV (PairV (f x) (list_to_val f xs)) | x::xs => SOMEV ((f x), (list_to_val f xs))%V
end. end.
Definition pizza_list_to_val := list_to_val pizza_to_val. Notation pizza_list_to_val := (list_to_val pizza_to_val).
Fixpoint is_list {T} (f : T -> val) (v : val) (ws : list T) : iProp Σ := Fixpoint is_list {T} (f : T val) (v : val) (ws : list T) : iProp Σ :=
match ws with match ws with
| [] => v = NONEV | [] => v = NONEV
| w::ws => (v' : val), v = SOMEV (PairV (f w) v') is_list f v' ws | w::ws => (v' : val), v = SOMEV ((f w), v')%V is_list f v' ws
end. end.
Definition is_int_list : val list Z iProp Σ := Notation is_int_list := (is_list (λ v, LitV $ LitInt $ v)).
is_list (λ v, LitV $ LitInt $ v). Notation is_pizza_list := (is_list pizza_to_val).
Definition is_pizza_list : val list pizza iProp Σ := Lemma is_pizza_list_pizzas pizzas :
is_list pizza_to_val. is_pizza_list (pizza_list_to_val pizzas) pizzas.
Proof. induction pizzas; [eauto | iExists _; eauto]. Qed.
Fixpoint int_list_sum (xs : list Z) : Z := Fixpoint int_list_sum (xs : list Z) : Z :=
match xs with match xs with
...@@ -52,7 +53,7 @@ Section example. ...@@ -52,7 +53,7 @@ Section example.
Lemma sum_list_spec v xs : Lemma sum_list_spec v xs :
{{{ is_int_list v xs }}} {{{ is_int_list v xs }}}
sum_list v sum_list v
{{{ RET #(int_list_sum xs)%Z; True }}}. {{{ RET #(int_list_sum xs); True }}}.
Proof. Proof.
unfold is_int_list. unfold is_int_list.
iIntros (Φ) "Hxs HΦ". iIntros (Φ) "Hxs HΦ".
...@@ -67,9 +68,9 @@ Section example. ...@@ -67,9 +68,9 @@ Section example.
by iApply "HΦ". by iApply "HΦ".
Qed. Qed.
Definition order_pizza : val := Definition order_pizza (pizzas : list pizza) : val :=
λ: "cc" "c", λ: "cc" "c",
send "c" (pizza_list_to_val [Margherita; Calzone]);; send "c" (pizza_list_to_val pizzas);;
send "c" "cc";; send "c" "cc";;
let: "receipt" := recv "c" in let: "receipt" := recv "c" in
(sum_list "receipt", !"cc"). (sum_list "receipt", !"cc").
...@@ -90,17 +91,17 @@ Section example. ...@@ -90,17 +91,17 @@ Section example.
ProtoUnfold pizza_prot (pizza_prot_aux pizza_prot). ProtoUnfold pizza_prot (pizza_prot_aux pizza_prot).
Proof. apply proto_unfold_eq, (fixpoint_unfold _). Qed. Proof. apply proto_unfold_eq, (fixpoint_unfold _). Qed.
Lemma order_pizza_spec c cc (x : Z) : Lemma order_pizza_spec pizzas c cc (x1 : Z) :
{{{ c pizza_prot cc #x }}} {{{ c pizza_prot cc #x1 }}}
order_pizza #cc c order_pizza pizzas #cc c
{{{ (y x2 : Z), RET PairV #y #x2; {{{ (x2 : Z), RET (#x2, #(x1 - x2))%V;
c pizza_prot cc #x2 x2 = (x - y)%Z }}}. c pizza_prot cc #(x1 - x2)%Z }}}.
Proof. Proof.
iIntros (Φ) "[Hc Hcc] HΦ". iIntros (Φ) "[Hc Hcc] HΦ".
wp_lam. wp_lam.
wp_send (_ [Margherita; Calzone]) with "[]". wp_send (_ pizzas) with "[]".
{ unfold is_pizza_list. simpl. eauto. } { iApply is_pizza_list_pizzas. }
wp_send with "[Hcc]"=> //. wp_send with "[Hcc //]".
wp_recv (v2 xs2) as "[Hxs2 [_ Hcc]]". wp_recv (v2 xs2) as "[Hxs2 [_ Hcc]]".
wp_load. wp_load.
wp_apply (sum_list_spec with "Hxs2"). wp_apply (sum_list_spec with "Hxs2").
...@@ -111,57 +112,62 @@ Section example. ...@@ -111,57 +112,62 @@ Section example.
eauto with iFrame. eauto with iFrame.
Qed. Qed.
Definition lock_example : val := Definition lock_example : val :=
λ: "c", λ: "jesper_cc" "robbert_cc" "c",
let: "lk" := newlock #() in let: "lk" := newlock #() in
( (
(let: "jesper_cc" := ref #0 in (acquire "lk";;
acquire "lk";; let: "v1" := order_pizza [Margherita] "jesper_cc" "c" in
send "c" (pizza_list_to_val [Margherita]);; release "lk";;
send "c" "jesper_cc";; "v1")
let: "jesper_receipt" := recv "c" in
"jesper_receipt")
||| |||
(let: "robbert_cc" := ref #0 in (acquire "lk";;
acquire "lk";; let: "v2" := order_pizza [Calzone] "robbert_cc" "c" in
send "c" (pizza_list_to_val [Calzone]);; release "lk";;
send "c" "robbert_cc";; "v2")
let: "robbert_receipt" := recv "c" in
"robbert_receipt")
). ).
Lemma lock_example_spec c : Lemma lock_example_spec jcc rcc c (x1 y1 : Z) :
{{{ c pizza_prot }}} {{{ c pizza_prot jcc #x1 rcc #y1 }}}
lock_example c lock_example #jcc #rcc c
{{{ v, RET v; True }}}. {{{ (x2 y2 : Z), RET ((#x2, #(x1 - x2)), (#y2, #(y1 - y2)))%V;
jcc #(x1 - x2) rcc #(y1 - y2) }}}.
Proof. Proof.
iIntros (Φ) "Hc HΦ". iIntros (Φ) "[Hc [Hjcc Hrcc]] HΦ".
wp_lam. wp_lam. wp_pures.
wp_apply (newlock_spec with "Hc"). wp_apply (newlock_spec with "Hc").
iIntros (lk γ) "#Hlk". iIntros (lk γ) "#Hlk".
wp_pures. wp_pures.
wp_apply wp_par. wp_apply (wp_par (λ v, (x2:Z), v = (#x2, #(x1 - x2))%V
- wp_alloc cc as "Hcc". jcc #(x1 - x2)%Z)%I
wp_pures. (λ v, (y2:Z), v = (#y2, #(y1 - y2))%V
rcc #(y1 - y2)%Z)%I
with "[Hjcc] [Hrcc]").
- wp_pures.
wp_apply (acquire_spec with "Hlk"). wp_apply (acquire_spec with "Hlk").
iIntros "[Hlocked Hc]". iIntros "[Hlocked Hc]".
wp_send (_ [Margherita]) with "[]". wp_pures. wp_apply (order_pizza_spec with "[$Hc $Hjcc]").
{ eauto. } iIntros (x2) "[Hc Hjcc]".
wp_send with "[Hcc]"=> //. wp_pures.
wp_recv (v2 xs2) as "[Hxs2 [_ Hcc]]". wp_apply (release_spec with "[$Hlk $Hlocked $Hc]").
wp_pures. eauto. iIntros "_".
- wp_alloc cc as "Hcc".
wp_pures. wp_pures.
eauto.
- wp_pures.
wp_apply (acquire_spec with "Hlk"). wp_apply (acquire_spec with "Hlk").
iIntros "[Hlocked Hc]". iIntros "[Hlocked Hc]".
wp_send (_ [Calzone]) with "[]". wp_pures. wp_apply (order_pizza_spec with "[$Hc $Hrcc]").
{ eauto. } iIntros (y2) "[Hc Hrcc]".
wp_send with "[Hcc]"=> //. wp_pures.
wp_recv (v2 xs2) as "[Hxs2 [_ Hcc]]". wp_apply (release_spec with "[$Hlk $Hlocked $Hc]").
wp_pures. eauto. iIntros "_".
- iIntros (v1 v2) "[_ _]". wp_pures.
by iApply "HΦ". eauto.
- iIntros (v1 v2) "[HΨ1 HΨ2]".
iIntros "!>".
iDestruct "HΨ1" as (x2) "[-> HΨ1]".
iDestruct "HΨ2" as (y2) "[-> HΨ2]".
iApply ("HΦ" with "[$HΨ1 $HΨ2]").
Qed. Qed.
End example. End example.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment