Commit ed2a50a1 authored by Dan Frumin's avatar Dan Frumin

Get rid of the second mask in the refinement judgement

parent 45c61194
...@@ -16,7 +16,7 @@ Definition F : val := rec: "f" "g" := ...@@ -16,7 +16,7 @@ Definition F : val := rec: "f" "g" :=
Section contents. Section contents.
Context `{logrelG Σ}. Context `{logrelG Σ}.
Lemma Y_semtype Δ Γ A : Lemma Y_semtype Δ Γ A :
{,;Δ;Γ} Y log Y : TArrow (TArrow A A) A. {Δ;Γ} Y log Y : TArrow (TArrow A A) A.
Proof. Proof.
unlock Y. simpl. unlock Y. simpl.
iApply bin_log_related_arrow; eauto. iApply bin_log_related_arrow; eauto.
...@@ -29,7 +29,7 @@ Section contents. ...@@ -29,7 +29,7 @@ Section contents.
Qed. Qed.
Lemma KNOT_Y Δ Γ A : Lemma KNOT_Y Δ Γ A :
{,;Δ;Γ} Knot log Y : TArrow (TArrow A A) A. {Δ;Γ} Knot log Y : TArrow (TArrow A A) A.
Proof. Proof.
unlock Y Knot. simpl. unlock Y Knot. simpl.
iApply bin_log_related_arrow; eauto. iApply bin_log_related_arrow; eauto.
...@@ -46,7 +46,7 @@ Section contents. ...@@ -46,7 +46,7 @@ Section contents.
Qed. Qed.
Lemma Y_KNOT Δ Γ A : Lemma Y_KNOT Δ Γ A :
{,;Δ;Γ} Y log Knot : TArrow (TArrow A A) A. {Δ;Γ} Y log Knot : TArrow (TArrow A A) A.
Proof. Proof.
unlock Y Knot. simpl. unlock Y Knot. simpl.
iApply bin_log_related_arrow; eauto. iApply bin_log_related_arrow; eauto.
...@@ -63,7 +63,7 @@ Section contents. ...@@ -63,7 +63,7 @@ Section contents.
Qed. Qed.
Lemma FIX_Y Δ Γ A : Lemma FIX_Y Δ Γ A :
{,;Δ;Γ} F log Y : TArrow (TArrow A A) A. {Δ;Γ} F log Y : TArrow (TArrow A A) A.
Proof. Proof.
unlock Y F. simpl. unlock Y F. simpl.
iApply bin_log_related_arrow; eauto. iApply bin_log_related_arrow; eauto.
...@@ -76,7 +76,7 @@ Section contents. ...@@ -76,7 +76,7 @@ Section contents.
Qed. Qed.
Lemma Y_FIX Δ Γ A : Lemma Y_FIX Δ Γ A :
{,;Δ;Γ} Y log F : TArrow (TArrow A A) A. {Δ;Γ} Y log F : TArrow (TArrow A A) A.
Proof. Proof.
unlock Y F. simpl. unlock Y F. simpl.
iApply bin_log_related_arrow; eauto. iApply bin_log_related_arrow; eauto.
......
...@@ -60,11 +60,11 @@ Section bit_refinement. ...@@ -60,11 +60,11 @@ Section bit_refinement.
Instance bitτi_persistent ww : Persistent (bitτi ww). Instance bitτi_persistent ww : Persistent (bitτi ww).
Proof. apply _. Qed. Proof. apply _. Qed.
Lemma bit_prerefinement Γ E : Lemma bit_prerefinement Γ :
{E;Δ;Γ} bit_bool log bit_nat : bitτ. {Δ;Γ} bit_bool log bit_nat : bitτ.
Proof. Proof.
unfold bit_bool, bit_nat; simpl. (* we need this to compute the coercion from values to expression *) unfold bit_bool, bit_nat; simpl. (* we need this to compute the coercion from values to expression *)
iApply (bin_log_related_pack _ bitτi). iApply (bin_log_related_pack bitτi).
repeat iApply bin_log_related_pair. repeat iApply bin_log_related_pair.
- rel_vals; simpl; eauto. (* TODO: make a rel_finish tactic or change rel_vals *) - rel_vals; simpl; eauto. (* TODO: make a rel_finish tactic or change rel_vals *)
- unfold flip_nat. - unfold flip_nat.
...@@ -115,14 +115,13 @@ Section heapify_refinement. ...@@ -115,14 +115,13 @@ Section heapify_refinement.
Variable (Δ : list (prodC valC valC -n> iProp Σ)). Variable (Δ : list (prodC valC valC -n> iProp Σ)).
Notation D := (prodC valC valC -n> iProp Σ). Notation D := (prodC valC valC -n> iProp Σ).
Lemma heapify_refinement_ez Γ E1 b1 b2 : Lemma heapify_refinement_ez Γ b1 b2 :
logrelN E1 {Δ;Γ} b1 log b2 : bitτ -
{E1;Δ;Γ} b1 log b2 : bitτ - {Δ;Γ} heapify b1 log heapify b2 : bitτ.
{E1;Δ;Γ} heapify b1 log heapify b2 : bitτ.
Proof. Proof.
iIntros (?) "Hb1b2". iIntros "Hb1b2".
iApply bin_log_related_app; eauto. iApply bin_log_related_app; eauto.
iApply binary_fundamental_masked; eauto with typeable. iApply binary_fundamental; eauto with typeable.
Qed. Qed.
End heapify_refinement. End heapify_refinement.
......
...@@ -10,8 +10,8 @@ Hint Resolve bot_typed : typeable. ...@@ -10,8 +10,8 @@ Hint Resolve bot_typed : typeable.
Section contents. Section contents.
Context `{logrelG Σ}. Context `{logrelG Σ}.
Lemma bot_l Δ Γ E K t τ : Lemma bot_l Δ Γ K t τ :
{E;Δ;Γ} fill K (bot #()) log t : τ. {Δ;Γ} fill K (bot #()) log t : τ.
Proof. Proof.
iLöb as "IH". iLöb as "IH".
rel_rec_l. rel_rec_l.
......
...@@ -44,7 +44,7 @@ Section refinement. ...@@ -44,7 +44,7 @@ Section refinement.
{Δ;Γ} bit_bool log bit_nat : bitT. {Δ;Γ} bit_bool log bit_nat : bitT.
Proof. Proof.
unlock bit_bool bit_nat; simpl. unlock bit_bool bit_nat; simpl.
iApply (bin_log_related_pack _ R). iApply (bin_log_related_pack R).
repeat iApply bin_log_related_pair. repeat iApply bin_log_related_pair.
- rel_finish. - rel_finish.
- rel_arrow_val. simpl. - rel_arrow_val. simpl.
......
...@@ -37,12 +37,12 @@ Section CG_Counter. ...@@ -37,12 +37,12 @@ Section CG_Counter.
Hint Resolve CG_increment_type : typeable. Hint Resolve CG_increment_type : typeable.
Lemma bin_log_related_CG_increment_r Γ K E1 E2 t τ (x l : loc) (n : nat) : Lemma bin_log_related_CG_increment_r Γ K E t τ (x l : loc) (n : nat) :
nclose specN E1 nclose specN E
(x ↦ₛ # n - l ↦ₛ #false - (x ↦ₛ # n - l ↦ₛ #false -
(x ↦ₛ # (S n) - l ↦ₛ #false - (x ↦ₛ # (S n) - l ↦ₛ #false -
({E1,E2;Δ;Γ} t log fill K #n : τ)) - ({E;Δ;Γ} t log fill K #n : τ)) -
{E1,E2;Δ;Γ} t log fill K ((CG_increment $/ (LitV (Loc x)) $/ LitV (Loc l)) #()) : τ)%I. {E;Δ;Γ} t log fill K ((CG_increment $/ (LitV (Loc x)) $/ LitV (Loc l)) #()) : τ)%I.
Proof. Proof.
iIntros (?) "Hx Hl Hlog". iIntros (?) "Hx Hl Hlog".
unfold CG_increment. unlock. simpl_subst/=. unfold CG_increment. unlock. simpl_subst/=.
...@@ -60,11 +60,11 @@ Section CG_Counter. ...@@ -60,11 +60,11 @@ Section CG_Counter.
by iApply ("Hlog" with "Hx Hl"). by iApply ("Hlog" with "Hx Hl").
Qed. Qed.
Lemma bin_log_counter_read_r Γ E1 E2 K x (n : nat) t τ Lemma bin_log_counter_read_r Γ E K x (n : nat) t τ
(Hspec : nclose specN E1) : (Hspec : nclose specN E) :
x ↦ₛ #n - x ↦ₛ #n -
(x ↦ₛ #n - {E1,E2;Δ;Γ} t log fill K #n : τ) - (x ↦ₛ #n - {E;Δ;Γ} t log fill K #n : τ) -
{E1,E2;Δ;Γ} t log fill K ((counter_read $/ LitV (Loc x)) #()) : τ. {E;Δ;Γ} t log fill K ((counter_read $/ LitV (Loc x)) #()) : τ.
Proof. Proof.
iIntros "Hx Hlog". iIntros "Hx Hlog".
unfold counter_read. unlock. simpl. unfold counter_read. unlock. simpl.
...@@ -92,12 +92,12 @@ Section CG_Counter. ...@@ -92,12 +92,12 @@ Section CG_Counter.
Hint Resolve FG_increment_type : typeable. Hint Resolve FG_increment_type : typeable.
Lemma bin_log_related_FG_increment_r Γ K E1 E2 t τ (x : loc) (n : nat) : Lemma bin_log_related_FG_increment_r Γ K E t τ (x : loc) (n : nat) :
nclose specN E1 nclose specN E
(x ↦ₛ # n - (x ↦ₛ # n -
(x ↦ₛ #(S n) - (x ↦ₛ #(S n) -
{E1,E2;Δ;Γ} t log fill K #n : τ) - {E;Δ;Γ} t log fill K #n : τ) -
{E1,E2;Δ;Γ} t log fill K ((FG_increment $/ (LitV (Loc x))) #()) : τ)%I. {E;Δ;Γ} t log fill K ((FG_increment $/ (LitV (Loc x))) #()) : τ)%I.
Proof. Proof.
iIntros (?) "Hx Hlog". iIntros (?) "Hx Hlog".
unlock FG_increment. simpl_subst/=. unlock FG_increment. simpl_subst/=.
...@@ -123,13 +123,13 @@ Section CG_Counter. ...@@ -123,13 +123,13 @@ Section CG_Counter.
(* A logically atomic specification for (* A logically atomic specification for
a fine-grained increment with a baked in frame. *) a fine-grained increment with a baked in frame. *)
(* Unfortunately, the precondition is not baked in the rule so you can only use it when your spatial context is empty *) (* Unfortunately, the precondition is not baked in the rule so you can only use it when your spatial context is empty *)
Lemma bin_log_FG_increment_logatomic R P Γ E1 E2 K x t τ : Lemma bin_log_FG_increment_logatomic R P Γ E K x t τ :
P - P -
(|={E1,E2}=> n : nat, x ↦ᵢ #n R n (|={,E}=> n : nat, x ↦ᵢ #n R n
(( n : nat, x ↦ᵢ #n R n) ={E2,E1}= True) (( n : nat, x ↦ᵢ #n R n) ={E,}= True)
( m, x ↦ᵢ # (S m) R m - P - ( m, x ↦ᵢ # (S m) R m - P -
{E2,E1;Δ;Γ} fill K #m log t : τ)) {E;Δ;Γ} fill K #m log t : τ))
- ({E1;Δ;Γ} fill K ((FG_increment $/ LitV (Loc x)) #()) log t : τ). - ({Δ;Γ} fill K ((FG_increment $/ LitV (Loc x)) #()) log t : τ).
Proof. Proof.
iIntros "HP #H". iIntros "HP #H".
iLöb as "IH". iLöb as "IH".
...@@ -166,13 +166,13 @@ Section CG_Counter. ...@@ -166,13 +166,13 @@ Section CG_Counter.
Qed. Qed.
(* A similar atomic specification for the counter_read fn *) (* A similar atomic specification for the counter_read fn *)
Lemma bin_log_counter_read_atomic_l R P Γ E1 E2 K x t τ : Lemma bin_log_counter_read_atomic_l R P Γ E K x t τ :
P - P -
(|={E1,E2}=> n : nat, x ↦ᵢ #n R n (|={,E}=> n : nat, x ↦ᵢ #n R n
(( n : nat, x ↦ᵢ #n R n) ={E2,E1}= True) (( n : nat, x ↦ᵢ #n R n) ={E,}= True)
( m : nat, x ↦ᵢ #m R m - P - ( m : nat, x ↦ᵢ #m R m - P -
{E2,E1;Δ;Γ} fill K #m log t : τ)) {E;Δ;Γ} fill K #m log t : τ))
- {E1;Δ;Γ} fill K ((counter_read $/ LitV (Loc x)) #()) log t : τ. - {Δ;Γ} fill K ((counter_read $/ LitV (Loc x)) #()) log t : τ.
Proof. Proof.
iIntros "HP #H". iIntros "HP #H".
unfold counter_read. unlock. simpl. unfold counter_read. unlock. simpl.
......
...@@ -73,7 +73,7 @@ Section namegen_refinement. ...@@ -73,7 +73,7 @@ Section namegen_refinement.
iMod (inv_alloc N _ (ng_Inv γ c) with "[-]") as "#Hinv". iMod (inv_alloc N _ (ng_Inv γ c) with "[-]") as "#Hinv".
{ iNext. iExists 0, . iFrame. { iNext. iExists 0, . iFrame.
by rewrite big_sepS_empty. } by rewrite big_sepS_empty. }
iApply (bin_log_related_pack _ (ngR γ)). iApply (bin_log_related_pack (ngR γ)).
iApply bin_log_related_pair. iApply bin_log_related_pair.
- (* New name *) - (* New name *)
iApply bin_log_related_arrow_val; eauto. iApply bin_log_related_arrow_val; eauto.
...@@ -219,7 +219,7 @@ Section cell_refinement. ...@@ -219,7 +219,7 @@ Section cell_refinement.
unlock cell2 cell1 cellτ. unlock cell2 cell1 cellτ.
iApply bin_log_related_tlam; auto. iApply bin_log_related_tlam; auto.
iIntros (R HR) "!#". iIntros (R HR) "!#".
iApply (bin_log_related_pack _ (cellR R)). iApply (bin_log_related_pack (cellR R)).
repeat iApply bin_log_related_pair. repeat iApply bin_log_related_pair.
- (* New cell *) - (* New cell *)
iApply bin_log_related_arrow_val; eauto. iApply bin_log_related_arrow_val; eauto.
......
...@@ -36,12 +36,11 @@ Section Refinement. ...@@ -36,12 +36,11 @@ Section Refinement.
iIntros "Hy"; iMod ("Hcl" with "[Hy]"); eauto. iIntros "Hy"; iMod ("Hcl" with "[Hy]"); eauto.
Qed. Qed.
Lemma rand_l Δ Γ E1 K ρ t τ : Lemma rand_l Δ Γ K ρ t τ :
choiceN E1 spec_ctx ρ - ( b : bool, {Δ;Γ} fill K #b log t : τ) -
spec_ctx ρ - ( b : bool, {E1;Δ;Γ} fill K #b log t : τ) - {Δ;Γ} fill K (rand #()) log t : τ.
{E1;Δ;Γ} fill K (rand #()) log t : τ.
Proof. Proof.
iIntros (?) "#Hs Hlog". iIntros "#Hs Hlog".
unfold rand. unlock. simpl. unfold rand. unlock. simpl.
rel_rec_l. rel_rec_l.
rel_alloc_l as y "Hy". simpl. rel_alloc_l as y "Hy". simpl.
...@@ -67,12 +66,12 @@ Section Refinement. ...@@ -67,12 +66,12 @@ Section Refinement.
done. done.
Qed. Qed.
Lemma rand_r (b : bool) Δ Γ E1 E2 K ρ t τ : Lemma rand_r (b : bool) Δ Γ E1 K ρ t τ :
specN E1 specN E1
choiceN E1 choiceN E1
spec_ctx ρ - spec_ctx ρ -
{E1,E2;Δ;Γ} t log fill K #b : τ - {E1;Δ;Γ} t log fill K #b : τ -
{E1,E2;Δ;Γ} t log fill K (rand #()) : τ. {E1;Δ;Γ} t log fill K (rand #()) : τ.
Proof. Proof.
iIntros (??) "#Hs Hlog". iIntros (??) "#Hs Hlog".
unfold rand. unlock. unfold rand. unlock.
...@@ -89,8 +88,8 @@ Section Refinement. ...@@ -89,8 +88,8 @@ Section Refinement.
Lemma lateChoice_l Δ Γ x v ρ t : Lemma lateChoice_l Δ Γ x v ρ t :
spec_ctx ρ - x ↦ᵢ v - spec_ctx ρ - x ↦ᵢ v -
(x ↦ᵢ #0 - b : bool, {,;Δ;Γ} #b log t : TBool) - (x ↦ᵢ #0 - b : bool, {Δ;Γ} #b log t : TBool) -
{,;Δ;Γ} lateChoice #x log t : TBool. {Δ;Γ} lateChoice #x log t : TBool.
Proof. Proof.
iIntros "#Hs Hx Hlog". iIntros "#Hs Hx Hlog".
unfold lateChoice. unlock. unfold lateChoice. unlock.
...@@ -103,7 +102,7 @@ Section Refinement. ...@@ -103,7 +102,7 @@ Section Refinement.
Lemma prerefinement Δ Γ x x' n ρ : Lemma prerefinement Δ Γ x x' n ρ :
spec_ctx ρ - x ↦ᵢ #n - x' ↦ₛ #n - spec_ctx ρ - x ↦ᵢ #n - x' ↦ₛ #n -
{,;Δ;Γ} lateChoice #x log earlyChoice #x' : TBool. {Δ;Γ} lateChoice #x log earlyChoice #x' : TBool.
Proof. Proof.
iIntros "#Hspec Hx Hx'". iIntros "#Hspec Hx Hx'".
iApply (lateChoice_l with "Hspec Hx"). iIntros "Hx". iApply (lateChoice_l with "Hspec Hx"). iIntros "Hx".
...@@ -120,7 +119,7 @@ Section Refinement. ...@@ -120,7 +119,7 @@ Section Refinement.
Lemma prerefinement2 Δ Γ x x' n ρ : Lemma prerefinement2 Δ Γ x x' n ρ :
spec_ctx ρ - x ↦ᵢ #n - x' ↦ₛ #n - spec_ctx ρ - x ↦ᵢ #n - x' ↦ₛ #n -
{,;Δ;Γ} earlyChoice #x log lateChoice #x' : TBool. {Δ;Γ} earlyChoice #x log lateChoice #x' : TBool.
Proof. Proof.
iIntros "#Hspec Hx Hx'". iIntros "#Hspec Hx Hx'".
unfold earlyChoice. unlock. unfold earlyChoice. unlock.
......
...@@ -69,11 +69,11 @@ Section lockG_rules. ...@@ -69,11 +69,11 @@ Section lockG_rules.
Global Instance locked_timeless γ : Timeless (locked γ). Global Instance locked_timeless γ : Timeless (locked γ).
Proof. apply _. Qed. Proof. apply _. Qed.
Lemma bin_log_related_newlock_l (R : iProp Σ) Δ Γ E K t τ : Lemma bin_log_related_newlock_l (R : iProp Σ) Δ Γ K t τ :
R - R -
( (lk : loc) γ, is_lock γ #lk R ( (lk : loc) γ, is_lock γ #lk R
- ({E;Δ;Γ} fill K #lk log t: τ)) - - ({Δ;Γ} fill K #lk log t: τ)) -
{E;Δ;Γ} fill K (newlock #()) log t: τ. {Δ;Γ} fill K (newlock #()) log t: τ.
Proof. Proof.
iIntros "HR Hlog". iIntros "HR Hlog".
iApply bin_log_related_wp_l. iApply bin_log_related_wp_l.
...@@ -85,15 +85,14 @@ Section lockG_rules. ...@@ -85,15 +85,14 @@ Section lockG_rules.
iModIntro. iApply "Hlog". iExists l. eauto. iModIntro. iApply "Hlog". iExists l. eauto.
Qed. Qed.
Lemma bin_log_related_release_l (R : iProp Σ) (lk : loc) γ Δ Γ E K t τ : Lemma bin_log_related_release_l (R : iProp Σ) (lk : loc) γ Δ Γ K t τ :
N E
is_lock γ #lk R - is_lock γ #lk R -
locked γ - locked γ -
R - R -
({E;Δ;Γ} fill K #() log t: τ) - ({Δ;Γ} fill K #() log t: τ) -
{E;Δ;Γ} fill K (release #lk) log t: τ. {Δ;Γ} fill K (release #lk) log t: τ.
Proof. Proof.
iIntros (?) "Hlock Hlocked HR Hlog". iIntros "Hlock Hlocked HR Hlog".
iDestruct "Hlock" as (l) "[% #?]"; simplify_eq. iDestruct "Hlock" as (l) "[% #?]"; simplify_eq.
unlock release. simpl. unlock release. simpl.
rel_let_l. rel_let_l.
...@@ -106,13 +105,12 @@ Section lockG_rules. ...@@ -106,13 +105,12 @@ Section lockG_rules.
iApply "Hlog". iApply "Hlog".
Qed. Qed.
Lemma bin_log_related_acquire_l (R : iProp Σ) (lk : loc) γ Δ Γ E K t τ : Lemma bin_log_related_acquire_l (R : iProp Σ) (lk : loc) γ Δ Γ K t τ :
N E
is_lock γ #lk R - is_lock γ #lk R -
(locked γ - R - {E;Δ;Γ} fill K #() log t: τ) - (locked γ - R - {Δ;Γ} fill K #() log t: τ) -
{E;Δ;Γ} fill K (acquire #lk) log t: τ. {Δ;Γ} fill K (acquire #lk) log t: τ.
Proof. Proof.
iIntros (?) "#Hlock Hlog". iIntros "#Hlock Hlog".
iLöb as "IH". iLöb as "IH".
unlock acquire. simpl. unlock acquire. simpl.
rel_rec_l. rel_rec_l.
...@@ -139,13 +137,13 @@ End lockG_rules. ...@@ -139,13 +137,13 @@ End lockG_rules.
Section lock_rules_r. Section lock_rules_r.
Context `{logrelG Σ}. Context `{logrelG Σ}.
Variable (E1 E2 : coPset). Variable (E : coPset).
Variable (Δ : list (prodC valC valC -n> iProp Σ)). Variable (Δ : list (prodC valC valC -n> iProp Σ)).
Lemma bin_log_related_newlock_r Γ K t τ Lemma bin_log_related_newlock_r Γ K t τ
(Hcl : nclose specN E1) : (Hcl : nclose specN E) :
( l : loc, l ↦ₛ #false - {E1,E2;Δ;Γ} t log fill K #l : τ) - ( l : loc, l ↦ₛ #false - {E;Δ;Γ} t log fill K #l : τ) -
{E1,E2;Δ;Γ} t log fill K (newlock #()): τ. {E;Δ;Γ} t log fill K (newlock #()): τ.
Proof. Proof.
iIntros "Hlog". iIntros "Hlog".
unfold newlock. unlock. unfold newlock. unlock.
...@@ -155,8 +153,8 @@ Section lock_rules_r. ...@@ -155,8 +153,8 @@ Section lock_rules_r.
Qed. Qed.
Lemma bin_log_related_newlock_l_simp Γ K t τ : Lemma bin_log_related_newlock_l_simp Γ K t τ :
( l : loc, l ↦ᵢ #false - {E1;Δ;Γ} fill K #l log t : τ) - ( l : loc, l ↦ᵢ #false - {Δ;Γ} fill K #l log t : τ) -
{E1;Δ;Γ} fill K (newlock #()) log t : τ. {Δ;Γ} fill K (newlock #()) log t : τ.
Proof. Proof.
iIntros "Hlog". iIntros "Hlog".
unfold newlock. unlock. unfold newlock. unlock.
...@@ -170,10 +168,10 @@ Section lock_rules_r. ...@@ -170,10 +168,10 @@ Section lock_rules_r.
Transparent acquire. Transparent acquire.
Lemma bin_log_related_acquire_r Γ K l t τ Lemma bin_log_related_acquire_r Γ K l t τ
(Hcl : nclose specN E1) : (Hcl : nclose specN E) :
l ↦ₛ #false - l ↦ₛ #false -
(l ↦ₛ #true - {E1,E2;Δ;Γ} t log fill K Unit : τ) - (l ↦ₛ #true - {E;Δ;Γ} t log fill K Unit : τ) -
{E1,E2;Δ;Γ} t log fill K (acquire #l) : τ. {E;Δ;Γ} t log fill K (acquire #l) : τ.
Proof. Proof.
iIntros "Hl Hlog". iIntros "Hl Hlog".
unfold acquire. unlock. unfold acquire. unlock.
...@@ -185,8 +183,8 @@ Section lock_rules_r. ...@@ -185,8 +183,8 @@ Section lock_rules_r.
Lemma bin_log_related_acquire_suc_l Γ K l t τ : Lemma bin_log_related_acquire_suc_l Γ K l t τ :
l ↦ᵢ #false - l ↦ᵢ #false -
(l ↦ᵢ #true - {E1;Δ;Γ} fill K (#()) log t : τ) - (l ↦ᵢ #true - {Δ;Γ} fill K (#()) log t : τ) -
{E1;Δ;Γ} fill K (acquire #l) log t : τ. {Δ;Γ} fill K (acquire #l) log t : τ.
Proof. Proof.
iIntros "Hl Hlog". iIntros "Hl Hlog".
unfold acquire. unlock. unfold acquire. unlock.
...@@ -202,8 +200,8 @@ Section lock_rules_r. ...@@ -202,8 +200,8 @@ Section lock_rules_r.
Lemma bin_log_related_acquire_fail_l Γ K l t τ : Lemma bin_log_related_acquire_fail_l Γ K l t τ :
l ↦ᵢ #true - l ↦ᵢ #true -
(l ↦ᵢ #false - {E1;Δ;Γ} fill K (acquire #l) log t : τ) - (l ↦ᵢ #false - {Δ;Γ} fill K (acquire #l) log t : τ) -
{E1;Δ;Γ} fill K (acquire #l) log t : τ. {Δ;Γ} fill K (acquire #l) log t : τ.
Proof. Proof.
iIntros "Hl Hlog". iIntros "Hl Hlog".
iLöb as "IH". iLöb as "IH".
...@@ -222,10 +220,10 @@ Section lock_rules_r. ...@@ -222,10 +220,10 @@ Section lock_rules_r.
Transparent release. Transparent release.
Lemma bin_log_related_release_r Γ K l t τ (b : bool) Lemma bin_log_related_release_r Γ K l t τ (b : bool)
(Hcl : nclose specN E1) : (Hcl : nclose specN E) :
l ↦ₛ #b - l ↦ₛ #b -
(l ↦ₛ #false - {E1,E2;Δ;Γ} t log fill K Unit : τ) - (l ↦ₛ #false - {E;Δ;Γ} t log fill K Unit : τ) -
{E1,E2;Δ;Γ} t log fill K (release #l) : τ. {E;Δ;Γ} t log fill K (release #l) : τ.
Proof. Proof.
iIntros "Hl Hlog". iIntros "Hl Hlog".
unfold release. unlock. unfold release. unlock.
...@@ -236,36 +234,4 @@ Section lock_rules_r. ...@@ -236,36 +234,4 @@ Section lock_rules_r.
Global Opaque release. Global Opaque release.
Lemma bin_log_related_with_lock_r Γ K Q e ev ew cl v w l t τ :
(to_val e = Some cl)
(to_val ev = Some v)
(to_val ew = Some w)
(nclose specN E1)
( K, (Q - {E1,E2;Δ;Γ} t log fill K ev : τ) -
{E1,E2;Δ;Γ} t log fill K (App e ew) : τ) -
l ↦ₛ #false -
(Q - l ↦ₛ #false - {E1,E2;Δ;Γ} t log fill K ev : τ) -
{E1,E2;Δ;Γ} t log fill K (with_lock e #l ew) : τ.
Proof.
iIntros (????) "HA Hl Hlog".
rel_bind_r (with_lock e).
unfold with_lock. unlock. (*TODO: unlock here needed *)
iApply (bin_log_related_rec_r); eauto. simpl_subst.
rel_bind_r (App _ (# l)).
iApply (bin_log_related_rec_r); eauto. simpl_subst.
iApply (bin_log_related_rec_r); eauto. simpl_subst.
rel_bind_r (App acquire (# l)).
iApply (bin_log_related_acquire_r Γ (_ :: K) l with "Hl"); auto.
iIntros "Hl". simpl.
iApply (bin_log_related_rec_r); eauto. simpl_subst/=.
rel_bind_r (App e ew).
iApply "HA". iIntros "HQ". simpl.
iApply (bin_log_related_rec_r); eauto. simpl_subst.
rel_bind_r (App release _).
iApply (bin_log_related_release_r with "Hl"); eauto.
iIntros "Hl". simpl.
iApply (bin_log_related_rec_r); eauto. simpl_subst.
iApply ("Hlog" with "HQ Hl").
Qed.
End lock_rules_r. End lock_rules_r.
...@@ -34,24 +34,22 @@ Hint Resolve or_type : typeable. ...@@ -34,24 +34,22 @@ Hint Resolve or_type : typeable.
Section contents. Section contents.
Context `{logrelG Σ}. Context `{logrelG Σ}.
Lemma bin_log_related_or Δ Γ E e1 e2 e1' e2' : Lemma bin_log_related_or Δ Γ e1 e2 e1' e2' :
logrelN E {Δ;Γ} e1 log e1' : TArrow TUnit TUnit -
{E;Δ;Γ} e1 log e1' : TArrow TUnit TUnit - {Δ;Γ} e2 log e2' : TArrow TUnit TUnit -
{E;Δ;Γ} e2 log e2' : TArrow TUnit TUnit - {Δ;Γ} or e1 e2 log or e1' e2' : TUnit.
{E;Δ;Γ} or e1 e2 log or e1' e2' : TUnit.
Proof. Proof.
iIntros (?) "He1 He2". iIntros "He1 He2".
iApply (bin_log_related_app with "[He1] He2"). iApply (bin_log_related_app with "[He1] He2").
iApply (bin_log_related_app with "[] He1"). iApply (bin_log_related_app with "[] He1").
iApply binary_fundamental_masked; eauto with typeable. iApply binary_fundamental; eauto with typeable.
Qed. Qed.
Lemma bin_log_or_choice_1_r_val Δ Γ E (v1 v1' v2 : val) : Lemma bin_log_or_choice_1_r_val Δ Γ (v1 v1' v2 : val) :
logrelN E {Δ;Γ} v1 log v1' : TArrow TUnit TUnit -
{E;Δ;Γ} v1 log v1' : TArrow TUnit TUnit - {Δ;Γ} v1 #() log or v1' v2 : TUnit.
{E;Δ;Γ} v1 #() log or v1' v2 : TUnit.
Proof. Proof.
iIntros (?) "Hlog". iIntros "Hlog".
unlock or. repeat rel_rec_r. unlock or. repeat rel_rec_r.
rel_alloc_r as x "Hx". rel_alloc_r as x "Hx".
repeat rel_let_r. repeat rel_let_r.
...@@ -61,22 +59,20 @@ Section contents. ...@@ -61,22 +59,20 @@ Section contents.
iApply bin_log_related_unit. iApply bin_log_related_unit.
Qed. Qed.
Lemma bin_log_or_choice_1_r_val_typed Δ Γ E (v1 v2 : val) : Lemma bin_log_or_choice_1_r_val_typed Δ Γ (v1 v2 : val) :
logrelN E
Γ ⊢ₜ v1 : TArrow TUnit TUnit Γ ⊢ₜ v1 : TArrow TUnit TUnit
{E;Δ;Γ} v1 #() log or v1 v2 : TUnit. {Δ;Γ} v1 #() log or v1 v2 : TUnit.
Proof. Proof.
iIntros (??). iIntros (?).
iApply bin_log_or_choice_1_r_val; eauto. iApply bin_log_or_choice_1_r_val; eauto.
iApply binary_fundamental_masked; eauto with typeable. iApply binary_fundamental; eauto with typeable.
Qed. Qed.
Lemma bin_log_or_choice_1_r Δ Γ E (e1 e1' : expr) (v2 : val) : Lemma bin_log_or_choice_1_r Δ Γ (e1 e1' : expr) (v2 : val) :
logrelN E {Δ;Γ} e1 log e1' : TArrow TUnit TUnit -
{E;Δ;Γ} e1 log e1' : TArrow TUnit TUnit - {Δ;Γ} e1 #() log or e1' v2 : TUnit.
{E;Δ;Γ} e1 #() log or e1' v2 : TUnit.
Proof. Proof.
iIntros (?) "Hlog". iIntros "Hlog".
rel_bind_l e1. rel_bind_l e1.
rel_bind_r e1'. rel_bind_r e1'.
iApply (related_bind with "Hlog"). iApply (related_bind with "Hlog").
...@@ -86,19 +82,18 @@ Section contents. ...@@ -86,19 +82,18 @@ Section contents.
iApply interp_ret; eauto using to_of_val. iApply interp_ret; eauto using to_of_val.
Qed. Qed.