diff --git a/theories/channel/proto_channel.v b/theories/channel/proto_channel.v index 3d7940207f7eab317533b5214468c6150bc4579f..66ba0e657a1d70897183a81e5ef06b1c31a3493b 100644 --- a/theories/channel/proto_channel.v +++ b/theories/channel/proto_channel.v @@ -52,48 +52,74 @@ Instance: Params (@iProto_message) 3. Notation "< a > x1 .. xn , 'MSG' v {{ P }}; p" := (iProto_message - (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) a (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ λ x1, .. (λ xn, (v%V,P%I,p%proto)) ..)) (at level 20, a at level 10, x1 binder, xn binder, v at level 20, P, p at level 200) : proto_scope. Notation "< a > x1 .. xn , 'MSG' v ; p" := (iProto_message - (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) a (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ λ x1, .. (λ xn, (v%V,True%I,p%proto)) ..)) (at level 20, a at level 10, x1 binder, xn binder, v at level 20, p at level 200) : proto_scope. +Notation "< a > 'MSG' v {{ P }}; p" := + (iProto_message + a + (tele_app (TT:=TeleO) (v%V,P%I,p%proto))) + (at level 20, a at level 10, v at level 20, P, p at level 200) : proto_scope. +Notation "< a > 'MSG' v ; p" := + (iProto_message + a + (tele_app (TT:=TeleO) (v%V,True%I,p%proto))) + (at level 20, a at level 10, v at level 20, p at level 200) : proto_scope. Notation "<!> x1 .. xn , 'MSG' v {{ P }}; p" := (iProto_message - (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) Send (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ λ x1, .. (λ xn, (v%V,P%I,p%proto)) ..)) (at level 20, x1 binder, xn binder, v at level 20, P, p at level 200) : proto_scope. Notation "<!> x1 .. xn , 'MSG' v ; p" := (iProto_message - (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) Send (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ λ x1, .. (λ xn, (v%V,True%I,p%proto)) ..)) (at level 20, x1 binder, xn binder, v at level 20, p at level 200) : proto_scope. +Notation "<!> 'MSG' v {{ P }}; p" := + (iProto_message + (TT:=TeleO) + Send + (tele_app (TT:=TeleO) (v%V,P%I,p%proto))) + (at level 20, v at level 20, P, p at level 200) : proto_scope. +Notation "<!> 'MSG' v ; p" := + (iProto_message + (TT:=TeleO) + Send + (tele_app (TT:=TeleO) (v%V,True%I,p%proto))) + (at level 20, v at level 20, p at level 200) : proto_scope. Notation "<?> x1 .. xn , 'MSG' v {{ P }}; p" := (iProto_message - (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) Receive (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ λ x1, .. (λ xn, (v%V,P%I,p%proto)) ..)) (at level 20, x1 binder, xn binder, v at level 20, P, p at level 200) : proto_scope. Notation "<?> x1 .. xn , 'MSG' v ; p" := (iProto_message - (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) Receive (tele_app (TT:=TeleS (λ x1, .. (TeleS (λ xn, TeleO)) .. )) $ λ x1, .. (λ xn, (v%V,True%I,p%proto)) ..)) (at level 20, x1 binder, xn binder, v at level 20, p at level 200) : proto_scope. +Notation "<?> 'MSG' v {{ P }}; p" := + (iProto_message + Receive + (tele_app (TT:=TeleO) (v%V,P%I,p%proto))) + (at level 20, v at level 20, P, p at level 200) : proto_scope. +Notation "<?> 'MSG' v ; p" := + (iProto_message + Receive + (tele_app (TT:=TeleO) (v%V,True%I,p%proto))) + (at level 20, v at level 20, p at level 200) : proto_scope. Notation "'END'" := iProto_end : proto_scope. diff --git a/theories/examples/list_sort.v b/theories/examples/list_sort.v index 825924714786ae06f12db190054969c4605ca774..406ec94a3800c336485ba6122965b75e6e04ccc2 100644 --- a/theories/examples/list_sort.v +++ b/theories/examples/list_sort.v @@ -4,20 +4,14 @@ From iris.heap_lang Require Import proofmode notation. From osiris.utils Require Import list. Definition lmerge : val := - rec: "go" "cmp" "hys" "hzs" := - match: "hys" with - NONE => "hzs" - | SOME "_" => - match: "hzs" with - NONE => "hys" - | SOME "_" => - let: "y" := lhead "hys" in - let: "z" := lhead "hzs" in - if: "cmp" "y" "z" - then lcons "y" ("go" "cmp" (ltail "hys") "hzs") - else lcons "z" ("go" "cmp" "hys" (ltail "hzs")) - end - end. + rec: "go" "cmp" "ys" "zs" := + if: lisnil "ys" then "zs" else + if: lisnil "zs" then "ys" else + let: "y" := lhead "ys" in + let: "z" := lhead "zs" in + if: "cmp" "y" "z" + then lcons "y" ("go" "cmp" (ltail "ys") "zs") + else lcons "z" ("go" "cmp" "ys" (ltail "zs")). Definition list_sort_service : val := rec: "go" "c" := @@ -70,12 +64,12 @@ Section list_sort. {{{ ws, RET val_encode ws; [∗ list] x;v ∈ list_merge R xs1 xs2;ws, I x v }}}. Proof. iIntros "#Hcmp" (Ψ) "!> [HI1 HI2] HΨ". iLöb as "IH" forall (xs1 xs2 vs1 vs2 Ψ). - destruct xs1 as [|x1 xs1], vs1 as [|v1 vs1]; simpl; try done. - { wp_lam. wp_pures. iApply "HΨ". by rewrite list_merge_nil_l. } - wp_lam; wp_pures. - destruct xs2 as [|x2 xs2], vs2 as [|v2 vs2]; simpl; try done. - { wp_pures. iApply "HΨ". iFrame. } - wp_pures. + wp_lam. wp_apply (lisnil_spec (A:=val) with "[//]"); iIntros (_). + destruct xs1 as [|x1 xs1], vs1 as [|v1 vs1]; simpl; done || wp_pures. + { iApply "HΨ". by rewrite list_merge_nil_l. } + wp_apply (lisnil_spec (A:=val) with "[//]"); iIntros (_). + destruct xs2 as [|x2 xs2], vs2 as [|v2 vs2]; simpl; done || wp_pures. + { iApply "HΨ". iFrame. } wp_apply (lhead_spec (A:=val) with "[//]"); iIntros (_). wp_apply (lhead_spec (A:=val) with "[//]"); iIntros (_). iDestruct "HI1" as "[HI1 HI1']"; iDestruct "HI2" as "[HI2 HI2']". diff --git a/theories/examples/list_sort_instances.v b/theories/examples/list_sort_instances.v index acfdbfce64686503ac7f139f22e45dad4998628a..d1f83dc5b3b34e5f34ade6228ed44b9d10ed60ea 100644 --- a/theories/examples/list_sort_instances.v +++ b/theories/examples/list_sort_instances.v @@ -4,45 +4,42 @@ From iris.heap_lang Require Import proofmode notation. From osiris.utils Require Import list. From osiris.examples Require Import list_sort. +Definition cmpZ : val := + λ: "x" "y", "x" ≤ "y". + Section list_sort_instances. Context `{!heapG Σ, !proto_chanG Σ} (N : namespace). (* Example: Sort of integers *) - Definition IZ (x : Z) (v : val) : iProp Σ := - ⌜∃ w, v = LitV $ LitInt w ∧ x = wâŒ%I. - - Definition compareZ : val := - λ: "x" "y", "x" ≤ "y". + Definition IZ (x : Z) (v : val) : iProp Σ := ⌜v = #xâŒ%I. - Lemma compareZ_spec : cmp_spec IZ (≤) compareZ. + Lemma cmpZ_spec : cmp_spec IZ (≤) cmpZ. Proof. - iIntros (x x' v v' Φ) "!>". - iIntros ([[w [-> ->]] [w' [-> ->]]]) "HΦ". - wp_lam. wp_pures. iApply "HΦ". eauto 10 with iFrame. + rewrite /IZ. iIntros (x x' v v' Φ [-> ->]) "!> HΦ". + wp_lam. wp_pures. by iApply "HΦ". Qed. - + Local Arguments val_encode _ _ !_ /. Lemma list_sort_client_le_spec l (xs : list Z) : {{{ l ↦ val_encode xs }}} - list_sort_client compareZ #l + list_sort_client cmpZ #l {{{ ys, RET #(); ⌜Sorted (≤) ys⌠∗ ⌜ ys ≡ₚ xs⌠∗ l ↦ val_encode ys }}}. Proof. assert (∀ zs : list Z, val_encode zs = val_encode (LitV ∘ LitInt <$> zs)) as Henc. { intros zs. induction zs; f_equal/=; auto with f_equal. } iIntros (Φ) "Hl HΦ". iApply (list_sort_client_spec N IZ (≤) _ _ (LitV ∘ LitInt <$> xs) xs with "[] [Hl] [HΦ]"). - { iApply compareZ_spec. } + { iApply cmpZ_spec. } { rewrite -Henc. iFrame "Hl". iInduction xs as [|x xs] "IH"; csimpl; first by iFrame. - iFrame "IH". by iExists x. } + by iFrame "IH". } iIntros "!>" (ys ws) "(?&?&?&HI)". iAssert ⌜ ws = (LitV ∘ LitInt) <$> ys âŒ%I with "[HI]" as %->. { iInduction ys as [|y ys] "IH" forall (ws); destruct ws as [|w ws]; csimpl; try done. - iDestruct "HI" as "[HI1 HI2]"; iDestruct "HI1" as %(?&->&->). + iDestruct "HI" as "[-> HI2]". by iDestruct ("IH" with "HI2") as %->. } rewrite -Henc. iApply ("HΦ" $! ys with "[$]"). Qed. - End list_sort_instances. diff --git a/theories/utils/list.v b/theories/utils/list.v index 58fe05e39ed3098eb0dfd556543478d963f17a12..4d0702ef9976a7fcb4de38940876a34209c6ede8 100644 --- a/theories/utils/list.v +++ b/theories/utils/list.v @@ -14,6 +14,12 @@ Instance list_val_enc `{ValEnc A} : ValEnc (list A) := Definition lnil : val := λ: <>, NONEV. Definition lcons : val := λ: "x" "l", SOME ("x", "l"). +Definition lisnil : val := λ: "l", + match: "l" with + SOME "p" => #false + | NONE => #true + end. + Definition lhead : val := λ: "l", match: "l" with SOME "p" => Fst "p" @@ -106,6 +112,12 @@ Lemma lcons_spec x xs : {{{ RET val_encode (x :: xs); True }}}. Proof. iIntros (Φ _) "HΦ". wp_lam. wp_pures. by iApply "HΦ". Qed. +Lemma lisnil_spec xs: + {{{ True }}} + lisnil (val_encode xs) + {{{ RET #(if xs is [] then true else false); True }}}. +Proof. iIntros (Φ _) "HΦ". wp_lam. destruct xs; wp_pures; by iApply "HΦ". Qed. + Lemma lhead_spec x xs: {{{ True }}} lhead (val_encode (x::xs)) {{{ RET val_encode x; True }}}. Proof. iIntros (Φ _) "HΦ". wp_lam. wp_pures. by iApply "HΦ". Qed.