Commit cd70979b authored by Robbert Krebbers's avatar Robbert Krebbers

Make everything work; lots of refactoring.

parent 72be456a
......@@ -5,9 +5,9 @@ theories/utils/llist.v
theories/utils/compare.v
theories/utils/contribution.v
theories/utils/group.v
theories/channel/channel.v
theories/channel/proto_model.v
theories/channel/proto_channel.v
theories/channel/proto.v
theories/channel/channel.v
theories/channel/proofmode.v
theories/examples/basics.v
theories/examples/sort.v
......
This diff is collapsed.
......@@ -9,7 +9,7 @@ In addition to the tactics for symbolic execution, this file defines the tactic
recursive protocols are contractive. *)
From iris.heap_lang Require Export proofmode notation.
From iris.proofmode Require Export tactics.
From actris Require Export proto_channel.
From actris Require Export channel.
From iris.proofmode Require Import coq_tactics reduction spec_patterns.
(** * Tactics for proving contractiveness of protocols *)
......@@ -56,7 +56,7 @@ Notation ProtoUnfold p1 p2 := (∀ d pas q,
ProtoNormalize d p2 pas q ProtoNormalize d p1 pas q).
Section classes.
Context `{!proto_chanG Σ, !heapG Σ}.
Context `{!chanG Σ, !heapG Σ}.
Implicit Types p : iProto Σ.
Implicit Types TT : tele.
......@@ -163,7 +163,7 @@ End classes.
(** * Symbolic execution tactics *)
(* TODO: Maybe strip laters from other hypotheses in the future? *)
Lemma tac_wp_recv `{!proto_chanG Σ, !heapG Σ} {TT : tele} Δ i j K
Lemma tac_wp_recv `{!chanG Σ, !heapG Σ} {TT : tele} Δ i j K
c p (pc : TT val * iProp Σ * iProto Σ) Φ :
envs_lookup i Δ = Some (false, c p)%I
ProtoNormalize false p [] (iProto_message Receive pc)
......@@ -241,7 +241,7 @@ Tactic Notation "wp_recv" "(" simple_intropattern_list(xs) ")" "as" "(" simple_i
simple_intropattern(x8) ")" constr(pat) :=
wp_recv_core (intros xs) as (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat).
Lemma tac_wp_send `{!proto_chanG Σ, !heapG Σ} {TT : tele} Δ neg i js K
Lemma tac_wp_send `{!chanG Σ, !heapG Σ} {TT : tele} Δ neg i js K
c v p (pc : TT val * iProp Σ * iProto Σ) Φ :
envs_lookup i Δ = Some (false, c p)%I
ProtoNormalize false p [] (iProto_message Send pc)
......@@ -337,7 +337,7 @@ Tactic Notation "wp_send" "(" uconstr(x1) uconstr(x2) uconstr(x3) uconstr(x4) ")
wp_send_core (eexists x1; eexists x2; eexists x3; eexists x4; eexists x5;
eexists x6; eexists x7; eexists x8) with pat.
Lemma tac_wp_branch `{!proto_chanG Σ, !heapG Σ} Δ i j K
Lemma tac_wp_branch `{!chanG Σ, !heapG Σ} Δ i j K
c p P1 P2 (p1 p2 : iProto Σ) Φ :
envs_lookup i Δ = Some (false, c p)%I
ProtoNormalize false p [] (p1 <{P1}&{P2}> p2)
......@@ -385,7 +385,7 @@ Tactic Notation "wp_branch" "as" "%" simple_intropattern(pat1) "|" "%" simple_in
wp_branch_core as (fun H => iPure H as pat1) (fun H => iPure H as pat2).
Tactic Notation "wp_branch" := wp_branch as %_ | %_.
Lemma tac_wp_select `{!proto_chanG Σ, !heapG Σ} Δ neg i js K
Lemma tac_wp_select `{!chanG Σ, !heapG Σ} Δ neg i js K
c (b : bool) p P1 P2 (p1 p2 : iProto Σ) Φ :
envs_lookup i Δ = Some (false, c p)%I
ProtoNormalize false p [] (p1 <{P1}+{P2}> p2)
......
(** This file defines the model of dependent separation protocols, along with
various operations, such as append and map.
(** This file defines the model of dependent separation protocols as the
solution of a recursive domain equation, along with various primitive
operations, such as append and map.
Important: This file should not be used directly, but rather the wrappers in
[proto_channel] should be used.
[proto] should be used.
Dependent Separation Protocols are modeled as the solution of the following
recursive domain equation:
......
(** This file includes basic examples that each describe a unique feature of
dependent separation protocols. *)
From actris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation lib.spin_lock.
From actris.channel Require Import proofmode.
From iris.heap_lang Require Import lib.spin_lock.
From actris.utils Require Import contribution.
(** Basic *)
......@@ -87,7 +87,7 @@ Definition prog_lock : val := λ: <>,
recv "c" + recv "c".
Section proofs.
Context `{heapG Σ, proto_chanG Σ}.
Context `{heapG Σ, chanG Σ}.
(** Protocols for the respective programs *)
Definition prot : iProto Σ :=
......@@ -146,7 +146,7 @@ Fixpoint prot_lock (n : nat) : iProto Σ :=
Lemma prog_spec : {{{ True }}} prog #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec prot); iIntros (c) "Hc".
wp_apply (start_chan_spec prot); iIntros (c) "Hc".
- by wp_send with "[]".
- wp_recv as "_". by iApply "HΦ".
Qed.
......@@ -154,7 +154,7 @@ Qed.
Lemma prog_ref_spec : {{{ True }}} prog_ref #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec prot_ref); iIntros (c) "Hc".
wp_apply (start_chan_spec prot_ref); iIntros (c) "Hc".
- wp_alloc l as "Hl". by wp_send with "[$Hl]".
- wp_recv (l) as "Hl". wp_load. by iApply "HΦ".
Qed.
......@@ -162,17 +162,16 @@ Qed.
Lemma prog_del_spec : {{{ True }}} prog_del #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec prot_del); iIntros (c) "Hc".
- wp_apply (new_chan_proto_spec with "[//]").
iIntros (c2 c2') "Hcc2". iMod ("Hcc2" $! prot) as "[Hc2 Hc2']".
wp_send with "[$Hc2]". by wp_send with "[]".
wp_apply (start_chan_spec prot_del); iIntros (c) "Hc".
- wp_apply (new_chan_spec prot with "[//]").
iIntros (c2 c2') "[Hc2 Hc2']". wp_send with "[$Hc2]". by wp_send with "[]".
- wp_recv (c2) as "Hc2". wp_recv as "_". by iApply "HΦ".
Qed.
Lemma prog_dep_spec : {{{ True }}} prog_dep #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec prot_dep); iIntros (c) "Hc".
wp_apply (start_chan_spec prot_dep); iIntros (c) "Hc".
- wp_recv (x) as "_". by wp_send with "[]".
- wp_send with "[//]". wp_recv as "_". by iApply "HΦ".
Qed.
......@@ -180,7 +179,7 @@ Qed.
Lemma prog2_ref_spec : {{{ True }}} prog_dep_ref #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec prot_dep_ref); iIntros (c) "Hc".
wp_apply (start_chan_spec prot_dep_ref); iIntros (c) "Hc".
- wp_recv (l x) as "Hl". wp_load. wp_store. by wp_send with "[Hl]".
- wp_alloc l as "Hl". wp_send with "[$Hl]". wp_recv as "Hl". wp_load.
by iApply "HΦ".
......@@ -189,9 +188,8 @@ Qed.
Lemma prog_dep_del_spec : {{{ True }}} prog_dep_del #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec prot_dep_del); iIntros (c) "Hc".
- wp_apply (new_chan_proto_spec with "[//]").
iIntros (c2 c2') "Hcc2". iMod ("Hcc2" $! prot_dep) as "[Hc2 Hc2']".
wp_apply (start_chan_spec prot_dep_del); iIntros (c) "Hc".
- wp_apply (new_chan_spec prot_dep with "[//]"); iIntros (c2 c2') "[Hc2 Hc2']".
wp_send with "[$Hc2]". wp_recv (x) as "_". by wp_send with "[]".
- wp_recv (c2) as "Hc2". wp_send with "[//]". wp_recv as "_".
by iApply "HΦ".
......@@ -200,9 +198,9 @@ Qed.
Lemma prog_dep_del_2_spec : {{{ True }}} prog_dep_del_2 #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec prot_dep_del_2); iIntros (c) "Hc".
wp_apply (start_chan_spec prot_dep_del_2); iIntros (c) "Hc".
{ wp_recv (c2) as "Hc2". wp_send with "[//]". by wp_send with "[$Hc2]". }
wp_apply (start_chan_proto_spec prot_dep); iIntros (c2) "Hc2".
wp_apply (start_chan_spec prot_dep); iIntros (c2) "Hc2".
{ wp_recv (x) as "_". by wp_send with "[//]". }
wp_send with "[$Hc2]". wp_recv as "Hc2". wp_recv as "_". by iApply "HΦ".
Qed.
......@@ -210,10 +208,10 @@ Qed.
Lemma prog_dep_del_3_spec : {{{ True }}} prog_dep_del_3 #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec prot_dep_del_3); iIntros (c) "Hc".
wp_apply (start_chan_spec prot_dep_del_3); iIntros (c) "Hc".
{ wp_recv (c2) as "Hc2". wp_recv (y) as "_".
wp_send with "[//]". by wp_send with "[$Hc2]". }
wp_apply (start_chan_proto_spec prot_dep); iIntros (c2) "Hc2".
wp_apply (start_chan_spec prot_dep); iIntros (c2) "Hc2".
{ wp_recv (x) as "_". by wp_send with "[//]". }
wp_send with "[$Hc2]". wp_send with "[//]".
wp_recv as "Hc2". wp_recv as "_". by iApply "HΦ".
......@@ -222,7 +220,7 @@ Qed.
Lemma prog_loop_spec : {{{ True }}} prog_loop #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec prot_loop); iIntros (c) "Hc".
wp_apply (start_chan_spec prot_loop); iIntros (c) "Hc".
- iAssert ( Ψ, WP (rec: "go" <> := let: "x" := recv c in
send c ("x" + #2) ;; "go" #())%V #() {{ Ψ }})%I with "[Hc]" as "H".
{ iIntros (Ψ). iLöb as "IH". wp_recv (x) as "_". wp_send with "[//]".
......@@ -235,7 +233,7 @@ Qed.
Lemma prog_fun_spec : {{{ True }}} prog_fun #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec prot_fun); iIntros (c) "Hc".
wp_apply (start_chan_spec prot_fun); iIntros (c) "Hc".
- wp_recv (P Ψ vf) as "#Hf". wp_send with "[]"; last done.
iIntros "!>" (Ψ') "HP HΨ'". wp_apply ("Hf" with "HP"); iIntros (x) "HΨ".
wp_pures. by iApply "HΨ'".
......@@ -250,8 +248,8 @@ Lemma prog_lock_spec `{!lockG Σ, contributionG Σ unitUR} :
{{{ True }}} prog_lock #() {{{ RET #42; True }}}.
Proof.
iIntros (Φ) "_ HΦ". wp_lam.
wp_apply (start_chan_proto_spec (prot_lock 2)); iIntros (c) "Hc".
- iMod (contribution_init) as (γ) "Hs".
wp_apply (start_chan_spec (prot_lock 2)); iIntros (c) "Hc".
- iMod contribution_init as (γ) "Hs".
iMod (alloc_client with "Hs") as "[Hs Hcl1]".
iMod (alloc_client with "Hs") as "[Hs Hcl2]".
wp_apply (newlock_spec nroot ( n, server γ n ε
......
(** This file implements a distributed mapper service, a specification thereof,
and its proofs. *)
From actris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation lib.spin_lock.
From actris.channel Require Import proofmode.
From iris.heap_lang Require Import lib.spin_lock.
From actris.utils Require Import llist contribution.
From iris.algebra Require Import gmultiset.
......@@ -60,7 +60,7 @@ Class mapG Σ A `{Countable A} := {
Section map.
Context `{Countable A} {B : Type}.
Context `{!heapG Σ, !proto_chanG Σ, !mapG Σ A}.
Context `{!heapG Σ, !chanG Σ, !mapG Σ A}.
Context (IA : A val iProp Σ) (IB : B val iProp Σ) (map : A list B).
Local Open Scope nat_scope.
Implicit Types n : nat.
......@@ -202,7 +202,7 @@ Section map.
{{{ ys, RET #(); ys xs = map llist IB l ys }}}.
Proof.
iIntros (?) "#Hmap !>"; iIntros (Φ) "Hl HΦ". wp_lam; wp_pures.
wp_apply (start_chan_proto_spec (par_map_protocol n )); iIntros (c) "// Hc".
wp_apply (start_chan_spec (par_map_protocol n )); iIntros (c) "// Hc".
{ wp_apply (par_map_service_spec with "Hmap Hc"); auto. }
wp_pures. wp_apply (lnil_spec with "[//]"); iIntros (k) "Hk".
wp_apply (par_map_client_loop_spec with "[$Hl $Hk $Hc //]"); first lia.
......
(** This file implements a simple distributed map-reduce function, a
specification thereof, and its proofs. *)
From actris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation.
From actris.channel Require Import proofmode.
From actris.utils Require Import llist compare contribution group.
From actris.examples Require Import map sort_fg.
From iris.algebra Require Import gmultiset.
......@@ -97,7 +96,7 @@ Class map_reduceG Σ A B `{Countable A, Countable B} := {
Section mapper.
Context `{Countable A, Countable B} {C : Type}.
Context `{!heapG Σ, !proto_chanG Σ, !map_reduceG Σ A B}.
Context `{!heapG Σ, !chanG Σ, !map_reduceG Σ A B}.
Context (IA : A val iProp Σ) (IB : Z B val iProp Σ) (IC : C val iProp Σ).
Context (map : A list (Z * B)) (red : Z list B list C).
Context `{! j, Proper (() ==> ()) (red j)}.
......@@ -282,10 +281,10 @@ Section mapper.
{{{ zs, RET #(); zs map_reduce map red xs llist IC l zs }}}.
Proof.
iIntros (??) "#Hmap #Hred !>"; iIntros (Φ) "Hl HΦ". wp_lam; wp_pures.
wp_apply (start_chan_proto_spec (par_map_protocol IA IZB map n ));
wp_apply (start_chan_spec (par_map_protocol IA IZB map n ));
iIntros (cmap) "// Hcmap".
{ wp_pures. wp_apply (par_map_service_spec with "Hmap Hcmap"); auto. }
wp_apply (start_chan_proto_spec (sort_fg_protocol IZB RZB <++> END)%proto);
wp_apply (start_chan_spec (sort_fg_protocol IZB RZB <++> END)%proto);
iIntros (csort) "Hcsort".
{ wp_apply (sort_service_fg_spec with "[] Hcsort"); last by auto.
iApply RZB_cmp_spec. }
......@@ -293,7 +292,7 @@ Section mapper.
wp_apply (par_map_reduce_map_spec with "[$Hl $Hcmap $Hcsort]"); first lia.
iIntros (iys). rewrite gmultiset_elements_empty right_id_L.
iDestruct 1 as (Hiys) "[Hl Hcsort] /=". wp_select; wp_pures; simpl.
wp_apply (start_chan_proto_spec (par_map_protocol IZBs IC (curry red) m ));
wp_apply (start_chan_spec (par_map_protocol IZBs IC (curry red) m ));
iIntros (cred) "// Hcred".
{ wp_pures. wp_apply (par_map_service_spec with "Hred Hcred"); auto. }
wp_branch as %_|%Hnil; last first.
......
......@@ -6,8 +6,7 @@ thereof, and its proofs. There are two variants:
- [sort_service_func]: a service that only takes a channel as its argument. The
comparison function is sent over the channel. *)
From stdpp Require Import sorting.
From actris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation.
From actris.channel Require Import proofmode.
From actris.utils Require Export llist compare.
Definition lmerge : val :=
......@@ -43,7 +42,7 @@ Definition sort_client_func : val := λ: "cmp" "xs",
recv "c".
Section sort.
Context `{!heapG Σ, !proto_chanG Σ}.
Context `{!heapG Σ, !chanG Σ}.
Definition sort_protocol {A} (I : A val iProp Σ) (R : A A Prop) : iProto Σ :=
(<!> (xs : list A) (l : loc), MSG #l {{ llist I l xs }};
......@@ -106,10 +105,10 @@ Section sort.
wp_send with "[$Hl]"; first by auto. by iApply "HΨ". }
wp_apply (lsplit_spec with "Hl"); iIntros (l2 vs1 vs2);
iDestruct 1 as (->) "[Hl1 Hl2]".
wp_apply (start_chan_proto_spec (sort_protocol I R)); iIntros (cy) "Hcy".
wp_apply (start_chan_spec (sort_protocol I R)); iIntros (cy) "Hcy".
{ rewrite -{2}(right_id END%proto _ (iProto_dual _)).
wp_apply ("IH" with "Hcy"); auto. }
wp_apply (start_chan_proto_spec (sort_protocol I R)); iIntros (cz) "Hcz".
wp_apply (start_chan_spec (sort_protocol I R)); iIntros (cz) "Hcz".
{ rewrite -{2}(right_id END%proto _ (iProto_dual _)).
wp_apply ("IH" with "Hcz"); auto. }
wp_send with "[$Hl1]".
......@@ -142,7 +141,7 @@ Section sort.
{{{ ys, RET #(); Sorted R ys ys xs llist I l ys }}}.
Proof.
iIntros "#Hcmp !>" (Φ) "Hl HΦ". wp_lam.
wp_apply (start_chan_proto_spec sort_protocol_func); iIntros (c) "Hc".
wp_apply (start_chan_spec sort_protocol_func); iIntros (c) "Hc".
{ rewrite -(right_id END%proto _ (iProto_dual _)).
wp_apply (sort_service_func_spec with "Hc"); auto. }
wp_send with "[$Hcmp]".
......
......@@ -8,8 +8,7 @@ sort, demonstrating Actris's support for delegation and branching:
- [sort_service_br_del]: a service that allows one to sort a series of list by
forking itself. *)
From stdpp Require Import sorting.
From actris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation.
From actris.channel Require Import proofmode.
From actris.examples Require Import sort.
Definition sort_service_br : val :=
......@@ -35,7 +34,7 @@ Definition sort_service_br_del : val :=
else #().
Section sort_service_br_del.
Context `{!heapG Σ, !proto_chanG Σ}.
Context `{!heapG Σ, !chanG Σ}.
Context {A} (I : A val iProp Σ) (R : A A Prop) `{!RelDecision R, !Total R}.
Definition sort_protocol_br_aux (rec : iProto Σ) : iProto Σ :=
......@@ -77,8 +76,7 @@ Section sort_service_br_del.
Proof.
iIntros "#Hcmp !>" (Ψ) "Hc HΨ". iLöb as "IH" forall (Ψ).
wp_rec. wp_branch; wp_pures.
{ wp_apply (start_chan_proto_spec (sort_protocol I R <++> END)%proto);
iIntros (c') "Hc'".
{ wp_apply (start_chan_spec (sort_protocol I R <++> END)%proto); iIntros (c') "Hc'".
{ wp_pures. wp_apply (sort_service_spec with "Hcmp Hc'"); auto. }
wp_send with "[$Hc']". by wp_apply ("IH" with "Hc"). }
by iApply "HΨ".
......@@ -104,7 +102,7 @@ Section sort_service_br_del.
{ wp_apply (sort_service_spec with "Hcmp Hc"); iIntros "Hc".
by wp_apply ("IH" with "Hc"). }
wp_branch; wp_pures.
{ wp_apply (start_chan_proto_spec sort_protocol_br_del); iIntros (c') "Hc'".
{ wp_apply (start_chan_spec sort_protocol_br_del); iIntros (c') "Hc'".
{ wp_apply ("IH" with "Hc'"); auto. }
wp_send with "[$Hc']".
by wp_apply ("IH" with "Hc"). }
......
......@@ -3,8 +3,7 @@ specification thereof, and its proofs. We call this version fine-grained because
the lists are not transmitted using a single message, but using a series of
messages. *)
From stdpp Require Export sorting.
From actris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation.
From actris.channel Require Import proofmode.
From iris.heap_lang Require Import assert.
From actris.utils Require Import llist compare.
......@@ -73,7 +72,7 @@ Definition sort_client_fg : val := λ: "cmp" "xs",
recv_all "c" "xs".
Section sort_fg.
Context `{!heapG Σ, !proto_chanG Σ}.
Context `{!heapG Σ, !chanG Σ}.
Section sort_fg_inner.
Context {A} (I : A val iProp Σ) (R : relation A) `{!RelDecision R, !Total R}.
......@@ -222,10 +221,10 @@ Section sort_fg.
wp_rec; wp_pures. wp_branch; wp_pures.
- wp_recv (x1 v1) as "HIx1". wp_branch; wp_pures.
+ wp_recv (x2 v2) as "HIx2".
wp_apply (start_chan_proto_spec (sort_fg_protocol <++> END)%proto).
wp_apply (start_chan_spec (sort_fg_protocol <++> END)%proto).
{ iIntros (cy) "Hcy". wp_apply ("IH" with "Hcy"). auto. }
iIntros (cy) "Hcy".
wp_apply (start_chan_proto_spec (sort_fg_protocol <++> END)%proto).
wp_apply (start_chan_spec (sort_fg_protocol <++> END)%proto).
{ iIntros (cz) "Hcz". wp_apply ("IH" with "Hcz"); auto. }
iIntros (cz) "Hcz". rewrite !right_id.
wp_select. wp_send with "[$HIx1]".
......@@ -241,7 +240,7 @@ Section sort_fg.
wp_select. by iApply "HΨ".
- wp_select. by iApply "HΨ".
Qed.
Lemma send_all_spec c p xs' l xs :
{{{ llist I l xs c (sort_fg_head_protocol xs' <++> p) }}}
send_all c #l
......@@ -282,8 +281,7 @@ Section sort_fg.
{{{ ys, RET #(); Sorted R ys ys xs llist I l ys }}}.
Proof.
iIntros "#Hcmp !>" (Φ) "Hl HΦ". wp_lam.
wp_apply (start_chan_proto_spec (sort_fg_protocol <++> END)%proto);
iIntros (c) "Hc".
wp_apply (start_chan_spec (sort_fg_protocol <++> END)%proto); iIntros (c) "Hc".
{ wp_apply (sort_service_fg_spec with "Hcmp Hc"); auto. }
wp_apply (send_all_spec with "[$Hl $Hc]"); iIntros "[Hl Hc]".
wp_select.
......
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