Commit aa334d0a authored by Ike Mulder's avatar Ike Mulder
Browse files

Simuliris automation working nicely except for val_discr_source stuff. First...

Simuliris automation working nicely except for val_discr_source stuff. First steps for na_inv working.
parent ede2af41
Pipeline #62714 passed with stage
in 8 minutes and 11 seconds
From iris Require Import bi.bi.
From iris.proofmode Require Import proofmode.
From simuliris.simulation Require Import slsls lifting.
From simuliris.simulang Require Import lang notation tactics
proofmode log_rel_structural wf behavior hoare.
From simuliris.simulang.na_inv Require Export inv.
From simuliris.simulang.na_inv Require Import readonly_refl adequacy.
From iris.prelude Require Import options.
From iris_automation.symb_exec Require Import defs.
From iris_automation.examples.external.simuliris Require Import simuliris_automation_base.
Section data_race.
Context `{naGS Σ}.
Existing Instance load_na_step_source.
Existing Instance load_na_step_target.
Typeclasses Opaque loc_rel heap_freeable.
(*
Global Instance sim_load_spec (l_t l_s : loc) :
SimultaneousSpec (! #l_t) (! #l_s) empty_hyp_last (λ π Φ,
l_t ↔h l_s ∗ (∀ v_t v_s, val_rel v_t v_s -∗ Φ (of_val v_t) (of_val v_s)))%I.
Proof.
split.
- iStepsS. sim_load v_t v_s as "Hv".
iStepsS.
- iStepsS. iSplit; iStepsS; iApply x2; iStepsS.
Qed. *)
(** ** Example from 3.2 *)
Definition load_na_sc_unopt : expr :=
"x" <- #42;;
!ˢᶜ "y";;
!"x".
Definition load_na_sc_opt : expr :=
"x" <- #42;;
!ˢᶜ "y";;
#42.
Instance store_na_step_source w (l : loc) (v : val) :
ReductionStep (source_red_cond, w) (#l <- v)%E id v', l s v' ; empty_hyp_first =[^0]=>
id #() l s v.
Proof.
rewrite /ReductionStep' /ReductionTemplateStep /=.
iStepsS.
iApply (source_red_store_na with "H1"). iStepsS.
Qed.
Existing Instance store_na_step_target.
Global Instance sim_bij_exploit_store_biabd π l_t (l_s : loc) e_s col p K (v' : val) :
(* (∀ P_s σ_s, safe_reach P_s e_s σ_s (post_in_ectx (λ e' σ', ∃ v' : val, e' = StoreNa1Ord #l_s v' ∧ ∃ v, σ_s.(heap) !! l_s = Some (RSt 0, v)))) → *)
BiAbd (TTl := [tele]) (TTr := [tele_pair val]) p (l_t h l_s) (λ v_s, l_s s v_s)%I (update_si_strong e_s π)
(na_locs π col col !! l_s = None ReshapeExprAnd expr e_s K (#l_s <- v')%E $ SatisfiesContextCondition context_as_item_condition K)%I (λ v_s, v_t, l_t t v_t val_rel v_t v_s na_locs π (<[l_s := (l_t, NaExcl)]> col))%I.
Proof.
rewrite /BiAbd /= bi.intuitionistically_if_elim. Typeclasses Transparent loc_rel.
iIntros "[#[Hbij %Hidx] [Hcol [%Hcol %HK]]]". Typeclasses Opaque loc_rel.
destruct HK as [HK1 HK2]. destruct HK2. rewrite -H0 in HK1.
assert (( P_s σ_s, safe_reach P_s e_s σ_s (post_in_ectx (λ e' σ', v' : val, e' = Store Na1Ord #l_s v' v, σ_s.(heap) !! l_s = Some (RSt 0, v))))).
{ intros. rewrite HK1. apply: fill_safe_reach. apply: safe_reach_safe_implies => [[l [v [[= <-] Hlv2]]]].
apply safe_reach_refl. apply post_in_ectx_intro. eauto. }
destruct l_s as [b_s o], l_t as [b_t o']; simplify_eq/=. rewrite /update_si_strong.
iIntros (??????) "($&$&$&Hσ_s&Hinv) [%HT %Hsafe]".
iDestruct (heap_ctx_wf with "Hσ_s") as %?.
have [?[?[[?[?[_ [?[_ [??]]]]]] _]]]:= pool_safe_safe_reach _ _ _ _ _ _ ltac:(done) ltac:(done) ltac:(done) ltac:(done).
iDestruct (na_bij_access with "Hinv Hbij") as (cols ? Hwf) "(Hcols&Halloc&Hclose)".
iDestruct (ghost_map.ghost_map_lookup with "Hcols Hcol") as %Hcols. rewrite lookup_map_seq_0 in Hcols.
move: (Hcols) => /(lookup_lt_Some _ _ _) ?.
set (cols' := <[π := (<[Loc b_s o := (Loc b_t o, NaExcl)]>col)]> cols).
efeed pose proof na_locs_wf_combined_state_store as Hcom; [done|done | |done|done| |]. 2: {
move => ??. apply: safe_reach_mono; [done|]. move => ???. apply: post_in_ectx_mono; [done|]. naive_solver.
} { done. }
rewrite Hcol /= in Hcom.
iMod (alloc_rel_remove_frac (λ _, alloc_rel_pred cols') with "Halloc Hσ_s") as (v_t) "(H1&H2&H3&H4&H5)".
{ done. }
{ rewrite /alloc_rel_pred => q. by erewrite Hcom. }
{ by rewrite /alloc_rel_pred combine_na_locs_list_insert //= Hcom. }
{ move => q o' ? /=. rewrite /alloc_rel_pred combine_na_locs_list_partial_alter_ne // => -[?]. done. }
{ done. }
{ done. }
iMod (ghost_map.ghost_map_update with "Hcols Hcol") as "[Hcols Hcol]". rewrite insert_map_seq_0 //.
iModIntro. iFrame. iSplitR "H1 H2 H3"; last iStepsS.
iApply ("Hclose" with "[] [] [] [] [$] [$]"); iPureIntro.
- by rewrite insert_length.
- apply: na_locs_wf_insert_store; [done..| by rewrite list_insert_id | ].
move => ?. apply: safe_reach_mono; [done|]. move => ???. apply: post_in_ectx_mono; [done|]. naive_solver.
- move => ???? /list_lookup_insert_Some[[?[??]]|[??]] Hl'; simplify_eq; [|naive_solver].
move: Hl' => /lookup_insert_Some[[??]|[??]]; simplify_map_eq; naive_solver.
- move => ????. rewrite /alloc_rel_pred combine_na_locs_list_partial_alter_ne // => -[??]; simplify_eq.
Qed.
Hint Extern 4 (ReshapeExprAnd _ _ _ _ _) => iSolveTC : solve_pure_add.
Lemma sim_bij_release_update ns π e_s col l_s l_t v_t v_s:
let q := if ns is NaRead q then q else 1%Qp in
col !! l_s = Some (l_t, ns)
l_t h l_s -
na_locs π col -
l_t t{#q} v_t -
l_s s{#q} v_s -
val_rel v_t v_s -
update_si_strong e_s π (na_locs π (delete l_s col)).
Proof.
iIntros (q Hl_s). rewrite /loc_rel. iIntros "#[Hbij %Hidx] Hcol Hl_t Hl_s Hv".
destruct l_s as [b_s o], l_t as [b_t o']; simplify_eq/=. rewrite /update_si_strong.
iIntros (??????) "($&$&$&Hσ_s&Hinv) [%HT %Hsafe]".
iDestruct (na_bij_access with "Hinv Hbij") as (cols ? Hwf) "(Hcols&Halloc&Hclose)".
iDestruct (ghost_map.ghost_map_lookup with "Hcols Hcol") as %Hcols. rewrite lookup_map_seq_0 in Hcols.
move: (Hcols) => /(lookup_lt_Some _ _ _) ?.
set (cols' := <[π := (delete (Loc b_s o) col)]> cols).
iMod (alloc_rel_add_frac (λ _, alloc_rel_pred cols') with "Halloc Hl_t Hl_s Hv Hσ_s") as "[? $]".
{ move => q' /=. rewrite /alloc_rel_pred (combine_na_locs_list_delete _ _ _ _ _ _ Hl_s Hcols) /=.
rewrite -/cols' /q /combine_na_locs.
repeat case_match; simplify_eq => //.
- move => <-. rewrite assoc. f_equal. apply: comm.
- by move => ->.
}
{ move => q' o' ? /=. rewrite /alloc_rel_pred combine_na_locs_list_partial_alter_ne // => -[?]. done. }
iMod (ghost_map.ghost_map_update with "Hcols Hcol") as "[Hcols Hcol]". rewrite insert_map_seq_0 //.
iModIntro. iFrame "Hcol".
iApply ("Hclose" with "[] [] [] [] [$] [$]"); iPureIntro.
- by rewrite insert_length.
- by apply: na_locs_wf_delete.
- move => ???? /list_lookup_insert_Some[[?[??]]|[??]] Hl'; simplify_eq; [|naive_solver].
move: Hl' => /lookup_delete_Some[??]; simplify_eq; naive_solver.
- move => ????. rewrite /alloc_rel_pred combine_na_locs_list_partial_alter_ne // => -[??]; simplify_eq.
Qed.
Global Instance dealloc_na_locs m1 π e :
BiAbd (TTl := [tele]) (TTr := [tele]) false (na_locs π m1) (na_locs π ) (update_si_strong e π)
([ map] l pr m1, let q := if pr.2 is NaRead q then q else 1%Qp in v1 v2, l s{#q} v1 pr.1 t{#q} v2 pr.1 h l val_rel v2 v1 )%I emp%I | 99.
Proof.
rewrite /BiAbd /=. revert m1.
apply map_ind; iStepsS.
rewrite big_sepM_insert //.
iDestruct "H2" as "[Hx0 H2]".
iDestruct "Hx0" as (v1 v2) "(Hlt & Hls & #Hlh & #Hlv)".
set (q := match x0.2 with | NaExcl => 1%Qp | NaRead q' => q' end). unseal_diaframe => /=.
iMod (sim_bij_release_update with "Hlh H1 Hls Hlt Hlv") as "H1". { rewrite lookup_insert //. by destruct x0. }
rewrite delete_insert //.
iCombine "H1 H2" as "H". rewrite x3.
iMod "H". iStepsS.
Qed.
Existing Instance load_sc_step_source.
Existing Instance load_sc_step_target.
Global Instance sim_load_sc_spec (l_t l_s : loc) col :
SimultaneousSpec (!ˢᶜ #l_t) (!ˢᶜ #l_s) empty_hyp_last (λ π Φ,
l_t h l_s na_locs π col match col !! l_s with
| None => ( v_t v_s, val_rel v_t v_s na_locs π col - Φ (of_val v_t) (of_val v_s))
| Some pr => let q := if pr.2 is NaRead q then q else 1%Qp in
v1 v2, l_s s{#q} v1 l_t t{#q} v2 pr.1 = l_t (l_s s{#q} v1 l_t t{#q} v2 na_locs π col - Φ (of_val v2) (of_val v1))
end
)%I.
Proof.
split.
- iStepsS.
destruct (col !! l_s) eqn:Hcol.
* iReIntro "H3". iStepsS.
* iApply (sim_bij_load_sc with "H1 H2"); [done| ].
iStepsS.
- iStepsS. destruct (col !! l_s); iSplit; iStepsS; iApply x2; iStepsS.
Qed.
Global Instance big_op_map_insert_hint `{!EqDecision K, !Countable K} `(m : gmap K V) k v P :
BiAbd (TTl := [tele]) (TTr := [tele]) (PROP := iPropI Σ) false empty_hyp_first (big_opM bi_sep P $ insert k v m) id
(P k v big_opM bi_sep P $ delete k m)%I emp%I.
Proof.
rewrite /BiAbd /=.
iStepS. rewrite -insert_delete_insert.
rewrite big_sepM_insert //; first iStepsS.
apply lookup_delete.
Qed.
(** For completeness: the triple shown in the paper.
(really, we usually want to prove [load_na_sc_log] below).
*)
Lemma load_na_sc_sim π (x_t x_s y_s y_t : loc) :
{{{ x_t h x_s y_t h y_s na_locs π }}}
subst "x" #x_t $ subst "y" #y_t $ load_na_sc_opt [π]
subst "x" #x_s $ subst "y" #y_s $ load_na_sc_unopt
{{{ lift_post (λ v_t v_s, v_t = v_s na_locs π ) }}}.
Proof.
iIntros "!> (#Hx & #Hy & Hcol)".
rewrite /load_na_sc_opt /load_na_sc_unopt.
simpl_subst.
iStepS.
iStepS. change (heap_mapsto sheapG_heap_source x_s (RSt 0) 1) with (λ v, x_s s v)%I.
iStepsS.
destruct (decide (y_s = x_s)) as [ -> | Hneq].
- rewrite lookup_insert.
iPoseProof (heapbij_loc_inj with "Hx Hy") as "<-".
iStepsS.
rewrite delete_empty big_opM_empty. iStepsS.
- (* don't alias *)
rewrite lookup_insert_ne // lookup_empty.
iStepsS.
rewrite delete_empty big_opM_empty. iStepsS.
Qed.
Arguments gen_val_rel {_} _ !_ !_ /.
(** The statement we really want (as described in Section 4): a [log_rel]. *)
Lemma load_na_sc_log :
log_rel load_na_sc_opt load_na_sc_unopt.
Proof.
(* closes open variables with related values *)
log_rel. iStepsS.
change (heap_mapsto sheapG_heap_source x4 (RSt 0) 1) with (λ v, x4 s v)%I.
val_discr_source "H6".
iStepsS.
val_discr_source "H7".
iStepsS.
destruct (decide (x4 = x5)) as [ -> | Hneq].
- rewrite lookup_insert.
iPoseProof (heapbij_loc_inj with "H6 H7") as "<-".
iStepsS.
rewrite delete_empty big_opM_empty. iStepsS.
- (* don't alias *)
rewrite lookup_insert_ne // lookup_empty.
iStepsS.
rewrite delete_empty big_opM_empty. iStepsS.
Qed.
(** ** Example from 3.2 (arbitrary readonly expressions *)
Definition load_na_unopt e : expr :=
"x" <- #42;;
e;;
!"x".
Definition load_na_opt e : expr :=
"x" <- #42;;
e;;
#42.
(** We currently do not have good automation when we don't know a upper bound
on the set of variables used by [e], therefore there's a bit of manual work
regarding substitution involved here.
*)
Import gen_log_rel.
Lemma load_na_log e :
gen_expr_wf readonly_wf e
log_rel (load_na_opt e) (load_na_unopt e).
Proof.
iIntros (Hwf). rewrite /log_rel. iModIntro.
iIntros (π map) "#Hsubst Hcol".
simpl.
iPoseProof (subst_map_rel_lookup _ "x" with "Hsubst") as "(%vx_t & %vx_s & %Heq & Hx')".
{ set_solver. }
rewrite !lookup_fmap. rewrite !Heq. simpl.
(* closes open variables with related values *)
sim_bind (Store _ _ _) (Store _ _ _).
iApply sim_safe_implies. iIntros "(%x_s & ->)".
iPoseProof (gen_val_rel_loc_source with "Hx'") as "(%x_t & -> & Hx)".
iApply (sim_bij_exploit_store with "Hx Hcol"); [ | done | ].
{ intros. safe_reach_fill (Store _ _ _).
eapply safe_reach_safe_implies; first apply _.
intros (? & ? & ? & ?). simplify_eq.
apply safe_reach_refl. apply post_in_ectx_intro. eauto.
}
iIntros (v_t v_s) "Hx_t Hx_s Hv Hcol".
source_store. target_store. sim_val.
sim_pures.
(* use read-only reflexivity theorem *)
sim_bind (subst_map _ _) (subst_map _ _).
iPoseProof (subst_map_rel_weaken _ _ (free_vars e) with "Hsubst") as "Hsubst'"; first set_solver.
iPoseProof (subst_map_rel_dom with "Hsubst'") as "%Hdom".
iApply (sim_refl' with "[] [Hcol Hx_t Hx_s]");
[ by rewrite !dom_fmap_L | |
apply (readonly_log_rel_structural [(x_t, x_s, #42 , #42 , 1%Qp)]) | done | | | ].
{ by rewrite dom_fmap_L. }
{ rewrite map_fmap_zip. rewrite map_zip_diag. rewrite -map_fmap_compose.
erewrite (map_fmap_ext _ id). { rewrite map_fmap_id. done. }
move => i [x y] Hl //.
}
{ rewrite /readonly_thread_own. iFrame.
unfold mapsto_list, na_locs_in_mapsto_list.
iSplit; [|iSplit; [ iSplit; done | done]].
iPureIntro. intros ???. rewrite lookup_insert_Some.
rewrite lookup_empty. intros [[<- [= <- <-]] | [_ [=]]].
exists 0. eauto.
}
iIntros (??).
rewrite /readonly_thread_own.
unfold mapsto_list. simpl.
iIntros "(_ & Hcol & (Hx_t & Hx_s & _ & _) & _) _".
iApply lift_post_val.
sim_pures. source_load.
iApply (sim_bij_release NaExcl with "Hx Hcol Hx_t Hx_s []"); [ | done | ].
{ apply lookup_insert. }
rewrite delete_insert; last done. iIntros "Hcol".
sim_val. by iFrame.
Qed.
(** ** Optimization from the intro and 3.3 *)
(** (In file [theories/simulang/na_inv/examples/data_races.v], there is a version of this
where the memory is actually freed in the end)
*)
Definition hoist_load_both_unopt : expr :=
let: "i" := ref #0 in
let: "r" := ref (!"y") in
while: !"i" ! "x" do
"i" <- !"i" + #1;;
"r" <- !"r" + !"y"
od;;
!"r".
Definition hoist_load_both_opt : expr :=
let: "n" := !"x" in
let: "m" := !"y" in
let: "i" := ref #0 in
let: "r" := ref "m" in
while: !"i" "n" do
"i" <- !"i" + #1;;
"r" <- !"r" + "m"
od;;
!"r".
Lemma int_is_unboxed (z : Z) : val_is_unboxed #z.
Proof. done. Qed.
(** We directly prove a [log_rel], as that is the statement we really want. *)
Lemma hoist_load_both_log:
log_rel hoist_load_both_opt hoist_load_both_unopt.
Proof.
log_rel.
iIntros "%x_t1 %x_s1 #Hrel_x %y_t1 %y_s1 #Hrel_y !# %π Hc".
source_alloc li_s as "Hli_s" "_". sim_pures.
source_bind (Load _ _). iApply source_red_safe_implies. iIntros ([lx_s ?]); simplify_eq.
iDestruct (gen_val_rel_loc_source with "Hrel_x") as (lx_t ->) "Hbij_x".
iApply source_red_base. iModIntro. to_sim.
iApply (sim_bij_exploit_load with "Hbij_x Hc"); [|done|]. {
intros.
safe_reach_fill (! _)%E => /=.
apply: safe_reach_safe_implies => ?.
apply: safe_reach_refl. apply: post_in_ectx_intro. naive_solver.
}
iIntros (qx vx_t vx_s) "Hx_t Hx_s #Hvx Hc".
source_load.
source_alloc lr_s as "Hlr_s" "_". sim_pures.
destruct (if y_s1 is #(LitLoc _) then true else false) eqn:Heq. 2: {
source_while.
source_bind (! _)%E. iApply source_red_safe_implies.
iIntros ([l_s ?]); simplify_eq.
}
destruct y_s1 as [[| | | |ly_s |]| | |] => //.
iDestruct (gen_val_rel_loc_source with "Hrel_y") as (ly_t ->) "Hbij_y".
(* hint for the [sim_pure] automation to reduce the comparison *)
specialize int_is_unboxed as Hunb.
(* case analysis: do [x] and [y] alias? *)
destruct (decide (ly_s = lx_s)) as [-> | Hneq].
- (* they do alias, so we do not need to exploit a second time. *)
rename lx_s into l_s.
iPoseProof (heapbij_loc_inj with "Hbij_x Hbij_y") as "->".
rename ly_t into l_t.
(* we now have ownership of all relevant locations and can continue *)
target_load. target_load. target_alloc li_t as "Hli_t" "_".
target_alloc lr_t as "Hlr_t" "_".
sim_pures.
set inv := (
(z_i : Z) (vr_t vr_s : val),
l_t t{#qx} vx_t
l_s s{#qx} vx_s
li_s s #z_i
li_t t #z_i
lr_t t vr_t
lr_s s vr_s
val_rel vr_t vr_s
na_locs π (<[l_s:=(l_t, NaRead qx)]> ))%I.
sim_bind (While _ _) (While _ _).
iApply (sim_while_while inv with "[Hli_s Hx_t Hx_s Hc Hlr_s Hli_t Hlr_t] []").
{ iExists 0, vx_t, vx_s. iFrame. done. }
iModIntro. iIntros "(%z_i & %vr_t & %vr_s & Hx_t & Hx_s & Hli_s & Hli_t & Hlr_t & Hlr_s & #Hvr & Hc)".
source_load. source_load. target_load. to_sim.
sim_pures.
destruct (bool_decide (#z_i = vx_s)) eqn:Heq_vx_s.
+ (* compare equal in the source; leave the loop *)
apply bool_decide_eq_true_1 in Heq_vx_s. subst vx_s.
val_discr_source "Hvx".
rewrite bool_decide_eq_true_2; last done.
sim_pures. iApply sim_expr_base. iLeft. iApply lift_post_val.
sim_pures. source_load. target_load. sim_pures.
(* cleanup *)
iApply (sim_bij_release (NaRead qx) with "Hbij_x Hc Hx_t Hx_s [//]").
{ apply lookup_insert. }
rewrite delete_insert; last done. iIntros "Hc".
sim_val. eauto.
+ (* compare unequal and take another trip around the loop *)
apply bool_decide_eq_false_1 in Heq_vx_s.
destruct (bool_decide (#z_i = vx_t)) eqn:Heq_vx_t.
{ (* contradiction *)
apply bool_decide_eq_true_1 in Heq_vx_t. subst vx_t.
val_discr_target "Hvx". done.
}
sim_pures.
source_load. source_store.
source_load. source_load.
(* gain knowledge that both are ints *)
source_bind (BinOp _ _ _). iApply source_red_safe_implies.
iIntros "[(%z_r & ->) (%z_s & ->)]".
val_discr_source "Hvx". val_discr_source "Hvr". source_pures.
source_store.
target_load. target_store.
target_load. target_store.
sim_pures. iApply sim_expr_base. iRight.
iSplitR; first done. iSplitR; first done.
iExists (z_i + 1)%Z, #(z_r + z_s)%Z, #(z_r + z_s)%Z.
iFrame. done.
- (* the locations do not alias, so we also need to exploit "y" *)
(* the proof of this case is very similar to the one above, except that we carry around
the additional locations in the invariant and have to release both in the end. *)
iApply (sim_bij_exploit_load with "Hbij_y Hc"); [| |]. {
intros.
safe_reach_fill (While _ _)%E => /=.
apply: safe_reach_pure; [eapply pure_while | done | ].
safe_reach_fill (Load _ _)%E.
apply: safe_reach_safe_implies => ?.
apply: safe_reach_refl. apply: post_in_ectx_intro. naive_solver.
}
{ rewrite lookup_insert_ne; last done. apply lookup_empty. }
iIntros (qy vy_t vy_s) "Hy_t Hy_s #Hvy Hc".
target_load. target_load.
target_alloc li_t as "Hli_t" "_".
target_alloc lr_t as "Hlr_t" "_".
sim_pures.
set inv := (
(z_i : Z) (vr_t vr_s : val),
lx_t t{#qx} vx_t
lx_s s{#qx} vx_s
ly_t t{#qy} vy_t
ly_s s{#qy} vy_s
li_s s #z_i
li_t t #z_i
lr_t t vr_t
lr_s s vr_s
val_rel vr_t vr_s
na_locs π (<[ly_s:=(ly_t, NaRead qy)]> $ <[lx_s:=(lx_t, NaRead qx)]> ))%I.
sim_bind (While _ _) (While _ _).
iApply (sim_while_while inv with "[Hy_t Hy_s Hli_s Hx_t Hx_s Hc Hlr_s Hli_t Hlr_t] []").
{ iExists 0, vx_t, vx_s. iFrame. done. }
iModIntro. iIntros "(%z_i & %vr_t & %vr_s & Hx_t & Hx_s & Hy_t & Hy_s & Hli_s & Hli_t & Hlr_t & Hlr_s & #Hvr & Hc)".
source_load. source_load. target_load. sim_pures.
destruct (bool_decide (#z_i = vy_s)) eqn:Heq_vy_s.
+ (* compare equal in the source; leave the loop *)
apply bool_decide_eq_true_1 in Heq_vy_s. subst vy_s.
val_discr_source "Hvy".
rewrite bool_decide_eq_true_2; last done.
sim_pures. iApply sim_expr_base. iLeft. iApply lift_post_val.
sim_pures. source_load. target_load. sim_pures.
(* cleanup *)
iApply (sim_bij_release (NaRead qy) with "Hbij_y Hc Hy_t Hy_s [//]").
{ apply lookup_insert. }
rewrite delete_insert; last by rewrite lookup_insert_ne.
iIntros "Hc".
iApply (sim_bij_release (NaRead qx) with "Hbij_x Hc Hx_t Hx_s [//]").
{ apply lookup_insert. }
rewrite delete_insert; last done. iIntros "Hc".
sim_val. eauto.
+ (* compare unequal and take another trip around the loop *)
apply bool_decide_eq_false_1 in Heq_vy_s.
destruct (bool_decide (#z_i = vy_t)) eqn:Heq_vy_t.
{ (* contradiction *)
apply bool_decide_eq_true_1 in Heq_vy_t. subst vy_t.
val_discr_target "Hvy". done.
}
sim_pures.
source_load. source_store.
source_load. source_load.
(* gain knowledge that both are ints *)
source_bind (BinOp _ _ _). iApply source_red_safe_implies.
iIntros "[(%z_r & ->) (%z_s & ->)]".
val_discr_source "Hvx". val_discr_source "Hvr". source_pures.
source_store.
target_load. target_store.
target_load. target_store.
sim_pures. iApply sim_expr_base. iRight.
iSplitR; first done. iSplitR; first done.
iExists (z_i + 1)%Z, #(z_r + z_s)%Z, #(z_r + z_s)%Z.
iFrame. done.
Qed.
End data_race.
(* Deriving contextual refinements *)
Section closed.
Lemma load_na_sc_ctx :
ctx_ref load_na_sc_opt load_na_sc_unopt.
Proof.
intros ??.
set Σ := #[naΣ].
apply (log_rel_adequacy Σ)=>?.
by apply load_na_sc_log.
Qed.
Lemma load_na_ctx e :
gen_expr_wf readonly_wf e
ctx_ref (load_na_opt e) (load_na_unopt e).
Proof.
intros ??.
set Σ := #[naΣ].
apply (log_rel_adequacy Σ)=>?.
by apply load_na_log.
Qed.
Lemma hoist_load_both_ctx :
ctx_ref hoist_load_both_opt hoist_load_both_unopt.
Proof.