Commit 70299030 authored by Dan Frumin's avatar Dan Frumin

Update F_mu_ref to work with Iris 3

Main changes:
- Rewrite cfgG and cfgUR
- Use gen_heap from iris
parent 6d458e00
......@@ -5,7 +5,7 @@ From iris.base_logic Require Export big_op.
Definition log_typed `{heapG Σ} (Γ : list type) (e : expr) (τ : type) := Δ vs,
env_PersistentP Δ
heap_ctx Γ * Δ vs τ ⟧ₑ Δ e.[env_subst vs].
Γ * Δ vs τ ⟧ₑ Δ e.[env_subst vs].
Notation "Γ ⊨ e : τ" := (log_typed Γ e τ) (at level 74, e, τ at next level).
Section fundamental.
......@@ -15,13 +15,13 @@ Section fundamental.
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Δ) "# /=".
- (* var *)
iDestruct (interp_env_Some_l with "HΓ") as (v) "[% ?]"; first done.
rewrite /env_subst. simplify_option_eq. by value_case.
......@@ -29,7 +29,7 @@ Section fundamental.
- (* pair *)
smart_wp_bind (PairLCtx e2.[env_subst vs]) v "#Hv" IHtyped1.
smart_wp_bind (PairRCtx v) v' "# Hv'" IHtyped2.
value_case; eauto 10.
value_case; eauto 10.
- (* fst *)
smart_wp_bind (FstCtx) v "# Hv" IHtyped; cbn.
iDestruct "Hv" as (w1 w2) "#[% [H2 H3]]"; subst.
......@@ -50,16 +50,16 @@ Section fundamental.
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.
- (* lam *)
value_case; iAlways; iIntros (w) "#Hw".
value_case. simpl. iAlways. iIntros (w) "#Hw".
iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_lam; auto 1 using to_of_val. iNext.
asimpl. erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped Δ (w :: vs)). iFrame "Hheap". iApply interp_env_cons; auto.
iApply (IHtyped Δ (w :: vs)). iApply interp_env_cons; auto.
- (* app *)
smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHtyped1.
smart_wp_bind (AppRCtx v) w "#Hw" IHtyped2.
......@@ -67,7 +67,7 @@ Section fundamental.
- (* 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" $! (interp τ' Δ)); iPureIntro; apply _|].
......@@ -88,7 +88,7 @@ Section fundamental.
iNext; iModIntro. by rewrite -interp_subst.
- (* 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.
......@@ -96,16 +96,15 @@ Section fundamental.
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_load with "Hw1 [Hclose]").
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.
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 [Hclose]"); eauto using to_of_val. iNext.
iIntros "Hz1". iMod ("Hclose" with "[Hz1 Hz2]"); eauto.
Qed.
End fundamental.
......@@ -5,12 +5,12 @@ From iris.base_logic Require Export big_op.
Section bin_log_def.
Context `{cfgSG Σ}.
Context `{!heapG Σ}.
Notation D := (prodC valC valC -n> iProp Σ).
Definition bin_log_related (Γ : list type) (e e' : expr) (τ : type) := Δ vvs ρ,
env_PersistentP Δ
heap_ctx spec_ctx ρ
Γ * Δ vvs τ ⟧ₑ Δ (e.[env_subst (vvs.*1)], e'.[env_subst (vvs.*2)]).
Definition bin_log_related (Γ : list type) (e e' : expr) (τ : type) := Δ vvs (ρ : cfg lang),
env_PersistentP Δ
spec_inv ρ Γ * Δ vvs τ ⟧ₑ Δ (e.[env_subst (vvs.*1)], e'.[env_subst (vvs.*2)]).
End bin_log_def.
Notation "Γ ⊨ e '≤log≤' e' : τ" :=
......@@ -18,6 +18,7 @@ Notation "Γ ⊨ e '≤log≤' e' : τ" :=
Section fundamental.
Context `{cfgSG Σ}.
Context `{!heapG Σ}.
Notation D := (prodC valC valC -n> iProp Σ).
Implicit Types e : expr.
Implicit Types Δ : listC D.
......@@ -32,17 +33,17 @@ Section fundamental.
iIntros (v) Htmp; iDestruct Htmp as (w) Hv;
rewrite fill_app; simpl.
Local Ltac value_case := iApply wp_value; [cbn; rewrite ?to_of_val; trivial|].
Local Ltac value_case := iApply wp_value; eauto using to_of_val.
(* Put all quantifiers at the outer level *)
Lemma bin_log_related_alt {Γ e e' τ} : Γ e log e' : τ Δ vvs ρ K,
env_PersistentP Δ
heap_ctx spec_ctx ρ Γ * Δ vvs fill K (e'.[env_subst (vvs.*2)])
spec_inv ρ Γ * Δ vvs fill K (e'.[env_subst (vvs.*2)])
WP e.[env_subst (vvs.*1)] {{ v, v',
fill K (of_val v') interp τ Δ (v, v') }}.
Proof.
iIntros (Hlog Δ vvs ρ K ?) "(#Hh & #Hs & HΓ & Hj)".
iApply (Hlog with "[HΓ] *"); iFrame; eauto.
iIntros (Hlog Δ vvs K ρ ?) "[#Hρ [HΓ Hj]]". asimpl.
iApply (Hlog with "[HΓ] *"); iFrame. eauto.
Qed.
Notation "' H" := (bin_log_related_alt H) (at level 8).
......@@ -50,14 +51,15 @@ Section fundamental.
Lemma bin_log_related_var Γ x τ :
Γ !! x = Some τ Γ Var x log Var x : τ.
Proof.
iIntros (? Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (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.
iIntros (? Δ vvs ρ ?) "[#Hρ #HΓ]". iIntros (K) "Hj /=".
iDestruct (interp_env_Some_l with "HΓ") as ([v v']) "[% Hv]"; first done.
rewrite /env_subst !list_lookup_fmap; simplify_option_eq.
value_case.
Qed.
Lemma bin_log_related_unit Γ : Γ Unit log Unit : TUnit.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]". iIntros (K) "Hj /=".
value_case. iExists UnitV; eauto.
Qed.
......@@ -66,12 +68,13 @@ Section fundamental.
(IHHtyped2 : Γ e2 log e2' : τ2) :
Γ Pair e1 e2 log Pair e1' e2' : TProd τ1 τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
smart_wp_bind (PairLCtx e2.[env_subst _]) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ (K ++ [PairLCtx e2'.[env_subst _] ])).
smart_wp_bind (PairRCtx v) w w' "[Hw #Hiw]"
('IHHtyped2 _ _ _ (K ++ [PairRCtx v'])).
value_case. iExists (PairV v' w'); iFrame "Hw".
value_case. rewrite /= to_of_val /= to_of_val /=. eauto.
iExists (PairV v' w'); iFrame "Hw".
iExists (v, v'), (w, w'); simpl; repeat iSplit; trivial.
Qed.
......@@ -79,10 +82,10 @@ Section fundamental.
(IHHtyped : Γ e log e' : TProd τ1 τ2) :
Γ Fst e log Fst e' : τ1.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "[#Hρ #HΓ]"; iIntros (K) "Hj /=".
smart_wp_bind (FstCtx) v v' "[Hv #Hiv]" ('IHHtyped _ _ _ (K ++ [FstCtx])); cbn.
iDestruct "Hiv" as ([w1 w1'] [w2 w2']) "#[% [Hw1 Hw2]]"; simplify_eq.
iMod (step_fst _ _ K (of_val w1') w1' (of_val w2') w2' with "* [-]") as "Hw"; eauto.
iDestruct "Hiv" as ([w1 w1'] [w2 w2']) "#[% [Hw1 Hw2]]"; simplify_eq.
iMod (step_fst _ _ K (of_val w1') w1' (of_val w2') w2' with "[-]") as "Hw"; eauto.
iApply wp_fst; eauto.
Qed.
......@@ -90,7 +93,7 @@ Section fundamental.
(IHHtyped : Γ e log e' : TProd τ1 τ2) :
Γ Snd e log Snd e' : τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
smart_wp_bind (SndCtx) v v' "[Hv #Hiv]" ('IHHtyped _ _ _ (K ++ [SndCtx])); cbn.
iDestruct "Hiv" as ([w1 w1'] [w2 w2']) "#[% [Hw1 Hw2]]"; simplify_eq.
iMod (step_snd _ _ K (of_val w1') w1' (of_val w2') w2' with "* [-]") as "Hw"; eauto.
......@@ -101,10 +104,11 @@ Section fundamental.
(IHHtyped : Γ e log e' : τ1) :
Γ InjL e log InjL e' : (TSum τ1 τ2).
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
smart_wp_bind (InjLCtx) v v' "[Hv #Hiv]"
('IHHtyped _ _ _ (K ++ [InjLCtx])); cbn.
value_case. iExists (InjLV v'); iFrame "Hv".
value_case. repeat rewrite /= to_of_val. eauto.
iExists (InjLV v'); iFrame "Hv".
iLeft; iExists (_,_); eauto 10.
Qed.
......@@ -112,10 +116,11 @@ Section fundamental.
(IHHtyped : Γ e log e' : τ2) :
Γ InjR e log InjR e' : TSum τ1 τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
smart_wp_bind (InjRCtx) v v' "[Hv #Hiv]"
('IHHtyped _ _ _ (K ++ [InjRCtx])); cbn.
value_case. iExists (InjRV v'); iFrame "Hv".
value_case. repeat rewrite /= to_of_val. eauto.
iExists (InjRV v'); iFrame "Hv".
iRight; iExists (_,_); eauto 10.
Qed.
......@@ -129,7 +134,7 @@ 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 (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
iDestruct (interp_env_length with "HΓ") as %?.
smart_wp_bind (CaseCtx _ _) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ (K ++ [CaseCtx _ _])); cbn.
......@@ -154,7 +159,7 @@ Section fundamental.
(IHHtyped : τ1 :: Γ e log e' : τ2) :
Γ Lam e log Lam e' : TArrow τ1 τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
value_case. iExists (LamV _). iIntros "{$Hj} !#".
iIntros ([v v']) "#Hiv". iIntros (K') "Hj".
iDestruct (interp_env_length with "HΓ") as %?.
......@@ -170,7 +175,7 @@ Section fundamental.
(IHHtyped2 : Γ e2 log e2' : τ1) :
Γ App e1 e2 log App e1' e2' : τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
smart_wp_bind (AppLCtx (e2.[env_subst (vvs.*1)])) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ (K ++ [(AppLCtx (e2'.[env_subst (vvs.*2)]))])); cbn.
smart_wp_bind (AppRCtx v) w w' "[Hw #Hiw]"
......@@ -182,7 +187,7 @@ Section fundamental.
(IHHtyped : (subst (ren (+1)) <$> Γ) e log e' : τ) :
Γ TLam e log TLam e' : TForall τ.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
value_case. iExists (TLamV _).
iIntros "{$Hj} /= !#"; iIntros (τi ? K') "Hv /=".
iApply wp_tlam; iNext.
......@@ -194,13 +199,13 @@ Section fundamental.
(IHHtyped : Γ e log e' : TForall τ) :
Γ TApp e log TApp e' : τ.[τ'/].
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
smart_wp_bind (TAppCtx) v v' "[Hj #Hv]"
('IHHtyped _ _ _ (K ++ [TAppCtx])); cbn.
('IHHtyped _ _ _ (K ++ [TAppCtx])).
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".
iExists _; rewrite -interp_subst; eauto.
Qed.
......@@ -208,12 +213,13 @@ Section fundamental.
(IHHtyped : Γ e log e' : τ.[(TRec τ)/]) :
Γ Fold e log Fold e' : TRec τ.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
iApply (wp_bind [FoldCtx]); iApply wp_wand_l; iSplitR;
[|iApply ('IHHtyped _ _ _ (K ++ [FoldCtx]));
rewrite ?fill_app; simpl; repeat iSplitR; trivial].
iIntros (v); iDestruct 1 as (w) "[Hv #Hiv]"; rewrite fill_app.
value_case. iExists (FoldV w); iFrame "Hv".
value_case. repeat rewrite /= to_of_val. eauto.
iExists (FoldV w); iFrame "Hv".
rewrite fixpoint_unfold /= -interp_subst.
iAlways; iExists (_, _); eauto.
Qed.
......@@ -222,7 +228,7 @@ Section fundamental.
(IHHtyped : Γ e log e' : TRec τ) :
Γ Unfold e log Unfold e' : τ.[(TRec τ)/].
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]"; iIntros (K) "Hj /=".
iApply (wp_bind [UnfoldCtx]); iApply wp_wand_l; iSplitR;
[|iApply ('IHHtyped _ _ _ (K ++ [UnfoldCtx]));
rewrite ?fill_app; simpl; repeat iSplitR; trivial].
......@@ -239,29 +245,29 @@ Section fundamental.
(IHHtyped : Γ e log e' : τ) :
Γ Alloc e log Alloc e' : Tref τ.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[Hρ HΓ]". iIntros (K) "Hj /=".
smart_wp_bind (AllocCtx) v v' "[Hv #Hiv]" ('IHHtyped _ _ _ (K ++ [AllocCtx])).
iMod (step_alloc _ _ K (of_val v') v' with "* [-]") as (l') "[Hj Hl]"; eauto.
iApply wp_fupd. iApply (wp_alloc with "[]"); auto.
iIntros "!>"; iIntros (l) "Hl'".
iMod (step_alloc _ _ K (of_val v') v' with "[Hv]") as (l') "[Hj Hl']"; eauto.
iApply wp_fupd. iApply wp_alloc; auto.
iIntros "!>"; 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. }
iModIntro; iExists (LocV l'). iFrame "Hj". iExists (l, l'); eauto.
iModIntro; iExists (LocV l'). iFrame "Hj". iExists (l, l'). eauto.
Qed.
Lemma bin_log_related_load Γ e e' τ
(IHHtyped : Γ e log e' : (Tref τ)) :
Γ Load e log Load e' : τ.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[? HΓ]"; iIntros (K) "Hj /=".
smart_wp_bind (LoadCtx) v v' "[Hv #Hiv]" ('IHHtyped _ _ _ (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 _ _ K l' 1 w' with "[Hv Hw2]") as "[Hv Hw2]";
[solve_ndisj|by iFrame|].
iApply (wp_load _ _ 1 with "[Hw1]"); [|iFrame "Hh"|]; trivial; try solve_ndisj.
iApply (wp_load _ _ 1 with "[Hw1]"); eauto.
iNext. iIntros "Hw1". iMod ("Hclose" with "[Hw1 Hw2]").
{ iNext. iExists (w,w'); by iFrame. }
iModIntro. iExists w'; by iFrame.
......@@ -272,7 +278,7 @@ Section fundamental.
(IHHtyped2 : Γ e2 log e2' : τ) :
Γ Store e1 e2 log Store e1' e2' : TUnit.
Proof.
iIntros (Δ vvs ρ ?) "#(Hh & Hs & HΓ)"; iIntros (K) "Hj /=".
iIntros (Δ vvs ρ ?) "#[? HΓ]"; iIntros (K) "Hj /=".
smart_wp_bind (StoreLCtx _) v v' "[Hv #Hiv]"
('IHHtyped1 _ _ _ (K ++ [StoreLCtx _])).
smart_wp_bind (StoreRCtx _) w w' "[Hw #Hiw]"
......@@ -281,7 +287,7 @@ Section fundamental.
iInv (logN .@ (l,l')) as ([v v']) "[>Hv1 [>Hv2 #Hv]]" "Hclose".
iMod (step_store _ _ 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.
iApply (wp_store with "[Hv1]"); eauto using to_of_val.
iNext. iIntros "Hv1". iMod ("Hclose" with "[Hv1 Hv2]").
{ iNext; iExists (w, w'); by iFrame. }
iExists UnitV; iFrame; auto.
......
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.
......@@ -232,10 +232,13 @@ Definition is_atomic (e : expr) : Prop :=
| Store e1 e2 => 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.
......
......@@ -19,16 +19,16 @@ Section logrel.
from_option id (cconst True)%I (Δ !! x).
Solve Obligations with solve_proper_alt.
Definition interp_unit : listC D -n> D := λne Δ w, (w = UnitV)%I.
Definition interp_unit : listC D -n> D := λne Δ w, w = UnitV%I.
Program Definition interp_prod
(interp1 interp2 : listC D -n> D) : listC D -n> D := λne Δ w,
( w1 w2, w = PairV w1 w2 interp1 Δ w1 interp2 Δ w2)%I.
( w1 w2, w = PairV w1 w2 interp1 Δ w1 interp2 Δ w2)%I.
Solve Obligations with solve_proper.
Program Definition interp_sum
(interp1 interp2 : listC D -n> D) : listC D -n> D := λne Δ w,
(( w1, w = InjLV w1 interp1 Δ w1) ( w2, w = InjRV w2 interp2 Δ w2))%I.
(( w1, w = InjLV w1 interp1 Δ w1) ( w2, w = InjRV w2 interp2 Δ w2))%I.
Solve Obligations with solve_proper.
Program Definition interp_arrow
......@@ -39,20 +39,16 @@ Section logrel.
Program Definition interp_forall
(interp : listC D -n> D) : listC D -n> D := λne Δ w,
( τi : D,
( v, PersistentP (τi v)) WP TApp (# w) {{ interp (τi :: Δ) }})%I.
( v, PersistentP (τi v)) WP TApp (# w) {{ interp (τi :: Δ) }})%I.
Solve Obligations with solve_proper.
Definition interp_rec1
(interp : listC D -n> D) (Δ : listC D) (τi : D) : D := λne w,
( ( v, w = FoldV v interp (τi :: Δ) v))%I.
( ( v, w = FoldV v interp (τi :: Δ) v))%I.
Global Instance interp_rec1_contractive
(interp : listC D -n> D) (Δ : listC D) : Contractive (interp_rec1 interp Δ).
Proof.
intros n τi1 τi2 Hτi w; cbn.
apply always_ne, exist_ne; intros v; apply and_ne; trivial.
apply later_contractive =>i Hi. by rewrite Hτi.
Qed.
Proof. by solve_contractive. Qed.
Program Definition interp_rec (interp : listC D -n> D) : listC D -n> D := λne Δ,
fixpoint (interp_rec1 interp Δ).
......@@ -66,7 +62,7 @@ Section logrel.
Program Definition interp_ref
(interp : listC D -n> D) : listC D -n> D := λne Δ w,
( l, w = LocV l inv (logN .@ l) (interp_ref_inv l (interp Δ)))%I.
( l, w = LocV l inv (logN .@ l) (interp_ref_inv l (interp Δ)))%I.
Solve Obligations with solve_proper.
Fixpoint interp (τ : type) : listC D -n> D :=
......@@ -84,7 +80,7 @@ Section logrel.
Definition interp_env (Γ : list type)
(Δ : listC D) (vs : list val) : iProp Σ :=
(length Γ = length vs [] zip_with (λ τ, τ Δ) Γ vs)%I.
(length Γ = length vs [] zip_with (λ τ, τ Δ) Γ vs)%I.
Notation "⟦ Γ ⟧*" := (interp_env Γ).
Definition interp_expr (τ : type) (Δ : listC D) (e : expr) : iProp Σ :=
......@@ -122,7 +118,7 @@ Section logrel.
properness; auto. apply (IHτ (_ :: _)).
- rewrite iter_up; destruct lt_dec as [Hl | Hl]; simpl.
{ by rewrite !lookup_app_l. }
rewrite !lookup_app_r; [|lia ..]. do 2 f_equiv. lia. done.
rewrite !lookup_app_r; [|lia ..]. do 2 f_equiv. lia.
- intros w; simpl; properness; auto. apply (IHτ (_ :: _)).
- intros w; simpl; properness; auto. by apply IHτ.
Qed.
......@@ -143,7 +139,7 @@ Section logrel.
rewrite !lookup_app_r; [|lia ..].
destruct (x - length Δ1) as [|n] eqn:?; simpl.
{ symmetry. asimpl. apply (interp_weaken [] Δ1 Δ2 τ'). }
rewrite !lookup_app_r; [|lia ..]. do 2 f_equiv. lia. done.
rewrite !lookup_app_r; [|lia ..]. do 2 f_equiv. lia.
- intros w; simpl; properness; auto. apply (IHτ (_ :: _)).
- intros w; simpl; properness; auto. by apply IHτ.
Qed.
......@@ -151,11 +147,11 @@ Section logrel.
Lemma interp_subst Δ2 τ τ' : τ ( τ' Δ2 :: Δ2) τ.[τ'/] Δ2.
Proof. apply (interp_subst_up []). Qed.
Lemma interp_env_length Δ Γ vs : Γ * Δ vs length Γ = length vs.
Lemma interp_env_length Δ Γ vs : Γ * Δ vs length Γ = length vs.
Proof. by iIntros "[% ?]". Qed.
Lemma interp_env_Some_l Δ Γ vs x τ :
Γ !! x = Some τ Γ * Δ vs v, vs !! x = Some v τ Δ v.
Γ !! x = Some τ Γ * Δ vs v, vs !! x = Some v τ Δ v.
Proof.
iIntros (?) "[Hlen HΓ]"; iDestruct "Hlen" as %Hlen.
destruct (lookup_lt_is_Some_2 vs x) as [v Hv].
......@@ -170,7 +166,7 @@ Section logrel.
Lemma interp_env_cons Δ Γ vs τ v :
τ :: Γ * Δ (v :: vs) ⊣⊢ τ Δ v Γ * Δ vs.
Proof.
rewrite /interp_env /= (assoc _ ( _ _ _)) -(comm _ (_ = _)%I) -assoc.
rewrite /interp_env /= (assoc _ ( _ _ _)) -(comm _ (_ = _)%I) -assoc.
by apply sep_proper; [apply pure_proper; omega|].
Qed.
......
......@@ -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 ?
......@@ -43,20 +43,20 @@ Section logrel.
Solve Obligations with solve_proper_alt.
Program Definition interp_unit : listC D -n> D := λne Δ ww,
(ww.1 = UnitV ww.2 = UnitV)%I.
(ww.1 = UnitV ww.2 = UnitV)%I.
Solve Obligations with solve_proper_alt.
Program Definition interp_prod
(interp1 interp2 : listC D -n> D) : listC D -n> D := λne Δ ww,
( vv1 vv2, ww = (PairV (vv1.1) (vv2.1), PairV (vv1.2) (vv2.2))
( vv1 vv2, ww = (PairV (vv1.1) (vv2.1), PairV (vv1.2) (vv2.2))
interp1 Δ vv1 interp2 Δ vv2)%I.
Solve Obligations with solve_proper.
Solve Obligations with (preprocess_solve_proper; auto_equiv).
Program Definition interp_sum
(interp1 interp2 : listC D -n> D) : listC D -n> D := λne Δ ww,
(( vv, ww = (InjLV (vv.1), InjLV (vv.2)) interp1 Δ vv)
( vv, ww = (InjRV (vv.1), InjRV (vv.2)) interp2 Δ vv))%I.
Solve Obligations with solve_proper.
(( vv, ww = (InjLV (vv.1), InjLV (vv.2)) interp1 Δ vv)
( vv, ww = (InjRV (vv.1), InjRV (vv.2)) interp2 Δ vv))%I.
Solve Obligations with (preprocess_solve_proper; auto_equiv).
Program Definition interp_arrow
(interp1 interp2 : listC D -n> D) : listC D -n> D :=
......@@ -65,28 +65,24 @@ Section logrel.
interp_expr
interp2 Δ (App (of_val (ww.1)) (of_val (vv.1)),
App (of_val (ww.2)) (of_val (vv.2))))%I.
Solve Obligations with solve_proper.
Solve Obligations with (preprocess_solve_proper; auto_equiv).
Program Definition interp_forall
(interp : listC D -n> D) : listC D -n> D := λne Δ ww,
( τi,
( ww, PersistentP (τi ww))
⌜∀ ww, PersistentP (τi ww)
interp_expr
interp (τi :: Δ) (TApp (of_val (ww.1)), TApp (of_val (ww.2))))%I.
Solve Obligations with solve_proper.
Solve Obligations with (preprocess_solve_proper; auto_equiv).
Program Definition interp_rec1
(interp : listC D -n> D) (Δ : listC D) (τi : D) : D := λne ww,
( vv, ww = (FoldV (vv.1), FoldV (vv.2)) interp (τi :: Δ) vv)%I.
Solve Obligations with solve_proper.
( vv, ww = (FoldV (vv.1), FoldV (vv.2)) interp (τi :: Δ) vv)%I.
Solve Obligations with (preprocess_solve_proper; auto_equiv).
Global Instance interp_rec1_contractive
(interp : listC D -n> D) (Δ : listC D) : Contractive (interp_rec1 interp Δ).
Proof.
intros n τi1 τi2 Hτi ww; cbn.
apply always_ne, exist_ne; intros vv; apply and_ne; trivial.
apply later_contractive =>i Hi. by rewrite Hτi.
Qed.
Proof. by solve_contractive. Qed.
Program Definition interp_rec (interp : listC D -n> D) : listC D -n> D := λne Δ,
fixpoint (interp_rec1 interp Δ).
......@@ -96,13 +92,13 @@ Section logrel.
Program Definition interp_ref_inv (ll : loc * loc) : D -n> iProp Σ := λne τi,
( vv, ll.1 vv.1 ll.2 ↦ₛ vv.2 τi vv)%I.
Solve Obligations with solve_proper.
Solve Obligations with (preprocess_solve_proper; auto_equiv).
Program Definition interp_ref
(interp : listC D -n> D) : listC D -n> D := λne Δ ww,
( ll, ww = (LocV (ll.1), LocV (ll.2))
( ll, ww = (LocV (ll.1), LocV (ll.2))
inv (logN .@ ll) (interp_ref_inv ll (interp Δ)))%I.
Solve Obligations with solve_proper.
Solve Obligations with (preprocess_solve_proper; auto_equiv).
Fixpoint interp (τ : type) : listC D -n> D :=
match τ return _ with
......@@ -119,7 +115,7 @@ Section logrel.
Definition interp_env (Γ : list type)
(Δ : listC D) (vvs : list (val * val)) : iProp Σ :=
(length Γ = length vvs [] zip_with (λ τ, τ Δ) Γ vvs)%I.
(length Γ = length vvs [] zip_with (λ τ, τ Δ) Γ vvs)%I.
Notation "⟦ Γ ⟧*" := (interp_env Γ).
Class env_PersistentP Δ :=
......@@ -147,7 +143,6 @@ Section logrel.
τ (Δ1 ++ Δ2).
Proof.
revert Δ1 Π Δ2. induction τ=> Δ1 Π Δ2; simpl; auto.
- intros ww; simpl; properness; auto.
- intros ww; simpl; properness; auto. by apply IHτ1. by apply IHτ2.
- intros ww; simpl; properness; auto. by apply IHτ1. by apply IHτ2.
- unfold interp_expr.
......@@ -156,7 +151,7 @@ Section logrel.
properness; auto. apply (IHτ (_ :: _)).
- rewrite iter_up; destruct lt_dec as [Hl | Hl]; simpl.