Skip to content

GitLab

R
ReLoC-v1
Commit dcf43df0 authored by Dan Frumin's avatar Dan Frumin
Browse files
Options

Modify the relational interpretation to account for masks/invariants

parent 8fad37e8
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 1479 additions and 742 deletions
F_mu_ref_conc/examples/counter.v
View file @ dcf43df0
From iris.proofmode Require Import tactics.
From iris.algebra Require Import auth.
From iris_logrel.F_mu_ref_conc Require Export examples.lock.
From iris_logrel.F_mu_ref_conc Require Import tactics soundness_binary.
From iris_logrel.F_mu_ref_conc Require Import tactics soundness_binary relational_properties.
From iris.program_logic Require Import adequacy.
Definition CG_increment (x : expr) : expr :=
......@@ -123,6 +123,24 @@ Section CG_Counter.
Unshelve. all: trivial.
Qed.
Lemma bin_log_related_CG_locked_increment Γ K E1 E2 t τ x n l :
nclose specN ⊆ E1 →
(x ↦ₛ (#nv n) -∗ l ↦ₛ (#♭v false) -∗
(x ↦ₛ (#nv S n) -∗ l ↦ₛ (#♭v false) -∗
({E1,E2;Γ} ⊨ t ≤log≤ fill K Unit : τ)) -∗
{E1,E2;Γ} ⊨ t ≤log≤ fill K (App (CG_locked_increment (Loc x) (Loc l)) Unit) : τ)%I.
Proof.
iIntros (?) "Hx Hl Hlog".
unfold CG_locked_increment.
change Unit with (of_val UnitV).
iApply (bin_log_related_with_lock_r Γ K E1 E2 (x ↦ₛ (#nv n))%I (x ↦ₛ (#nv S n)) (CG_increment (Loc x)) UnitV UnitV l t τ with "[Hx] [Hl] [Hlog]"); auto.
- iIntros (ρ j K') "#Hspec Hx Hj /=".
tp_apply j steps_CG_increment with "Hx" as "Hx". iModIntro.
iFrame.
- iIntros "Hl Hx". iApply ("Hlog" with "Hx Hl").
Qed.
Global Opaque CG_locked_increment.
Lemma counter_read_to_val x : to_val (counter_read x) = Some (counter_readV x).
......@@ -242,103 +260,236 @@ Section CG_Counter.
Definition counterN : namespace := nroot .@ "counter".
(* TODO: those should be accompaied by lemmas; preferably so that
[change] does not change too much *)
Ltac rel_bind_l efoc :=
lazymatch goal with
| [ |- (_ ⊢ bin_log_related _ _ _ ?e _ _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e'))
end.
Ltac rel_bind_r efoc :=
lazymatch goal with
| [ |- (_ ⊢ bin_log_related _ _ _ _ ?e _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e'))
end.
Lemma bin_log_related_arrow Γ (e e' : expr) τ τ'
(Hclosed : ∀ f, e.[upn 2 f] = e)
(Hclosed' : ∀ f, e'.[upn 2 f] = e') :
□(∀ Δ vv, ⟦ τ ⟧ Δ vv -∗
[] ⊨ App (Rec e) (of_val (vv.1)) ≤log≤ App (Rec e') (of_val (vv.2)) : τ') -∗
Γ ⊨ (Rec e) ≤log≤ (Rec e') : TArrow τ τ'.
Proof.
iIntros "#H".
iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
iModIntro. iApply wp_value; auto.
iModIntro. iExists (RecV e').
rewrite Hclosed Hclosed'. simpl.
iFrame "Hj". iAlways. iIntros (vv) "Hvv".
iSpecialize ("H" $! Δ vv with "Hvv").
iSpecialize ("H" $! Δ with "* Hs []").
{ iAlways. iApply interp_env_nil. }
rewrite ?fmap_nil. rewrite ?empty_env_subst.
done.
Qed.
Lemma FG_CG_counter_refinement :
[] ⊨ FG_counter ≤log≤ CG_counter : TProd (TArrow TUnit TUnit) (TArrow TUnit TNat).
Proof.
iIntros (Δ [|??] ρ) "#Hspec #HΓ"; iIntros (j K) "Hj"; last first.
{ iDestruct (interp_env_length with "HΓ") as %[=]. }
iClear "HΓ". cbn -[FG_counter CG_counter].
rewrite ?empty_env_subst /CG_counter /FG_counter.
iApply fupd_wp.
tp_bind j newlock.
tp_apply j steps_newlock.
iDestruct "Hj" as (l) "[Hj Hl]".
tp_rec j.
asimpl. rewrite CG_locked_increment_subst /=.
unfold FG_counter, CG_counter.
iApply (bin_log_related_alloc_l [] _ _ [AppRCtx (RecV (FG_counter_body (Var 1)))]); auto; simpl. iModIntro.
iIntros (cnt) "Hcnt".
rel_bind_r newlock.
iApply (bin_log_related_newlock_r); auto; simpl.
iIntros (l) "Hl".
iApply (bin_log_related_rec_r [] []); auto. asimpl.
rewrite CG_locked_increment_subst /=.
rewrite counter_read_subst /=.
tp_alloc j as cnt' "Hcnt'". tp_normalise j.
tp_rec j. tp_normalise j.
asimpl. rewrite CG_locked_increment_subst /=.
rewrite counter_read_subst /=.
iModIntro. wp_bind (Alloc _).
iApply wp_alloc; eauto. iNext.
iIntros (cnt) "Hcnt /=".
rel_bind_r (Alloc (#n 0)).
iApply (bin_log_related_alloc_r); auto.
iIntros (cnt') "Hcnt' /=".
(* establishing the invariant *)
iAssert ((∃ n, l ↦ₛ (#♭v false) ∗ cnt ↦ᵢ (#nv n) ∗ cnt' ↦ₛ (#nv n) )%I)
with "[Hl Hcnt Hcnt']" as "Hinv".
{ iExists _. by iFrame. }
iApply fupd_wp.
iMod (inv_alloc counterN with "[Hinv]") as "#Hinv"; trivial.
{ iNext; iExact "Hinv". }
(* splitting increment and read *)
iApply wp_rec; trivial. iNext. asimpl.
iApply (bin_log_related_rec_l [] []); auto.
iNext. asimpl.
rewrite counter_read_subst /=.
iApply wp_value; simpl.
{ by rewrite counter_read_to_val. }
iExists (PairV (CG_locked_incrementV _ _) (counter_readV _)); simpl.
rewrite CG_locked_increment_of_val counter_read_of_val.
iFrame "Hj".
iExists (_, _), (_, _); simpl; repeat iSplit; trivial.
- (* refinement of increment *)
iAlways. clear j K. iIntros (v) "#Heq". iIntros (j K) "Hj".
rewrite CG_locked_increment_of_val /=.
destruct v; iDestruct "Heq" as "[% %]"; simplify_eq/=.
iLöb as "Hlat".
iApply wp_rec; trivial. asimpl. iNext.
(* fine-grained reads the counter *)
wp_bind (Load _).
iApply wp_atomic; eauto.
iInv counterN as (n) ">[Hl [Hcnt Hcnt']]" "Hclose".
iApply (wp_load with "[Hcnt]"); [iNext; by iFrame|].
iNext. iIntros "Hcnt".
iMod ("Hclose" with "[Hl Hcnt Hcnt']").
{ iNext. iExists _. iFrame "Hl Hcnt Hcnt'". }
iApply wp_rec; trivial. asimpl. iNext.
(* fine-grained performs increment *)
wp_bind (BinOp Add _ _).
iApply wp_nat_binop; simpl.
iNext. iModIntro.
wp_bind (CAS _ _ _).
iApply wp_atomic; eauto.
iInv counterN as (n') ">[Hl [Hcnt Hcnt']]" "Hclose".
(* performing CAS *)
destruct (decide (n = n')) as [|Hneq]; subst.
+ (* CAS succeeds *)
(* In this case, we perform increment in the coarse-grained one *)
tp_apply j steps_CG_locked_increment with "Hcnt' Hl"
as "[Hcnt' Hl]".
iApply (wp_cas_suc with "[Hcnt]"); auto.
iNext. iIntros "Hcnt".
iMod ("Hclose" with "[Hl Hcnt Hcnt']").
{ iNext. iExists _. iFrame "Hl Hcnt Hcnt'"; trivial. }
simpl.
iApply wp_if_true. iNext. iApply wp_value; trivial.
iExists UnitV; iFrame; auto.
+ (* CAS fails *)
(* In this case, we perform a recursive call *)
iApply (wp_cas_fail _ _ _ (#nv n') with "[Hcnt]"); auto;
[inversion 1; subst; auto | ].
iNext. iIntros "Hcnt".
iMod ("Hclose" with "[Hl Hcnt Hcnt']").
{ iNext. iExists _; iFrame "Hl Hcnt Hcnt'". }
iApply wp_if_false. iNext. by iApply "Hlat".
- (* refinement of read *)
iAlways. clear j K. iIntros (v) "#Heq". iIntros (j K) "Hj".
rewrite ?counter_read_of_val.
iDestruct "Heq" as "[% %]"; destruct v; simplify_eq/=.
Transparent counter_read.
unfold counter_read at 2.
iApply wp_rec; trivial. simpl.
iNext.
iApply wp_atomic; eauto.
iInv counterN as (n) ">[Hl [Hcnt Hcnt']]" "Hclose".
tp_apply j steps_counter_read with "Hcnt'" as "Hcnt'".
iApply (wp_load with "[Hcnt]"); eauto.
iNext. iIntros "Hcnt".
iApply (bin_log_related_rec_r [] []); auto. simpl.
rewrite CG_locked_increment_subst /=.
rewrite counter_read_subst /=.
iApply (bin_log_related_pair [] with "[]"); last first.
- Transparent counter_read.
unfold counter_read.
iApply (bin_log_related_rec); auto. iAlways. asimpl.
rel_bind_l (Load (Loc cnt)).
iApply (bin_log_related_load_l).
iInv counterN as (n) "[>Hl [Hcnt >Hcnt']]" "Hclose".
iModIntro.
iExists (#nv n). iFrame "Hcnt". iSplit; eauto.
iIntros "Hcnt". simpl.
iApply (bin_log_related_load_r _ [] with "[Hcnt']"); auto.
{ solve_ndisj. } { by compute. }
iIntros "Hcnt'".
iApply fupd_logrel.
iMod ("Hclose" with "[Hl Hcnt Hcnt']").
{ iNext. iExists _; iFrame "Hl Hcnt Hcnt'". }
iExists (#nv _); eauto.
{ iNext. iExists _. by iFrame. }
simpl. iModIntro.
iPoseProof (bin_log_related_nat [TArrow TUnit TNat; TUnit] ⊤ n) as "H". iFrame "H". (* TODO: iApply does not work in this case *)
- Transparent CG_locked_increment.
unfold CG_locked_increment.
Transparent with_lock.
unfold with_lock.
iApply (bin_log_related_arrow); auto.
iAlways. iIntros (Δ [v v']) "[% %]"; simpl in *; subst. clear Δ.
(* fold this stuff back *)
change (Rec
(App
(Rec
(App (Rec (App (Rec (Var 3)) (App release (Loc l))))
(App (CG_increment (Loc cnt')).[ren (+4)] (Var 3))))
(App acquire (Loc l))))
with (CG_locked_increment (Loc cnt') (Loc l)).
iLöb as "Hlat".
iApply (bin_log_related_rec_l _ []); auto. iNext. asimpl.
rel_bind_l (Load (Loc cnt)).
iApply (bin_log_related_load_l).
iInv counterN as (n) "[>Hl [Hcnt >Hcnt']]" "Hclose". iModIntro.
iExists (#nv n). iSplit; eauto. iFrame "Hcnt".
iIntros "Hcnt". simpl.
iApply fupd_logrel.
iMod ("Hclose" with "[Hl Hcnt Hcnt']").
{ iNext. iExists _. iFrame "Hl Hcnt Hcnt'". }
iApply (bin_log_related_rec_l _ []); auto. iNext. asimpl.
rel_bind_l (BinOp Add (#n 1) (#n n)).
iApply (bin_log_related_binop_l). iNext. simpl.
rel_bind_l (CAS (Loc cnt) (#n n) (#n (S n))).
iApply (bin_log_related_cas_l); auto.
iInv counterN as (m) "[>Hl [Hcnt >Hcnt']]" "Hclose".
iModIntro.
iExists (#nv m). iFrame "Hcnt".
destruct (decide (n = m)).
+ (* CAS succeeds *) subst. iSplitR; eauto.
{ iDestruct 1 as %Hfoo. by exfalso. }
iIntros "_ Hcnt". simpl.
iApply (bin_log_related_CG_locked_increment _ [] with "Hcnt' Hl");
auto. solve_ndisj.
iIntros "Hcnt' Hl".
iApply fupd_logrel.
iMod ("Hclose" with "[Hl Hcnt Hcnt']").
{ iNext. iExists (S m). iFrame. }
iApply (bin_log_related_if_true_l _ []); auto.
iNext. simpl. iPoseProof (bin_log_related_unit [] ⊤) as "H".
iExact "H". (* TODO iApply does not work *)
+ (* CAS fails *)
iSplitL; eauto; last first.
{ iDestruct 1 as %Hfoo. injection Hfoo. intro. by exfalso. }
iIntros "_ Hcnt". simpl.
iApply fupd_logrel.
iMod ("Hclose" with "[Hl Hcnt Hcnt']").
{ iNext. iExists m. iFrame. }
iApply (bin_log_related_if_false_l [] []); auto.
Qed.
(* iIntros (Δ [|??] ρ) "#Hspec #HΓ"; iIntros (j K) "Hj"; last first. *)
(* { iDestruct (interp_env_length with "HΓ") as %[=]. } *)
(* iClear "HΓ". cbn -[FG_counter CG_counter]. *)
(* rewrite ?empty_env_subst /CG_counter /FG_counter. *)
(* iApply fupd_wp. *)
(* tp_bind j newlock. *)
(* tp_apply j steps_newlock. *)
(* iDestruct "Hj" as (l) "[Hj Hl]". *)
(* tp_rec j. *)
(* asimpl. rewrite CG_locked_increment_subst /=. *)
(* rewrite counter_read_subst /=. *)
(* tp_alloc j as cnt' "Hcnt'". tp_normalise j. *)
(* tp_rec j. tp_normalise j. *)
(* asimpl. rewrite CG_locked_increment_subst /=. *)
(* rewrite counter_read_subst /=. *)
(* iModIntro. wp_bind (Alloc _). *)
(* iApply wp_alloc; eauto. iNext. *)
(* iIntros (cnt) "Hcnt /=". *)
(* (* establishing the invariant *) *)
(* iAssert ((∃ n, l ↦ₛ (#♭v false) ∗ cnt ↦ᵢ (#nv n) ∗ cnt' ↦ₛ (#nv n) )%I) *)
(* with "[Hl Hcnt Hcnt']" as "Hinv". *)
(* { iExists _. by iFrame. } *)
(* iApply fupd_wp. *)
(* iMod (inv_alloc counterN with "[Hinv]") as "#Hinv"; trivial. *)
(* { iNext; iExact "Hinv". } *)
(* (* splitting increment and read *) *)
(* iApply wp_rec; trivial. iNext. asimpl. *)
(* rewrite counter_read_subst /=. *)
(* iApply wp_value; simpl. *)
(* { by rewrite counter_read_to_val. } *)
(* iExists (PairV (CG_locked_incrementV _ _) (counter_readV _)); simpl. *)
(* rewrite CG_locked_increment_of_val counter_read_of_val. *)
(* iFrame "Hj". *)
(* iExists (_, _), (_, _); simpl; repeat iSplit; trivial. *)
(* - (* refinement of increment *) *)
(* iAlways. clear j K. iIntros (v) "#Heq". iIntros (j K) "Hj". *)
(* rewrite CG_locked_increment_of_val /=. *)
(* destruct v; iDestruct "Heq" as "[% %]"; simplify_eq/=. *)
(* iLöb as "Hlat". *)
(* iApply wp_rec; trivial. asimpl. iNext. *)
(* (* fine-grained reads the counter *) *)
(* wp_bind (Load _). *)
(* iApply wp_atomic; eauto. *)
(* iInv counterN as (n) ">[Hl [Hcnt Hcnt']]" "Hclose". *)
(* iApply (wp_load with "[Hcnt]"); [iNext; by iFrame|]. *)
(* iNext. iIntros "Hcnt". *)
(* iMod ("Hclose" with "[Hl Hcnt Hcnt']"). *)
(* { iNext. iExists _. iFrame "Hl Hcnt Hcnt'". } *)
(* iApply wp_rec; trivial. asimpl. iNext. *)
(* (* fine-grained performs increment *) *)
(* wp_bind (BinOp Add _ _). *)
(* iApply wp_nat_binop; simpl. *)
(* iNext. iModIntro. *)
(* wp_bind (CAS _ _ _). *)
(* iApply wp_atomic; eauto. *)
(* iInv counterN as (n') ">[Hl [Hcnt Hcnt']]" "Hclose". *)
(* (* performing CAS *) *)
(* destruct (decide (n = n')) as [|Hneq]; subst. *)
(* + (* CAS succeeds *) *)
(* (* In this case, we perform increment in the coarse-grained one *) *)
(* tp_apply j steps_CG_locked_increment with "Hcnt' Hl" *)
(* as "[Hcnt' Hl]". *)
(* iApply (wp_cas_suc with "[Hcnt]"); auto. *)
(* iNext. iIntros "Hcnt". *)
(* iMod ("Hclose" with "[Hl Hcnt Hcnt']"). *)
(* { iNext. iExists _. iFrame "Hl Hcnt Hcnt'"; trivial. } *)
(* simpl. *)
(* iApply wp_if_true. iNext. iApply wp_value; trivial. *)
(* iExists UnitV; iFrame; auto. *)
(* + (* CAS fails *) *)
(* (* In this case, we perform a recursive call *) *)
(* iApply (wp_cas_fail _ _ _ (#nv n') with "[Hcnt]"); auto; *)
(* [inversion 1; subst; auto | ]. *)
(* iNext. iIntros "Hcnt". *)
(* iMod ("Hclose" with "[Hl Hcnt Hcnt']"). *)
(* { iNext. iExists _; iFrame "Hl Hcnt Hcnt'". } *)
(* iApply wp_if_false. iNext. by iApply "Hlat". *)
(* - (* refinement of read *) *)
(* iAlways. clear j K. iIntros (v) "#Heq". iIntros (j K) "Hj". *)
(* rewrite ?counter_read_of_val. *)
(* iDestruct "Heq" as "[% %]"; destruct v; simplify_eq/=. *)
(* Transparent counter_read. *)
(* unfold counter_read at 2. *)
(* iApply wp_rec; trivial. simpl. *)
(* iNext. *)
(* iApply wp_atomic; eauto. *)
(* iInv counterN as (n) ">[Hl [Hcnt Hcnt']]" "Hclose". *)
(* tp_apply j steps_counter_read with "Hcnt'" as "Hcnt'". *)
(* iApply (wp_load with "[Hcnt]"); eauto. *)
(* iNext. iIntros "Hcnt". *)
(* iMod ("Hclose" with "[Hl Hcnt Hcnt']"). *)
(* { iNext. iExists _; iFrame "Hl Hcnt Hcnt'". } *)
(* iExists (#nv _); eauto. *)
End CG_Counter.
Theorem counter_ctx_refinement :
......
F_mu_ref_conc/examples/lock.v
View file @ dcf43df0
From iris.proofmode Require Import tactics.
From iris_logrel.F_mu_ref_conc Require Import tactics.
From iris_logrel.F_mu_ref_conc Require Export rules_binary typing fundamental_binary.
From iris_logrel.F_mu_ref_conc Require Export rules_binary typing fundamental_binary relational_properties.
From iris.base_logic Require Import namespaces.
(** [newlock = alloc false] *)
......@@ -206,18 +206,19 @@ Section proof.
by iFrame.
Qed.
Lemma bin_log_related_with_lock_r Γ K P Q e v w l t τ :
Lemma bin_log_related_with_lock_r Γ K E1 E2 P Q e v w l t τ :
(nclose specN ⊆ E1) →
(∀ f, e.[f] = e) (* e is a closed term *) →
(∀ f, (of_val v).[f] = of_val v) (* v is a closed term *) →
(∀ f, (of_val w).[f] = of_val w) (* w is a closed term *) →
(∀ ρ j K', spec_ctx ρ -∗ P -∗ j ⤇ fill K' (App e (of_val w))
={⊤}=∗ j ⤇ fill K' (of_val v) ∗ Q) →
={E1}=∗ j ⤇ fill K' (of_val v) ∗ Q) →
P -∗
l ↦ₛ (#♭v false) -∗
(l ↦ₛ (#♭v false) -∗ Q -∗ Γ ⊨ t ≤log≤ fill K (of_val v) : τ)%I
-∗ Γ ⊨ t ≤log≤ fill K (App (with_lock e (Loc l)) (of_val w)) : τ.
(l ↦ₛ (#♭v false) -∗ Q -∗ {E1,E2;Γ} ⊨ t ≤log≤ fill K (of_val v) : τ)%I
-∗ {E1,E2;Γ} ⊨ t ≤log≤ fill K (App (with_lock e (Loc l)) (of_val w)) : τ.
Proof.
iIntros (????) "HP Hl Hlog".
iIntros (?????) "HP Hl Hlog".
pose (Φ := (fun (w: val) => ⌜w = v⌝ ∗ Q ∗ l ↦ₛ (#♭v false))%I).
iApply (bin_log_related_step_r Φ with "[HP Hl]").
{ intros.
......
F_mu_ref_conc/examples/stack/refinement.v
View file @ dcf43df0
......@@ -92,8 +92,9 @@ Section Stack_refinement.
tp_bind j (App (of_val f2) _).
iSpecialize ("Hff" $! (y1, y2) with "[Hy]"); first by iFrame.
iSpecialize ("Hff" $! j (K ++ _) with "Hj"). simpl.
iApply fupd_wp. iMod "Hff". iModIntro.
iApply (wp_wand with "Hff").
iIntros (v). iDestruct 1 as (v2) "[Hj [% %]]".
iIntros (v). iMod 1 as (v2) "[Hj [% %]]".
tp_normalise j. asimpl.
iApply fupd_wp. tp_rec j; auto using to_of_val.
asimpl.
......@@ -161,7 +162,8 @@ Section Stack_refinement.
congruence. iNext. iIntros "Hst".
close_sinv "Hclose" "[HLK Hst Hoe Hl Hst' Histk']".
iApply wp_if_false. iNext.
iApply "IH". iFrame.
iMod ("IH" with "Hj") as "IH'".
iApply "IH'".
Qed.
Lemma FG_CG_pop_refinement ρ st st' (τi : D) l Δ {τP : ∀ ww, PersistentP (τi ww)} {SH : stackG Σ}:
......@@ -198,7 +200,7 @@ Section Stack_refinement.
iApply wp_case_inl; auto. iNext.
iApply wp_value; auto.
iExists (InjLV ())%V. iFrame "Hj".
iLeft. iExists (_,_). iSplit; auto.
iLeft. iExists (_,_). iModIntro. iSplit; auto.
+ close_sinv "Hclose" "[Hoe Hst' Hst Hl]".
wp_bind (Unfold _). iApply wp_fold; first auto. iNext.
iApply wp_rec; first auto. iNext. asimpl.
......@@ -250,14 +252,14 @@ Section Stack_refinement.
iModIntro.
iApply wp_value; try by rewrite /= ?to_of_val /=.
iExists (InjRV zn1). iFrame "Hj".
iRight. iExists (_,_). simpl. iSplit; auto.
iRight. iExists (_,_). simpl. iModIntro. iSplit; auto.
* (* CAS fails *)
iApply (wp_cas_fail with "Hst"); try by (rewrite /= ?to_of_val /=).
congruence.
iNext. iIntros "Hst".
close_sinv "Hclose" "[-Hj]".
iApply wp_if_false. iNext.
by iApply "IH".
by iMod ("IH" with "Hj").
Qed.
(* ∀ α. (α → Unit) * (Unit → Unit + α) * ((α → Unit) → Unit) *)
......@@ -278,7 +280,7 @@ Section Stack_refinement.
(TArrow (TVar 0) TUnit)
(TArrow TUnit (TSum TUnit (TVar 0))))
(TArrow (TArrow (TVar 0) TUnit) TUnit))).
clear j K. iAlways. iIntros (τi) "%".
clear j K. iModIntro. iAlways. iIntros (τi) "%".
iIntros (j K) "Hj /=".
iApply fupd_wp.
tp_tlam j.
......@@ -324,7 +326,7 @@ Section Stack_refinement.
iApply wp_value; first by eauto.
iExists (PairV (PairV (CG_locked_pushV _ _) (CG_locked_popV _ _)) (RecV _)).
simpl. rewrite CG_locked_push_of_val CG_locked_pop_of_val. iFrame "Hj".
iExists (_, _), (_, _); iSplit; eauto.
iExists (_, _), (_, _); iModIntro; iSplit; eauto.
iSplit.
(* refinement of push and pop *)
- iExists (_, _), (_, _); iSplit; eauto. iSplit.
......@@ -332,7 +334,7 @@ Section Stack_refinement.
(* TODO: fold (interp (...)) does not work here *)
change (□ (∀ vv : prodC valC valC,
□ τi vv
→ interp_expr interp_unit (τi :: Δ)
→ interp_expr ⊤ ⊤ interp_unit (τi :: Δ)
((rec: (rec: if: CAS #stk (Var 1)
(Fold (ref InjR (Var 3, Var 1)))
then () else (Var 2) (Var 3))
......
F_mu_ref_conc/fundamental_binary.v
View file @ dcf43df0
This diff is collapsed.
F_mu_ref_conc/logrel_binary.v
View file @ dcf43df0
......@@ -32,13 +32,13 @@ Section logrel.
Implicit Types Δ : listC D.
Implicit Types interp : listC D → D.
Definition interp_expr (τi : listC D -n> D) (Δ : listC D)
Definition interp_expr (E1 E2 : coPset) (τi : listC D -n> D) (Δ : listC D)
(ee : expr * expr) : iProp Σ := (∀ j K,
j ⤇ fill K (ee.2) -∗
WP ee.1 {{ v, ∃ v', j ⤇ fill K (of_val v') ∗ τi Δ (v, v') }})%I.
Global Instance interp_expr_ne n :
Proper (dist n ==> dist n ==> (=) ==> dist n) interp_expr.
Proof. solve_proper. Qed.
|={E1,E2}=> WP ee.1 @ E2 {{ v, |={E2}=> ∃ v', j ⤇ fill K (of_val v') ∗ τi Δ (v, v') }})%I.
Global Instance interp_expr_ne n E1 E2:
Proper (dist n ==> dist n ==> (=) ==> dist n) (interp_expr E1 E2).
Proof. solve_proper. Qed.
Program Definition ctx_lookup (x : var) : listC D -n> D := λne Δ ww,
(□ from_option id (cconst True)%I (Δ !! x) ww)%I.
......@@ -71,7 +71,7 @@ Section logrel.
(interp1 interp2 : listC D -n> D) : listC D -n> D :=
λne Δ ww,
(□ ∀ vv, interp1 Δ vv →
interp_expr
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.
......@@ -80,7 +80,7 @@ Section logrel.
(interp : listC D -n> D) : listC D -n> D := λne Δ ww,
(□ ∀ τi,
⌜∀ ww, PersistentP (τi ww)⌝ →
interp_expr
interp_expr ⊤ ⊤
interp (τi :: Δ) (TApp (of_val (ww.1)), TApp (of_val (ww.2))))%I.
Solve Obligations with solve_proper.
......@@ -245,5 +245,5 @@ End logrel.
Typeclasses Opaque interp_env.
Notation "⟦ τ ⟧" := (interp τ).
Notation "⟦ τ ⟧ₑ" := (interp_expr (interp τ)).
Notation "⟦ τ ⟧ₑ" := (interp_expr ⊤ ⊤ (interp τ)).
Notation "⟦ Γ ⟧*" := (interp_env Γ).
F_mu_ref_conc/relational_properties.v 0 → 100644
View file @ dcf43df0
This diff is collapsed.
F_mu_ref_conc/soundness_binary.v
View file @ dcf43df0
......@@ -25,15 +25,20 @@ Proof.
{ iNext. iExists [e'], ∅. rewrite /to_gen_heap fin_maps.map_fmap_empty. auto. }
set (HeapΣ := (HeapIG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
iExists (λ σ, own γ (● to_gen_heap σ)); iFrame.
iApply wp_fupd. iApply wp_wand_r.
iApply wp_fupd.
iApply wp_wand_r.
iSplitL.
iPoseProof (Hlog _ _) as "Hrel".
iSpecialize ("Hrel" $! [] [] with "* [$Hcfg] []").
{ iAlways. iApply logrel_binary.interp_env_nil. }
simpl.
rewrite empty_env_subst empty_env_subst. iApply ("Hrel" $! 0 []).
rewrite empty_env_subst empty_env_subst.
iSpecialize ("Hrel" $! 0 []).
iAssert (0 ⤇ e')%I with "[Hcfg2]" as "H0".
{ rewrite tpool_mapsto_eq /tpool_mapsto_def. asimpl. iFrame. }
iIntros (v1); iDestruct 1 as (v2) "[Hj #Hinterp]".
iApply fupd_wp. iApply "Hrel"; auto.
iIntros (v1).
iMod 1 as (v2) "[Hj #Hinterp]".
iInv specN as (tp σ) ">[Hown Hsteps]" "Hclose"; iDestruct "Hsteps" as %Hsteps'.
rewrite tpool_mapsto_eq /tpool_mapsto_def /=.
iDestruct (own_valid_2 with "Hown Hj") as %Hvalid.
......
F_mu_ref_conc/weakestpre.v
View file @ dcf43df0
......@@ -14,8 +14,8 @@ Implicit Types v : val.
Implicit Types e : expr.
(* Inverse bind lemma *)
Lemma wp_bind_inv K e Φ :
WP fill K e {{ Φ }} ⊢ WP e {{ v, WP fill K (of_val v) {{ Φ }} }}.
Lemma wp_bind_inv K E e Φ :
WP fill K e @ E {{ Φ }} ⊢ WP e @ E {{ v, WP fill K (of_val v) @ E {{ Φ }} }}.
Proof.
iIntros "H". iLöb as "IH" forall (e Φ). rewrite wp_unfold /wp_pre.
iDestruct "H" as "[Hv|[% H]]".
......@@ -33,7 +33,7 @@ Proof.
destruct eval.
- iApply wp_value. symmetry. eauto.
replace e with (of_val v) in H; last first.
{ by rewrite (of_to_val e). }
{ by rewrite (of_to_val e). }
rewrite wp_unfold /wp_pre; iRight; iSplit; eauto.
iIntros (σ1) "Hσ". iMod ("H" $! _ with "Hσ") as "[% H]".
iModIntro; iSplit.
......
Makefile
View file @ dcf43df0
# Makefile originally taken from coq-club
all: Makefile.coq
+make -f Makefile.coq all
#############################################################################
## v # The Coq Proof Assistant ##
## <O___,, # INRIA - CNRS - LIX - LRI - PPS ##
## \VV/ # ##
## // # Makefile automagically generated by coq_makefile V8.6 ##
#############################################################################
clean: Makefile.coq
+make -f Makefile.coq clean
rm -f Makefile.coq
# WARNING
#
# This Makefile has been automagically generated
# Edit at your own risks !
#
# END OF WARNING
Makefile.coq: _CoqProject
coq_makefile -f _CoqProject -o Makefile.coq
#
# This Makefile was generated by the command line :
# coq_makefile -f _CoqProject
#
%: Makefile.coq
+make -f Makefile.coq $@
.DEFAULT_GOAL := all
# This Makefile may take arguments passed as environment variables:
# COQBIN to specify the directory where Coq binaries resides;
# TIMECMD set a command to log .v compilation time;
# TIMED if non empty, use the default time command as TIMECMD;
# ZDEBUG/COQDEBUG to specify debug flags for ocamlc&ocamlopt/coqc;