Commit 19d36a41 authored by Dan Frumin's avatar Dan Frumin
Browse files

Reorganize lemmas in translation.v

parent 6d35edfe
......@@ -46,7 +46,6 @@ Notation "e1 ;;;; e2" :=
Definition a_if : val := λ: "cnd" "e1" "e2",
a_bind (λ: "c", if: "c" then "e1" #() else "e2" #()) "cnd".
Definition a_while: val :=
rec: "while" "cnd" "bdy" :=
a_if ("cnd" #()) (λ:<>, "bdy" #() ;;;; "while" "cnd" "bdy") a_seq%E.
......@@ -54,110 +53,84 @@ Definition a_while: val :=
Section proofs.
Context `{locking_heapG Σ, heapG Σ, flockG Σ, spawnG Σ}.
Lemma a_while_spec R Φ (c b: expr) `{Closed [] c} `{Closed [] b} :
awp (a_if c
(λ:<>, (#() ;; b) ;;;; a_while (λ:<>, c) (λ:<>, b))
a_seq)%E R Φ -
awp (a_while (λ:<>, c) (λ:<>, b))%E R Φ.
Proof.
iIntros "H".
awp_lam. awp_lam. awp_seq.
iApply "H".
Qed.
Lemma a_if_spec R Φ (e e1 e2 : expr) `{Closed [] e1} `{Closed [] e2} :
AsVal e1 ->
AsVal e2 ->
awp e R (λ v, (v = #true awp (e1 #()) R Φ)
(v = #false awp (e2 #()) R Φ)) -
awp (a_if e e1 e2) R Φ.
Proof.
iIntros ([v1 <-%of_to_val] [v2 <-%of_to_val]) "H".
awp_apply (a_wp_awp with "H"). iIntros (v) "H". do 3 awp_lam.
iApply awp_bind. iApply (awp_wand with "H"). clear v.
iIntros (v) "[[% H] | [% H]]"; simplify_eq; awp_lam; by awp_if.
Qed.
Lemma a_if_true_spec R (e1 e2 : expr) `{Closed [] e1, Closed [] e2} Φ :
awp e1 R Φ - awp (a_if (a_ret #true) (λ: <>, e1) (λ: <>, e2))%E R Φ.
Proof.
iIntros "HΦ".
iApply a_if_spec.
iApply awp_ret. iApply wp_value.
iLeft. iSplit; eauto. by awp_seq.
Qed.
Lemma a_if_false_spec R (e1 e2 : expr) `{Closed [] e1, Closed [] e2} Φ :
awp e2 R Φ - awp (a_if (a_ret #false) (λ: <>, e1) (λ: <>, e2))%E R Φ.
Lemma a_alloc_spec R Φ e :
awp e R (λ v, l, l U v - Φ #l) -
awp (a_alloc e) R Φ.
Proof.
iIntros "HΦ".
iApply a_if_spec.
iApply awp_ret. iApply wp_value.
iRight. iSplit; eauto. by awp_seq.
iIntros "H". awp_apply (a_wp_awp with "H"); iIntros (v) "H". awp_lam.
iApply awp_bind.
iApply (awp_wand with "H"). clear v.
iIntros (v) "H". awp_lam.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
iApply wp_fupd.
wp_let. wp_alloc l as "Hl".
iAssert (⌜σ !! l = None)%I with "[Hl Hls]" as %Hl.
{ remember (σ !! l) as σl. destruct σl; simplify_eq; eauto.
iExFalso. rewrite (bi.big_sepM_lookup _ σ l _); last eauto.
iDestruct "Hls" as (v') "Hl'".
by iDestruct (mapsto_valid_2 l with "Hl Hl'") as %[]. }
iDestruct "Hl" as "[Hl Hl']".
iMod (locking_heap_alloc σ l ULvl v with "Hl' Hσ") as "[Hσ Hl']"; eauto.
iModIntro. iFrame "HR". iSplitR "H Hl'".
- iExists X,(<[l:=ULvl]>σ). iFrame. iSplit.
+ rewrite bi.big_sepM_insert; eauto. iFrame. eauto.
+ iPureIntro. by rewrite locked_locs_alloc_unlocked.
- iApply ("H" with "Hl'").
Qed.
Lemma a_seq_spec R Φ :
U (Φ #()) -
awp (a_seq #()) R Φ.
Lemma a_store_spec R Φ Ψ1 Ψ2 e1 e2 :
awp e1 R (λ v, l : loc, v = #l Ψ1 l)-
awp e2 R Ψ2 -
( (l : loc) w,
Ψ1 l - Ψ2 w - ( v, l U v (l L w - Φ w))) -
awp (a_store e1 e2) R Φ.
Proof.
iIntros "HΦ". rewrite /a_seq. awp_lam.
iIntros "H1 H2 HΦ".
awp_apply (a_wp_awp with "H1"); iIntros (v1) "H1". awp_lam.
awp_apply (a_wp_awp with "H2"); iIntros (v2) "H2". awp_lam.
iApply awp_bind. iApply (awp_par with "H1 H2").
iIntros "!>" (w1 w2) "H1 H2 !>". iDestruct "H1" as (l ->) "H1". awp_lam.
iDestruct ("HΦ" with "H1 H2") as (v) "[Hv HΦ]".
iApply awp_atomic_env.
iIntros (env) "Henv HR".
iApply wp_fupd.
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
wp_let. iApply (mset_clear_spec with "HX").
iNext. iIntros "HX".
iDestruct "HΦ" as (us) "[Hus HΦ]".
clear Hlocks.
iInduction us as [|u us] "IH" forall (σ); simpl.
- iModIntro. iFrame "HR". iSplitR "HΦ".
+ iExists , σ. iFrame. iPureIntro.
rewrite /correct_locks /set_Forall. set_solver.
+ by iApply "HΦ".
- iDestruct "Hus" as "[Hu Hus]".
iAssert (⌜σ !! u.1 = Some LLvl%I) with "[Hσ Hu]" as %?.
iDestruct (locked_locs_unlocked with "Hv Hσ") as %Hl.
assert (#l X).
{ unfold correct_locks in *. intros Hx. apply Hl.
destruct (Hlocks _ Hx) as [l' [? Hl']]. by simplify_eq/=. }
wp_let. wp_proj.
wp_apply (mset_add_spec with "[$HX]"); eauto.
iIntros "HX". wp_seq.
iAssert (⌜σ !! l = Some ULvl%I) with "[Hσ Hv]" as %?.
{ rewrite mapsto_eq /mapsto_def.
iDestruct "Hu" as "[Hu Hl]".
iDestruct "Hv" as "[Hv Hl]".
by iDestruct (own_valid_2 with "Hσ Hl")
as %[?%heap_singleton_included _]%auth_valid_discrete_2. }
iMod (locking_heap_change_lock _ _ _ ULvl with "Hσ Hu") as "[Hσ Hu]".
iApply ("IH" with "Hus [HΦ Hu] Hσ [Hls] HR HX").
{ iIntros "Hus". iApply "HΦ". by iFrame. }
{ rewrite -bi.big_sepM_insert_override; eauto. }
Qed.
Lemma a_sequence_spec R Φ (f e : expr) :
AsVal f
awp e R (λ v, U (awp (f v) R Φ)) -
awp (a_seq_bind f e) R Φ.
Proof.
iIntros ([fv <-%of_to_val]) "H". rewrite /a_seq_bind /=. awp_lam.
awp_apply (a_wp_awp with "H"); iIntros (v) "H". awp_lam.
iApply awp_bind. iApply (awp_wand with "H"). iIntros (w) "H".
awp_lam. iApply awp_bind. iApply a_seq_spec.
iModIntro. by awp_lam.
Qed.
Lemma a_while_inv_spec I R Φ (c b: expr) `{Closed [] c} `{Closed [] b} :
I -
(I - awp c R (λ v, (v = #false U (Φ #()))
(v = #true (awp b R (λ _, U I))))%I) -
awp (a_while (λ:<>, c) (λ:<>, b))%E R Φ.
Proof.
iIntros "Hi #Hinv". iLöb as "IH".
iApply a_while_spec. iNext.
iApply a_if_spec.
iSpecialize ("Hinv" with "Hi"). iApply (awp_wand with "Hinv").
iIntros (v) "[(% & H) | (% & H)] //="; subst.
- iRight. iSplit; by eauto; iApply a_seq_spec.
- iLeft. iSplit; first eauto. awp_seq.
iApply a_sequence_spec. awp_seq.
iApply (awp_wand with "H").
iIntros (v) "Hi". iModIntro. awp_seq.
by iApply ("IH" with "Hi").
iMod (locking_heap_change_lock _ _ ULvl LLvl with "Hσ Hv") as "[Hσ Hv]".
do 2 wp_proj. rewrite mapsto_eq /mapsto_def.
iDestruct "Hv" as "[Hv Hl]".
rewrite (bi.big_sepM_lookup_acc _ _ l ULvl); last done.
iDestruct "Hls" as "[Hl' Hls]".
iDestruct "Hl'" as (?) "Hl'".
rewrite Qp_mult_1_l.
iDestruct (mapsto_agree l (1/2) (1/2) with "Hl' Hv") as %->.
iCombine "Hv Hl'" as "Hv".
wp_store.
iDestruct "Hv" as "[Hv Hl']".
iSpecialize ("Hls" with "[Hl']"); eauto.
wp_proj. iFrame "HR". iSplitR "HΦ Hl Hv".
- iExists ({[#l]} X),(<[l:=LLvl]> σ). iFrame. iSplitL.
+ rewrite -bi.big_sepM_insert_override; eauto.
+ (* TODO: a separate lemma somewhere *)
iPureIntro. rewrite locked_locs_lock.
revert Hlocks. rewrite /correct_locks /set_Forall. set_solver.
- iApply "HΦ". iFrame.
Qed.
Lemma a_load_spec R Φ q e :
......@@ -190,35 +163,6 @@ Section proofs.
- by iApply "HΦ".
Qed.
Lemma a_alloc_spec R Φ e :
awp e R (λ v, l, l U v - Φ #l) -
awp (a_alloc e) R Φ.
Proof.
iIntros "H". awp_apply (a_wp_awp with "H"); iIntros (v) "H". awp_lam.
iApply awp_bind.
iApply (awp_wand with "H"). clear v.
iIntros (v) "H". awp_lam.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
iApply wp_fupd.
wp_let. wp_alloc l as "Hl".
iAssert (⌜σ !! l = None)%I with "[Hl Hls]" as %Hl.
{ remember (σ !! l) as σl. destruct σl; simplify_eq; eauto.
iExFalso. rewrite (bi.big_sepM_lookup _ σ l _); last eauto.
iDestruct "Hls" as (v') "Hl'".
by iDestruct (mapsto_valid_2 l with "Hl Hl'") as %[]. }
iDestruct "Hl" as "[Hl Hl']".
iMod (locking_heap_alloc σ l ULvl v with "Hl' Hσ") as "[Hσ Hl']"; eauto.
iModIntro. iFrame "HR". iSplitR "H Hl'".
- iExists X,(<[l:=ULvl]>σ). iFrame. iSplit.
+ rewrite bi.big_sepM_insert; eauto. iFrame. eauto.
+ iPureIntro. by rewrite locked_locs_alloc_unlocked.
- iApply ("H" with "Hl'").
Qed.
Lemma a_un_op_spec R Φ e op:
awp e R (λ v, w, un_op_eval op v = Some w Φ w) -
awp (a_un_op op e) R Φ.
......@@ -248,56 +192,108 @@ Section proofs.
iDestruct "HΦ" as (w0) "[% H]". by wp_pure _.
Qed.
Lemma a_store_spec R Φ Ψ1 Ψ2 e1 e2 :
awp e1 R (λ v, l : loc, v = #l Ψ1 l)-
awp e2 R Ψ2 -
( (l : loc) w,
Ψ1 l - Ψ2 w - ( v, l U v (l L w - Φ w))) -
awp (a_store e1 e2) R Φ.
Lemma a_seq_spec R Φ :
U (Φ #()) -
awp (a_seq #()) R Φ.
Proof.
iIntros "H1 H2 HΦ".
awp_apply (a_wp_awp with "H1"); iIntros (v1) "H1". awp_lam.
awp_apply (a_wp_awp with "H2"); iIntros (v2) "H2". awp_lam.
iApply awp_bind. iApply (awp_par with "H1 H2").
iIntros "!>" (w1 w2) "H1 H2 !>". iDestruct "H1" as (l ->) "H1". awp_lam.
iDestruct ("HΦ" with "H1 H2") as (v) "[Hv HΦ]".
iIntros "HΦ". rewrite /a_seq. awp_lam.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
iApply wp_fupd.
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
iDestruct (locked_locs_unlocked with "Hv Hσ") as %Hl.
assert (#l X).
{ unfold correct_locks in *. intros Hx. apply Hl.
destruct (Hlocks _ Hx) as [l' [? Hl']]. by simplify_eq/=. }
wp_let. wp_proj.
wp_apply (mset_add_spec with "[$HX]"); eauto.
iIntros "HX". wp_seq.
iAssert (⌜σ !! l = Some ULvl%I) with "[Hσ Hv]" as %?.
wp_let. iApply (mset_clear_spec with "HX").
iNext. iIntros "HX".
iDestruct "HΦ" as (us) "[Hus HΦ]".
clear Hlocks.
iInduction us as [|u us] "IH" forall (σ); simpl.
- iModIntro. iFrame "HR". iSplitR "HΦ".
+ iExists , σ. iFrame. iPureIntro.
rewrite /correct_locks /set_Forall. set_solver.
+ by iApply "HΦ".
- iDestruct "Hus" as "[Hu Hus]".
iAssert (⌜σ !! u.1 = Some LLvl%I) with "[Hσ Hu]" as %?.
{ rewrite mapsto_eq /mapsto_def.
iDestruct "Hv" as "[Hv Hl]".
iDestruct "Hu" as "[Hu Hl]".
by iDestruct (own_valid_2 with "Hσ Hl")
as %[?%heap_singleton_included _]%auth_valid_discrete_2. }
iMod (locking_heap_change_lock _ _ ULvl LLvl with "Hσ Hv") as "[Hσ Hv]".
do 2 wp_proj. rewrite mapsto_eq /mapsto_def.
iDestruct "Hv" as "[Hv Hl]".
rewrite (bi.big_sepM_lookup_acc _ _ l ULvl); last done.
iDestruct "Hls" as "[Hl' Hls]".
iDestruct "Hl'" as (?) "Hl'".
rewrite Qp_mult_1_l.
iDestruct (mapsto_agree l (1/2) (1/2) with "Hl' Hv") as %->.
iCombine "Hv Hl'" as "Hv".
wp_store.
iDestruct "Hv" as "[Hv Hl']".
iSpecialize ("Hls" with "[Hl']"); eauto.
wp_proj. iFrame "HR". iSplitR "HΦ Hl Hv".
- iExists ({[#l]} X),(<[l:=LLvl]> σ). iFrame. iSplitL.
+ rewrite -bi.big_sepM_insert_override; eauto.
+ (* TODO: a separate lemma somewhere *)
iPureIntro. rewrite locked_locs_lock.
revert Hlocks. rewrite /correct_locks /set_Forall. set_solver.
- iApply "HΦ". iFrame.
iMod (locking_heap_change_lock _ _ _ ULvl with "Hσ Hu") as "[Hσ Hu]".
iApply ("IH" with "Hus [HΦ Hu] Hσ [Hls] HR HX").
{ iIntros "Hus". iApply "HΦ". by iFrame. }
{ rewrite -bi.big_sepM_insert_override; eauto. }
Qed.
Lemma a_sequence_spec R Φ (f e : expr) :
AsVal f
awp e R (λ v, U (awp (f v) R Φ)) -
awp (a_seq_bind f e) R Φ.
Proof.
iIntros ([fv <-%of_to_val]) "H". rewrite /a_seq_bind /=. awp_lam.
awp_apply (a_wp_awp with "H"); iIntros (v) "H". awp_lam.
iApply awp_bind. iApply (awp_wand with "H"). iIntros (w) "H".
awp_lam. iApply awp_bind. iApply a_seq_spec.
iModIntro. by awp_lam.
Qed.
Lemma a_while_spec R Φ (c b: expr) `{Closed [] c} `{Closed [] b} :
awp (a_if c
(λ:<>, (#() ;; b) ;;;; a_while (λ:<>, c) (λ:<>, b))
a_seq)%E R Φ -
awp (a_while (λ:<>, c) (λ:<>, b))%E R Φ.
Proof.
iIntros "H".
awp_lam. awp_lam. awp_seq.
iApply "H".
Qed.
Lemma a_if_spec R Φ (e e1 e2 : expr) `{Closed [] e1} `{Closed [] e2} :
AsVal e1 ->
AsVal e2 ->
awp e R (λ v, (v = #true awp (e1 #()) R Φ)
(v = #false awp (e2 #()) R Φ)) -
awp (a_if e e1 e2) R Φ.
Proof.
iIntros ([v1 <-%of_to_val] [v2 <-%of_to_val]) "H".
awp_apply (a_wp_awp with "H"). iIntros (v) "H". do 3 awp_lam.
iApply awp_bind. iApply (awp_wand with "H"). clear v.
iIntros (v) "[[% H] | [% H]]"; simplify_eq; awp_lam; by awp_if.
Qed.
Lemma a_if_true_spec R (e1 e2 : expr) `{Closed [] e1, Closed [] e2} Φ :
awp e1 R Φ - awp (a_if (a_ret #true) (λ: <>, e1) (λ: <>, e2))%E R Φ.
Proof.
iIntros "HΦ".
iApply a_if_spec.
iApply awp_ret. iApply wp_value.
iLeft. iSplit; eauto. by awp_seq.
Qed.
Lemma a_if_false_spec R (e1 e2 : expr) `{Closed [] e1, Closed [] e2} Φ :
awp e2 R Φ - awp (a_if (a_ret #false) (λ: <>, e1) (λ: <>, e2))%E R Φ.
Proof.
iIntros "HΦ".
iApply a_if_spec.
iApply awp_ret. iApply wp_value.
iRight. iSplit; eauto. by awp_seq.
Qed.
Lemma a_while_inv_spec I R Φ (c b: expr) `{Closed [] c} `{Closed [] b} :
I -
(I - awp c R (λ v, (v = #false U (Φ #()))
(v = #true (awp b R (λ _, U I))))%I) -
awp (a_while (λ:<>, c) (λ:<>, b))%E R Φ.
Proof.
iIntros "Hi #Hinv". iLöb as "IH".
iApply a_while_spec. iNext.
iApply a_if_spec.
iSpecialize ("Hinv" with "Hi"). iApply (awp_wand with "Hinv").
iIntros (v) "[(% & H) | (% & H)] //="; subst.
- iRight. iSplit; by eauto; iApply a_seq_spec.
- iLeft. iSplit; first eauto. awp_seq.
iApply a_sequence_spec. awp_seq.
iApply (awp_wand with "H").
iIntros (v) "Hi". iModIntro. awp_seq.
by iApply ("IH" with "Hi").
Qed.
End proofs.
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