Skip to content

GitLab

Commit f2045770 authored by Dan Frumin's avatar Dan Frumin
Browse files
Options

Update F_mu_ref_conc to Iris 3 

sans examples
parent 70299030
Hide whitespace changes
Inline Side-by-side
Showing with 337 additions and 407 deletions
F_mu_ref_conc/fundamental_binary.v
View file @ f2045770
......@@ -5,11 +5,12 @@ From iris.base_logic Require Export big_op.
Section bin_log_def.
Context `{cfgSG Σ}.
Context `{heapIG Σ}.
Notation D := (prodC valC valC -n> iProp Σ).
Definition bin_log_related (Γ : list type) (e e' : expr) (τ : type) := ∀ Δ vvs ρ,
env_PersistentP Δ →
heapI_ctx ∧ spec_ctx ρ ∧
spec_ctx ρ ∧
⟦ Γ ⟧* Δ vvs ⊢ ⟦ τ ⟧ₑ Δ (e.[env_subst (vvs.*1)], e'.[env_subst (vvs.*2)]).
End bin_log_def.
......@@ -18,6 +19,7 @@ Notation "Γ ⊨ e '≤log≤' e' : τ" :=
Section fundamental.
Context `{cfgSG Σ}.
Context `{heapIG Σ}.
Notation D := (prodC valC valC -n> iProp Σ).
Implicit Types e : expr.
Implicit Types Δ : listC D.
......@@ -37,11 +39,11 @@ Section fundamental.
(* Put all quantifiers at the outer level *)
Lemma bin_log_related_alt {Γ e e' τ} : Γ ⊨ e ≤log≤ e' : τ → ∀ Δ vvs ρ j K,
env_PersistentP Δ →
heapI_ctx ∗ spec_ctx ρ ∗ ⟦ Γ ⟧* Δ vvs ∗ j ⤇ fill K (e'.[env_subst (vvs.*2)])
spec_ctx ρ ∗ ⟦ Γ ⟧* Δ vvs ∗ j ⤇ fill K (e'.[env_subst (vvs.*2)])
⊢ WP e.[env_subst (vvs.*1)] {{ v, ∃ v',
j ⤇ fill K (of_val v') ∗ interp τ Δ (v, v') }}.
Proof.
iIntros (Hlog Δ vvs ρ j K ?) "(#Hh & #Hs & HΓ & Hj)".
iIntros (Hlog Δ vvs ρ j K ?) "(#Hs & HΓ & Hj)".
iApply (Hlog with "[HΓ] *"); iFrame; eauto.
Qed.
......@@ -50,26 +52,26 @@ Section fundamental.
Lemma bin_log_related_var Γ x τ :
Γ !! x = Some τ → Γ ⊨ Var x ≤log≤ Var x : τ.
Proof.
iIntros (? Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (? Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
iDestruct (interp_env_Some_l with "HΓ") as ([v v']) "[% ?]"; first done.
rewrite /env_subst !list_lookup_fmap; simplify_option_eq. value_case; eauto.
Qed.
Lemma bin_log_related_unit Γ : Γ ⊨ Unit ≤log≤ Unit : TUnit.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
value_case. iExists UnitV; eauto.
Qed.
Lemma bin_log_related_nat Γ n : Γ ⊨ #n n ≤log≤ #n n : TNat.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
value_case. iExists (#nv _); eauto.
Qed.
Lemma bin_log_related_bool Γ b : Γ ⊨ #♭ b ≤log≤ #♭ b : TBool.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
value_case. iExists (#♭v _); eauto.
Qed.
......@@ -78,7 +80,7 @@ Section fundamental.
(IHHtyped2 : Γ ⊨ e2 ≤log≤ e2' : τ2) :
Γ ⊨ Pair e1 e2 ≤log≤ Pair e1' e2' : TProd τ1 τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (PairLCtx e2.[env_subst _]) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ j (K ++ [PairLCtx e2'.[env_subst _] ])).
smart_wp_bind (PairRCtx v) w w' "[Hw #Hiw]"
......@@ -91,29 +93,29 @@ Section fundamental.
(IHHtyped : Γ ⊨ e ≤log≤ e' : TProd τ1 τ2) :
Γ ⊨ Fst e ≤log≤ Fst e' : τ1.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (FstCtx) v v' "[Hv #Hiv]" ('IHHtyped _ _ _ j (K ++ [FstCtx])); cbn.
iDestruct "Hiv" as ([w1 w1'] [w2 w2']) "#[% [Hw1 Hw2]]"; simplify_eq.
iMod (step_fst _ _ j K (of_val w1') w1' (of_val w2') w2' with "* [-]") as "Hw"; eauto.
iApply wp_fst; eauto.
iApply wp_fst; eauto. iNext.
iMod (step_fst with "[Hs Hv]") as "Hw"; eauto.
Qed.
Lemma bin_log_related_snd Γ e e' τ1 τ2
(IHHtyped : Γ ⊨ e ≤log≤ e' : TProd τ1 τ2) :
Γ ⊨ Snd e ≤log≤ Snd e' : τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (SndCtx) v v' "[Hv #Hiv]" ('IHHtyped _ _ _ j (K ++ [SndCtx])); cbn.
iDestruct "Hiv" as ([w1 w1'] [w2 w2']) "#[% [Hw1 Hw2]]"; simplify_eq.
iMod (step_snd _ _ j K (of_val w1') w1' (of_val w2') w2' with "* [-]") as "Hw"; eauto.
iApply wp_snd; eauto.
iApply wp_snd; eauto. iNext.
iMod (step_snd with "[Hs Hv]") as "Hw"; eauto.
Qed.
Lemma bin_log_related_injl Γ e e' τ1 τ2
(IHHtyped : Γ ⊨ e ≤log≤ e' : τ1) :
Γ ⊨ InjL e ≤log≤ InjL e' : (TSum τ1 τ2).
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (InjLCtx) v v' "[Hv #Hiv]"
('IHHtyped _ _ _ j (K ++ [InjLCtx])); cbn.
value_case. iExists (InjLV v'); iFrame "Hv".
......@@ -124,7 +126,7 @@ Section fundamental.
(IHHtyped : Γ ⊨ e ≤log≤ e' : τ2) :
Γ ⊨ InjR e ≤log≤ InjR e' : TSum τ1 τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (InjRCtx) v v' "[Hv #Hiv]"
('IHHtyped _ _ _ j (K ++ [InjRCtx])); cbn.
value_case. iExists (InjRV v'); iFrame "Hv".
......@@ -141,20 +143,22 @@ Section fundamental.
(IHHtyped3 : τ2 :: Γ ⊨ e2 ≤log≤ e2' : τ3) :
Γ ⊨ Case e0 e1 e2 ≤log≤ Case e0' e1' e2' : τ3.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
iDestruct (interp_env_length with "HΓ") as %?.
smart_wp_bind (CaseCtx _ _) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ j (K ++ [CaseCtx _ _])); cbn.
iDestruct "Hiv" as "[Hiv|Hiv]".
- iDestruct "Hiv" as ([w w']) "[% Hw]"; simplify_eq.
iMod (step_case_inl _ _ j K (of_val w') w' with "* [-]") as "Hz"; eauto.
iApply wp_case_inl; auto 1 using to_of_val. iNext.
asimpl. erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto).
iApply ('IHHtyped2 _ ((w,w') :: vvs)); repeat iSplit; eauto.
iDestruct "Hiv" as "[Hiv|Hiv]";
iDestruct "Hiv" as ([w w']) "[% Hw]"; simplify_eq.
- iApply fupd_wp.
iMod (step_case_inl with "[Hs Hv]") as "Hz"; eauto.
iApply wp_case_inl; eauto using to_of_val. fold of_val. iNext.
asimpl.
erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto).
iApply ('IHHtyped2 _ ((w,w') :: vvs)). repeat iSplit; eauto.
iApply interp_env_cons; auto.
- iDestruct "Hiv" as ([w w']) "[% Hw]"; simplify_eq.
iMod (step_case_inr _ _ j K (of_val w') w' with "* [-]") as "Hz"; eauto.
iApply wp_case_inr; auto 1 using to_of_val. iNext.
- iApply fupd_wp.
iMod (step_case_inr with "[Hs Hv]") as "Hz"; eauto.
iApply wp_case_inr; eauto using to_of_val. fold of_val. iNext.
asimpl. erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto).
iApply ('IHHtyped3 _ ((w,w') :: vvs)); repeat iSplit; eauto.
iApply interp_env_cons; auto.
......@@ -166,13 +170,13 @@ Section fundamental.
(IHHtyped3 : Γ ⊨ e2 ≤log≤ e2' : τ) :
Γ ⊨ If e0 e1 e2 ≤log≤ If e0' e1' e2' : τ.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (IfCtx _ _) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ j (K ++ [IfCtx _ _])); cbn.
iDestruct "Hiv" as ([]) "[% %]"; simplify_eq/=.
- iMod (step_if_true _ _ j K with "* [-]") as "Hz"; eauto.
iDestruct "Hiv" as ([]) "[% %]"; simplify_eq/=; iApply fupd_wp.
- iMod (step_if_true _ _ j K with "[-]") as "Hz"; eauto.
iApply wp_if_true. iNext. iApply 'IHHtyped2; eauto.
- iMod (step_if_false _ _ j K with "* [-]") as "Hz"; eauto.
- iMod (step_if_false _ _ j K with "[-]") as "Hz"; eauto.
iApply wp_if_false. iNext. iApply 'IHHtyped3; eauto.
Qed.
......@@ -181,14 +185,15 @@ Section fundamental.
(IHHtyped2 : Γ ⊨ e2 ≤log≤ e2' : TNat) :
Γ ⊨ BinOp op e1 e2 ≤log≤ BinOp op e1' e2' : binop_res_type op.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (BinOpLCtx _ _) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ j (K ++ [BinOpLCtx _ _])); cbn.
smart_wp_bind (BinOpRCtx _ _) w w' "[Hw #Hiw]"
('IHHtyped2 _ _ _ j (K ++ [BinOpRCtx _ _])); cbn.
iDestruct "Hiv" as (n) "[% %]"; simplify_eq/=.
iDestruct "Hiw" as (n') "[% %]"; simplify_eq/=.
iMod (step_nat_binop _ _ j K with "* [-]") as "Hz"; eauto.
iApply fupd_wp.
iMod (step_nat_binop _ _ j K with "[-]") as "Hz"; eauto.
iApply wp_nat_binop. iNext. iModIntro. iExists _; iSplitL; eauto.
destruct op; simpl; try destruct eq_nat_dec; try destruct le_dec;
try destruct lt_dec; eauto.
......@@ -200,11 +205,12 @@ Section fundamental.
(IHHtyped : TArrow τ1 τ2 :: τ1 :: Γ ⊨ e ≤log≤ e' : τ2) :
Γ ⊨ Rec e ≤log≤ Rec e' : TArrow τ1 τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
value_case. iExists (RecV _). iIntros "{$Hj} !#".
iLöb as "IH". iIntros ([v v']) "#Hiv". iIntros (j' K') "Hj".
iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_rec; auto 1 using to_of_val. iNext.
iApply fupd_wp.
iMod (step_rec _ _ j' K' _ (of_val v') v' with "* [-]") as "Hz"; eauto.
asimpl. change (Rec ?e) with (of_val (RecV e)).
erewrite !n_closed_subst_head_simpl_2 by (rewrite ?fmap_length; eauto).
......@@ -217,7 +223,7 @@ Section fundamental.
(IHHtyped2 : Γ ⊨ e2 ≤log≤ e2' : τ1) :
Γ ⊨ App e1 e2 ≤log≤ App e1' e2' : τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (AppLCtx (e2.[env_subst (vvs.*1)])) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ j (K ++ [(AppLCtx (e2'.[env_subst (vvs.*2)]))])); cbn.
smart_wp_bind (AppRCtx v) w w' "[Hw #Hiw]"
......@@ -229,10 +235,11 @@ Section fundamental.
(IHHtyped : (subst (ren (+1)) <$> Γ) ⊨ e ≤log≤ e' : τ) :
Γ ⊨ TLam e ≤log≤ TLam e' : TForall τ.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
value_case. iExists (TLamV _).
iIntros "{$Hj} /= !#"; iIntros (τi ? j' K') "Hv /=".
iApply wp_tlam; iNext.
iApply fupd_wp.
iMod (step_tlam _ _ j' K' (e'.[env_subst (vvs.*2)]) with "* [-]") as "Hz"; eauto.
iApply 'IHHtyped; repeat iSplit; eauto. by iApply interp_env_ren.
Qed.
......@@ -241,13 +248,13 @@ Section fundamental.
(IHHtyped : Γ ⊨ e ≤log≤ e' : TForall τ) :
Γ ⊨ TApp e ≤log≤ TApp e' : τ.[τ'/].
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (TAppCtx) v v' "[Hj #Hv]"
('IHHtyped _ _ _ j (K ++ [TAppCtx])); cbn.
iApply wp_wand_r; iSplitL.
{ iSpecialize ("Hv" $! (interp τ' Δ) with "[#]"); [iPureIntro; apply _|].
iApply "Hv"; eauto. }
iIntros (w); iDestruct 1 as (w') "[Hw #Hiw]".
iIntros (w). iDestruct 1 as (w') "[Hw Hiw]".
iExists _; rewrite -interp_subst; eauto.
Qed.
......@@ -255,7 +262,7 @@ Section fundamental.
(IHHtyped : Γ ⊨ e ≤log≤ e' : τ.[(TRec τ)/]) :
Γ ⊨ Fold e ≤log≤ Fold e' : TRec τ.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
iApply (wp_bind [FoldCtx]); iApply wp_wand_l; iSplitR;
[|iApply ('IHHtyped _ _ _ j (K ++ [FoldCtx]));
rewrite ?fill_app; simpl; repeat iSplitR; trivial].
......@@ -269,7 +276,7 @@ Section fundamental.
(IHHtyped : Γ ⊨ e ≤log≤ e' : TRec τ) :
Γ ⊨ Unfold e ≤log≤ Unfold e' : τ.[(TRec τ)/].
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
iApply (wp_bind [UnfoldCtx]); iApply wp_wand_l; iSplitR;
[|iApply ('IHHtyped _ _ _ j (K ++ [UnfoldCtx]));
rewrite ?fill_app; simpl; repeat iSplitR; trivial].
......@@ -277,6 +284,7 @@ Section fundamental.
rewrite /= fixpoint_unfold /=.
change (fixpoint _) with (interp (TRec τ) Δ).
iDestruct "Hiw" as ([w w']) "#[% Hiz]"; simplify_eq/=.
iApply fupd_wp.
iMod (step_Fold _ _ j K (of_val w') w' with "* [-]") as "Hz"; eauto.
iApply wp_fold; cbn; auto.
iNext; iModIntro; iExists _; iFrame "Hz". by rewrite -interp_subst.
......@@ -286,7 +294,8 @@ Section fundamental.
(IHHtyped : Γ ⊨ e ≤log≤ e' : TUnit) :
Γ ⊨ Fork e ≤log≤ Fork e' : TUnit.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
iApply fupd_wp.
iMod (step_fork _ _ j K with "* [-]") as (j') "[Hj Hj']"; eauto.
iApply wp_fork; iNext; iSplitL "Hj".
- iExists UnitV; eauto.
......@@ -297,14 +306,16 @@ Section fundamental.
(IHHtyped : Γ ⊨ e ≤log≤ e' : τ) :
Γ ⊨ Alloc e ≤log≤ Alloc e' : Tref τ.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (AllocCtx) v v' "[Hv #Hiv]" ('IHHtyped _ _ _ j (K ++ [AllocCtx])).
iApply fupd_wp.
iMod (step_alloc _ _ j K (of_val v') v' with "* [-]") as (l') "[Hj Hl]"; eauto.
iApply wp_fupd. iApply (wp_alloc with "[]"); auto.
iIntros "!>"; iIntros (l) "Hl'".
iApply wp_atomic; eauto.
iApply wp_alloc; eauto. iNext.
iIntros (l) "Hl'".
iMod (inv_alloc (logN .@ (l,l')) _ (∃ w : val * val,
l ↦ᵢ w.1 ∗ l' ↦ₛ w.2 ∗ interp τ Δ w)%I with "[Hl Hl']") as "HN"; eauto.
{ iNext; iExists (v, v'); by iFrame. }
{ iNext. iExists (v, v'); iFrame. iFrame "Hiv". }
iModIntro; iExists (LocV l'). iFrame "Hj". iExists (l, l'); eauto.
Qed.
......@@ -312,15 +323,18 @@ Section fundamental.
(IHHtyped : Γ ⊨ e ≤log≤ e' : (Tref τ)) :
Γ ⊨ Load e ≤log≤ Load e' : τ.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (LoadCtx) v v' "[Hv #Hiv]" ('IHHtyped _ _ _ j (K ++ [LoadCtx])).
iDestruct "Hiv" as ([l l']) "[% Hinv]"; simplify_eq/=.
iInv (logN .@ (l,l')) as ([w w']) "[Hw1 [Hw2 #Hw]]" "Hclose"; simpl.
iMod "Hw2".
iMod (step_load _ _ j K l' 1 w' with "[Hv Hw2]") as "[Hv Hw2]";
iApply wp_atomic; eauto.
iInv (logN .@ (l,l')) as ([w w']) "[Hw1 [>Hw2 #Hw]]" "Hclose"; simpl.
(* TODO: why can we eliminate the next modality here? ↑ *)
iModIntro.
iApply (wp_load with "Hw1").
iNext. iIntros "Hw1".
iMod (step_load with "[Hv Hw2]") as "[Hv Hw2]";
[solve_ndisj|by iFrame|].
iApply (wp_load _ _ 1 with "[Hw1]"); [|iFrame "Hh"|]; trivial; try solve_ndisj.
iNext. iIntros "Hw1". iMod ("Hclose" with "[Hw1 Hw2]").
iMod ("Hclose" with "[Hw1 Hw2]").
{ iNext. iExists (w,w'); by iFrame. }
iModIntro. iExists w'; by iFrame.
Qed.
......@@ -330,18 +344,21 @@ Section fundamental.
(IHHtyped2 : Γ ⊨ e2 ≤log≤ e2' : τ) :
Γ ⊨ Store e1 e2 ≤log≤ Store e1' e2' : TUnit.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (StoreLCtx _) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ j (K ++ [StoreLCtx _])).
smart_wp_bind (StoreRCtx _) w w' "[Hw #Hiw]"
('IHHtyped2 _ _ _ j (K ++ [StoreRCtx _])).
iDestruct "Hiv" as ([l l']) "[% Hinv]"; simplify_eq/=.
iInv (logN .@ (l,l')) as ([v v']) "[>Hv1 [>Hv2 #Hv]]" "Hclose".
iMod (step_store _ _ j K l' v' (of_val w') w' with "[Hw Hv2]")
as "[Hw Hv2]"; [eauto|solve_ndisj|by iFrame|].
iApply (wp_store with "[Hv1]"); auto using to_of_val. solve_ndisj.
iNext. iIntros "Hv1". iMod ("Hclose" with "[Hv1 Hv2]").
{ iNext; iExists (w, w'); by iFrame. }
iApply wp_atomic; eauto.
iInv (logN .@ (l,l')) as ([v v']) "[Hv1 [>Hv2 #Hv]]" "Hclose".
iModIntro.
iApply (wp_store with "Hv1"); auto using to_of_val.
iNext. iIntros "Hw2".
iMod (step_store with "[$Hs Hw Hv2]") as "[Hw Hv2]"; eauto;
[solve_ndisj | by iFrame|].
iMod ("Hclose" with "[Hw2 Hv2]").
{ iNext; iExists (w, w'); simpl; iFrame. iFrame "Hiw". }
iExists UnitV; iFrame; auto.
Qed.
......@@ -352,7 +369,7 @@ Section fundamental.
(IHHtyped3 : Γ ⊨ e3 ≤log≤ e3' : τ) :
Γ ⊨ CAS e1 e2 e3 ≤log≤ CAS e1' e2' e3' : TBool.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (j K) "Hj /=".
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
smart_wp_bind (CasLCtx _ _) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ j (K ++ [CasLCtx _ _])).
smart_wp_bind (CasMCtx _ _) w w' "[Hw #Hiw]"
......@@ -360,25 +377,31 @@ Section fundamental.
smart_wp_bind (CasRCtx _ _) u u' "[Hu #Hiu]"
('IHHtyped3 _ _ _ j (K ++ [CasRCtx _ _])).
iDestruct "Hiv" as ([l l']) "[% Hinv]"; simplify_eq/=.
iInv (logN .@ (l,l')) as ([v v']) "[>Hv1 [>Hv2 #Hv]]" "Hclose".
iApply wp_atomic; eauto.
iInv (logN .@ (l,l')) as ([v v']) "[Hv1 [>Hv2 #Hv]]" "Hclose".
iModIntro.
iPoseProof ("Hv") as "Hv'".
rewrite {2}[⟦ τ ⟧ Δ (v, v')]interp_EqType_agree; trivial.
iMod "Hv'" as %Hv'; subst.
destruct (decide (v' = w)) as [|Hneq]; subst.
- iAssert (▷ (w' = w))%I as ">%".
- iAssert (▷ ⌜w' = w⌝)%I as ">%".
{ rewrite ?interp_EqType_agree; trivial. by iSimplifyEq. }
iMod (step_cas_suc _ _ j K l' (of_val w') w' w (of_val u') u'
with "[$Hs $Hu $Hv2]") as "[Hw Hv2]"; simpl; eauto; first solve_ndisj.
iApply (wp_cas_suc with "[Hv1]"); eauto using to_of_val; first solve_ndisj.
iNext. iIntros "Hv1". iMod ("Hclose" with "[Hv1 Hv2]").
simpl. iApply (wp_cas_suc with "Hv1"); eauto using to_of_val.
iNext. iIntros "Hv1".
iMod (step_cas_suc
with "[Hu Hv2]") as "[Hw Hv2]"; simpl; eauto; first solve_ndisj.
iFrame. iFrame "Hs".
iMod ("Hclose" with "[Hv1 Hv2]").
{ iNext; iExists (_, _); by iFrame. }
iExists (#♭v true); iFrame; eauto.
-iAssert (▷ ■ (v' ≠ w'))%I as ">%".
{ rewrite ?interp_EqType_agree; trivial. iSimplifyEq. auto. }
iMod (step_cas_fail _ _ j K l' 1 v' (of_val w') w' (of_val u') u'
with "[$Hs $Hu $Hv2]") as "[Hw Hv2]"; simpl; eauto; first solve_ndisj.
iApply (wp_cas_fail with "[Hv1]"); eauto using to_of_val; first solve_ndisj.
iNext. iIntros "Hv1". iMod ("Hclose" with "[Hv1 Hv2]").
- iAssert (▷ ⌜v' ≠ w'⌝)%I as ">%".
{ rewrite ?interp_EqType_agree; trivial. iSimplifyEq. auto. }
simpl. iApply (wp_cas_fail with "Hv1"); eauto.
iNext. iIntros "Hv1".
iMod (step_cas_fail
with "[$Hs Hu Hv2]") as "[Hw Hv2]"; simpl; eauto; first solve_ndisj.
iFrame.
iMod ("Hclose" with "[Hv1 Hv2]").
{ iNext; iExists (_, _); by iFrame. }
iExists (#♭v false); eauto.
Qed.
......
F_mu_ref_conc/fundamental_unary.v
View file @ f2045770
......@@ -5,7 +5,7 @@ From iris.proofmode Require Import tactics.
Definition log_typed `{heapIG Σ} (Γ : list type) (e : expr) (τ : type) := ∀ Δ vs,
env_PersistentP Δ →
heapI_ctx ∧ ⟦ Γ ⟧* Δ vs ⊢ ⟦ τ ⟧ₑ Δ e.[env_subst vs].
⟦ Γ ⟧* Δ vs ⊢ ⟦ τ ⟧ₑ Δ e.[env_subst vs].
Notation "Γ ⊨ e : τ" := (log_typed Γ e τ) (at level 74, e, τ at next level).
Section typed_interp.
......@@ -15,13 +15,13 @@ Section typed_interp.
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) uconstr(Hp) :=
iApply (wp_bind [ctx]);
iApply wp_wand_l;
iSplitL; [| iApply Hp; trivial]; [iIntros (v) Hv|iSplit; trivial]; cbn.
iSplitR; [|iApply Hp; trivial]; iIntros (v) Hv; cbn.
Local Ltac value_case := iApply wp_value; [cbn; rewrite ?to_of_val; trivial|].
Theorem fundamental Γ e τ : Γ ⊢ₜ e : τ → Γ ⊨ e : τ.
Proof.
induction 1; iIntros (Δ vs HΔ) "#[Hheap HΓ] /=".
induction 1; iIntros (Δ vs HΔ) "#HΓ /=".
- (* var *)
iDestruct (interp_env_Some_l with "HΓ") as (v) "[% ?]"; first done.
rewrite /env_subst. simplify_option_eq. by value_case.
......@@ -32,7 +32,7 @@ Section typed_interp.
smart_wp_bind (BinOpLCtx _ e2.[env_subst vs]) v "#Hv" IHtyped1.
smart_wp_bind (BinOpRCtx _ v) v' "# Hv'" IHtyped2.
iDestruct "Hv" as (n) "%"; iDestruct "Hv'" as (n') "%"; simplify_eq/=.
iApply wp_nat_binop. iNext. iIntros "!> {Hheap HΓ}".
iApply wp_nat_binop. iNext. iIntros "!>".
destruct op; simpl; try destruct eq_nat_dec;
try destruct le_dec; try destruct lt_dec; eauto 10.
- (* pair *)
......@@ -59,22 +59,22 @@ Section typed_interp.
iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as (w) "[% Hw]"; simplify_eq/=.
+ iApply wp_case_inl; auto 1 using to_of_val; asimpl. iNext.
erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped2 Δ (w :: vs)). iSplit; [|iApply interp_env_cons]; auto.
iApply (IHtyped2 Δ (w :: vs)). iApply interp_env_cons; auto.
+ iApply wp_case_inr; auto 1 using to_of_val; asimpl. iNext.
erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped3 Δ (w :: vs)). iSplit; [|iApply interp_env_cons]; auto.
iApply (IHtyped3 Δ (w :: vs)). iApply interp_env_cons; auto.
- (* If *)
smart_wp_bind (IfCtx _ _) v "#Hv" IHtyped1; cbn.
iDestruct "Hv" as ([]) "%"; subst; simpl;
[iApply wp_if_true| iApply wp_if_false]; iNext;
[iApply IHtyped2| iApply IHtyped3]; auto.
- (* Rec *)
value_case; iAlways. simpl. iLöb as "IH"; iIntros (w) "#Hw".
value_case. simpl. iAlways. iLöb as "IH". iIntros (w) "#Hw".
iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_rec; auto 1 using to_of_val. iNext.
asimpl. change (Rec _) with (of_val (RecV e.[upn 2 (env_subst vs)])) at 2.
erewrite typed_subst_head_simpl_2 by naive_solver.
iApply (IHtyped Δ (_ :: w :: vs)). iSplit; [done|].
iApply (IHtyped Δ (_ :: w :: vs)).
iApply interp_env_cons; iSplit; [|iApply interp_env_cons]; auto.
- (* app *)
smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHtyped1.
......@@ -83,7 +83,7 @@ Section typed_interp.
- (* TLam *)
value_case.
iAlways; iIntros (τi) "%". iApply wp_tlam; iNext.
iApply IHtyped. iFrame "Hheap". by iApply interp_env_ren.
iApply IHtyped. by iApply interp_env_ren.
- (* TApp *)
smart_wp_bind TAppCtx v "#Hv" IHtyped; cbn.
iApply wp_wand_r; iSplitL; [iApply ("Hv" $! (⟦ τ' ⟧ Δ)); iPureIntro; apply _|]; cbn.
......@@ -107,37 +107,40 @@ Section typed_interp.
iApply wp_wand_l. iSplitL; [|iApply IHtyped; auto]; auto.
- (* Alloc *)
smart_wp_bind AllocCtx v "#Hv" IHtyped; cbn. iClear "HΓ". iApply wp_fupd.
iApply (wp_alloc with "Hheap []"); auto 1 using to_of_val.
iApply wp_alloc; auto 1 using to_of_val.
iNext; iIntros (l) "Hl".
iMod (inv_alloc _ with "[Hl]") as "HN";
[| iModIntro; iExists _; iSplit; trivial]; eauto.
- (* Load *)
smart_wp_bind LoadCtx v "#Hv" IHtyped; cbn. iClear "HΓ".
iDestruct "Hv" as (l) "[% #Hv]"; subst.
iInv (logN .@ l) as (w) "[Hw1 #Hw2]" "Hclose".
iApply ((wp_load _ _ 1) with "[Hw1] [Hclose]"); [|iFrame "Hheap"|];
trivial. solve_ndisj. iNext.
iIntros "Hw1". iMod ("Hclose" with "[-]"); eauto.
iApply wp_atomic; eauto.
iInv (logN .@ l) as (w) "[Hw1 #Hw2]" "Hclose".
iApply (wp_load with "Hw1").
iNext.
iIntros "Hw1". iMod ("Hclose" with "[Hw1 Hw2]"); eauto.
- (* Store *)
smart_wp_bind (StoreLCtx _) v "#Hv" IHtyped1; cbn.
smart_wp_bind (StoreRCtx _) w "#Hw" IHtyped2; cbn. iClear "HΓ".
iDestruct "Hv" as (l) "[% #Hv]"; subst.
iApply wp_atomic; eauto.
iInv (logN .@ l) as (z) "[Hz1 #Hz2]" "Hclose".
iApply (wp_store with "[Hz1] [Hclose]"); [| |iFrame "Hheap Hz1"|].
by rewrite to_of_val. solve_ndisj. iNext.
iIntros "Hz1". iMod ("Hclose" with "[-]"); eauto.
iApply (wp_store with "Hz1"); auto using to_of_val.
iNext.
iIntros "Hz1". iMod ("Hclose" with "[Hz1 Hz2]"); eauto.
- (* CAS *)
smart_wp_bind (CasLCtx _ _) v1 "#Hv1" IHtyped1; cbn.
smart_wp_bind (CasMCtx _ _) v2 "#Hv2" IHtyped2; cbn.
smart_wp_bind (CasRCtx _ _) v3 "#Hv3" IHtyped3; cbn. iClear "HΓ".
iDestruct "Hv1" as (l) "[% Hinv]"; subst.
iDestruct "Hv1" as (l) "[% Hv1]"; subst.
iApply wp_atomic; eauto.
iInv (logN .@ l) as (w) "[Hw1 #Hw2]" "Hclose".
destruct (decide (v2 = w)) as [|Hneq]; subst.
+ iApply (wp_cas_suc with "[Hw1] [Hclose]"); [| | |iFrame "Hheap Hw1"|];
eauto using to_of_val. solve_ndisj. iNext.
iIntros "Hw1". iMod ("Hclose" with "[-]"); eauto.
+ iApply (wp_cas_fail with "[Hw1] [Hclose]"); [| | | |iFrame "Hheap Hw1"|];
eauto using to_of_val. solve_ndisj. iNext.
iIntros "Hw1". iMod ("Hclose" with "[-]"); eauto.
+ iApply (wp_cas_suc with "Hw1"); auto using to_of_val.
iNext.
iIntros "Hw1". iMod ("Hclose" with "[Hw1 Hw2]"); eauto.
+ iApply (wp_cas_fail with "Hw1"); auto using to_of_val.
iNext.
iIntros "Hw1". iMod ("Hclose" with "[Hw1 Hw2]"); eauto.
Qed.
End typed_interp.
F_mu_ref_conc/lang.v
View file @ f2045770
From iris.program_logic Require Export ectx_language ectxi_language.
From iris_logrel.prelude Require Export base.
From iris.algebra Require Export cofe.
From iris.algebra Require Export ofe.
From iris.prelude Require Import gmap.
Module lang.
......@@ -299,10 +299,14 @@ Definition is_atomic (e : expr) : Prop :=
| CAS e0 e1 e2 => is_Some (to_val e0) ∧ is_Some (to_val e1) ∧ is_Some (to_val e2)
| _ => False
end.
Local Hint Resolve language.val_irreducible.
Local Hint Resolve to_of_val.
Local Hint Unfold language.irreducible.
Lemma is_atomic_correct e : is_atomic e → language.atomic e.
Proof.
intros ?; apply ectx_language_atomic.
- destruct 1; simpl; by eauto using to_of_val.
- destruct 1; simpl; eauto.
- intros [|Ki K] e' -> Hval%eq_None_not_Some; [done|].
destruct Hval; apply (fill_val K e'). destruct Ki; naive_solver.
Qed.
......
F_mu_ref_conc/logrel_binary.v
View file @ f2045770
......@@ -7,7 +7,7 @@ From iris.prelude Require Import tactics.
Import uPred.
(* HACK: move somewhere else *)
Ltac auto_equiv ::=
Ltac auto_equiv :=
(* Deal with "pointwise_relation" *)
repeat lazymatch goal with
| |- pointwise_relation _ _ _ _ => intros ?
......@@ -20,6 +20,8 @@ Ltac auto_equiv ::=
(* repeatedly apply congruence lemmas and use the equalities in the hypotheses. *)