Skip to content
Snippets Groups Projects
Commit 353e65d6 authored by jihgfee's avatar jihgfee
Browse files

Finalised list_sort_elem

parent e6186854
No related branches found
No related tags found
No related merge requests found
...@@ -9,3 +9,4 @@ theories/channel/proto_channel.v ...@@ -9,3 +9,4 @@ theories/channel/proto_channel.v
theories/examples/list_sort.v theories/examples/list_sort.v
theories/examples/list_sort_instances.v theories/examples/list_sort_instances.v
theories/examples/loop_sort.v theories/examples/loop_sort.v
theories/examples/loop_sort.v
\ No newline at end of file
...@@ -10,29 +10,29 @@ Definition compareZ : val := ...@@ -10,29 +10,29 @@ Definition compareZ : val :=
Definition cont := true. Definition cont := true.
Definition stop := false. Definition stop := false.
Definition list_sort_service_split : val := Definition list_sort_elem_service_split : val :=
rec: "go" "c" "c1" "c2" := rec: "go" "c" "c1" "c2" :=
if: ~(recv "c") if: ~(recv "c")
then send "c1" #stop;; send "c2" #stop then send "c1" #stop;; send "c2" #stop
else let: "x" := recv "c" in else let: "x" := recv "c" in
send "c1" #cont;; send "c1" "x";; "go" "c" "c2" "c1". send "c1" #cont;; send "c1" "x";; "go" "c" "c2" "c1".
Definition list_sort_service_copy : val := Definition list_sort_elem_service_copy : val :=
rec: "go" "c" "cin" := rec: "go" "c" "cin" :=
if: ~(recv "cin") if: ~(recv "cin")
then send "c" #stop then send "c" #stop
else let: "x" := recv "cin" in send "c" #cont;; send "c" "x";; "go" "c" "cin". else let: "x" := recv "cin" in send "c" #cont;; send "c" "x";; "go" "c" "cin".
Definition list_sort_service_merge : val := Definition list_sort_elem_service_merge : val :=
rec: "go" "c" "x1" "c1" "c2" := rec: "go" "c" "x1" "c1" "c2" :=
if: ~recv "c2" if: ~recv "c2"
then send "c" #cont;; send "c" "x1";; list_sort_service_copy "c" "c1" then send "c" #cont;; send "c" "x1";; list_sort_elem_service_copy "c" "c1"
else let: "x2" := recv "c2" in else let: "x2" := recv "c2" in
if: compareZ "x1" "x2" if: compareZ "x1" "x2"
then send "c" #cont;; send "c" "x1";; "go" "c" "x2" "c2" "c1" then send "c" #cont;; send "c" "x1";; "go" "c" "x2" "c2" "c1"
else send "c" #cont;; send "c" "x2";; "go" "c" "x1" "c1" "c2". else send "c" #cont;; send "c" "x2";; "go" "c" "x1" "c1" "c2".
Definition list_sort_service : val := Definition list_sort_elem_service : val :=
rec: "go" "c" := rec: "go" "c" :=
if: ~(recv "c") if: ~(recv "c")
then send "c" #stop then send "c" #stop
...@@ -44,9 +44,9 @@ Definition list_sort_service : val := ...@@ -44,9 +44,9 @@ Definition list_sort_service : val :=
let: "c2" := start_chan ("go") in let: "c2" := start_chan ("go") in
send "c1" #cont;; send "c1" "x";; send "c1" #cont;; send "c1" "x";;
send "c2" #cont;; send "c2" "y";; send "c2" #cont;; send "c2" "y";;
list_sort_service_split "c" "c1" "c2";; list_sort_elem_service_split "c" "c1" "c2";;
let: "x" := (if: recv "c1" then recv "c1" else assert #false) in let: "x" := (if: recv "c1" then recv "c1" else assert #false) in
list_sort_service_merge "c" "x" "c1" "c2". list_sort_elem_service_merge "c" "x" "c1" "c2".
Section list_sort_elem. Section list_sort_elem.
Context `{!heapG Σ, !proto_chanG Σ} (N : namespace). Context `{!heapG Σ, !proto_chanG Σ} (N : namespace).
...@@ -104,13 +104,13 @@ Section list_sort_elem. ...@@ -104,13 +104,13 @@ Section list_sort_elem.
Definition list_sort_elem_protocol := helper_protocol []. Definition list_sort_elem_protocol := helper_protocol [].
Lemma loop_sort_service_split_spec c c1 c2 (xs xs1 xs2 : list Z) : Lemma list_sort_elem_service_split_spec c c1 c2 (xs xs1 xs2 : list Z) :
{{{ {{{
c iProto_dual (helper_protocol xs) @ N c iProto_dual (helper_protocol xs) @ N
c1 helper_protocol xs1 @ N c1 helper_protocol xs1 @ N
c2 helper_protocol xs2 @ N c2 helper_protocol xs2 @ N
}}} }}}
list_sort_service_split c c1 c2 list_sort_elem_service_split c c1 c2
{{{ xs' xs1' xs2', RET #(); {{{ xs' xs1' xs2', RET #();
c iProto_dual (tail_protocol (xs++xs') []) @ N c iProto_dual (tail_protocol (xs++xs') []) @ N
c1 tail_protocol (xs1++xs1') [] @ N c1 tail_protocol (xs1++xs1') [] @ N
...@@ -158,25 +158,30 @@ Section list_sort_elem. ...@@ -158,25 +158,30 @@ Section list_sort_elem.
done. done.
Qed. Qed.
Lemma cmp_spec : Lemma cmp_spec :
( x y, ( x y,
{{{ True }}} {{{ True }}}
compareZ #x #y compareZ #x #y
{{{ RET #(bool_decide (x y)); True }}})%I. {{{ RET #(bool_decide (x y)); True }}})%I.
Proof. Admitted. Proof.
iIntros (x y Φ).
iModIntro.
iIntros "_ HΦ".
wp_lam.
wp_pures.
by iApply "HΦ".
Qed.
Lemma list_sort_service_elem_copy_spec c cin xs ys zs xs' ys' : Lemma list_sort_elem_service_copy_spec c cin xs ys zs xs' ys' :
xs xs' ++ zs xs xs' ++ zs
ys ys' ++ zs ys ys' ++ zs
(* xs ≡ₚ ys ++ zs → *)
(* xs'≡ₚ ys' ++ zs → *)
Sorted () ys Sorted () ys
( x, TlRel Z.le x ys' TlRel Z.le x ys) ( x, TlRel Z.le x ys' TlRel Z.le x ys)
{{{ {{{
c iProto_dual (tail_protocol xs ys) @ N c iProto_dual (tail_protocol xs ys) @ N
cin tail_protocol xs' ys' @ N cin tail_protocol xs' ys' @ N
}}} }}}
list_sort_service_copy c cin list_sort_elem_service_copy c cin
{{{ RET #(); c END @ N cin END @ N }}}. {{{ RET #(); c END @ N cin END @ N }}}.
Proof. Proof.
iIntros (H1 H2 Hsorted Hrel Ψ) "[Hc Hcin] HΨ". iIntros (H1 H2 Hsorted Hrel Ψ) "[Hc Hcin] HΨ".
...@@ -196,7 +201,7 @@ Section list_sort_elem. ...@@ -196,7 +201,7 @@ Section list_sort_elem.
wp_apply (send_proto_spec N with "Hc")=> //=. wp_apply (send_proto_spec N with "Hc")=> //=.
iExists x. iSplit; first done; iSplit; first by auto. iIntros "!> Hc". iExists x. iSplit; first done; iSplit; first by auto. iIntros "!> Hc".
wp_apply ("IH" with "[%] [%] [%] [%] Hc Hcin")=> //. wp_apply ("IH" with "[%] [%] [%] [%] Hc Hcin")=> //.
{ admit. } { by rewrite H2 -app_assoc -app_assoc (Permutation_app_comm zs). }
{ apply Sorted_snoc; auto. } { apply Sorted_snoc; auto. }
{ intros x'. inversion 1; discriminate_list || simplify_list_eq. { intros x'. inversion 1; discriminate_list || simplify_list_eq.
by constructor. } by constructor. }
...@@ -210,9 +215,9 @@ Section list_sort_elem. ...@@ -210,9 +215,9 @@ Section list_sort_elem.
iIntros "!> Hc". iIntros "!> Hc".
iApply "HΨ". iApply "HΨ".
iFrame. iFrame.
Admitted. Qed.
Lemma loop_sort_service_merge_spec c c1 c2 xs ys xs1 xs2 y1 ys1 ys2 : Lemma list_sort_elem_service_merge_spec c c1 c2 xs ys xs1 xs2 y1 ys1 ys2 :
xs xs1 ++ xs2 xs xs1 ++ xs2
ys ys1 ++ ys2 ys ys1 ++ ys2
Sorted () ys Sorted () ys
...@@ -223,7 +228,7 @@ Section list_sort_elem. ...@@ -223,7 +228,7 @@ Section list_sort_elem.
c1 tail_protocol xs1 (ys1 ++ [y1]) @ N c1 tail_protocol xs1 (ys1 ++ [y1]) @ N
c2 tail_protocol xs2 ys2 @ N c2 tail_protocol xs2 ys2 @ N
}}} }}}
list_sort_service_merge c #y1 c1 c2 list_sort_elem_service_merge c #y1 c1 c2
{{{ RET #(); c END @ N c1 END @ N c2 END @ N}}}. {{{ RET #(); c END @ N c1 END @ N c2 END @ N}}}.
Proof. Proof.
iIntros (Hxs Hys Hsort Htl Htl_le Ψ) "(Hc & Hc1 & Hc2) HΨ". iIntros (Hxs Hys Hsort Htl Htl_le Ψ) "(Hc & Hc1 & Hc2) HΨ".
...@@ -268,20 +273,21 @@ Section list_sort_elem. ...@@ -268,20 +273,21 @@ Section list_sort_elem.
- wp_apply (send_proto_spec N with "Hc")=> //=. - wp_apply (send_proto_spec N with "Hc")=> //=.
iExists cont. iSplit; first done; iSplit; first done; iIntros "!> Hc". iExists cont. iSplit; first done; iSplit; first done; iIntros "!> Hc".
wp_apply (send_proto_spec N with "Hc")=> //=. wp_apply (send_proto_spec N with "Hc")=> //=.
iDestruct "HP" as %HP.
iExists y1. iSplit; first done; iSplit; first done; iIntros "!> Hc". iExists y1. iSplit; first done; iSplit; first done; iIntros "!> Hc".
wp_apply (list_sort_service_elem_copy_spec with "[$Hc $Hc1]")=> //. wp_apply (list_sort_elem_service_copy_spec with "[$Hc $Hc1]")=> //.
{ rewrite Hys. admit. } { by rewrite Hys -app_assoc -app_assoc (Permutation_app_comm [y1]) HP. }
{ by apply Sorted_snoc. } { by apply Sorted_snoc. }
{ intros x'. inversion 1; discriminate_list || simplify_list_eq. { intros x'. inversion 1; discriminate_list || simplify_list_eq.
constructor; lia. } constructor; lia. }
iIntros "[Hc Hc1]". iIntros "[Hc Hc1]".
iApply "HΨ". iApply "HΨ".
iFrame. iFrame.
Admitted. Qed.
Lemma list_sort_service_elem_spec c : Lemma list_sort_elem_service_spec c :
{{{ c iProto_dual list_sort_elem_protocol @ N }}} {{{ c iProto_dual list_sort_elem_protocol @ N }}}
list_sort_service c list_sort_elem_service c
{{{ RET #(); c END @ N }}}. {{{ RET #(); c END @ N }}}.
Proof. Proof.
iIntros (Ψ) "Hc HΨ". iLöb as "IH" forall (c Ψ). iIntros (Ψ) "Hc HΨ". iLöb as "IH" forall (c Ψ).
...@@ -318,8 +324,7 @@ Section list_sort_elem. ...@@ -318,8 +324,7 @@ Section list_sort_elem.
iExists cont. iSplit; first done; iSplit; first done; iIntros "!> Hcz". iExists cont. iSplit; first done; iSplit; first done; iIntros "!> Hcz".
wp_apply (send_proto_spec N with "Hcz")=> //=. wp_apply (send_proto_spec N with "Hcz")=> //=.
iExists x2. iSplit; first done; iSplit; first done; iIntros "!> Hcz". iExists x2. iSplit; first done; iSplit; first done; iIntros "!> Hcz".
wp_apply (list_sort_elem_service_split_spec with "[Hc Hcy Hcz]")=> //.
wp_apply (loop_sort_service_split_spec with "[Hc Hcy Hcz]")=> //.
iFrame. iFrame.
iIntros (xs' xs1' xs2') "(Hc & Hcy & Hcz & Hperm)". iIntros (xs' xs1' xs2') "(Hc & Hcy & Hcz & Hperm)".
iDestruct "Hperm" as %Hperm. iDestruct "Hperm" as %Hperm.
...@@ -332,7 +337,7 @@ Section list_sort_elem. ...@@ -332,7 +337,7 @@ Section list_sort_elem.
iClear "HP". iClear "HP".
wp_apply (recv_proto_spec N with "[Hcy]")=> //=. wp_apply (recv_proto_spec N with "[Hcy]")=> //=.
iIntros (x) "Hcy _". iIntros (x) "Hcy _".
wp_apply (loop_sort_service_merge_spec _ _ _ _ [] _ _ _ [] [] wp_apply (list_sort_elem_service_merge_spec _ _ _ _ [] _ _ _ [] []
with "[$Hc $Hcy $Hcz]"); auto using TlRel_nil. with "[$Hc $Hcy $Hcz]"); auto using TlRel_nil.
{ by rewrite /= Hperm Permutation_middle. } { by rewrite /= Hperm Permutation_middle. }
iIntros "(Hc & Hcy & Hcz)". iIntros "(Hc & Hcy & Hcz)".
......
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