Skip to content
Snippets Groups Projects
Commit 65d9b861 authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan
Browse files

Simplify somewhat...

parent 627509b9
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
perm.v
+ 2
− 2
View file @ 65d9b861
...@@ -99,12 +99,12 @@ Section has_type. ...@@ -99,12 +99,12 @@ Section has_type.
Qed. Qed.
Lemma has_type_wp E (ν : expr) ty tid (Φ : val -> iProp _) : Lemma has_type_wp E (ν : expr) ty tid (Φ : val -> iProp _) :
(ν ◁ ty)%P tid ★ (∀ (v : val), eval_expr ν = Some v ★ (v ◁ ty)%P tid -★ Φ v) (ν ◁ ty)%P tid ★ (∀ (v : val), eval_expr ν = Some v ★ (v ◁ ty)%P tid ={E}=★ Φ v)
⊢ WP ν @ E {{ Φ }}. ⊢ WP ν @ E {{ Φ }}.
Proof. Proof.
iIntros "[H◁ HΦ]". setoid_rewrite has_type_value. unfold has_type. iIntros "[H◁ HΦ]". setoid_rewrite has_type_value. unfold has_type.
destruct (eval_expr ν) eqn:EQν; last by iDestruct "H◁" as "[]". simpl. destruct (eval_expr ν) eqn:EQν; last by iDestruct "H◁" as "[]". simpl.
iSpecialize ("HΦ" $! v with "[$H◁]"). done. iMod ("HΦ" $! v with "[$H◁]") as "HΦ". done.
iInduction ν as [| | |[] e ? [|[]| | | | | | | | | |] _| | | | | | | |] "IH" iInduction ν as [| | |[] e ? [|[]| | | | | | | | | |] _| | | | | | | |] "IH"
forall (Φ v EQν); try done. forall (Φ v EQν); try done.
- inversion EQν. subst. wp_value. auto. - inversion EQν. subst. wp_value. auto.
......
typing.v
+ 17
− 16
View file @ 65d9b861
...@@ -163,7 +163,7 @@ Section typing. ...@@ -163,7 +163,7 @@ Section typing.
typed_step (ν ◁ own 1 ty) (Free #ty.(ty_size) ν) (λ _, top). typed_step (ν ◁ own 1 ty) (Free #ty.(ty_size) ν) (λ _, top).
Proof. Proof.
iIntros (tid) "!#(#HEAP&H◁&$)". wp_bind ν. iIntros (tid) "!#(#HEAP&H◁&$)". wp_bind ν.
iApply (has_type_wp with "[$H◁]"). iIntros (v) "[_ H◁]". iApply (has_type_wp with "[$H◁]"). iIntros (v) "[_ H◁]!>".
rewrite has_type_value. rewrite has_type_value.
iDestruct "H◁" as (l) "(Hv & >H† & H↦★:)". iDestruct "Hv" as %[=->]. iDestruct "H◁" as (l) "(Hv & >H† & H↦★:)". iDestruct "Hv" as %[=->].
iDestruct "H↦★:" as (vl) "[>H↦ Hown]". iDestruct "H↦★:" as (vl) "[>H↦ Hown]".
...@@ -186,8 +186,8 @@ Section typing. ...@@ -186,8 +186,8 @@ Section typing.
Lemma consumes_copy_own ty q: Lemma consumes_copy_own ty q:
ty.(ty_dup) → consumes ty (λ ν, ν ◁ own q ty)%P (λ ν, ν ◁ own q ty)%P. ty.(ty_dup) → consumes ty (λ ν, ν ◁ own q ty)%P (λ ν, ν ◁ own q ty)%P.
Proof. Proof.
iIntros (? ν tid Φ) "(H◁ & Htl & HΦ)". iApply wp_fupd. iIntros (? ν tid Φ) "(H◁ & Htl & HΦ)". iApply (has_type_wp with "[- $H◁]").
iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv. iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv.
rewrite has_type_value. iDestruct "H◁" as (l) "[Heq [>H† H↦]]". rewrite has_type_value. iDestruct "H◁" as (l) "[Heq [>H† H↦]]".
iDestruct "Heq" as %[=->]. iDestruct "H↦" as (vl) "[>H↦ #Hown]". iDestruct "Heq" as %[=->]. iDestruct "H↦" as (vl) "[>H↦ #Hown]".
iAssert (▷ (length vl = ty_size ty))%I with "[#]" as ">%". iAssert (▷ (length vl = ty_size ty))%I with "[#]" as ">%".
...@@ -199,8 +199,8 @@ Section typing. ...@@ -199,8 +199,8 @@ Section typing.
Lemma consumes_move ty q: Lemma consumes_move ty q:
consumes ty (λ ν, ν ◁ own q ty)%P (λ ν, ν ◁ own q (uninit ty.(ty_size)))%P. consumes ty (λ ν, ν ◁ own q ty)%P (λ ν, ν ◁ own q (uninit ty.(ty_size)))%P.
Proof. Proof.
iIntros (ν tid Φ) "(H◁ & Htl & HΦ)". iApply wp_fupd. iIntros (ν tid Φ) "(H◁ & Htl & HΦ)". iApply (has_type_wp with "[- $H◁]").
iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv. iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv.
rewrite has_type_value. iDestruct "H◁" as (l) "(Heq & >H† & H↦)". rewrite has_type_value. iDestruct "H◁" as (l) "(Heq & >H† & H↦)".
iDestruct "Heq" as %[=->]. iDestruct "H↦" as (vl) "[>H↦ Hown]". iDestruct "Heq" as %[=->]. iDestruct "H↦" as (vl) "[>H↦ Hown]".
iAssert (▷ (length vl = ty_size ty))%I with "[#]" as ">%". iAssert (▷ (length vl = ty_size ty))%I with "[#]" as ">%".
...@@ -214,7 +214,7 @@ Section typing. ...@@ -214,7 +214,7 @@ Section typing.
consumes ty (λ ν, ν ◁ &uniq{κ}ty ★ κ' ⊑ κ ★ [κ']{q})%P consumes ty (λ ν, ν ◁ &uniq{κ}ty ★ κ' ⊑ κ ★ [κ']{q})%P
(λ ν, ν ◁ &uniq{κ}ty ★ κ' ⊑ κ ★ [κ']{q})%P. (λ ν, ν ◁ &uniq{κ}ty ★ κ' ⊑ κ ★ [κ']{q})%P.
Proof. Proof.
iIntros (? ν tid Φ) "((H◁ & #H⊑ & Htok & #Hκ') & Htl & HΦ)". iApply wp_fupd. iIntros (? ν tid Φ) "((H◁ & #H⊑ & Htok & #Hκ') & Htl & HΦ)".
iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv. iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv.
rewrite has_type_value. iDestruct "H◁" as (l') "[Heq H↦]". iDestruct "Heq" as %[=->]. rewrite has_type_value. iDestruct "H◁" as (l') "[Heq H↦]". iDestruct "Heq" as %[=->].
iMod (lft_incl_trade with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver. iMod (lft_incl_trade with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver.
...@@ -233,7 +233,7 @@ Section typing. ...@@ -233,7 +233,7 @@ Section typing.
consumes ty (λ ν, ν ◁ &shr{κ}ty ★ κ' ⊑ κ ★ [κ']{q})%P consumes ty (λ ν, ν ◁ &shr{κ}ty ★ κ' ⊑ κ ★ [κ']{q})%P
(λ ν, ν ◁ &shr{κ}ty ★ κ' ⊑ κ ★ [κ']{q})%P. (λ ν, ν ◁ &shr{κ}ty ★ κ' ⊑ κ ★ [κ']{q})%P.
Proof. Proof.
iIntros (? ν tid Φ) "((H◁ & #H⊑ & [Htok #Hκ']) & Htl & HΦ)". iApply wp_fupd. iIntros (? ν tid Φ) "((H◁ & #H⊑ & [Htok #Hκ']) & Htl & HΦ)".
iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv. iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv.
rewrite has_type_value. iDestruct "H◁" as (l') "[Heq #Hshr]". iDestruct "Heq" as %[=->]. rewrite has_type_value. iDestruct "H◁" as (l') "[Heq #Hshr]". iDestruct "Heq" as %[=->].
iMod (lft_incl_trade with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver. iMod (lft_incl_trade with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver.
...@@ -270,7 +270,7 @@ Section typing. ...@@ -270,7 +270,7 @@ Section typing.
(λ v, v ◁ &uniq{κ} ty ★ κ' ⊑ κ ★ [κ']{q})%P. (λ v, v ◁ &uniq{κ} ty ★ κ' ⊑ κ ★ [κ']{q})%P.
Proof. Proof.
iIntros (tid) "!#(#HEAP & (H◁ & #H⊑ & Htok & #Hκ') & Htl)". wp_bind ν. iIntros (tid) "!#(#HEAP & (H◁ & #H⊑ & Htok & #Hκ') & Htl)". wp_bind ν.
iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv. iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]!>". iDestruct "Hνv" as %Hνv.
rewrite has_type_value. iDestruct "H◁" as (l) "[Heq H↦]". iDestruct "Heq" as %[=->]. rewrite has_type_value. iDestruct "H◁" as (l) "[Heq H↦]". iDestruct "Heq" as %[=->].
iMod (lft_incl_trade with "H⊑ Htok") as (q'') "[Htok Hclose]". done. iMod (lft_incl_trade with "H⊑ Htok") as (q'') "[Htok Hclose]". done.
iMod (lft_borrow_open with "H↦ Htok") as "[H↦ Hclose']". done. iMod (lft_borrow_open with "H↦ Htok") as "[H↦ Hclose']". done.
...@@ -291,7 +291,7 @@ Section typing. ...@@ -291,7 +291,7 @@ Section typing.
(λ v, v ◁ &shr{κ} ty ★ κ' ⊑ κ ★ [κ']{q})%P. (λ v, v ◁ &shr{κ} ty ★ κ' ⊑ κ ★ [κ']{q})%P.
Proof. Proof.
iIntros (tid) "!#(#HEAP & (H◁ & #H⊑ & Htok & #Hκ') & Htl)". wp_bind ν. iIntros (tid) "!#(#HEAP & (H◁ & #H⊑ & Htok & #Hκ') & Htl)". wp_bind ν.
iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv. iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]!>". iDestruct "Hνv" as %Hνv.
rewrite has_type_value. iDestruct "H◁" as (l) "[Heq #H↦]". iDestruct "Heq" as %[=->]. rewrite has_type_value. iDestruct "H◁" as (l) "[Heq #H↦]". iDestruct "Heq" as %[=->].
iMod (lft_incl_trade with "H⊑ Htok") as (q'') "[[Htok1 Htok2] Hclose]". done. iMod (lft_incl_trade with "H⊑ Htok") as (q'') "[[Htok1 Htok2] Hclose]". done.
iDestruct "H↦" as (vl) "[H↦b Hown]". iDestruct "H↦" as (vl) "[H↦b Hown]".
...@@ -306,7 +306,8 @@ Section typing. ...@@ -306,7 +306,8 @@ Section typing.
iAssert (|={mgmtE ∪ ⊤ ∖ (mgmtE ∪ lrustN), heapN}▷=> True)%I as "H". iAssert (|={mgmtE ∪ ⊤ ∖ (mgmtE ∪ lrustN), heapN}▷=> True)%I as "H".
{ iApply fupd_mono. iIntros "H!>"; iExact "H". { iApply fupd_mono. iIntros "H!>"; iExact "H".
iApply fupd_intro_mask; last done. iApply fupd_intro_mask; last done.
assert (Hdisj:nclose heapN ⊥ (mgmtE ∪ lrustN)) by (rewrite !disjoint_union_r; solve_ndisj). assert (Hdisj:nclose heapN ⊥ (mgmtE ∪ lrustN))
by (rewrite !disjoint_union_r; solve_ndisj).
set_solver. } set_solver. }
rewrite {3 4}(union_difference_L (mgmtE ∪ lrustN) ⊤); last done. rewrite {3 4}(union_difference_L (mgmtE ∪ lrustN) ⊤); last done.
iApply fupd_trans. iApply fupd_mask_frame_r. set_solver. iApply fupd_trans. iApply fupd_mask_frame_r. set_solver.
...@@ -324,7 +325,7 @@ Section typing. ...@@ -324,7 +325,7 @@ Section typing.
(λ v, v ◁ &uniq{κ'} ty ★ κ ⊑ κ' ★ [κ]{q})%P. (λ v, v ◁ &uniq{κ'} ty ★ κ ⊑ κ' ★ [κ]{q})%P.
Proof. Proof.
iIntros (tid) "!#(#HEAP & (H◁ & #H⊑1 & [Htok #Hκ'] & #H⊑2) & Htl)". wp_bind ν. iIntros (tid) "!#(#HEAP & (H◁ & #H⊑1 & [Htok #Hκ'] & #H⊑2) & Htl)". wp_bind ν.
iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv. iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]!>". iDestruct "Hνv" as %Hνv.
rewrite has_type_value. iDestruct "H◁" as (l) "[Heq H↦]". iDestruct "Heq" as %[=->]. rewrite has_type_value. iDestruct "H◁" as (l) "[Heq H↦]". iDestruct "Heq" as %[=->].
iMod (lft_incl_trade with "H⊑1 Htok") as (q'') "[Htok Hclose]". done. iMod (lft_incl_trade with "H⊑1 Htok") as (q'') "[Htok Hclose]". done.
iMod (lft_borrow_exists with "H↦ Htok") as (vl) "[Hbor Htok]". done. iMod (lft_borrow_exists with "H↦ Htok") as (vl) "[Hbor Htok]". done.
...@@ -364,8 +365,8 @@ Section typing. ...@@ -364,8 +365,8 @@ Section typing.
ty1.(ty_size) = ty2.(ty_size) → ty1.(ty_size) = ty2.(ty_size) →
update ty1 (λ ν, ν ◁ own q ty2)%P (λ ν, ν ◁ own q ty1)%P. update ty1 (λ ν, ν ◁ own q ty2)%P (λ ν, ν ◁ own q ty1)%P.
Proof. Proof.
iIntros (Hsz ν tid Φ) "[H◁ HΦ]". iApply wp_fupd. iIntros (Hsz ν tid Φ) "[H◁ HΦ]". iApply (has_type_wp with "[- $H◁]").
iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv. iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv.
rewrite has_type_value. iDestruct "H◁" as (l) "(Heq & >H† & H↦)". rewrite has_type_value. iDestruct "H◁" as (l) "(Heq & >H† & H↦)".
iDestruct "Heq" as %[= ->]. iDestruct "H↦" as (vl) "[>H↦ Hown]". iDestruct "Heq" as %[= ->]. iDestruct "H↦" as (vl) "[>H↦ Hown]".
rewrite ty2.(ty_size_eq) -Hsz. iDestruct "Hown" as ">%". iApply "HΦ". iFrame "★%". rewrite ty2.(ty_size_eq) -Hsz. iDestruct "Hown" as ">%". iApply "HΦ". iFrame "★%".
...@@ -377,7 +378,7 @@ Section typing. ...@@ -377,7 +378,7 @@ Section typing.
update ty (λ ν, ν ◁ &uniq{κ} ty ★ κ' ⊑ κ ★ [κ']{q})%P update ty (λ ν, ν ◁ &uniq{κ} ty ★ κ' ⊑ κ ★ [κ']{q})%P
(λ ν, ν ◁ &uniq{κ} ty ★ κ' ⊑ κ ★ [κ']{q})%P. (λ ν, ν ◁ &uniq{κ} ty ★ κ' ⊑ κ ★ [κ']{q})%P.
Proof. Proof.
iIntros (ν tid Φ) "[(H◁ & #H⊑ & Htok & #Hκ) HΦ]". iApply wp_fupd. iIntros (ν tid Φ) "[(H◁ & #H⊑ & Htok & #Hκ) HΦ]".
iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv. iApply (has_type_wp with "[- $H◁]"). iIntros (v) "[Hνv H◁]". iDestruct "Hνv" as %Hνv.
rewrite has_type_value. iDestruct "H◁" as (l) "(Heq & H↦)". iDestruct "Heq" as %[=->]. rewrite has_type_value. iDestruct "H◁" as (l) "(Heq & H↦)". iDestruct "Heq" as %[=->].
iMod (lft_incl_trade with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver. iMod (lft_incl_trade with "H⊑ Htok") as (q') "[Htok Hclose]". set_solver.
...@@ -397,7 +398,7 @@ Section typing. ...@@ -397,7 +398,7 @@ Section typing.
iIntros (Hsz Hupd tid) "!#(#HEAP & [Hρ1 H◁] & $)". wp_bind ν1. iIntros (Hsz Hupd tid) "!#(#HEAP & [Hρ1 H◁] & $)". wp_bind ν1.
iApply wp_mask_mono. done. iApply Hupd. iFrame. iIntros (l vl) "(%&%&H↦&Hupd)". iApply wp_mask_mono. done. iApply Hupd. iFrame. iIntros (l vl) "(%&%&H↦&Hupd)".
rewrite ->Hsz in *. destruct vl as [|v[|]]; try done. rewrite ->Hsz in *. destruct vl as [|v[|]]; try done.
wp_bind ν2. iApply (has_type_wp with "[- $H◁]"). iIntros (v') "[% H◁]". wp_bind ν2. iApply (has_type_wp with "[- $H◁]"). iIntros (v') "[% H◁]!>".
rewrite heap_mapsto_vec_singleton. wp_write. rewrite heap_mapsto_vec_singleton. wp_write.
iApply fupd_mask_mono. done. iApply ("Hupd" $! [_]). iApply fupd_mask_mono. done. iApply ("Hupd" $! [_]).
rewrite heap_mapsto_vec_singleton has_type_value. iFrame. rewrite heap_mapsto_vec_singleton has_type_value. iFrame.
...@@ -450,7 +451,7 @@ Section typing. ...@@ -450,7 +451,7 @@ Section typing.
typed_program (ρ ★ ν ◁ bool) (if: ν then e1 else e2). typed_program (ρ ★ ν ◁ bool) (if: ν then e1 else e2).
Proof. Proof.
iIntros (He1 He2 tid) "!#(#HEAP & [Hρ H◁] & Htl)". iIntros (He1 He2 tid) "!#(#HEAP & [Hρ H◁] & Htl)".
wp_bind ν. iApply has_type_wp. iFrame. iIntros (v) "[% H◁]". wp_bind ν. iApply has_type_wp. iFrame. iIntros (v) "[% H◁]!>".
rewrite has_type_value. iDestruct "H◁" as (b) "Heq". iDestruct "Heq" as %[= ->]. rewrite has_type_value. iDestruct "H◁" as (b) "Heq". iDestruct "Heq" as %[= ->].
wp_if. destruct b; iNext. iApply He1; by iFrame. iApply He2; by iFrame. wp_if. destruct b; iNext. iApply He1; by iFrame. iApply He2; by iFrame.
Qed. Qed.
......
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