Commit 01db92e2 authored by Robbert Krebbers's avatar Robbert Krebbers

Update to new version of Iris.

parent e045456d
...@@ -8,43 +8,10 @@ Import uPred. ...@@ -8,43 +8,10 @@ Import uPred.
Section typed_interp. Section typed_interp.
Context {Σ : iFunctor}. Context {Σ : iFunctor}.
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
_ : ?A, _) => let W := fresh "W" in evar (W : A); iExists W; unfold W; clear W
end : itauto.
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
_) => iNext
end : itauto.
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
_) => eapply (@always_intro _ _ _ _)
end : itauto.
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
(_ _)) => iSplit
end : itauto.
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) uconstr(Hp) := Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) uconstr(Hp) :=
iApply (@wp_bind _ _ _ [ctx]); iApply (@wp_bind _ _ _ [ctx]);
iApply wp_impl_l; iApply wp_wand_l;
iSplit; [| iApply Hp; trivial]; cbn; iSplitL; [|iApply Hp; trivial]; cbn;
eapply (@always_intro _ _ _ _);
iIntros {v} Hv. iIntros {v} Hv.
Local Ltac value_case := iApply wp_value; cbn; rewrite ?to_of_val; trivial. Local Ltac value_case := iApply wp_value; cbn; rewrite ?to_of_val; trivial.
...@@ -53,8 +20,8 @@ Section typed_interp. ...@@ -53,8 +20,8 @@ Section typed_interp.
(Htyped : typed Γ e τ) (Htyped : typed Γ e τ)
(HΔ : context_interp_Persistent Δ) (HΔ : context_interp_Persistent Δ)
: List.length Γ = List.length vs : List.length Γ = List.length vs
Π∧ zip_with (λ τ v, interp τ Δ v) Γ vs [] zip_with (λ τ v, interp τ Δ v) Γ vs
WP (e.[env_subst vs]) @ {{ λ v, (@interp Σ) τ Δ v }}. WP e.[env_subst vs] {{ λ v, (@interp Σ) τ Δ v }}.
Proof. Proof.
revert Δ HΔ vs. revert Δ HΔ vs.
induction Htyped; intros Δ HΔ vs Hlen; iIntros "#HΓ"; cbn. induction Htyped; intros Δ HΔ vs Hlen; iIntros "#HΓ"; cbn.
...@@ -69,75 +36,66 @@ Section typed_interp. ...@@ -69,75 +36,66 @@ Section typed_interp.
- (* pair *) - (* pair *)
smart_wp_bind (PairLCtx e2.[env_subst vs]) v "# Hv" IHHtyped1. smart_wp_bind (PairLCtx e2.[env_subst vs]) v "# Hv" IHHtyped1.
smart_wp_bind (PairRCtx v) v' "# Hv'" IHHtyped2. smart_wp_bind (PairRCtx v) v' "# Hv'" IHHtyped2.
value_case; eauto 10 with itauto. value_case; eauto 10.
- (* fst *) - (* fst *)
smart_wp_bind (FstCtx) v "# Hv" IHHtyped; cbn. smart_wp_bind (FstCtx) v "# Hv" IHHtyped; cbn.
iApply double_exists; [|trivial]. iDestruct "Hv" as {w1 w2} "#[% [H2 H3]]"; subst.
intros w w'; cbn; iIntros "#[% [H2 H3]]"; rewrite H; cbn. iApply wp_fst; eauto using to_of_val.
iApply wp_fst; try iNext; eauto using to_of_val; cbn.
- (* snd *) - (* snd *)
smart_wp_bind (SndCtx) v "# Hv" IHHtyped; cbn. smart_wp_bind (SndCtx) v "# Hv" IHHtyped; cbn.
iApply double_exists; [|trivial]. iDestruct "Hv" as {w1 w2} "#[% [H2 H3]]"; subst.
intros w w'; cbn; iIntros "#[% [H2 H3]]"; rewrite H. iApply wp_snd; eauto using to_of_val.
iApply wp_snd; try iNext; eauto using to_of_val.
- (* injl *) - (* injl *)
smart_wp_bind (InjLCtx) v "# Hv" IHHtyped; cbn. smart_wp_bind (InjLCtx) v "# Hv" IHHtyped; cbn.
value_case; iLeft; auto with itauto. value_case; eauto.
- (* injr *) - (* injr *)
smart_wp_bind (InjRCtx) v "# Hv" IHHtyped; cbn. smart_wp_bind (InjRCtx) v "# Hv" IHHtyped; cbn.
value_case; iRight; auto with itauto. value_case; eauto.
- (* case *) - (* case *)
smart_wp_bind (CaseCtx _ _) v "#Hv" IHHtyped1; cbn. smart_wp_bind (CaseCtx _ _) v "#Hv" IHHtyped1; cbn.
iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as {w} "[% Hw]"; subst.
iDestruct "Hv" as {w} "[% Hw]"; rewrite H; + iApply wp_case_inl; auto 1 using to_of_val; asimpl.
[iApply wp_case_inl|iApply wp_case_inr]; specialize (IHHtyped2 Δ HΔ (w::vs)).
auto 1 using to_of_val; erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto).
asimpl; iNext; iApply IHHtyped2; cbn; auto.
[specialize (IHHtyped2 Δ HΔ (w::vs)) | + iApply wp_case_inr; auto 1 using to_of_val; asimpl.
specialize (IHHtyped3 Δ HΔ (w::vs))]; specialize (IHHtyped3 Δ HΔ (w::vs)).
erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto); iNext; erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto).
[iApply IHHtyped2 | iApply IHHtyped3]; cbn; auto with itauto. iNext; iApply IHHtyped3; cbn; auto.
- (* lam *) - (* lam *)
value_case; apply (always_intro _ _); iIntros {w} "#Hw". value_case; iAlways; iIntros {w} "#Hw".
iApply wp_lam; auto 1 using to_of_val. iApply wp_lam; auto 1 using to_of_val.
asimpl; erewrite typed_subst_head_simpl; [|eauto|cbn]; eauto. asimpl; erewrite typed_subst_head_simpl; [|eauto|cbn]; eauto.
iNext; iApply (IHHtyped Δ HΔ (w :: vs)); cbn; auto with itauto. iNext; iApply (IHHtyped Δ HΔ (w :: vs)); cbn; auto.
- (* app *) - (* app *)
smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHHtyped1. smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHHtyped1.
smart_wp_bind (AppRCtx v) w "#Hw" IHHtyped2. smart_wp_bind (AppRCtx v) w "#Hw" IHHtyped2.
iApply wp_mono; [|iApply "Hv"]; auto with itauto. iApply wp_mono; [|iApply "Hv"]; auto.
- (* TLam *) - (* TLam *)
value_case. value_case.
iIntros {τi}; destruct τi as [τi τiPr]. iAlways. iIntros { [τi τiPr] } "!". iApply wp_TLam; iNext; simpl in *.
iApply wp_TLam; iNext; simpl in *.
iApply IHHtyped; [rewrite map_length|]; trivial. iApply IHHtyped; [rewrite map_length|]; trivial.
iRevert "HΓ". rewrite zip_with_context_interp_subst; trivial.
rewrite zip_with_context_interp_subst.
iIntros "#HΓ"; trivial.
- (* TApp *) - (* TApp *)
smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn. smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn.
iSpecialize ("Hv" $! ((interp τ' Δ) _)); cbn. unshelve iSpecialize ("Hv" $! ((interp τ' Δ) _)); try apply _; cbn.
iApply always_elim. iApply always_mono; [|trivial]. iApply always_elim. iApply always_mono; [|trivial].
apply wp_mono => w. by rewrite interp_subst. apply wp_mono => w. by rewrite interp_subst.
- (* Fold *) - (* Fold *)
rewrite map_length in IHHtyped. rewrite map_length in IHHtyped.
iApply (@wp_bind _ _ _ [FoldCtx]). iApply (@wp_bind _ _ _ [FoldCtx]).
iApply wp_impl_l. iApply wp_wand_l.
iSplit; [eapply (@always_intro _ _ _ _)| iSplitL; [|iApply (IHHtyped (extend_context_interp ((interp (TRec τ)) Δ) Δ));
iApply (IHHtyped (extend_context_interp ((interp (TRec τ)) Δ) Δ));
trivial]. trivial].
+ iIntros {v} "#Hv". + iIntros {v} "#Hv".
value_case. value_case.
change (fixpoint _) with (interp (TRec τ) Δ) at 1; trivial. change (fixpoint _) with (interp (TRec τ) Δ) at 1; trivial.
rewrite fixpoint_unfold; cbn. rewrite fixpoint_unfold; cbn.
auto with itauto. iAlways; eauto.
+ iRevert "HΓ"; rewrite zip_with_context_interp_subst; iIntros "#HΓ"; trivial. + iRevert "HΓ"; rewrite zip_with_context_interp_subst; iIntros "#HΓ"; trivial.
- (* Unfold *) - (* Unfold *)
iApply (@wp_bind _ _ _ [UnfoldCtx]); iApply (@wp_bind _ _ _ [UnfoldCtx]);
iApply wp_impl_l; iApply wp_wand_l; iSplitL; [|iApply IHHtyped; trivial].
iSplit; [eapply (@always_intro _ _ _ _)|
iApply IHHtyped;
trivial].
iIntros {v}. iIntros {v}.
cbn [interp interp_rec cofe_mor_car]. cbn [interp interp_rec cofe_mor_car].
rewrite fixpoint_unfold. rewrite fixpoint_unfold.
...@@ -146,9 +104,5 @@ Section typed_interp. ...@@ -146,9 +104,5 @@ Section typed_interp.
iDestruct "Hv" as {w} "[% #Hw]"; rewrite H. iDestruct "Hv" as {w} "[% #Hw]"; rewrite H.
iApply wp_Fold; cbn; auto using to_of_val. iApply wp_Fold; cbn; auto using to_of_val.
rewrite -interp_subst; trivial. rewrite -interp_subst; trivial.
(* unshelving *)
Unshelve.
cbn; typeclasses eauto.
Qed. Qed.
End typed_interp.
End typed_interp.
\ No newline at end of file
...@@ -221,6 +221,9 @@ other words, [e] also contains the reducible expression *) ...@@ -221,6 +221,9 @@ other words, [e] also contains the reducible expression *)
eauto using fill_item_no_val_inj, values_head_stuck, fill_not_val. eauto using fill_item_no_val_inj, values_head_stuck, fill_not_val.
Qed. Qed.
Canonical Structure stateC := leibnizC state.
Canonical Structure valC := leibnizC val.
Canonical Structure exprC := leibnizC expr.
End lang. End lang.
(** Language *) (** Language *)
......
This diff is collapsed.
...@@ -2,7 +2,6 @@ Require Import iris.program_logic.lifting. ...@@ -2,7 +2,6 @@ Require Import iris.program_logic.lifting.
Require Import iris.algebra.upred_big_op. Require Import iris.algebra.upred_big_op.
Require Import iris_logrel.F_mu.lang. Require Import iris_logrel.F_mu.lang.
Section lang_rules. Section lang_rules.
Context {Σ : iFunctor}. Context {Σ : iFunctor}.
Implicit Types P : iProp lang Σ. Implicit Types P : iProp lang Σ.
......
...@@ -12,12 +12,12 @@ Section Soundness. ...@@ -12,12 +12,12 @@ Section Soundness.
Definition Σ := #[]. Definition Σ := #[].
Lemma empty_env_subst e : e.[env_subst []] = e. Lemma empty_env_subst e : e.[env_subst []] = e.
Proof.
replace (env_subst []) with (@ids expr _) by reflexivity. replace (env_subst []) with (@ids expr _) by reflexivity.
asimpl; trivial. asimpl; trivial.
Qed. Qed.
Definition free_type_context : Definition free_type_context : varC -n> valC -n> iProp lang (globalF Σ) :=
leibniz_var -n> leibniz_val -n> iProp lang (globalF Σ) :=
{| {|
cofe_mor_car := cofe_mor_car :=
λ x, λ x,
...@@ -50,7 +50,7 @@ Section Soundness. ...@@ -50,7 +50,7 @@ Section Soundness.
edestruct(@wp_adequacy_reducible lang (globalF Σ) edestruct(@wp_adequacy_reducible lang (globalF Σ)
(interp τ free_type_context) (interp τ free_type_context)
e e' (e' :: thp) tt ) as [Ha|Ha]; e e' (e' :: thp) tt ) as [Ha|Ha];
eauto using cmra_unit_valid; try tauto. eauto using ucmra_unit_valid; try tauto.
- iIntros "H". iApply H1. - iIntros "H". iApply H1.
- constructor. - constructor.
Qed. Qed.
......
...@@ -58,14 +58,13 @@ Proof. ...@@ -58,14 +58,13 @@ Proof.
Qed. Qed.
Definition env_subst (vs : list val) (x : var) : expr := Definition env_subst (vs : list val) (x : var) : expr :=
from_option (Var x) (of_val <$> vs !! x). from_option id (Var x) (of_val <$> vs !! x).
Notation "# v" := (of_val v) (at level 20). Notation "# v" := (of_val v) (at level 20).
Lemma typed_subst_head_simpl Δ τ e w ws : Lemma typed_subst_head_simpl Δ τ e w ws :
typed Δ e τ -> List.length Δ = S (List.length ws) typed Δ e τ -> List.length Δ = S (List.length ws)
e.[# w .: env_subst ws] = e.[env_subst (w :: ws)] e.[# w .: env_subst ws] = e.[env_subst (w :: ws)].
.
Proof. Proof.
intros H1 H2. intros H1 H2.
rewrite /env_subst. eapply typed_subst_invariant; eauto=> /= -[|x] ? //=. rewrite /env_subst. eapply typed_subst_invariant; eauto=> /= -[|x] ? //=.
...@@ -73,11 +72,9 @@ Proof. ...@@ -73,11 +72,9 @@ Proof.
by rewrite Hv. by rewrite Hv.
Qed. Qed.
Local Opaque eq_nat_dec. Local Opaque eq_nat_dec.
Lemma iter_up_subst_type (m : nat) (τ : type) (x : var) Lemma iter_up_subst_type (m : nat) (τ : type) (x : var) :
:
(iter m up (τ .: ids) x) = (iter m up (τ .: ids) x) =
if lt_dec x m then ids x else if lt_dec x m then ids x else
if eq_nat_dec x m then τ.[ren (+m)] else ids (x - 1). if eq_nat_dec x m then τ.[ren (+m)] else ids (x - 1).
......
...@@ -12,61 +12,23 @@ Import uPred. ...@@ -12,61 +12,23 @@ Import uPred.
Section typed_interp. Section typed_interp.
Context {Σ : gFunctors} `{i : heapG Σ} `{L : namespace}. Context {Σ : gFunctors} `{i : heapG Σ} `{L : namespace}.
Implicit Types P Q R : iPropG lang Σ. Implicit Types P Q R : iPropG lang Σ.
Notation "# v" := (of_val v) (at level 20). Notation "# v" := (of_val v) (at level 20).
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
_ : ?A, _) => let W := fresh "W" in evar (W : A); iExists W; unfold W; clear W
end : itauto.
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
_) => iNext
end : itauto.
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
_) => eapply (@always_intro _ _ _ _)
end : itauto.
Local Hint Extern 1 =>
match goal with
|-
(_
--------------------------------------
(_ _)) => iSplit
end : itauto.
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) uconstr(Hp) := Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) uconstr(Hp) :=
iApply (@wp_bind _ _ _ [ctx]); iApply (@wp_bind _ _ _ [ctx]);
iApply wp_impl_l; iApply wp_wand_l;
iSplit; [| iApply Hp; trivial]; iSplitL; [|iApply Hp; trivial]; [iIntros {v} Hv|iSplit; trivial]; cbn.
[apply (always_intro _ _); iIntros {v} Hv|iSplit; trivial]; cbn.
Local Ltac value_case := iApply wp_value; [cbn; rewrite ?to_of_val; trivial|]. Local Ltac value_case := iApply wp_value; [cbn; rewrite ?to_of_val; trivial|].
Lemma later_exist_turnstile (M : cmraT) (A : Type) :
Inhabited A Φ : A uPred M, ( ( a : A, Φ a))%I ( a : A, Φ a)%I.
Proof. intros H Φ. rewrite later_exist; trivial. Qed.
Lemma typed_interp N Δ Γ vs e τ Lemma typed_interp N Δ Γ vs e τ
(HNLdisj : l : loc, N L .@ l) (HNLdisj : l : loc, N L .@ l)
(Htyped : typed Γ e τ) (Htyped : typed Γ e τ)
(HΔ : context_interp_Persistent Δ) (HΔ : context_interp_Persistent Δ)
: List.length Γ = List.length vs : List.length Γ = List.length vs
(heap_ctx N Π∧ zip_with (λ τ v, (@interp Σ i L) τ Δ v) Γ vs)%I heap_ctx N [] zip_with (λ τ v, (@interp Σ i L) τ Δ v) Γ vs
WP (e.[env_subst vs]) @ {{ λ v, (@interp Σ i L) τ Δ v }}. WP e.[env_subst vs] {{ λ v, (@interp Σ i L) τ Δ v }}.
Proof. Proof.
revert Δ HΔ vs. revert Δ HΔ vs.
induction Htyped; intros Δ HΔ vs Hlen; iIntros "#[Hheap HΓ]"; cbn. induction Htyped; intros Δ HΔ vs Hlen; iIntros "#[Hheap HΓ]"; cbn.
...@@ -81,87 +43,74 @@ Section typed_interp. ...@@ -81,87 +43,74 @@ Section typed_interp.
- (* pair *) - (* pair *)
smart_wp_bind (PairLCtx e2.[env_subst vs]) v "#Hv" IHHtyped1. smart_wp_bind (PairLCtx e2.[env_subst vs]) v "#Hv" IHHtyped1.
smart_wp_bind (PairRCtx v) v' "# Hv'" IHHtyped2. smart_wp_bind (PairRCtx v) v' "# Hv'" IHHtyped2.
value_case; eauto 10 with itauto. value_case; eauto 10.
- (* fst *) - (* fst *)
smart_wp_bind (FstCtx) v "# Hv" IHHtyped; cbn. smart_wp_bind (FstCtx) v "# Hv" IHHtyped; cbn.
iApply double_exists; [|trivial]. iDestruct "Hv" as {w1 w2} "#[% [H2 H3]]"; subst.
intros w w'; cbn; iIntros "#[% [H2 H3]]"; rewrite H; cbn. iApply wp_fst; eauto using to_of_val.
iApply wp_fst; try iNext; eauto using to_of_val; cbn.
- (* snd *) - (* snd *)
smart_wp_bind (SndCtx) v "# Hv" IHHtyped; cbn. smart_wp_bind (SndCtx) v "# Hv" IHHtyped; cbn.
iApply double_exists; [|trivial]. iDestruct "Hv" as {w1 w2} "#[% [H2 H3]]"; subst.
intros w w'; cbn; iIntros "#[% [H2 H3]]"; rewrite H; cbn. iApply wp_snd; eauto using to_of_val.
iApply wp_snd; try iNext; eauto using to_of_val; cbn.
- (* injl *) - (* injl *)
smart_wp_bind (InjLCtx) v "# Hv" IHHtyped; cbn. smart_wp_bind (InjLCtx) v "# Hv" IHHtyped; cbn.
value_case; iLeft; auto with itauto. value_case; eauto.
- (* injr *) - (* injr *)
smart_wp_bind (InjRCtx) v "# Hv" IHHtyped; cbn. smart_wp_bind (InjRCtx) v "# Hv" IHHtyped; cbn.
value_case; iRight; auto with itauto. value_case; eauto.
- (* case *) - (* case *)
smart_wp_bind (CaseCtx _ _) v "#Hv" IHHtyped1; cbn. smart_wp_bind (CaseCtx _ _) v "#Hv" IHHtyped1; cbn.
iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as "[Hv|Hv]"; iDestruct "Hv" as {w} "[% Hw]"; subst.
iDestruct "Hv" as {w} "[% Hw]"; rewrite H; + iApply wp_case_inl; auto 1 using to_of_val; asimpl.
[iApply wp_case_inl|iApply wp_case_inr]; specialize (IHHtyped2 Δ HΔ (w::vs)).
auto 1 using to_of_val; erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto).
asimpl; iNext; iApply IHHtyped2; cbn; auto.
[specialize (IHHtyped2 Δ HΔ (w::vs)) | + iApply wp_case_inr; auto 1 using to_of_val; asimpl.
specialize (IHHtyped3 Δ HΔ (w::vs))]; specialize (IHHtyped3 Δ HΔ (w::vs)).
erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto); iNext; erewrite <- ?typed_subst_head_simpl in * by (cbn; eauto).
[iApply IHHtyped2 | iApply IHHtyped3]; cbn; auto with itauto. iNext; iApply IHHtyped3; cbn; auto.
- (* lam *) - (* lam *)
value_case; apply (always_intro _ _); iIntros {w} "#Hw". value_case; iAlways; iIntros {w} "#Hw".
iApply wp_lam; auto 1 using to_of_val. iApply wp_lam; auto 1 using to_of_val.
asimpl; erewrite typed_subst_head_simpl; [|eauto|cbn]; eauto. asimpl; erewrite typed_subst_head_simpl; [|eauto|cbn]; eauto.
iNext; iApply (IHHtyped Δ HΔ (w :: vs)); cbn; auto with itauto. iNext; iApply (IHHtyped Δ HΔ (w :: vs)); cbn; auto.
- (* app *) - (* app *)
smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHHtyped1. smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHHtyped1.
smart_wp_bind (AppRCtx v) w "#Hw" IHHtyped2. smart_wp_bind (AppRCtx v) w "#Hw" IHHtyped2.
iApply wp_mono; [|iApply "Hv"]; auto with itauto. iApply wp_mono; [|iApply "Hv"]; auto.
- (* TLam *) - (* TLam *)
value_case. value_case. iIntros { [τi τiPr] } "!".
iIntros {τi}; destruct τi as [τi τiPr].
iRevert "Hheap".
iPoseProof (always_intro with "HΓ") as "HP"; try typeclasses eauto;
try (iApply always_impl; iExact "HP").
iIntros "#HΓ #Hheap".
iApply wp_TLam; iNext. iApply wp_TLam; iNext.
iApply IHHtyped; [rewrite map_length|]; trivial. iApply IHHtyped; [rewrite map_length|]; trivial.
iSplit; trivial. iSplit; trivial.
iRevert "Hheap HΓ". rewrite zip_with_context_interp_subst. rewrite zip_with_context_interp_subst; trivial.
iIntros "#Hheap #HΓ"; trivial.
- (* TApp *) - (* TApp *)
smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn. smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn.
iSpecialize ("Hv" $! ((interp τ' Δ) _)); cbn. unshelve iSpecialize ("Hv" $! ((interp L τ' Δ) _)); try apply _; cbn.
iApply always_elim. iApply always_mono; [|trivial]. iApply wp_mono; [|done].
apply wp_mono => w. by rewrite -interp_subst; simpl. intros w; rewrite interp_subst; trivial.
- (* Fold *) - (* Fold *)
rewrite map_length in IHHtyped. rewrite map_length in IHHtyped.
iApply (@wp_bind _ _ _ [FoldCtx]). iApply (@wp_bind _ _ _ [FoldCtx]).
iApply wp_impl_l. iApply wp_wand_l.
iSplit; [eapply (@always_intro _ _ _ _)| iSplitL; [|iApply (IHHtyped (extend_context_interp ((interp L (TRec τ)) Δ) Δ));
iApply (IHHtyped (extend_context_interp ((interp (TRec τ)) Δ) Δ));
trivial]. trivial].
+ iIntros {v} "#Hv". + iIntros {v} "#Hv".
value_case. value_case.
rewrite fixpoint_unfold; cbn. rewrite fixpoint_unfold; cbn.
auto with itauto. iAlways; eauto.
+ iRevert "Hheap HΓ"; rewrite zip_with_context_interp_subst; + rewrite zip_with_context_interp_subst; auto.
iIntros "#Hheap #HΓ"; auto with itauto.
- (* Unfold *) - (* Unfold *)
iApply (@wp_bind _ _ _ [UnfoldCtx]); iApply (@wp_bind _ _ _ [UnfoldCtx]);
iApply wp_impl_l; iApply wp_wand_l; iSplitL; [|iApply IHHtyped; auto].
iSplit; [eapply (@always_intro _ _ _ _)|
iApply IHHtyped;
auto with itauto].
iIntros {v}. iIntros {v}.
cbn [interp interp_rec cofe_mor_car]. cbn [interp interp_rec cofe_mor_car].
rewrite fixpoint_unfold. rewrite fixpoint_unfold.
iIntros "#Hv"; cbn. iIntros "#Hv"; cbn.
change (fixpoint _) with (@interp _ _ L (TRec τ) Δ). change (fixpoint _) with (interp L (TRec τ) Δ).
iDestruct "Hv" as {w} "[% #Hw]"; rewrite H. iDestruct "Hv" as {w} "[% #Hw]"; rewrite H.
iApply wp_Fold; cbn; auto using to_of_val. iApply wp_Fold; cbn; auto using to_of_val.
rewrite -interp_subst; auto with itauto. rewrite -interp_subst; auto.
- (* Alloc *) - (* Alloc *)
smart_wp_bind AllocCtx v "#Hv" IHHtyped; cbn. iClear "HΓ". smart_wp_bind AllocCtx v "#Hv" IHHtyped; cbn. iClear "HΓ".
iApply wp_atomic; cbn; trivial; [rewrite to_of_val; auto|]. iApply wp_atomic; cbn; trivial; [rewrite to_of_val; auto|].
...@@ -175,8 +124,7 @@ Section typed_interp. ...@@ -175,8 +124,7 @@ Section typed_interp.
iNext; iExists _; iFrame "Hl"; trivial. iNext; iExists _; iFrame "Hl"; trivial.
- (* Load *) - (* Load *)
smart_wp_bind LoadCtx v "#Hv" IHHtyped; cbn. iClear "HΓ". smart_wp_bind LoadCtx v "#Hv" IHHtyped; cbn. iClear "HΓ".
iRevert "Hheap". iApply exist_elim; [|iExact "Hv"]. iDestruct "Hv" as {l} "[% #Hv]"; subst.
iIntros {l} "[% #Hv] #Hheap"; rewrite H.
iApply wp_atomic; cbn; eauto using to_of_val. iApply wp_atomic; cbn; eauto using to_of_val.
iPvsIntro. iPvsIntro.
iInv (L .@ l) as {w} "[Hw1 #Hw2]". iInv (L .@ l) as {w} "[Hw1 #Hw2]".
...@@ -188,8 +136,7 @@ Section typed_interp. ...@@ -188,8 +136,7 @@ Section typed_interp.
- (* Store *) - (* Store *)
smart_wp_bind (StoreLCtx _) v "#Hv" IHHtyped1; cbn. smart_wp_bind (StoreLCtx _) v "#Hv" IHHtyped1; cbn.
smart_wp_bind (StoreRCtx _) w "#Hw" IHHtyped2; cbn. iClear "HΓ". smart_wp_bind (StoreRCtx _) w "#Hw" IHHtyped2; cbn. iClear "HΓ".
iRevert "Hheap Hw". iApply exist_elim; [|iExact "Hv"]. iDestruct "Hv" as {l} "[% #Hv]"; subst.
iIntros {l} "#[% Hl] #Hheap #Hw"; rewrite H.
iApply wp_atomic; cbn; [trivial| rewrite ?to_of_val; auto |]. iApply wp_atomic; cbn; [trivial| rewrite ?to_of_val; auto |].
iPvsIntro. iPvsIntro.
iInv (L .@ l) as {z} "[Hz1 #Hz2]". iInv (L .@ l) as {z} "[Hz1 #Hz2]".
...@@ -197,13 +144,8 @@ Section typed_interp. ...@@ -197,13 +144,8 @@ Section typed_interp.
iApply (wp_store N); auto using to_of_val. iApply (wp_store N); auto using to_of_val.
specialize (HNLdisj l); set_solver_ndisj. specialize (HNLdisj l); set_solver_ndisj.
iFrame "Hheap Hz1". iFrame "Hheap Hz1".
iNext. iIntros "> Hz1".
iIntros "Hz1".
iSplitL; [|iPvsIntro; trivial]. iSplitL; [|iPvsIntro; trivial].
iNext; iExists _. iFrame "Hz1"; trivial. iNext; iExists _. iFrame "Hz1"; trivial.
(* unshelving *)
Unshelve.
cbn; typeclasses eauto.
Qed. Qed.
End typed_interp.
End typed_interp.
\ No newline at end of file
...@@ -39,7 +39,6 @@ Module lang. ...@@ -39,7 +39,6 @@ Module lang.
Instance Subst_expr : Subst expr. derive. Defined. Instance Subst_expr : Subst expr. derive. Defined.
Instance SubstLemmas_expr : SubstLemmas expr. derive. Qed. Instance SubstLemmas_expr : SubstLemmas expr. derive. Qed.
Global Instance expr_dec_eq (e e' : expr) : Decision (e = e'). Global Instance expr_dec_eq (e e' : expr) : Decision (e = e').
Proof. Proof.
unfold Decision. unfold Decision.
...@@ -297,6 +296,9 @@ other words, [e] also contains the reducible expression *) ...@@ -297,6 +296,9 @@ other words, [e] also contains the reducible expression *)
head_step e1 σ1 e2 σ2 ef to_val e1 = None. head_step e1 σ1 e2 σ2 ef to_val e1 = None.
Proof. destruct 1; naive_solver. Qed. Proof. destruct 1; naive_solver. Qed.
Canonical Structure stateC := leibnizC state.
Canonical Structure valC := leibnizC val.
Canonical Structure exprC := leibnizC expr.
End lang. End lang.
(** Language *) (** Language *)
...@@ -326,4 +328,4 @@ Global Instance lang_ctx_item Ki : ...@@ -326,4 +328,4 @@ Global Instance lang_ctx_item Ki :
LanguageCtx lang (lang.fill_item Ki). LanguageCtx lang (lang.fill_item Ki).
Proof. change (LanguageCtx lang (lang.fill [Ki])). by apply _. Qed.