Skip to content
Snippets Groups Projects
Commit 7da18513 authored by Ralf Jung's avatar Ralf Jung
Browse files

make JoinHandle unconditionally Send

parent 65c589ef
No related branches found
No related tags found
No related merge requests found
Pipeline #
...@@ -9,17 +9,17 @@ Definition spawnN := lrustN .@ "spawn". ...@@ -9,17 +9,17 @@ Definition spawnN := lrustN .@ "spawn".
Section join_handle. Section join_handle.
Context `{!typeG Σ, !spawnG Σ}. Context `{!typeG Σ, !spawnG Σ}.
Definition join_inv tid (ty : type) (v : val) := Definition join_inv (ty : type) (v : val) :=
(box ty).(ty_own) tid [v]. ( tid, (box ty).(ty_own) tid [v])%I.
Program Definition join_handle (ty : type) := Program Definition join_handle (ty : type) :=
{| ty_size := 1; {| ty_size := 1;
ty_own tid vl := ty_own _ vl :=
match vl return _ with match vl return _ with
| [ #(LitLoc l) ] =>join_handle spawnN l (join_inv tid ty) | [ #(LitLoc l) ] => lang.lib.spawn.join_handle spawnN l (join_inv ty)
| _ => False | _ => False
end%I; end%I;
ty_shr κ tid l := True%I |}. ty_shr κ _ l := True%I |}.
Next Obligation. by iIntros (ty tid [|[[]|][]]) "H". Qed. Next Obligation. by iIntros (ty tid [|[[]|][]]) "H". Qed.
Next Obligation. iIntros "* _ _ _ $". auto. Qed. Next Obligation. iIntros "* _ _ _ $". auto. Qed.
Next Obligation. iIntros (?) "**"; auto. Qed. Next Obligation. iIntros (?) "**"; auto. Qed.
...@@ -32,7 +32,8 @@ Section join_handle. ...@@ -32,7 +32,8 @@ Section join_handle.
Proof. Proof.
iIntros "#Hincl". iSplit; first done. iSplit; iAlways. iIntros "#Hincl". iSplit; first done. iSplit; iAlways.
- iIntros "* Hvl". destruct vl as [|[[|vl|]|] [|]]; try done. - iIntros "* Hvl". destruct vl as [|[[|vl|]|] [|]]; try done.
simpl. iApply (join_handle_impl with "[] Hvl"). iIntros "!# * Hown". simpl. iApply (join_handle_impl with "[] Hvl"). clear tid.
iIntros "!# * Hown" (tid).
iDestruct (box_type_incl with "Hincl") as "{Hincl} (_ & Hincl & _)". iDestruct (box_type_incl with "Hincl") as "{Hincl} (_ & Hincl & _)".
iApply "Hincl". done. iApply "Hincl". done.
- iIntros "* _". auto. - iIntros "* _". auto.
...@@ -51,19 +52,14 @@ Section join_handle. ...@@ -51,19 +52,14 @@ Section join_handle.
Global Instance join_handle_type_contractive : TypeContractive join_handle. Global Instance join_handle_type_contractive : TypeContractive join_handle.
Proof. Proof.
constructor; constructor;
solve_proper_core ltac:(fun _ => exact: type_dist2_dist || f_type_equiv || f_contractive || f_equiv). solve_proper_core ltac:(fun _ => progress unfold join_inv || exact: type_dist2_dist || f_type_equiv || f_contractive || f_equiv).
Qed. Qed.
Global Instance join_handle_ne : NonExpansive join_handle. Global Instance join_handle_ne : NonExpansive join_handle.
Proof. apply type_contractive_ne, _. Qed. Proof. apply type_contractive_ne, _. Qed.
Global Instance join_handle_send ty : Global Instance join_handle_send ty :
Send ty Send (join_handle ty). Send (join_handle ty).
Proof. Proof. iIntros (???) "$ //". Qed.
iIntros (??? vl) "Hvl". destruct vl as [|[[|vl|]|] [|]]; try done.
simpl. iApply (join_handle_impl with "[] Hvl"). iIntros "!# * Hv".
unfold join_inv. iApply @send_change_tid. done.
Qed.
Global Instance join_handle_sync ty : Sync (join_handle ty). Global Instance join_handle_sync ty : Sync (join_handle ty).
Proof. iIntros (????) "_ //". Qed. Proof. iIntros (????) "_ //". Qed.
End join_handle. End join_handle.
...@@ -93,7 +89,7 @@ Section spawn. ...@@ -93,7 +89,7 @@ Section spawn.
(λ j, [j join_handle retty])); try solve_typing; [|]. (λ j, [j join_handle retty])); try solve_typing; [|].
{ (* The core of the proof: showing that spawn is safe. *) { (* The core of the proof: showing that spawn is safe. *)
iIntros (tid) "#LFT #HE $ $ [Hf' [Henv _]]". rewrite !tctx_hasty_val [fn _]lock. iIntros (tid) "#LFT #HE $ $ [Hf' [Henv _]]". rewrite !tctx_hasty_val [fn _]lock.
iApply (spawn_spec _ (join_inv tid retty) with "[-]"); last first. iApply (spawn_spec _ (join_inv retty) with "[-]"); last first.
{ iIntros "!> *". rewrite tctx_interp_singleton tctx_hasty_val. { iIntros "!> *". rewrite tctx_interp_singleton tctx_hasty_val.
iIntros "?". by iFrame. } iIntros "?". by iFrame. }
simpl_subst. iIntros (c) "Hfin". iMod na_alloc as (tid') "Htl". wp_let. wp_let. simpl_subst. iIntros (c) "Hfin". iMod na_alloc as (tid') "Htl". wp_let. wp_let.
...@@ -104,7 +100,7 @@ Section spawn. ...@@ -104,7 +100,7 @@ Section spawn.
- by rewrite big_sepL_singleton tctx_hasty_val send_change_tid. - by rewrite big_sepL_singleton tctx_hasty_val send_change_tid.
- iIntros (r) "Htl _ Hret". - iIntros (r) "Htl _ Hret".
wp_rec. iApply (finish_spec with "[$Hfin Hret]"); last auto. wp_rec. iApply (finish_spec with "[$Hfin Hret]"); last auto.
by iApply @send_change_tid. } iIntros (?). by iApply @send_change_tid. }
iIntros (v). simpl_subst. iIntros (v). simpl_subst.
iApply type_new; [solve_typing..|]. iIntros (r). simpl_subst. iApply type_new; [solve_typing..|]. iIntros (r). simpl_subst.
iApply type_assign; [solve_typing..|]. iApply type_assign; [solve_typing..|].
......
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