Commit f72453a9 authored by Amin Timany's avatar Amin Timany
Browse files

Improve counter

parent 95bdb831
...@@ -5,36 +5,32 @@ From iris_examples.logrel.F_mu_ref_conc Require Import soundness_binary. ...@@ -5,36 +5,32 @@ From iris_examples.logrel.F_mu_ref_conc Require Import soundness_binary.
From iris.program_logic Require Import adequacy. From iris.program_logic Require Import adequacy.
Definition CG_increment (x : expr) : expr := Definition CG_increment (x : expr) : expr :=
Rec (Store x.[ren (+ 2)] (BinOp Add (#n 1) (Load x.[ren (+ 2)]))). Lam (Store x.[ren (+ 1)] (BinOp Add (#n 1) (Load x.[ren (+ 1)]))).
Definition CG_locked_increment (x l : expr) : expr := Definition CG_locked_increment (x l : expr) : expr :=
with_lock (CG_increment x) l. with_lock (CG_increment x) l.
Definition CG_locked_incrementV (x l : expr) : val := Definition CG_locked_incrementV (x l : expr) : val :=
with_lockV (CG_increment x) l. with_lockV (CG_increment x) l.
Definition counter_read (x : expr) : expr := Rec (Load x.[ren (+2)]). Definition counter_read (x : expr) : expr := Lam (Load x.[ren (+1)]).
Definition counter_readV (x : expr) : val := RecV (Load x.[ren (+2)]). Definition counter_readV (x : expr) : val := LamV (Load x.[ren (+1)]).
Definition CG_counter_body (x l : expr) : expr := Definition CG_counter_body (x l : expr) : expr :=
Pair (CG_locked_increment x l) (counter_read x). Pair (CG_locked_increment x l) (counter_read x).
Definition CG_counter : expr := Definition CG_counter : expr :=
App LetIn newlock (LetIn (Alloc (#n 0)) (CG_counter_body (Var 0) (Var 1))).
(Rec $ App (Rec (CG_counter_body (Var 1) (Var 3)))
(Alloc (#n 0)))
newlock.
Definition FG_increment (x : expr) : expr := Definition FG_increment (x : expr) : expr :=
Rec $ App Rec (LetIn
(Rec $ (Load x.[ren (+2)]) (* read the counter *)
(* try increment *) (* try increment *)
If (CAS x.[ren (+4)] (Var 1) (BinOp Add (#n 1) (Var 1))) (If (CAS x.[ren (+3)] (Var 0) (BinOp Add (#n 1) (Var 0)))
Unit (* increment succeeds we return unit *) Unit (* increment succeeds we return unit *)
(App (Var 2) (Var 3)) (* increment fails, we try again *)) (App (Var 1) (Var 2)) (* increment fails, we try again *))).
(Load x.[ren (+2)]) (* read the counter *).
Definition FG_counter_body (x : expr) : expr := Definition FG_counter_body (x : expr) : expr :=
Pair (FG_increment x) (counter_read x). Pair (FG_increment x) (counter_read x).
Definition FG_counter : expr := Definition FG_counter : expr :=
App (Rec (FG_counter_body (Var 1))) (Alloc (#n 0)). LetIn (Alloc (#n 0)) (FG_counter_body (Var 0)).
Section CG_Counter. Section CG_Counter.
Context `{heapIG Σ, cfgSG Σ}. Context `{heapIG Σ, cfgSG Σ}.
...@@ -48,37 +44,38 @@ Section CG_Counter. ...@@ -48,37 +44,38 @@ Section CG_Counter.
typed Γ (CG_increment x) (TArrow TUnit TUnit). typed Γ (CG_increment x) (TArrow TUnit TUnit).
Proof. Proof.
intros H1. repeat econstructor. intros H1. repeat econstructor.
- eapply (context_weakening [_; _]); eauto. - eapply (context_weakening [_]); eauto.
- eapply (context_weakening [_; _]); eauto. - eapply (context_weakening [_]); eauto.
Qed. Qed.
Lemma CG_increment_closed (x : expr) : Lemma CG_increment_closed (x : expr) :
( f, x.[f] = x) f, (CG_increment x).[f] = CG_increment x. ( f, x.[f] = x) f, (CG_increment x).[f] = CG_increment x.
Proof. intros Hx f. unfold CG_increment. asimpl. rewrite ?Hx; trivial. Qed. Proof. intros Hx f. unfold CG_increment. asimpl. rewrite ?Hx; trivial. Qed.
Hint Rewrite CG_increment_closed : autosubst.
Lemma CG_increment_subst (x : expr) f : Lemma CG_increment_subst (x : expr) f :
(CG_increment x).[f] = CG_increment x.[f]. (CG_increment x).[f] = CG_increment x.[f].
Proof. unfold CG_increment; asimpl; trivial. Qed. Proof. unfold CG_increment; asimpl; trivial. Qed.
Hint Rewrite CG_increment_subst : autosubst.
Lemma steps_CG_increment E ρ j K x n: Lemma steps_CG_increment E ρ j K x n:
nclose specN E nclose specN E
spec_ctx ρ x ↦ₛ (#nv n) j fill K (App (CG_increment (Loc x)) Unit) spec_ctx ρ x ↦ₛ (#nv n) j fill K (App (CG_increment (Loc x)) Unit)
|={E}=> j fill K (Unit) x ↦ₛ (#nv (S n)). |={E}=> j fill K (Unit) x ↦ₛ (#nv (S n)).
Proof. Proof.
iIntros (HNE) "[#Hspec [Hx Hj]]". unfold CG_increment. iIntros (HNE) "[#Hspec [Hx Hj]]". unfold CG_increment.
iMod (step_rec _ _ j K _ _ _ _ with "[Hj]") as "Hj"; eauto. iMod (do_step_pure with "[$Hj]") as "Hj"; eauto.
iMod (step_load _ _ j ((BinOpRCtx _ (#nv _) :: StoreRCtx (LocV _) :: K)) iMod (step_load _ _ j ((BinOpRCtx _ (#nv _) :: StoreRCtx (LocV _) :: K))
_ _ _ with "[Hj Hx]") as "[Hj Hx]"; eauto. _ _ _ with "[Hj Hx]") as "[Hj Hx]"; eauto.
simpl. iFrame "Hspec Hj"; trivial. { iFrame "Hspec Hj"; trivial. }
simpl. simpl.
iMod (step_nat_binop _ _ j ((StoreRCtx (LocV _)) :: K) iMod (do_step_pure _ _ _ ((StoreRCtx (LocV _)) :: K) with "[$Hj]") as "Hj";
_ _ _ with "[Hj]") as "Hj"; eauto. eauto.
simpl. simpl.
iMod (step_store _ _ j K _ _ _ _ _ with "[Hj Hx]") as "[Hj Hx]"; eauto. iMod (step_store _ _ j K with "[$Hj $Hx]") as "[Hj Hx]"; eauto.
iFrame "Hspec Hj"; trivial. iModIntro; iFrame.
iModIntro.
iFrame "Hj Hx"; trivial.
Unshelve. all: trivial.
Qed. Qed.
Global Opaque CG_increment. Global Opaque CG_increment.
...@@ -102,14 +99,6 @@ Section CG_Counter. ...@@ -102,14 +99,6 @@ Section CG_Counter.
eapply with_lock_type; auto using CG_increment_type. eapply with_lock_type; auto using CG_increment_type.
Qed. Qed.
Lemma CG_locked_increment_closed (x l : expr) :
( f, x.[f] = x) ( f, l.[f] = l)
f, (CG_locked_increment x l).[f] = CG_locked_increment x l.
Proof.
intros H1 H2 f. asimpl. unfold CG_locked_increment.
rewrite with_lock_closed; trivial. apply CG_increment_closed; trivial.
Qed.
Lemma CG_locked_increment_subst (x l : expr) f : Lemma CG_locked_increment_subst (x l : expr) f :
(CG_locked_increment x l).[f] = CG_locked_increment x.[f] l.[f]. (CG_locked_increment x l).[f] = CG_locked_increment x.[f] l.[f].
Proof. Proof.
...@@ -117,6 +106,8 @@ Section CG_Counter. ...@@ -117,6 +106,8 @@ Section CG_Counter.
rewrite with_lock_subst CG_increment_subst. asimpl; trivial. rewrite with_lock_subst CG_increment_subst. asimpl; trivial.
Qed. Qed.
Hint Rewrite CG_locked_increment_subst : autosubst.
Lemma steps_CG_locked_increment E ρ j K x n l : Lemma steps_CG_locked_increment E ρ j K x n l :
nclose specN E nclose specN E
spec_ctx ρ x ↦ₛ (#nv n) l ↦ₛ (#v false) spec_ctx ρ x ↦ₛ (#nv n) l ↦ₛ (#v false)
...@@ -125,11 +116,10 @@ Section CG_Counter. ...@@ -125,11 +116,10 @@ Section CG_Counter.
Proof. Proof.
iIntros (HNE) "[#Hspec [Hx [Hl Hj]]]". iIntros (HNE) "[#Hspec [Hx [Hl Hj]]]".
iMod (steps_with_lock iMod (steps_with_lock
_ _ j K _ _ _ _ UnitV UnitV _ _ with "[Hj Hx Hl]") as "Hj"; last done. _ _ j K _ _ _ _ UnitV UnitV with "[$Hj Hx $Hl]") as "Hj"; eauto.
- iIntros (K') "[#Hspec Hxj]". - iIntros (K') "[#Hspec Hxj]".
iApply steps_CG_increment; first done. iFrame. trivial. iApply steps_CG_increment; by try iFrame.
- by iFrame "Hspec Hj Hx". - by iFrame.
Unshelve. all: trivial.
Qed. Qed.
Global Opaque CG_locked_increment. Global Opaque CG_locked_increment.
...@@ -146,17 +136,21 @@ Section CG_Counter. ...@@ -146,17 +136,21 @@ Section CG_Counter.
typed Γ x (Tref TNat) typed Γ (counter_read x) (TArrow TUnit TNat). typed Γ x (Tref TNat) typed Γ (counter_read x) (TArrow TUnit TNat).
Proof. Proof.
intros H1. repeat econstructor. intros H1. repeat econstructor.
eapply (context_weakening [_; _]); trivial. eapply (context_weakening [_]); trivial.
Qed. Qed.
Lemma counter_read_closed (x : expr) : Lemma counter_read_closed (x : expr) :
( f, x.[f] = x) f, (counter_read x).[f] = counter_read x. ( f, x.[f] = x) f, (counter_read x).[f] = counter_read x.
Proof. intros H1 f. asimpl. unfold counter_read. by rewrite ?H1. Qed. Proof. intros H1 f. asimpl. unfold counter_read. by rewrite ?H1. Qed.
Hint Rewrite counter_read_closed : autosubst.
Lemma counter_read_subst (x: expr) f : Lemma counter_read_subst (x: expr) f :
(counter_read x).[f] = counter_read x.[f]. (counter_read x).[f] = counter_read x.[f].
Proof. unfold counter_read. by asimpl. Qed. Proof. unfold counter_read. by asimpl. Qed.
Hint Rewrite counter_read_subst : autosubst.
Lemma steps_counter_read E ρ j K x n : Lemma steps_counter_read E ρ j K x n :
nclose specN E nclose specN E
spec_ctx ρ x ↦ₛ (#nv n) spec_ctx ρ x ↦ₛ (#nv n)
...@@ -164,11 +158,10 @@ Section CG_Counter. ...@@ -164,11 +158,10 @@ Section CG_Counter.
={E}= j fill K (#n n) x ↦ₛ (#nv n). ={E}= j fill K (#n n) x ↦ₛ (#nv n).
Proof. Proof.
intros HNE. iIntros "[#Hspec [Hx Hj]]". unfold counter_read. intros HNE. iIntros "[#Hspec [Hx Hj]]". unfold counter_read.
iMod (step_rec _ _ j K _ Unit with "[Hj]") as "Hj"; eauto. iMod (do_step_pure with "[$Hj]") as "Hj"; eauto.
iAsimpl. iAsimpl.
iMod (step_load _ _ j K with "[Hj Hx]") as "[Hj Hx]"; eauto. iMod (step_load _ _ j K with "[$Hj Hx]") as "[Hj Hx]"; eauto.
{ by iFrame "Hspec Hj". } by iFrame.
iModIntro. by iFrame "Hj Hx".
Qed. Qed.
Opaque counter_read. Opaque counter_read.
...@@ -183,45 +176,43 @@ Section CG_Counter. ...@@ -183,45 +176,43 @@ Section CG_Counter.
eauto using CG_locked_increment_type, counter_read_type. eauto using CG_locked_increment_type, counter_read_type.
Qed. Qed.
Lemma CG_counter_body_closed (x l : expr) : Lemma CG_counter_body_subst (x l : expr) f :
( f, x.[f] = x) ( f, l.[f] = l) (CG_counter_body x l).[f] = CG_counter_body x.[f] l.[f].
f, (CG_counter_body x l).[f] = CG_counter_body x l. Proof. by asimpl. Qed.
Proof.
intros H1 H2 f. asimpl. Hint Rewrite CG_counter_body_subst : autosubst.
rewrite CG_locked_increment_closed; trivial. by rewrite counter_read_closed.
Qed.
Lemma CG_counter_type Γ : Lemma CG_counter_type Γ :
typed Γ CG_counter (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)). typed Γ CG_counter (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)).
Proof. Proof.
econstructor; eauto using newlock_type. econstructor; eauto using newlock_type.
do 2 econstructor; [|do 2 constructor]. econstructor; first eauto using typed.
constructor. apply CG_counter_body_type; by constructor. apply CG_counter_body_type; eauto using typed.
Qed. Qed.
Lemma CG_counter_closed f : CG_counter.[f] = CG_counter. Lemma CG_counter_closed f : CG_counter.[f] = CG_counter.
Proof. Proof. by asimpl. Qed.
asimpl; rewrite CG_locked_increment_subst counter_read_subst; by asimpl.
Qed. Hint Rewrite CG_counter_closed : autosubst.
(* Fine-grained increment *) (* Fine-grained increment *)
Lemma FG_increment_type x Γ : Lemma FG_increment_type x Γ :
typed Γ x (Tref TNat) typed Γ x (Tref TNat)
typed Γ (FG_increment x) (TArrow TUnit TUnit). typed Γ (FG_increment x) (TArrow TUnit TUnit).
Proof. Proof.
intros H1. do 3 econstructor. intros Hx. do 3 econstructor; eauto using typed.
do 2 econstructor; eauto using EqTNat.
- eapply (context_weakening [_; _; _; _]); eauto.
- by constructor.
- repeat constructor.
- by constructor.
- by constructor.
- eapply (context_weakening [_; _]); eauto. - eapply (context_weakening [_; _]); eauto.
- econstructor; [| |repeat econstructor |].
+ constructor.
+ eapply (context_weakening [_; _; _]); eauto.
+ repeat constructor.
Qed. Qed.
Lemma FG_increment_closed (x : expr) : Lemma FG_increment_subst (x : expr) f :
( f, x.[f] = x) f, (FG_increment x).[f] = FG_increment x. (FG_increment x).[f] = FG_increment x.[f].
Proof. intros Hx f. asimpl. unfold FG_increment. rewrite ?Hx; trivial. Qed. Proof. rewrite /FG_increment. by asimpl. Qed.
Hint Rewrite FG_increment_subst : autosubst.
Lemma FG_counter_body_type x Γ : Lemma FG_counter_body_type x Γ :
typed Γ x (Tref TNat) typed Γ x (Tref TNat)
...@@ -233,23 +224,23 @@ Section CG_Counter. ...@@ -233,23 +224,23 @@ Section CG_Counter.
- apply counter_read_type; trivial. - apply counter_read_type; trivial.
Qed. Qed.
Lemma FG_counter_body_closed (x : expr) : Lemma FG_counter_body_subst (x : expr) f :
( f, x.[f] = x) (FG_counter_body x).[f] = FG_counter_body x.[f].
f, (FG_counter_body x).[f] = FG_counter_body x. Proof. rewrite /FG_counter_body /FG_increment. by asimpl. Qed.
Proof.
intros H1 f. asimpl. unfold FG_counter_body, FG_increment. Hint Rewrite FG_counter_body_subst : autosubst.
rewrite ?H1. by rewrite counter_read_closed.
Qed.
Lemma FG_counter_type Γ : Lemma FG_counter_type Γ :
typed Γ FG_counter (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)). Γ FG_counter : (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)).
Proof. Proof.
econstructor; eauto using newlock_type, typed. econstructor; eauto using newlock_type, typed.
constructor. apply FG_counter_body_type; by constructor. apply FG_counter_body_type; by constructor.
Qed. Qed.
Lemma FG_counter_closed f : FG_counter.[f] = FG_counter. Lemma FG_counter_closed f : FG_counter.[f] = FG_counter.
Proof. asimpl; rewrite counter_read_subst; by asimpl. Qed. Proof. by asimpl. Qed.
Hint Rewrite FG_counter_closed : autosubst.
Definition counterN : namespace := nroot .@ "counter". Definition counterN : namespace := nroot .@ "counter".
...@@ -261,20 +252,17 @@ Section CG_Counter. ...@@ -261,20 +252,17 @@ Section CG_Counter.
iClear "HΓ". cbn -[FG_counter CG_counter]. iClear "HΓ". cbn -[FG_counter CG_counter].
rewrite ?empty_env_subst /CG_counter /FG_counter. rewrite ?empty_env_subst /CG_counter /FG_counter.
iApply fupd_wp. iApply fupd_wp.
iMod (steps_newlock _ _ j ((AppRCtx (RecV _)) :: K) _ with "[Hj]") iMod (steps_newlock _ _ j (LetInCtx _ :: K) with "[$Hj]")
as (l) "[Hj Hl]"; eauto. as (l) "[Hj Hl]"; eauto.
iMod (step_rec _ _ j K _ _ _ _ with "[Hj]") as "Hj"; eauto. simpl.
iAsimpl. rewrite CG_locked_increment_subst /=. iMod (do_step_pure with "[$Hj]") as "Hj"; eauto.
rewrite counter_read_subst /=. iAsimpl.
iMod (step_alloc _ _ j ((AppRCtx (RecV _)) :: K) _ _ _ _ with "[Hj]") iMod (step_alloc _ _ j (LetInCtx _ :: K) with "[$Hj]")
as (cnt') "[Hj Hcnt']"; eauto. as (cnt') "[Hj Hcnt']"; eauto.
iMod (step_rec _ _ j K _ _ _ _ with "[Hj]") as "Hj"; eauto. simpl.
iAsimpl. rewrite CG_locked_increment_subst /=. iMod (do_step_pure with "[$Hj]") as "Hj"; eauto.
rewrite counter_read_subst /=. iAsimpl.
Unshelve. iApply (wp_bind (fill [LetInCtx _])).
all: try match goal with |- to_val _ = _ => auto using to_of_val end.
all: trivial.
iApply (wp_bind (fill [AppRCtx (RecV _)])).
iApply wp_wand_l. iSplitR; [iModIntro; iIntros (v) "Hv"; iExact "Hv"|]. iApply wp_wand_l. iSplitR; [iModIntro; iIntros (v) "Hv"; iExact "Hv"|].
iApply (wp_alloc); trivial; iFrame "#"; iModIntro; iNext; iIntros (cnt) "Hcnt /=". iApply (wp_alloc); trivial; iFrame "#"; iModIntro; iNext; iIntros (cnt) "Hcnt /=".
(* establishing the invariant *) (* establishing the invariant *)
...@@ -285,7 +273,6 @@ Section CG_Counter. ...@@ -285,7 +273,6 @@ Section CG_Counter.
iMod (inv_alloc counterN with "[Hinv]") as "#Hinv"; [iNext; iExact "Hinv"|]. iMod (inv_alloc counterN with "[Hinv]") as "#Hinv"; [iNext; iExact "Hinv"|].
(* splitting increment and read *) (* splitting increment and read *)
iApply wp_pure_step_later; trivial. iModIntro. iNext. iAsimpl. iApply wp_pure_step_later; trivial. iModIntro. iNext. iAsimpl.
rewrite counter_read_subst /=.
iApply wp_value; auto. iApply wp_value; auto.
iExists (PairV (CG_locked_incrementV _ _) (counter_readV _)); simpl. iExists (PairV (CG_locked_incrementV _ _) (counter_readV _)); simpl.
rewrite CG_locked_increment_of_val counter_read_of_val. rewrite CG_locked_increment_of_val counter_read_of_val.
...@@ -298,7 +285,7 @@ Section CG_Counter. ...@@ -298,7 +285,7 @@ Section CG_Counter.
iLöb as "Hlat". iLöb as "Hlat".
iApply wp_pure_step_later; trivial. iAsimpl. iNext. iApply wp_pure_step_later; trivial. iAsimpl. iNext.
(* fine-grained reads the counter *) (* fine-grained reads the counter *)
iApply (wp_bind (fill [AppRCtx (RecV _)])); iApply (wp_bind (fill [LetInCtx _]));
iApply wp_wand_l; iSplitR; [iIntros (v) "Hv"; iExact "Hv"|]. iApply wp_wand_l; iSplitR; [iIntros (v) "Hv"; iExact "Hv"|].
iApply wp_atomic; eauto. iApply wp_atomic; eauto.
iInv counterN as (n) ">[Hl [Hcnt Hcnt']]" "Hclose". iInv counterN as (n) ">[Hl [Hcnt Hcnt']]" "Hclose".
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment