Commit f4fed4c2 authored by Amin Timany's avatar Amin Timany

Make EqType more realistic

parent 30b963ae
...@@ -187,7 +187,9 @@ Proof. ...@@ -187,7 +187,9 @@ Proof.
Qed. Qed.
Definition ctx_refines (Γ : list type) Definition ctx_refines (Γ : list type)
(e e' : expr) (τ : type) := K thp σ v, (e e' : expr) (τ : type) :=
typed Γ e τ typed Γ e' τ
K thp σ v,
typed_ctx K Γ τ [] TUnit typed_ctx K Γ τ [] TUnit
rtc step ([fill_ctx K e], ) (of_val v :: thp, σ) rtc step ([fill_ctx K e], ) (of_val v :: thp, σ)
thp' σ' v', rtc step ([fill_ctx K e'], ) (of_val v' :: thp', σ'). thp' σ' v', rtc step ([fill_ctx K e'], ) (of_val v' :: thp', σ').
......
...@@ -366,6 +366,6 @@ Theorem counter_ctx_refinement : ...@@ -366,6 +366,6 @@ Theorem counter_ctx_refinement :
Proof. Proof.
set (Σ := #[invΣ ; gen_heapΣ loc val ; GFunctor (authR cfgUR) ]). set (Σ := #[invΣ ; gen_heapΣ loc val ; GFunctor (authR cfgUR) ]).
set (HG := soundness_unary.HeapPreIG Σ _ _). set (HG := soundness_unary.HeapPreIG Σ _ _).
eapply (binary_soundness Σ _); auto. eapply (binary_soundness Σ _); auto using FG_counter_type, CG_counter_type.
intros. apply FG_CG_counter_refinement. intros. apply FG_CG_counter_refinement.
Qed. Qed.
...@@ -3,11 +3,14 @@ From iris_examples.logrel.F_mu_ref_conc Require Import typing. ...@@ -3,11 +3,14 @@ From iris_examples.logrel.F_mu_ref_conc Require Import typing.
Definition FG_StackType τ := Definition FG_StackType τ :=
TRec (Tref (TSum TUnit (TProd τ.[ren (+1)] (TVar 0)))). TRec (Tref (TSum TUnit (TProd τ.[ren (+1)] (TVar 0)))).
Definition FG_Stack_Ref_Type τ :=
Tref (TSum TUnit (TProd τ (FG_StackType τ))).
Definition FG_push (st : expr) : expr := Definition FG_push (st : expr) : expr :=
Rec (App (Rec Rec (App (Rec
(* try push *) (* try push *)
(If (CAS (st.[ren (+4)]) (Var 1) (If (CAS (st.[ren (+4)]) (Var 1)
(Fold (Alloc (InjR (Pair (Var 3) (Var 1))))) (Alloc (InjR (Pair (Var 3) (Fold (Var 1)))))
) )
Unit (* push succeeds we return unit *) Unit (* push succeeds we return unit *)
(App (Var 2) (Var 3)) (* push fails, we try again *) (App (Var 2) (Var 3)) (* push fails, we try again *)
...@@ -19,7 +22,7 @@ Definition FG_pushV (st : expr) : val := ...@@ -19,7 +22,7 @@ Definition FG_pushV (st : expr) : val :=
RecV (App (Rec RecV (App (Rec
(* try push *) (* try push *)
(If (CAS (st.[ren (+4)]) (Var 1) (If (CAS (st.[ren (+4)]) (Var 1)
(Fold (Alloc (InjR (Pair (Var 3) (Var 1))))) (Alloc (InjR (Pair (Var 3) (Fold (Var 1)))))
) )
Unit (* push succeeds we return unit *) Unit (* push succeeds we return unit *)
(App (Var 2) (Var 3)) (* push fails, we try again *) (App (Var 2) (Var 3)) (* push fails, we try again *)
...@@ -39,8 +42,8 @@ Definition FG_pop (st : expr) : expr := ...@@ -39,8 +42,8 @@ Definition FG_pop (st : expr) : expr :=
If If
(CAS (CAS
(st.[ren (+7)]) (st.[ren (+7)])
(Fold (Var 4)) (Var 4)
(Snd (Var 0)) (Unfold (Snd (Var 0)))
) )
(InjR (Fst (Var 0))) (* pop succeeds *) (InjR (Fst (Var 0))) (* pop succeeds *)
(App (Var 5) (Var 6)) (* pop fails, we retry*) (App (Var 5) (Var 6)) (* pop fails, we retry*)
...@@ -52,7 +55,7 @@ Definition FG_pop (st : expr) : expr := ...@@ -52,7 +55,7 @@ Definition FG_pop (st : expr) : expr :=
) )
) )
) )
(Unfold (Load st.[ren (+ 2)])) (Load st.[ren (+ 2)])
). ).
Definition FG_popV (st : expr) : val := Definition FG_popV (st : expr) : val :=
RecV RecV
...@@ -67,8 +70,8 @@ Definition FG_popV (st : expr) : val := ...@@ -67,8 +70,8 @@ Definition FG_popV (st : expr) : val :=
If If
(CAS (CAS
(st.[ren (+7)]) (st.[ren (+7)])
(Fold (Var 4)) (Var 4)
(Snd (Var 0)) (Unfold (Snd (Var 0)))
) )
(InjR (Fst (Var 0))) (* pop succeeds *) (InjR (Fst (Var 0))) (* pop succeeds *)
(App (Var 5) (Var 6)) (* pop fails, we retry*) (App (Var 5) (Var 6)) (* pop fails, we retry*)
...@@ -80,7 +83,7 @@ Definition FG_popV (st : expr) : val := ...@@ -80,7 +83,7 @@ Definition FG_popV (st : expr) : val :=
) )
) )
) )
(Unfold (Load st.[ren (+ 2)])) (Load st.[ren (+ 2)])
). ).
Definition FG_iter (f : expr) : expr := Definition FG_iter (f : expr) : expr :=
...@@ -100,14 +103,14 @@ Definition FG_iterV (f : expr) : val := ...@@ -100,14 +103,14 @@ Definition FG_iterV (f : expr) : val :=
) )
). ).
Definition FG_read_iter (st : expr) : expr := Definition FG_read_iter (st : expr) : expr :=
Rec (App (FG_iter (Var 1)) (Load st.[ren (+2)])). Rec (App (FG_iter (Var 1)) (Fold (Load st.[ren (+2)]))).
Definition FG_stack_body (st : expr) : expr := Definition FG_stack_body (st : expr) : expr :=
Pair (Pair (FG_push st) (FG_pop st)) (FG_read_iter st). Pair (Pair (FG_push st) (FG_pop st)) (FG_read_iter st).
Definition FG_stack : expr := Definition FG_stack : expr :=
TLam (App (Rec (FG_stack_body (Var 1))) TLam (App (Rec (FG_stack_body (Var 1)))
(Alloc (Fold (Alloc (InjL Unit))))). (Alloc (Alloc (InjL Unit)))).
Section FG_stack. Section FG_stack.
(* Fine-grained push *) (* Fine-grained push *)
...@@ -116,7 +119,7 @@ Section FG_stack. ...@@ -116,7 +119,7 @@ Section FG_stack.
Rec (App (Rec Rec (App (Rec
(* try push *) (* try push *)
(If (CAS (st.[ren (+4)]) (Var 1) (If (CAS (st.[ren (+4)]) (Var 1)
(Fold (Alloc (InjR (Pair (Var 3) (Var 1))))) (Alloc (InjR (Pair (Var 3) (Fold (Var 1)))))
) )
Unit (* push succeeds we return unit *) Unit (* push succeeds we return unit *)
(App (Var 2) (Var 3)) (* push fails, we try again *) (App (Var 2) (Var 3)) (* push fails, we try again *)
...@@ -127,20 +130,19 @@ Section FG_stack. ...@@ -127,20 +130,19 @@ Section FG_stack.
Proof. trivial. Qed. Proof. trivial. Qed.
Section FG_push_type. Section FG_push_type.
(* The following assumption is simply ** WRONG ** *)
(* We assume it though to just be able to prove that the
stack we are implementing is /type-sane/ so to speak! *)
Context (HEQTP : τ, EqType (FG_StackType τ)).
Lemma FG_push_type st Γ τ : Lemma FG_push_type st Γ τ :
typed Γ st (Tref (FG_StackType τ)) typed Γ st (Tref (FG_Stack_Ref_Type τ))
typed Γ (FG_push st) (TArrow τ TUnit). typed Γ (FG_push st) (TArrow τ TUnit).
Proof. Proof.
intros H1. repeat (econstructor; eauto using HEQTP). intros HTst.
repeat match goal with
|- typed _ _ _ => econstructor; eauto
end; repeat econstructor; eauto.
- eapply (context_weakening [_; _; _; _]); eauto. - eapply (context_weakening [_; _; _; _]); eauto.
- by asimpl. - by asimpl.
- eapply (context_weakening [_; _]); eauto. - eapply (context_weakening [_; _]); eauto.
Qed. Qed.
End FG_push_type. End FG_push_type.
Lemma FG_push_to_val st : to_val (FG_push st) = Some (FG_pushV st). Lemma FG_push_to_val st : to_val (FG_push st) = Some (FG_pushV st).
...@@ -173,8 +175,8 @@ Section FG_stack. ...@@ -173,8 +175,8 @@ Section FG_stack.
If If
(CAS (CAS
(st.[ren (+7)]) (st.[ren (+7)])
(Fold (Var 4)) (Var 4)
(Snd (Var 0)) (Unfold (Snd (Var 0)))
) )
(InjR (Fst (Var 0))) (* pop succeeds *) (InjR (Fst (Var 0))) (* pop succeeds *)
(App (Var 5) (Var 6)) (* pop fails, we retry*) (App (Var 5) (Var 6)) (* pop fails, we retry*)
...@@ -186,24 +188,28 @@ Section FG_stack. ...@@ -186,24 +188,28 @@ Section FG_stack.
) )
) )
) )
(Unfold (Load st.[ren (+ 2)])) (Load st.[ren (+ 2)])
). ).
Proof. trivial. Qed. Proof. trivial. Qed.
Section FG_pop_type. Section FG_pop_type.
(* The following assumption is simply ** WRONG ** *)
(* We assume it though to just be able to prove that the
stack we are implementing is /type-sane/ so to speak! *)
Context (HEQTP : τ, EqType (FG_StackType τ)).
Lemma FG_pop_type st Γ τ : Lemma FG_pop_type st Γ τ :
typed Γ st (Tref (FG_StackType τ)) typed Γ st (Tref (FG_Stack_Ref_Type τ))
typed Γ (FG_pop st) (TArrow TUnit (TSum TUnit τ)). typed Γ (FG_pop st) (TArrow TUnit (TSum TUnit τ)).
Proof. Proof.
intros H1. repeat (econstructor; eauto using HEQTP). replace (FG_Stack_Ref_Type τ) with
- eapply (context_weakening [_; _; _; _; _; _; _]); eauto. (Tref (TSum TUnit (TProd τ.[ren (+1)] (TVar 0)))).[FG_StackType τ/];
- asimpl; trivial. last first.
{ by asimpl. }
intros HTst.
repeat match goal with
|- typed _ _ _ => econstructor; eauto
end; repeat econstructor; eauto; last first.
- eapply (context_weakening [_; _]); eauto. - eapply (context_weakening [_; _]); eauto.
- by asimpl.
- eapply (context_weakening [_; _; _; _; _; _; _]); eauto.
- econstructor.
Qed. Qed.
End FG_pop_type. End FG_pop_type.
...@@ -270,13 +276,13 @@ Section FG_stack. ...@@ -270,13 +276,13 @@ Section FG_stack.
Global Opaque FG_iter. Global Opaque FG_iter.
Lemma FG_read_iter_type st Γ τ : Lemma FG_read_iter_type st Γ τ :
typed Γ st (Tref (FG_StackType τ)) typed Γ st (Tref (FG_Stack_Ref_Type τ))
typed Γ (FG_read_iter st) typed Γ (FG_read_iter st)
(TArrow (TArrow τ TUnit) TUnit). (TArrow (TArrow τ TUnit) TUnit).
Proof. Proof.
intros H1; repeat econstructor. intros H1; repeat econstructor.
- eapply FG_iter_type; by constructor. - eapply FG_iter_type; by constructor.
- by eapply (context_weakening [_;_]). - by eapply (context_weakening [_;_]); asimpl.
Qed. Qed.
Transparent FG_iter. Transparent FG_iter.
...@@ -296,13 +302,9 @@ Section FG_stack. ...@@ -296,13 +302,9 @@ Section FG_stack.
Global Opaque FG_iter. Global Opaque FG_iter.
Section FG_stack_body_type. Section FG_stack_body_type.
(* The following assumption is simply ** WRONG ** *)
(* We assume it though to just be able to prove that the
stack we are implementing is /type-sane/ so to speak! *)
Context (HEQTP : τ, EqType (FG_StackType τ)).
Lemma FG_stack_body_type st Γ τ : Lemma FG_stack_body_type st Γ τ :
typed Γ st (Tref (FG_StackType τ)) typed Γ st (Tref (FG_Stack_Ref_Type τ))
typed Γ (FG_stack_body st) typed Γ (FG_stack_body st)
(TProd (TProd
(TProd (TArrow τ TUnit) (TArrow TUnit (TSum TUnit τ))) (TProd (TArrow τ TUnit) (TArrow TUnit (TSum TUnit τ)))
...@@ -328,10 +330,6 @@ Section FG_stack. ...@@ -328,10 +330,6 @@ Section FG_stack.
Qed. Qed.
Section FG_stack_type. Section FG_stack_type.
(* The following assumption is simply ** WRONG ** *)
(* We assume it though to just be able to prove that the
stack we are implementing is /type-sane/ so to speak! *)
Context (HEQTP : τ, EqType (FG_StackType τ)).
Lemma FG_stack_type Γ : Lemma FG_stack_type Γ :
typed Γ FG_stack typed Γ FG_stack
...@@ -348,7 +346,6 @@ Section FG_stack. ...@@ -348,7 +346,6 @@ Section FG_stack.
- eapply FG_push_type; try constructor; simpl; eauto. - eapply FG_push_type; try constructor; simpl; eauto.
- eapply FG_pop_type; try constructor; simpl; eauto. - eapply FG_pop_type; try constructor; simpl; eauto.
- eapply FG_read_iter_type; constructor; by simpl. - eapply FG_read_iter_type; constructor; by simpl.
- asimpl. repeat constructor.
Qed. Qed.
End FG_stack_type. End FG_stack_type.
......
...@@ -41,7 +41,7 @@ Section Stack_refinement. ...@@ -41,7 +41,7 @@ Section Stack_refinement.
simpl. simpl.
rewrite CG_locked_push_subst CG_locked_pop_subst rewrite CG_locked_push_subst CG_locked_pop_subst
CG_iter_subst CG_snap_subst. simpl. asimpl. CG_iter_subst CG_snap_subst. simpl. asimpl.
iApply (wp_bind (fill [FoldCtx; AllocCtx; AppRCtx (RecV _)])); iApply (wp_bind (fill [AllocCtx; AppRCtx (RecV _)]));
iApply wp_wand_l; iSplitR; [iIntros (v) "Hv"; iExact "Hv"|]. iApply wp_wand_l; iSplitR; [iIntros (v) "Hv"; iExact "Hv"|].
iApply wp_alloc; first done. iNext; iIntros (istk) "Histk". iApply wp_alloc; first done. iNext; iIntros (istk) "Histk".
iApply (wp_bind (fill [AppRCtx (RecV _)])); iApply (wp_bind (fill [AppRCtx (RecV _)]));
...@@ -64,7 +64,7 @@ Section Stack_refinement. ...@@ -64,7 +64,7 @@ Section Stack_refinement.
iFrame "Hls". iLeft. iSplit; trivial. } iFrame "Hls". iLeft. iSplit; trivial. }
iAssert (( istk v h, (stack_owns h) iAssert (( istk v h, (stack_owns h)
stk' ↦ₛ v stk' ↦ₛ v
stk ↦ᵢ (FoldV (LocV istk)) stk ↦ᵢ (LocV istk)
StackLink τi (LocV istk, v) StackLink τi (LocV istk, v)
l ↦ₛ (#v false) l ↦ₛ (#v false)
)%I) with "[Hoe Hstk Hstk' HLK Hl]" as "Hinv". )%I) with "[Hoe Hstk Hstk' HLK Hl]" as "Hinv".
...@@ -98,8 +98,8 @@ Section Stack_refinement. ...@@ -98,8 +98,8 @@ Section Stack_refinement.
clear v h. clear v h.
iApply wp_pure_step_later; auto using to_of_val. iApply wp_pure_step_later; auto using to_of_val.
iModIntro. iNext. asimpl. iModIntro. iNext. asimpl.
iApply (wp_bind (fill [FoldCtx;
CasRCtx (LocV _) (FoldV (LocV _)); IfCtx _ _])); iApply (wp_bind (fill [CasRCtx (LocV _) (LocV _); IfCtx _ _]));
iApply wp_wand_l; iSplitR; [iIntros (w) "Hw"; iExact "Hw"|]. iApply wp_wand_l; iSplitR; [iIntros (w) "Hw"; iExact "Hw"|].
iApply wp_alloc; simpl; trivial. iApply wp_alloc; simpl; trivial.
iNext. iIntros (ltmp) "Hltmp". iNext. iIntros (ltmp) "Hltmp".
...@@ -140,7 +140,7 @@ Section Stack_refinement. ...@@ -140,7 +140,7 @@ Section Stack_refinement.
iApply wp_pure_step_later; auto. iNext. iApply wp_pure_step_later; auto. iNext.
rewrite -(FG_pop_folding (Loc stk)). rewrite -(FG_pop_folding (Loc stk)).
asimpl. asimpl.
iApply (wp_bind (fill [UnfoldCtx; AppRCtx (RecV _)])); iApply (wp_bind (fill [AppRCtx (RecV _)]));
iApply wp_wand_l; iSplitR; [iIntros (v) "Hv"; iExact "Hv"|]. iApply wp_wand_l; iSplitR; [iIntros (v) "Hv"; iExact "Hv"|].
iInv stackN as (istk v h) "[Hoe [Hstk' [Hstk [#HLK Hl]]]]" "Hclose". iInv stackN as (istk v h) "[Hoe [Hstk' [Hstk [#HLK Hl]]]]" "Hclose".
iApply (wp_load with "Hstk"). iNext. iIntros "Hstk". iApply (wp_load with "Hstk"). iNext. iIntros "Hstk".
...@@ -153,10 +153,7 @@ Section Stack_refinement. ...@@ -153,10 +153,7 @@ Section Stack_refinement.
as "[Hj [Hstk' Hl]]"; first solve_ndisj. as "[Hj [Hstk' Hl]]"; first solve_ndisj.
iMod ("Hclose" with "[-Hj Hmpt]") as "_". iMod ("Hclose" with "[-Hj Hmpt]") as "_".
{ iNext. iExists _, _, _. by iFrame "Hoe Hstk' Hstk Hl". } { iNext. iExists _, _, _. by iFrame "Hoe Hstk' Hstk Hl". }
iApply (wp_bind (fill [AppRCtx (RecV _)])); iModIntro.
iApply wp_wand_l; iSplitR; [iModIntro; iIntros (w) "Hw"; iExact "Hw"|].
iApply wp_pure_step_later; simpl; auto using to_of_val.
iModIntro. iNext. iApply wp_value.
iApply wp_pure_step_later; auto. iNext. asimpl. iApply wp_pure_step_later; auto. iNext. asimpl.
clear h. clear h.
iApply (wp_bind (fill [AppRCtx (RecV _)])); iApply (wp_bind (fill [AppRCtx (RecV _)]));
...@@ -176,10 +173,7 @@ Section Stack_refinement. ...@@ -176,10 +173,7 @@ Section Stack_refinement.
* (* The stack is not empty *) * (* The stack is not empty *)
iMod ("Hclose" with "[-Hj Hmpt HLK']") as "_". iMod ("Hclose" with "[-Hj Hmpt HLK']") as "_".
{ iNext. iExists _, _, _. by iFrame "Hstk' Hstk HLK Hl". } { iNext. iExists _, _, _. by iFrame "Hstk' Hstk HLK Hl". }
iApply (wp_bind (fill [AppRCtx (RecV _)])); iModIntro. iApply wp_pure_step_later; auto.
iApply wp_wand_l; iSplitR; [iModIntro; iIntros (w') "Hw"; iExact "Hw"|].
iApply wp_pure_step_later; simpl; auto.
iModIntro. iNext. iApply wp_value. iApply wp_pure_step_later; auto.
iNext. asimpl. iNext. asimpl.
clear h. clear h.
iApply (wp_bind (fill [AppRCtx (RecV _)])); iApply (wp_bind (fill [AppRCtx (RecV _)]));
...@@ -195,8 +189,12 @@ Section Stack_refinement. ...@@ -195,8 +189,12 @@ Section Stack_refinement.
iModIntro. iNext. asimpl. iModIntro. iNext. asimpl.
iDestruct "HLK'" as (y1 z1 y2 z2) "[% HLK']". subst. simpl. iDestruct "HLK'" as (y1 z1 y2 z2) "[% HLK']". subst. simpl.
iApply wp_pure_step_later; [simpl; by rewrite ?to_of_val |]. iApply wp_pure_step_later; [simpl; by rewrite ?to_of_val |].
iNext. iNext. asimpl.
iApply (wp_bind (fill [CasRCtx (LocV _) (FoldV (LocV _)); IfCtx _ _])); iApply (wp_bind (fill [UnfoldCtx; CasRCtx (LocV _) (LocV _); IfCtx _ _]));
iApply wp_wand_l; iSplitR; [iIntros (w) "Hw"; iExact "Hw"|].
asimpl. iApply wp_pure_step_later; auto.
simpl. iNext. iApply wp_value.
iApply (wp_bind (fill [CasRCtx (LocV _) (LocV _); IfCtx _ _]));
iApply wp_wand_l; iSplitR; [iIntros (w) "Hw"; iExact "Hw"|]. iApply wp_wand_l; iSplitR; [iIntros (w) "Hw"; iExact "Hw"|].
asimpl. iApply wp_pure_step_later; auto. asimpl. iApply wp_pure_step_later; auto.
simpl. iNext. iApply wp_value. simpl. iNext. iApply wp_value.
...@@ -249,7 +247,7 @@ Section Stack_refinement. ...@@ -249,7 +247,7 @@ Section Stack_refinement.
by (by rewrite FG_iter_of_val). by (by rewrite FG_iter_of_val).
replace (CG_iter (of_val f2)) with (of_val (CG_iterV (of_val f2))) replace (CG_iter (of_val f2)) with (of_val (CG_iterV (of_val f2)))
by (by rewrite CG_iter_of_val). by (by rewrite CG_iter_of_val).
iApply (wp_bind (fill [AppRCtx _])); iApply wp_wand_l; iApply (wp_bind (fill [FoldCtx; AppRCtx _])); iApply wp_wand_l;
iSplitR; [iIntros (w) "Hw"; iExact "Hw"|]. iSplitR; [iIntros (w) "Hw"; iExact "Hw"|].
iInv stackN as (istk3 w h) "[Hoe [>Hstk' [>Hstk [#HLK >Hl]]]]" "Hclose". iInv stackN as (istk3 w h) "[Hoe [>Hstk' [>Hstk [#HLK >Hl]]]]" "Hclose".
iMod (steps_CG_snap _ _ _ (AppRCtx _ :: K) iMod (steps_CG_snap _ _ _ (AppRCtx _ :: K)
...@@ -337,6 +335,6 @@ Theorem stack_ctx_refinement : ...@@ -337,6 +335,6 @@ Theorem stack_ctx_refinement :
Proof. Proof.
set (Σ := #[invΣ; gen_heapΣ loc val; GFunctor (authR cfgUR); GFunctor (authR stackUR)]). set (Σ := #[invΣ; gen_heapΣ loc val; GFunctor (authR cfgUR); GFunctor (authR stackUR)]).
set (HG := soundness_unary.HeapPreIG Σ _ _). set (HG := soundness_unary.HeapPreIG Σ _ _).
eapply (binary_soundness Σ); eauto using FG_stack_closed, CG_stack_closed. eapply (binary_soundness Σ); eauto using FG_stack_type, CG_stack_type.
intros; apply FG_CG_counter_refinement. intros; apply FG_CG_counter_refinement.
Qed. Qed.
...@@ -356,8 +356,8 @@ Section fundamental. ...@@ -356,8 +356,8 @@ Section fundamental.
iApply wp_atomic; eauto. iApply wp_atomic; eauto.
iInv (logN .@ (l,l')) as ([v v']) "[Hv1 [>Hv2 #Hv]]" "Hclose". iInv (logN .@ (l,l')) as ([v v']) "[Hv1 [>Hv2 #Hv]]" "Hclose".
iModIntro. iModIntro.
iApply (wp_store with "Hv1"); auto using to_of_val. iApply (wp_store with "Hv1"); auto using to_of_val.
iNext. iIntros "Hw2". iNext. iIntros "Hw2".
iMod (step_store with "[$Hs Hw Hv2]") as "[Hw Hv2]"; eauto; iMod (step_store with "[$Hs Hw Hv2]") as "[Hw Hv2]"; eauto;
[solve_ndisj | by iFrame|]. [solve_ndisj | by iFrame|].
iMod ("Hclose" with "[Hw2 Hv2]"). iMod ("Hclose" with "[Hw2 Hv2]").
...@@ -381,30 +381,31 @@ Section fundamental. ...@@ -381,30 +381,31 @@ Section fundamental.
('`IHHtyped3 _ _ _ j ((CasRCtx _ _) :: K)). ('`IHHtyped3 _ _ _ j ((CasRCtx _ _) :: K)).
iDestruct "Hiv" as ([l l']) "[% Hinv]"; simplify_eq/=. iDestruct "Hiv" as ([l l']) "[% Hinv]"; simplify_eq/=.
iApply wp_atomic; eauto. iApply wp_atomic; eauto.
iInv (logN .@ (l,l')) as ([v v']) "[Hv1 [>Hv2 #Hv]]" "Hclose". iMod (interp_ref_open' _ _ l l' with "[]") as
(v v') "(>Hl & >Hl' & #Hiv & Heq & Hcl)"; eauto.
{ iExists (_, _); eauto. }
iModIntro. iModIntro.
iPoseProof ("Hv") as "Hv'". destruct (decide (v = w)) as [|Hneq]; subst.
rewrite {2}[ τ Δ (v, v')]interp_EqType_agree; trivial. - iApply (wp_cas_suc with "Hl"); eauto using to_of_val; eauto.
iMod "Hv'" as %Hv'; subst. iNext. iIntros "Hl".
destruct (decide (v' = w)) as [|Hneq]; subst. iMod ("Heq" with "Hl Hl' Hiv Hiw") as "(Hl & Hl' & Heq)".
- iAssert ( w' = w)%I as ">%". iDestruct "Heq" as %[-> _]; last trivial.
{ rewrite ?interp_EqType_agree; trivial. by iSimplifyEq. }
simpl. iApply (wp_cas_suc with "Hv1"); eauto using to_of_val.
iNext. iIntros "Hv1".
iMod (step_cas_suc iMod (step_cas_suc
with "[Hu Hv2]") as "[Hw Hv2]"; simpl; eauto; first solve_ndisj. with "[Hu Hl']") as "[Hw Hl']"; simpl; eauto; first solve_ndisj.
iFrame. iFrame "Hs". { iFrame. iFrame "Hs". }
iMod ("Hclose" with "[Hv1 Hv2]"). iMod ("Hcl" with "[Hl Hl']").
{ iNext; iExists (_, _); by iFrame. } { iNext; iExists (_, _); by iFrame. }
iExists (#v true); iFrame; eauto. iExists (#v true); iFrame; eauto.
- iAssert ( v' w')%I as ">%". - iApply (wp_cas_fail with "Hl"); eauto using to_of_val; eauto.
{ rewrite ?interp_EqType_agree; trivial. iSimplifyEq. auto. } iNext. iIntros "Hl".
simpl. iApply (wp_cas_fail with "Hv1"); eauto. iMod ("Heq" with "Hl Hl' Hiv Hiw") as "(Hl & Hl' & Heq)".
iNext. iIntros "Hv1". iDestruct "Heq" as %[_ Heq].
assert (v' w').
{ by intros ?; apply Hneq; rewrite Heq. }
iMod (step_cas_fail iMod (step_cas_fail
with "[$Hs Hu Hv2]") as "[Hw Hv2]"; simpl; eauto; first solve_ndisj. with "[$Hs Hu Hl']") as "[Hw Hl']"; simpl; eauto; first solve_ndisj.
iFrame. iFrame.
iMod ("Hclose" with "[Hv1 Hv2]"). iMod ("Hcl" with "[Hl Hl']").
{ iNext; iExists (_, _); by iFrame. } { iNext; iExists (_, _); by iFrame. }
iExists (#v false); eauto. iExists (#v false); eauto.
Qed. Qed.
......
...@@ -231,25 +231,149 @@ Section logrel. ...@@ -231,25 +231,149 @@ Section logrel.
apply sep_proper; auto. apply (interp_weaken [] [τi] Δ). apply sep_proper; auto. apply (interp_weaken [] [τi] Δ).
Qed. Qed.
Lemma interp_EqType_agree τ v v' Δ : Lemma interp_ref_pointsto_neq E Δ τ l w (l1 l2 l3 l4 : loc) :
env_Persistent Δ EqType τ interp τ Δ (v, v') v = v'. logN.@(l1, l2) E
l2 l4
l ↦ᵢ w - interp (Tref τ) Δ (LocV l1, LocV l2) -
|={E logN.@(l3, l4)}=> l ↦ᵢ w l l1.
Proof. Proof.
intros ? Hτ; revert v v'; induction Hτ; iIntros (v v') "#H1 /=". intros Hnin Hneq.
- by iDestruct "H1" as "[% %]"; subst. destruct (decide (l = l1)); subst; last auto.
- by iDestruct "H1" as (n) "[% %]"; subst. iIntros "Hl1"; simpl; iDestruct 1 as ((l5, l6)) "[% Hl2]"; simplify_eq.
- by iDestruct "H1" as (b) "[% %]"; subst. iInv (logN.@(l5, l6)) as "Hi" "Hcl"; simpl.
- iDestruct "H1" as ([??] [??]) "[% [H1 H2]]"; simplify_eq/=. iDestruct "Hi" as ((v1, v2)) "(Hl3 & Hl2' & ?)".
rewrite IHHτ1 IHHτ2. iMod "Hl3".
by iDestruct "H1" as "%"; iDestruct "H2" as "%"; subst. by iDestruct (@mapsto_valid_2 with "Hl1 Hl3") as %?.
- iDestruct "H1" as "[H1|H1]".
+ iDestruct "H1" as ([??]) "[% H1]"; simplify_eq/=.
rewrite IHHτ1. by iDestruct "H1" as "%"; subst.
+ iDestruct "H1" as ([??]) "[% H1]"; simplify_eq/=.
rewrite IHHτ2. by iDestruct "H1" as "%"; subst.
Qed. Qed.
Lemma interp_ref_pointsto_neq' E Δ τ l w (l1 l2 l3 l4 : loc) :
logN.@(l1, l2) E
l1 l3
l ↦ₛ w - interp (Tref τ) Δ (LocV l1, LocV l2) -
|={E logN.@(l3, l4)}=> l ↦ₛ w l l2.
Proof.
intros Hnin Hneq.
destruct (decide (l = l2)); subst; last auto.
iIntros "Hl1"; simpl; iDestruct 1 as ((l5, l6)) "[% Hl2]"; simplify_eq.
iInv (logN.@(l5, l6)) as "Hi" "Hcl"; simpl.
iDestruct "Hi" as ((v1, v2)) "(Hl3 & Hl2' & ?)".
iMod "Hl2'"; simpl.
unfold heapS_mapsto.
iDestruct (@own_valid_2 _ _ _ cfg_name with "Hl1 Hl2'") as %[_ Hvl].
exfalso.
specialize (Hvl l6); revert Hvl. simpl.
rewrite /= gmap.lookup_op !lookup_singleton -Some_op. by intros [? _].
Qed.
Lemma interp_ref_open' Δ τ l l' :
env_Persistent Δ EqType τ
Tref τ Δ (LocV l, LocV l') -
|={, logN.@(l, l')}=>
w w', l ↦ᵢ w l' ↦ₛ w' τ Δ (w, w')
( z z' u u' v v',
l ↦ᵢ z - l' ↦ₛ z' - τ Δ (u, u') - τ Δ (v, v') -
|={ logN.@(l, l')}=> l ↦ᵢ z
l' ↦ₛ z' v = u v' = u')
( ( vv : val * val, l ↦ᵢ vv.1 l' ↦ₛ vv.2 τ Δ vv)
={ logN.@(l, l'), }= True).
Proof.