Commit 39148535 authored by Robbert Krebbers's avatar Robbert Krebbers

Simplify Persistent stuff.

parent 01db92e2
...@@ -16,12 +16,11 @@ Section typed_interp. ...@@ -16,12 +16,11 @@ Section typed_interp.
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 typed_interp Δ Γ vs e τ Lemma typed_interp (Δ : varC -n> valC -n> iProp lang Σ) Γ vs e τ
(Htyped : typed Γ e τ) (Htyped : typed Γ e τ)
(HΔ : context_interp_Persistent Δ) (HΔ : x v, PersistentP (Δ x v))
: List.length Γ = List.length vs : List.length Γ = List.length vs
[] zip_with (λ τ v, interp τ Δ v) Γ vs [] zip_with (λ τ, interp τ Δ) Γ vs WP e.[env_subst vs] {{ interp τ Δ }}.
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.
...@@ -74,8 +73,8 @@ Section typed_interp. ...@@ -74,8 +73,8 @@ Section typed_interp.
- (* TLam *) - (* TLam *)
value_case. value_case.
iIntros { [τi τiPr] } "!". iApply wp_TLam; iNext; simpl in *. iIntros { [τi τiPr] } "!". iApply wp_TLam; iNext; simpl in *.
iApply IHHtyped; [rewrite map_length|]; trivial. iApply (IHHtyped (extend_context_interp_fun1 τi Δ)); [rewrite map_length|]; trivial.
rewrite zip_with_context_interp_subst; trivial. by iDestruct (zip_with_context_interp_subst with "HΓ") as "?".
- (* TApp *) - (* TApp *)
smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn. smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn.
unshelve iSpecialize ("Hv" $! ((interp τ' Δ) _)); try apply _; cbn. unshelve iSpecialize ("Hv" $! ((interp τ' Δ) _)); try apply _; cbn.
...@@ -92,7 +91,7 @@ Section typed_interp. ...@@ -92,7 +91,7 @@ Section typed_interp.
change (fixpoint _) with (interp (TRec τ) Δ) at 1; trivial. change (fixpoint _) with (interp (TRec τ) Δ) at 1; trivial.
rewrite fixpoint_unfold; cbn. rewrite fixpoint_unfold; cbn.
iAlways; eauto. iAlways; eauto.
+ iRevert "HΓ"; rewrite zip_with_context_interp_subst; iIntros "#HΓ"; trivial. + by iDestruct (zip_with_context_interp_subst with "HΓ") as "?".
- (* Unfold *) - (* Unfold *)
iApply (@wp_bind _ _ _ [UnfoldCtx]); iApply (@wp_bind _ _ _ [UnfoldCtx]);
iApply wp_wand_l; iSplitL; [|iApply IHHtyped; trivial]. iApply wp_wand_l; iSplitL; [|iApply IHHtyped; trivial].
......
...@@ -10,11 +10,6 @@ Section logrel. ...@@ -10,11 +10,6 @@ Section logrel.
Context {Σ : iFunctor}. Context {Σ : iFunctor}.
Notation "# v" := (of_val v) (at level 20). Notation "# v" := (of_val v) (at level 20).
Class Val_to_IProp_Persistent (f : valC -n> iProp lang Σ) :=
val_to_iprop_persistent : v : val, PersistentP (f v).
Arguments Val_to_IProp_Persistent /.
(** Just to get nicer closed forms, we define extend_context_interp in three steps. *) (** Just to get nicer closed forms, we define extend_context_interp in three steps. *)
Program Definition extend_context_interp_fun1 Program Definition extend_context_interp_fun1
(τi : valC -n> iProp lang Σ) (τi : valC -n> iProp lang Σ)
...@@ -153,8 +148,7 @@ Section logrel. ...@@ -153,8 +148,7 @@ Section logrel.
{| {|
cofe_mor_car := cofe_mor_car :=
λ w, λ w,
( (τ'i : {f : (valC -n> iProp lang Σ) | ( (τ'i : {f : (valC -n> iProp lang Σ) | v, PersistentP (f v)}%type),
Val_to_IProp_Persistent f}),
WP TApp (# w) {{λ v, (τi (`τ'i) v)}})%I WP TApp (# w) {{λ v, (τi (`τ'i) v)}})%I
|} |}
|}. |}.
...@@ -240,41 +234,23 @@ Section logrel. ...@@ -240,41 +234,23 @@ Section logrel.
Solve Obligations with Solve Obligations with
repeat intros ?; match goal with [H : _ {_} _|- _] => rewrite H end; trivial. repeat intros ?; match goal with [H : _ {_} _|- _] => rewrite H end; trivial.
Class context_interp_Persistent (Δ : varC -n> valC -n> iProp lang Σ) :=
contextinterppersistent : v : var, Val_to_IProp_Persistent (Δ v).
Global Instance Val_to_IProp_Persistent_Persistent
(f : valC -n> iProp lang Σ)
{Hf : Val_to_IProp_Persistent f}
(v : val)
: PersistentP (f v).
Proof. apply Hf. Qed.
Global Instance interp_Persistent Global Instance interp_Persistent
τ (Δ : varC -n> valC -n> iProp lang Σ) τ (Δ : varC -n> valC -n> iProp lang Σ)
{HΔ : context_interp_Persistent Δ} {HΔ : x v, PersistentP (Δ x v)}
: Val_to_IProp_Persistent (interp τ Δ). : v, PersistentP (interp τ Δ v).
Proof. Proof.
revert Δ HΔ. revert Δ HΔ.
induction τ; cbn; intros Δ HΔ v; try apply _. induction τ; cbn; intros Δ HΔ v; try apply _.
- rewrite /PersistentP /interp_rec fixpoint_unfold /interp_rec_pre; cbn. rewrite /PersistentP /interp_rec fixpoint_unfold /interp_rec_pre; cbn.
apply always_intro'; trivial. apply always_intro'; trivial.
- apply Val_to_IProp_Persistent_Persistent; apply HΔ.
Qed. Qed.
Global Instance Persistent_context_interp_rel Δ Γ vs Global Instance extend_context_interp_Persistent
{HΔ : context_interp_Persistent Δ} (f : valC -n> iProp lang Σ) (Δ : varC -n> valC -n> iProp lang Σ)
: PersistentP ([] zip_with(λ τ v, interp τ Δ v) Γ vs)%I. (Hf : v, PersistentP (f v))
Proof. typeclasses eauto. Qed. {HΔ : x v, PersistentP (Δ x v)}
: x v, PersistentP (@extend_context_interp f Δ x v).
Global Program Instance extend_context_interp_Persistent f Δ Proof. intros x v. destruct x; cbn; trivial. Qed.
(Hf : Val_to_IProp_Persistent f)
{HΔ : context_interp_Persistent Δ}
: context_interp_Persistent (@extend_context_interp f Δ).
Next Obligation.
intros f Δ Hf HΔ v w; destruct v; cbn; trivial.
apply HΔ.
Qed.
Local Ltac properness := Local Ltac properness :=
repeat repeat
...@@ -542,8 +518,8 @@ Section logrel. ...@@ -542,8 +518,8 @@ Section logrel.
Lemma zip_with_context_interp_subst Lemma zip_with_context_interp_subst
(Δ : varC -n> valC -n> iProp lang Σ) (Γ : list type) (Δ : varC -n> valC -n> iProp lang Σ) (Γ : list type)
(vs : list valC) (τi : valC -n> iProp lang Σ) : (vs : list valC) (τi : valC -n> iProp lang Σ) :
(([] zip_with (λ τ v, interp τ Δ v) Γ vs)%I) (([] zip_with (λ τ, interp τ Δ) Γ vs)%I)
([] zip_with (λ τ v, interp τ (extend_context_interp τi Δ) v) ([] zip_with (λ τ, interp τ (extend_context_interp τi Δ))
(map (λ t : type, t.[ren (+1)]) Γ) vs)%I. (map (λ t : type, t.[ren (+1)]) Γ) vs)%I.
Proof. Proof.
revert Δ vs τi. revert Δ vs τi.
......
...@@ -23,21 +23,15 @@ Section Soundness. ...@@ -23,21 +23,15 @@ Section Soundness.
λ x, λ x,
{| {|
cofe_mor_car := cofe_mor_car :=
λ y, (True)%I λ y, True%I
|} |}
|}. |}.
Global Instance free_context_interp_Persistent :
context_interp_Persistent free_type_context.
Proof. intros x v; apply const_persistent. Qed.
Lemma wp_soundness e τ Lemma wp_soundness e τ
: typed [] e τ True WP e {{@interp (globalF Σ) τ free_type_context}}. : typed [] e τ True WP e {{ @interp (globalF Σ) τ free_type_context}}.
Proof. Proof.
iIntros {H} "". iIntros {H} "". rewrite -(empty_env_subst e).
rewrite -(empty_env_subst e). by iApply (@typed_interp _ _ _ []).
iPoseProof (@typed_interp _ _ _ []) as "Hi"; eauto; try typeclasses eauto.
iApply "Hi"; eauto.
Qed. Qed.
Theorem Soundness e τ : Theorem Soundness e τ :
...@@ -47,12 +41,11 @@ Section Soundness. ...@@ -47,12 +41,11 @@ Section Soundness.
Proof. Proof.
intros H1 e' thp Hstp Hnr. intros H1 e' thp Hstp Hnr.
eapply wp_soundness in H1; eauto. eapply wp_soundness in H1; eauto.
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 ucmra_unit_valid; try tauto. eauto using ucmra_unit_valid; try tauto.
- iIntros "H". iApply H1. - iIntros "H". iApply H1.
- constructor. - constructor.
Qed. Qed.
End Soundness. End Soundness.
\ No newline at end of file
...@@ -22,13 +22,13 @@ Section typed_interp. ...@@ -22,13 +22,13 @@ Section typed_interp.
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 typed_interp N Δ Γ vs e τ Lemma typed_interp N (Δ : varC -n> valC -n> iPropG lang Σ) Γ 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Δ : x v, PersistentP (Δ x v))
: List.length Γ = List.length vs : List.length Γ = List.length vs
heap_ctx N [] zip_with (λ τ v, (@interp Σ i L) τ Δ v) Γ vs heap_ctx N [] zip_with (λ τ, interp L τ Δ) Γ vs
WP e.[env_subst vs] {{ λ v, (@interp Σ i L) τ Δ v }}. WP e.[env_subst vs] {{ interp L τ Δ }}.
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.
...@@ -80,10 +80,9 @@ Section typed_interp. ...@@ -80,10 +80,9 @@ Section typed_interp.
iApply wp_mono; [|iApply "Hv"]; auto. iApply wp_mono; [|iApply "Hv"]; auto.
- (* TLam *) - (* TLam *)
value_case. iIntros { [τi τiPr] } "!". value_case. iIntros { [τi τiPr] } "!".
iApply wp_TLam; iNext. iApply wp_TLam; iNext. simpl.
iApply IHHtyped; [rewrite map_length|]; trivial. iApply (IHHtyped (extend_context_interp_fun1 τi Δ)); [rewrite map_length|]; trivial.
iSplit; trivial. rewrite -zip_with_context_interp_subst. auto.
rewrite zip_with_context_interp_subst; trivial.
- (* TApp *) - (* TApp *)
smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn. smart_wp_bind TAppCtx v "#Hv" IHHtyped; cbn.
unshelve iSpecialize ("Hv" $! ((interp L τ' Δ) _)); try apply _; cbn. unshelve iSpecialize ("Hv" $! ((interp L τ' Δ) _)); try apply _; cbn.
......
...@@ -14,11 +14,6 @@ Section logrel. ...@@ -14,11 +14,6 @@ Section logrel.
Context {Σ : gFunctors}. Context {Σ : gFunctors}.
Notation "# v" := (of_val v) (at level 20). Notation "# v" := (of_val v) (at level 20).
Class Val_to_IProp_Persistent (f : valC -n> iPropG lang Σ) :=
val_to_iprop_persistent : v : val, PersistentP (f v).
Arguments Val_to_IProp_Persistent /.
(** Just to get nicer closed forms, we define extend_context_interp in three steps. *) (** Just to get nicer closed forms, we define extend_context_interp in three steps. *)
Program Definition extend_context_interp_fun1 Program Definition extend_context_interp_fun1
(τi : valC -n> iPropG lang Σ) (τi : valC -n> iPropG lang Σ)
...@@ -156,13 +151,11 @@ Section logrel. ...@@ -156,13 +151,11 @@ Section logrel.
{| {|
cofe_mor_car := cofe_mor_car :=
λ w, λ w,
( (τ'i : {f : (valC -n> iPropG lang Σ) | ( (τ'i : {f : (valC -n> iPropG lang Σ) | v, PersistentP (f v)}%type),
Val_to_IProp_Persistent f}),
(WP TApp (# w) @ {{λ v, (τi (`τ'i) v)}}))%I (WP TApp (# w) @ {{λ v, (τi (`τ'i) v)}}))%I
|} |}
|}. |}.
Next Obligation. Next Obligation.
Proof.
intros τ τ' x y Hxy; cbn; rewrite Hxy; trivial. intros τ τ' x y Hxy; cbn; rewrite Hxy; trivial.
Qed. Qed.
Next Obligation. Next Obligation.
...@@ -187,16 +180,13 @@ Section logrel. ...@@ -187,16 +180,13 @@ Section logrel.
|} |}
|}. |}.
Next Obligation. Next Obligation.
Proof.
intros τi rec_appr n x y Hxy; rewrite Hxy; trivial. intros τi rec_appr n x y Hxy; rewrite Hxy; trivial.
Qed. Qed.
Next Obligation. Next Obligation.
Proof.
intros τi n f g Hfg x. cbn. intros τi n f g Hfg x. cbn.
apply always_ne, exist_ne =>w; rewrite Hfg; trivial. apply always_ne, exist_ne =>w; rewrite Hfg; trivial.
Qed. Qed.
Next Obligation. Next Obligation.
Proof.
intros n τi τi' Hτi f x. cbn. intros n τi τi' Hτi f x. cbn.
apply always_ne, exist_ne =>w; rewrite Hτi; trivial. apply always_ne, exist_ne =>w; rewrite Hτi; trivial.
Qed. Qed.
...@@ -220,7 +210,7 @@ Section logrel. ...@@ -220,7 +210,7 @@ Section logrel.
cofe_mor_car := λ τi, fixpoint (interp_rec_pre τi) cofe_mor_car := λ τi, fixpoint (interp_rec_pre τi)
|}. |}.
Next Obligation. Next Obligation.
Proof. intros n f g H; apply fixpoint_ne => z; rewrite H; trivial. Qed. intros n f g H; apply fixpoint_ne => z; rewrite H; trivial. Qed.
Context `{i : heapG Σ} (L : namespace). Context `{i : heapG Σ} (L : namespace).
...@@ -229,8 +219,7 @@ Section logrel. ...@@ -229,8 +219,7 @@ Section logrel.
{| {|
cofe_mor_car := λ τi, ( v, l v (τi v))%I cofe_mor_car := λ τi, ( v, l v (τi v))%I
|}. |}.
Next Obligation. Next Obligation. intros ???? H; apply exist_ne =>w; rewrite H; trivial. Qed.
Proof. intros ???? H; apply exist_ne =>w; rewrite H; trivial. Qed.
Program Definition interp_ref : Program Definition interp_ref :
(valC -n> iPropG lang Σ) -n> valC -n> iPropG lang Σ := (valC -n> iPropG lang Σ) -n> valC -n> iPropG lang Σ :=
...@@ -241,10 +230,8 @@ Section logrel. ...@@ -241,10 +230,8 @@ Section logrel.
λ w, ( l, w = LocV l inv (L .@ l) (interp_ref_pred l τi))%I λ w, ( l, w = LocV l inv (L .@ l) (interp_ref_pred l τi))%I
|} |}
|}. |}.
Next Obligation. intros ???? H; rewrite H; trivial. Qed.
Next Obligation. Next Obligation.
Proof. intros ???? H; rewrite H; trivial. Qed.
Next Obligation.
Proof.
intros ??? H ?; apply exist_ne=>w; apply and_ne; trivial; cbn. intros ??? H ?; apply exist_ne=>w; apply and_ne; trivial; cbn.
apply (contractive_ne _); apply exist_ne=>w'; rewrite H; trivial. apply (contractive_ne _); apply exist_ne=>w'; rewrite H; trivial.
Qed. Qed.
...@@ -273,41 +260,23 @@ Section logrel. ...@@ -273,41 +260,23 @@ Section logrel.
Solve Obligations Solve Obligations
with repeat intros ?; match goal with [H : _ {_} _|- _] => rewrite H end; trivial. with repeat intros ?; match goal with [H : _ {_} _|- _] => rewrite H end; trivial.
Class context_interp_Persistent (Δ : varC -n> valC -n> iPropG lang Σ) :=
contextinterppersistent : v : var, Val_to_IProp_Persistent (Δ v).
Global Instance Val_to_IProp_Persistent_Persistent
(f : valC -n> iPropG lang Σ)
{Hf : Val_to_IProp_Persistent f}
(v : val)
: PersistentP (f v).
Proof. apply Hf. Qed.
Global Instance interp_Persistent Global Instance interp_Persistent
τ (Δ : varC -n> valC -n> iPropG lang Σ) τ (Δ : varC -n> valC -n> iPropG lang Σ)
{HΔ : context_interp_Persistent Δ} {HΔ : x v, PersistentP (Δ x v)}
: Val_to_IProp_Persistent (interp τ Δ). : v, PersistentP (interp τ Δ v).
Proof. Proof.
revert Δ HΔ. revert Δ HΔ.
induction τ; cbn; intros Δ HΔ v; try apply _. induction τ; cbn; intros Δ HΔ v; try apply _.
- rewrite /PersistentP /interp_rec fixpoint_unfold /interp_rec_pre; cbn. rewrite /PersistentP /interp_rec fixpoint_unfold /interp_rec_pre; cbn.
apply always_intro'; trivial. apply always_intro'; trivial.
- apply Val_to_IProp_Persistent_Persistent; apply HΔ.
Qed. Qed.
Global Instance Persistent_context_interp_rel Δ Γ vs Global Instance extend_context_interp_Persistent
{HΔ : context_interp_Persistent Δ} (f : valC -n> iPropG lang Σ) (Δ : varC -n> valC -n> iPropG lang Σ)
: PersistentP ([] zip_with(λ τ v, interp τ Δ v) Γ vs)%I. (Hf : v, PersistentP (f v))
Proof. typeclasses eauto. Qed. {HΔ : x v, PersistentP (Δ x v)}
: x v, PersistentP (@extend_context_interp f Δ x v).
Global Program Instance extend_context_interp_Persistent f Δ Proof. intros x v. destruct x; cbn; trivial. Qed.
(Hf : Val_to_IProp_Persistent f)
{HΔ : context_interp_Persistent Δ}
: context_interp_Persistent (@extend_context_interp f Δ).
Next Obligation.
intros f Δ Hf HΔ v w; destruct v; cbn; trivial.
apply HΔ.
Qed.
Local Ltac properness := Local Ltac properness :=
repeat repeat
...@@ -380,10 +349,8 @@ Section logrel. ...@@ -380,10 +349,8 @@ Section logrel.
λ Δ, λ Δ,
{| cofe_mor_car := λ v, if lt_dec v m then Δ v else Δ (v - n) |} {| cofe_mor_car := λ v, if lt_dec v m then Δ v else Δ (v - n) |}
|}. |}.
Next Obligation. intros ?????? Hxy; destruct Hxy; trivial. Qed.
Next Obligation. Next Obligation.
Proof. intros ?????? Hxy; destruct Hxy; trivial. Qed.
Next Obligation.
Proof.
intros ????? Hfg ?; cbn. destruct lt_dec; rewrite Hfg; trivial. intros ????? Hfg ?; cbn. destruct lt_dec; rewrite Hfg; trivial.
Qed. Qed.
...@@ -474,12 +441,10 @@ Section logrel. ...@@ -474,12 +441,10 @@ Section logrel.
Next Obligation. Next Obligation.
Proof. intros m τi Δ n x y Hxy; destruct Hxy; trivial. Qed. Proof. intros m τi Δ n x y Hxy; destruct Hxy; trivial. Qed.
Next Obligation. Next Obligation.
Proof.
intros m τi n Δ Δ' HΔ x; cbn; intros m τi n Δ Δ' HΔ x; cbn;
destruct lt_dec; try destruct eq_nat_dec; auto. destruct lt_dec; try destruct eq_nat_dec; auto.
Qed. Qed.
Next Obligation. Next Obligation.
Proof.
intros m n f g Hfg F Δ x; cbn; intros m n f g Hfg F Δ x; cbn;
destruct lt_dec; try destruct eq_nat_dec; auto. destruct lt_dec; try destruct eq_nat_dec; auto.
Qed. Qed.
...@@ -579,8 +544,8 @@ Section logrel. ...@@ -579,8 +544,8 @@ Section logrel.
Lemma zip_with_context_interp_subst Lemma zip_with_context_interp_subst
(Δ : varC -n> valC -n> iPropG lang Σ) (Γ : list type) (Δ : varC -n> valC -n> iPropG lang Σ) (Γ : list type)
(vs : list valC) (τi : valC -n> iPropG lang Σ) : (vs : list valC) (τi : valC -n> iPropG lang Σ) :
(([] zip_with (λ τ v, interp τ Δ v) Γ vs)%I) (([] zip_with (λ τ, interp τ Δ) Γ vs)%I)
([] zip_with (λ τ v, interp τ (extend_context_interp τi Δ) v) ([] zip_with (λ τ, interp τ (extend_context_interp τi Δ))
(map (λ t : type, t.[ren (+1)]) Γ) vs)%I. (map (λ t : type, t.[ren (+1)]) Γ) vs)%I.
Proof. Proof.
revert Δ vs τi. revert Δ vs τi.
......
...@@ -23,14 +23,10 @@ Section Soundness. ...@@ -23,14 +23,10 @@ Section Soundness.
λ x, λ x,
{| {|
cofe_mor_car := cofe_mor_car :=
λ y, (True)%I λ y, True%I
|} |}
|}. |}.
Global Instance free_context_interp_Persistent :
context_interp_Persistent free_type_context.
Proof. intros x v; apply const_persistent. Qed.
Lemma wp_soundness e τ Lemma wp_soundness e τ
: typed [] e τ : typed [] e τ
ownership.ownP WP e {{v, H, @interp Σ H (nroot .@ "Fμ,ref" .@ 1) ownership.ownP WP e {{v, H, @interp Σ H (nroot .@ "Fμ,ref" .@ 1)
...@@ -42,11 +38,9 @@ Section Soundness. ...@@ -42,11 +38,9 @@ Section Soundness.
iApply wp_wand_l. iSplitR. iApply wp_wand_l. iSplitR.
{ iIntros {v} "HΦ". iExists H. iExact "HΦ". } { iIntros {v} "HΦ". iExists H. iExact "HΦ". }
rewrite -(empty_env_subst e). rewrite -(empty_env_subst e).
iPoseProof (@typed_interp _ _ (nroot .@ "Fμ,ref" .@ 1) iApply (@typed_interp _ _ (nroot .@ "Fμ,ref" .@ 1)
(nroot .@ "Fμ,ref" .@ 2) _ _ []) as "Hi"; eauto; (nroot .@ "Fμ,ref" .@ 2) _ _ []); eauto.
try typeclasses eauto. intros l. apply ndot_preserve_disjoint_r, ndot_ne_disjoint; auto.
- intros l. apply ndot_preserve_disjoint_r, ndot_ne_disjoint; auto.
- iApply "Hi"; iSplit; eauto.
Unshelve. all: trivial. Unshelve. all: trivial.
Qed. Qed.
......
...@@ -205,14 +205,15 @@ Section bin_log_related_under_typed_context. ...@@ -205,14 +205,15 @@ Section bin_log_related_under_typed_context.
Context {Σ : gFunctors} Context {Σ : gFunctors}
{iI : heapIG Σ} {iS : cfgSG Σ} {iI : heapIG Σ} {iS : cfgSG Σ}
{N : namespace}. {N : namespace}.
Implicit Types Δ : varC -n> bivalC -n> iPropG lang Σ.
Lemma bin_log_related_under_typed_context Γ e e' τ Γ' τ' K : Lemma bin_log_related_under_typed_context Γ e e' τ Γ' τ' K :
( f, e.[iter (List.length Γ) up f] = e) ( f, e.[iter (List.length Γ) up f] = e)
( f, e'.[iter (List.length Γ) up f] = e') ( f, e'.[iter (List.length Γ) up f] = e')
typed_context K Γ τ Γ' τ' typed_context K Γ τ Γ' τ'
( Δ {HΔ : context_interp_Persistent Δ}, ( Δ {HΔ : x vw, PersistentP (Δ x vw)},
@bin_log_related _ _ _ N Δ Γ e e' τ HΔ) @bin_log_related _ _ _ N Δ Γ e e' τ HΔ)
Δ {HΔ : context_interp_Persistent Δ}, Δ {HΔ : x vw, PersistentP (Δ x vw)},
@bin_log_related _ _ _ N Δ Γ' (fill_ctx K e) (fill_ctx K e') τ' HΔ. @bin_log_related _ _ _ N Δ Γ' (fill_ctx K e) (fill_ctx K e') τ' HΔ.
Proof. Proof.
revert Γ τ Γ' τ' e e'. revert Γ τ Γ' τ' e e'.
......
...@@ -6,6 +6,7 @@ Import uPred. ...@@ -6,6 +6,7 @@ Import uPred.
Section CG_Counter. Section CG_Counter.
Context {Σ : gFunctors} {iS : cfgSG Σ} {iI : heapIG Σ}. Context {Σ : gFunctors} {iS : cfgSG Σ} {iI : heapIG Σ}.
Implicit Types Δ : varC -n> bivalC -n> iPropG lang Σ.
(* Coarse-grained increment *) (* Coarse-grained increment *)
Definition CG_increment (x : expr) : expr := Definition CG_increment (x : expr) : expr :=
...@@ -269,7 +270,7 @@ Section CG_Counter. ...@@ -269,7 +270,7 @@ Section CG_Counter.
set (Hdsj := ndot_ne_disjoint N n n' Hneq); set_solver_ndisj. set (Hdsj := ndot_ne_disjoint N n n' Hneq); set_solver_ndisj.
Lemma FG_CG_counter_refinement N Δ Lemma FG_CG_counter_refinement N Δ
{HΔ : context_interp_Persistent Δ} {HΔ : x v, PersistentP (Δ x v)}
: :
(@bin_log_related _ _ _ N Δ [] FG_counter CG_counter (@bin_log_related _ _ _ N Δ [] FG_counter CG_counter
(TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)) HΔ). (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)) HΔ).
......
...@@ -9,6 +9,8 @@ Import uPred. ...@@ -9,6 +9,8 @@ Import uPred.
Section Stack_refinement. Section Stack_refinement.
Context {Σ : gFunctors} {iS : cfgSG Σ} {iI : heapIG Σ} Context {Σ : gFunctors} {iS : cfgSG Σ} {iI : heapIG Σ}
{iSTK : authG lang Σ stackUR}. {iSTK : authG lang Σ stackUR}.
Implicit Types Δ : varC -n> bivalC -n> iPropG lang Σ.
Ltac prove_disj N n n' := Ltac prove_disj N n n' :=
let Hneq := fresh "Hneq" in let Hneq := fresh "Hneq" in
let Hdsj := fresh "Hdsj" in let Hdsj := fresh "Hdsj" in
...@@ -16,7 +18,7 @@ Section Stack_refinement. ...@@ -16,7 +18,7 @@ Section Stack_refinement.
set (Hdsj := ndot_ne_disjoint N n n' Hneq); set_solver_ndisj. set (Hdsj := ndot_ne_disjoint N n n' Hneq); set_solver_ndisj.
Lemma FG_CG_counter_refinement N Δ Lemma FG_CG_counter_refinement N Δ
{HΔ : context_interp_Persistent Δ}