Commit 807e89f6 authored by Dan Frumin's avatar Dan Frumin

Add an environment for semantic types (relations)

Modify the logical relation judment to include an environment Δ that
contains a list of semantic types to interpret free type variables.
parent 55f1dc10
...@@ -230,12 +230,15 @@ Ltac fold_interp := ...@@ -230,12 +230,15 @@ Ltac fold_interp :=
Section bin_log_related_under_typed_ctx. Section bin_log_related_under_typed_ctx.
Context `{logrelG Σ}. Context `{logrelG Σ}.
Ltac fundamental := Ltac fundamental := simpl;
try (solve_ndisj); try (solve_ndisj);
lazymatch goal with lazymatch goal with
| [ H : _ ⊢ₜ ?e : _ |- (_ ?Γ ?e log ?e : _)] => | [ H : _ ⊢ₜ ?e : _ |- (_ {_,_;_;?Γ} ?e log ?e : _)] =>
let Z := iFresh in let Z := iFresh in
iPoseProof (binary_fundamental _ e _) as Z; [apply H | iFrame Z] iPoseProof (binary_fundamental_masked _ _ e _) as Z;
[ solve_ndisj..
| apply H
| try iFrame Z ]
end. end.
Ltac solve_closed_typed := Ltac solve_closed_typed :=
lazymatch goal with lazymatch goal with
...@@ -247,30 +250,32 @@ Section bin_log_related_under_typed_ctx. ...@@ -247,30 +250,32 @@ Section bin_log_related_under_typed_ctx.
(Closed (dom _ Γ) e) (Closed (dom _ Γ) e)
(Closed (dom _ Γ) e') (Closed (dom _ Γ) e')
typed_ctx K Γ τ Γ' τ' typed_ctx K Γ τ Γ' τ'
(Γ e log e' : τ) - Γ' fill_ctx K e log fill_ctx K e' : τ'. ( ( Δ, ({,;Δ;Γ} e log e' : τ)) -
Proof. Δ, ({,;Δ;Γ'} fill_ctx K e log fill_ctx K e' : τ'))%I.
Proof.
revert Γ τ Γ' τ' e e'. revert Γ τ Γ' τ' e e'.
induction K as [|k K]=> Γ τ Γ' τ' e e' H1 H2; simpl. induction K as [|k K]=> Γ τ Γ' τ' e e' H1 H2; simpl.
- inversion_clear 1; trivial. iIntros "#H"; eauto. - inversion_clear 1; trivial. iIntros "#H".
iIntros (Δ) "!#". by iApply "H".
- inversion_clear 1 as [|? ? ? ? ? ? ? ? Hx1 Hx2]. - inversion_clear 1 as [|? ? ? ? ? ? ? ? Hx1 Hx2].
iIntros "#Hrel".
specialize (IHK _ _ _ _ e e' H1 H2 Hx2). specialize (IHK _ _ _ _ e e' H1 H2 Hx2).
inversion Hx1; subst; simpl; try fold_interp. inversion Hx1; subst; simpl; try fold_interp; iIntros "#Hrel";
+ iApply (bin_log_related_rec with "[]"); auto; iIntros (Δ) "!#".
+ iApply (bin_log_related_rec with "[-]"); auto;
rewrite ?cons_binder_union. rewrite ?cons_binder_union.
replace ({[x]} ({[f]} dom (gset string) Γ')) replace ({[x]} ({[f]} dom (gset string) _))
with (dom _ (<[x:=τ0]> (<[f:=TArrow τ0 τ2]> Γ'))); with (dom _ (<[x:=τ0]> (<[f:=TArrow τ0 τ2]> Γ'))); last first.
last by rewrite ?dom_insert_binder. { by rewrite !dom_insert_binder. }
eapply typed_ctx_closed; eauto. eapply typed_ctx_closed; eauto.
replace ({[x]} ({[f]} dom (gset string) Γ')) replace ({[x]} ({[f]} dom (gset string) _))
with (dom _ (<[x:=τ0]> (<[f:=TArrow τ0 τ2]> Γ'))); with (dom _ (<[x:=τ0]> (<[f:=TArrow τ0 τ2]> Γ'))); last first.
last by rewrite ?dom_insert_binder. { by rewrite !dom_insert_binder. }
eapply typed_ctx_closed; eauto. eapply typed_ctx_closed; eauto.
iAlways. iApply (IHK with "[Hrel]"); auto. iAlways. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_app with "[]"). + iApply (bin_log_related_app with "[]").
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
fundamental. fundamental.
+ iApply (bin_log_related_app with "[]"); try fundamental. + iApply (bin_log_related_app _ _ _ _ _ _ _ τ2 with "[]"); try fundamental.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_pair with "[]"); try fundamental. + iApply (bin_log_related_pair with "[]"); try fundamental.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
...@@ -298,15 +303,15 @@ Section bin_log_related_under_typed_ctx. ...@@ -298,15 +303,15 @@ Section bin_log_related_under_typed_ctx.
end. end.
iApply (bin_log_related_case with "[] []"); try fundamental. iApply (bin_log_related_case with "[] []"); try fundamental.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_if with "[] []"); try fundamental. + iApply (bin_log_related_if with "[] []"); try fundamental.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_if with "[] []"); try fundamental. + iApply (bin_log_related_if with "[] []"); try fundamental.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_if with "[] []"); try fundamental. + iApply (bin_log_related_if with "[] []"); try fundamental.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_nat_binop with "[]"); try fundamental. + iApply (bin_log_related_nat_binop with "[]"); try fundamental; eauto.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_nat_binop with "[]"); try fundamental. + iApply (bin_log_related_nat_binop with "[]"); try fundamental; eauto.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_fold with "[]"); try fundamental. + iApply (bin_log_related_fold with "[]"); try fundamental.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
...@@ -314,16 +319,17 @@ Section bin_log_related_under_typed_ctx. ...@@ -314,16 +319,17 @@ Section bin_log_related_under_typed_ctx.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_tlam with "[]"); try fundamental. + iApply (bin_log_related_tlam with "[]"); try fundamental.
(* TODO something wrong with setoids here *) (* TODO something wrong with setoids here *)
replace (dom (gset string) Γ') replace (dom (gset string) _)
with (dom (gset string) (subst (ren (+1)) <$> Γ')); last first. with (dom (gset string) (subst (ren (+1)) <$> Γ')); last first.
{ unfold_leibniz. by rewrite dom_fmap. } { unfold_leibniz. by rewrite !dom_fmap. }
eapply typed_ctx_closed; eauto. eapply typed_ctx_closed; eauto.
replace (dom (gset string) Γ') replace (dom (gset string) _)
with (dom (gset string) (subst (ren (+1)) <$> Γ')); last first. with (dom (gset string) (subst (ren (+1)) <$> Γ')); last first.
{ unfold_leibniz. by rewrite dom_fmap. } { unfold_leibniz. by rewrite !dom_fmap. }
eapply typed_ctx_closed; eauto. eapply typed_ctx_closed; eauto.
iAlways. iApply (IHK with "[Hrel]"); auto. iIntros (τi) "%". iAlways.
+ iApply (bin_log_related_tapp with "[]"); try fundamental. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_tapp' with "[]"); try fundamental.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_fork with "[]"); try fundamental. + iApply (bin_log_related_fork with "[]"); try fundamental.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
...@@ -341,5 +347,5 @@ Section bin_log_related_under_typed_ctx. ...@@ -341,5 +347,5 @@ Section bin_log_related_under_typed_ctx.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_CAS with "[] []"); try fundamental. + iApply (bin_log_related_CAS with "[] []"); try fundamental.
iApply (IHK with "[Hrel]"); auto. iApply (IHK with "[Hrel]"); auto.
Qed. Qed.
End bin_log_related_under_typed_ctx. End bin_log_related_under_typed_ctx.
...@@ -31,6 +31,7 @@ Definition FG_counter : val := λ: <>, ...@@ -31,6 +31,7 @@ Definition FG_counter : val := λ: <>,
Section CG_Counter. Section CG_Counter.
Context `{logrelG Σ}. Context `{logrelG Σ}.
Variable (Δ : list (prodC valC valC -n> iProp Σ)).
(* Coarse-grained increment *) (* Coarse-grained increment *)
Lemma CG_increment_type Γ : Lemma CG_increment_type Γ :
...@@ -43,8 +44,8 @@ Section CG_Counter. ...@@ -43,8 +44,8 @@ Section CG_Counter.
nclose specN E1 nclose specN E1
(x ↦ₛ (#nv n) - l ↦ₛ (#v false) - (x ↦ₛ (#nv n) - l ↦ₛ (#v false) -
(x ↦ₛ (#nv S n) - l ↦ₛ (#v false) - (x ↦ₛ (#nv S n) - l ↦ₛ (#v false) -
({E1,E2;Γ} t log fill K (Lit Unit) : τ)) - ({E1,E2;Δ;Γ} t log fill K (Lit Unit) : τ)) -
{E1,E2;Γ} t log fill K ((CG_increment $/ LocV x $/ LocV l) Unit)%E : τ)%I. {E1,E2;Δ;Γ} t log fill K ((CG_increment $/ LocV x $/ LocV l) Unit)%E : τ)%I.
Proof. Proof.
iIntros (?) "Hx Hl Hlog". iIntros (?) "Hx Hl Hlog".
unfold CG_increment. unlock. simpl_subst/=. unfold CG_increment. unlock. simpl_subst/=.
...@@ -81,8 +82,8 @@ Section CG_Counter. ...@@ -81,8 +82,8 @@ Section CG_Counter.
Lemma bin_log_FG_increment_l Γ K E x n t τ : Lemma bin_log_FG_increment_l Γ K E x n t τ :
x ↦ᵢ (#nv n) - x ↦ᵢ (#nv n) -
(x ↦ᵢ (#nv (S n)) - {E,E;Γ} fill K (Lit Unit) log t : τ) - (x ↦ᵢ (#nv (S n)) - {E,E;Δ;Γ} fill K (Lit Unit) log t : τ) -
{E,E;Γ} fill K (FG_increment (Loc x) Unit) log t : τ. {E,E;Δ;Γ} fill K (FG_increment (Loc x) Unit) log t : τ.
Proof. Proof.
iIntros "Hx Hlog". iIntros "Hx Hlog".
iApply bin_log_related_wp_l. iApply bin_log_related_wp_l.
...@@ -123,8 +124,8 @@ Section CG_Counter. ...@@ -123,8 +124,8 @@ Section CG_Counter.
(Hspec : nclose specN E1) : (Hspec : nclose specN E1) :
x ↦ₛ (#nv n) x ↦ₛ (#nv n)
- (x ↦ₛ (#nv n) - (x ↦ₛ (#nv n)
- {E1,E2;Γ} t log fill K (#n n)%E : τ)%I - {E1,E2;Δ;Γ} t log fill K (#n n)%E : τ)%I
- {E1,E2;Γ} t log fill K (lamsubst counter_read (LocV x) #())%E : τ. - {E1,E2;Δ;Γ} t log fill K (lamsubst counter_read (LocV x) #())%E : τ.
Proof. Proof.
iIntros "Hx Hlog". iIntros "Hx Hlog".
unfold counter_read. unlock. simpl. unfold counter_read. unlock. simpl.
...@@ -140,8 +141,8 @@ Section CG_Counter. ...@@ -140,8 +141,8 @@ Section CG_Counter.
(|={E1,E2}=> n, x ↦ᵢ (#nv n) R(n) (|={E1,E2}=> n, x ↦ᵢ (#nv n) R(n)
(( n, x ↦ᵢ (#nv n) R(n)) ={E2,E1}= True) (( n, x ↦ᵢ (#nv n) R(n)) ={E2,E1}= True)
( m, x ↦ᵢ (#nv (S m)) R(m) - ( m, x ↦ᵢ (#nv (S m)) R(m) -
{E2,E1;Γ} fill K (Lit Unit) log t : τ)) {E2,E1;Δ;Γ} fill K (Lit Unit) log t : τ))
- ({E1,E1;Γ} fill K ((FG_increment $/ LocV x) Unit)%E log t : τ). - ({E1,E1;Δ;Γ} fill K ((FG_increment $/ LocV x) Unit)%E log t : τ).
Proof. Proof.
iIntros "#H". iIntros "#H".
unfold FG_increment. unlock. simpl. unfold FG_increment. unlock. simpl.
...@@ -167,12 +168,12 @@ Section CG_Counter. ...@@ -167,12 +168,12 @@ Section CG_Counter.
iIntros "_ !> Hx". simpl. iIntros "_ !> Hx". simpl.
iDestruct "HQ" as "[_ HQ]". iDestruct "HQ" as "[_ HQ]".
iSpecialize ("HQ" $! n' with "[Hx HR]"). { iFrame. } iSpecialize ("HQ" $! n' with "[Hx HR]"). { iFrame. }
iApply (bin_log_related_if_true_masked_l _ _ _ K); auto. iApply bin_log_related_if_true_masked_l; auto.
- iExists (#nv n'). iFrame. - iExists (#nv n'). iFrame.
iSplitL; eauto; last first. iSplitL; eauto; last first.
{ iDestruct 1 as %Hfoo. exfalso. simplify_eq. } { iDestruct 1 as %Hfoo. exfalso. simplify_eq. }
iIntros "_ !> Hx". simpl. iIntros "_ !> Hx". simpl.
iApply (bin_log_related_if_false_masked_l _ _ _ K); auto. iApply bin_log_related_if_false_masked_l; auto.
iDestruct "HQ" as "[HQ _]". iDestruct "HQ" as "[HQ _]".
iMod ("HQ" with "[Hx HR]"). iMod ("HQ" with "[Hx HR]").
{ iExists _; iFrame. } { iExists _; iFrame. }
...@@ -184,13 +185,13 @@ Section CG_Counter. ...@@ -184,13 +185,13 @@ Section CG_Counter.
(|={E1,E2}=> n, x ↦ᵢ (#nv n) R(n) (|={E1,E2}=> n, x ↦ᵢ (#nv n) R(n)
(( n, x ↦ᵢ (#nv n) R(n)) ={E2,E1}= True) (( n, x ↦ᵢ (#nv n) R(n)) ={E2,E1}= True)
( m, x ↦ᵢ (#nv m) R(m) - ( m, x ↦ᵢ (#nv m) R(m) -
{E2,E1;Γ} fill K (#n m) log t : τ)) {E2,E1;Δ;Γ} fill K (#n m) log t : τ))
- {E1,E1;Γ} fill K ((counter_read $/ LocV x) #())%E log t : τ. - {E1,E1;Δ;Γ} fill K ((counter_read $/ LocV x) #())%E log t : τ.
Proof. Proof.
iIntros "#H". iIntros "#H".
unfold counter_read. unlock. simpl. unfold counter_read. unlock. simpl.
rel_rec_l. rel_rec_l.
iApply (bin_log_related_load_l). iApply bin_log_related_load_l.
iMod "H" as (n) "[Hx [HR Hfin]]". iModIntro. iMod "H" as (n) "[Hx [HR Hfin]]". iModIntro.
iExists _; iFrame "Hx". iNext. iExists _; iFrame "Hx". iNext.
iIntros "Hx". iIntros "Hx".
...@@ -201,7 +202,7 @@ Section CG_Counter. ...@@ -201,7 +202,7 @@ Section CG_Counter.
(* TODO: try to use with_lock rules *) (* TODO: try to use with_lock rules *)
Lemma FG_CG_increment_refinement l cnt cnt' Γ : Lemma FG_CG_increment_refinement l cnt cnt' Γ :
inv counterN (counter_inv l cnt cnt') - inv counterN (counter_inv l cnt cnt') -
Γ FG_increment $/ LocV cnt log CG_increment $/ LocV cnt' $/ LocV l : TArrow TUnit TUnit. {,;Δ;Γ} FG_increment $/ LocV cnt log CG_increment $/ LocV cnt' $/ LocV l : TArrow TUnit TUnit.
Proof. Proof.
iIntros "#Hinv". iIntros "#Hinv".
iApply bin_log_related_arrow. iApply bin_log_related_arrow.
...@@ -210,7 +211,7 @@ Section CG_Counter. ...@@ -210,7 +211,7 @@ Section CG_Counter.
{ unfold FG_increment. unlock; simpl_subst/=. solve_closed. (* TODO: add a clause to the reflection mechanism that reifies a [lambdasubst] expression as a closed one *) } { unfold FG_increment. unlock; simpl_subst/=. solve_closed. (* TODO: add a clause to the reflection mechanism that reifies a [lambdasubst] expression as a closed one *) }
{ unfold CG_increment. unlock; simpl_subst/=. solve_closed. } { unfold CG_increment. unlock; simpl_subst/=. solve_closed. }
iAlways. iIntros (Δ [v v']) "[% %]"; simpl in *; subst. clear Δ. iAlways. iIntros ([v v']) "[% %]"; simpl in *; subst.
iApply (bin_log_FG_increment_logatomic (fun n => (l ↦ₛ (#v false)) cnt' ↦ₛ #nv n)%I _ _ _ [] cnt with "[Hinv]"). iApply (bin_log_FG_increment_logatomic (fun n => (l ↦ₛ (#v false)) cnt' ↦ₛ #nv n)%I _ _ _ [] cnt with "[Hinv]").
iAlways. iAlways.
iInv counterN as ">Hcnt" "Hcl". iModIntro. iInv counterN as ">Hcnt" "Hcl". iModIntro.
...@@ -232,7 +233,7 @@ Section CG_Counter. ...@@ -232,7 +233,7 @@ Section CG_Counter.
Lemma counter_read_refinement l cnt cnt' Γ : Lemma counter_read_refinement l cnt cnt' Γ :
inv counterN (counter_inv l cnt cnt') - inv counterN (counter_inv l cnt cnt') -
Γ counter_read $/ #cnt log counter_read $/ #cnt' : TArrow TUnit TNat. {,;Δ;Γ} counter_read $/ #cnt log counter_read $/ #cnt' : TArrow TUnit TNat.
Proof. Proof.
iIntros "#Hinv". iIntros "#Hinv".
iApply bin_log_related_arrow. iApply bin_log_related_arrow.
...@@ -240,7 +241,7 @@ Section CG_Counter. ...@@ -240,7 +241,7 @@ Section CG_Counter.
{ unfold counter_read. unlock. simpl. reflexivity. } { unfold counter_read. unlock. simpl. reflexivity. }
{ unfold counter_read. unlock. simpl. solve_closed. } { unfold counter_read. unlock. simpl. solve_closed. }
{ unfold counter_read. unlock. simpl. solve_closed. } { unfold counter_read. unlock. simpl. solve_closed. }
iAlways. iIntros (Δ [v v']) "[% %]"; simpl in *; subst. clear Δ. iAlways. iIntros ([v v']) "[% %]"; simpl in *; subst.
iApply (bin_log_counter_read_atomic_l (fun n => (l ↦ₛ (#v false)) cnt' ↦ₛ #nv n)%I _ _ _ [] cnt with "[Hinv]"). iApply (bin_log_counter_read_atomic_l (fun n => (l ↦ₛ (#v false)) cnt' ↦ₛ #nv n)%I _ _ _ [] cnt with "[Hinv]").
iAlways. iInv counterN as (n) "[>Hl [>Hcnt >Hcnt']]" "Hclose". iAlways. iInv counterN as (n) "[>Hl [>Hcnt >Hcnt']]" "Hclose".
iModIntro. iModIntro.
...@@ -254,16 +255,16 @@ Section CG_Counter. ...@@ -254,16 +255,16 @@ Section CG_Counter.
iIntros "Hcnt'". iIntros "Hcnt'".
iMod ("Hclose" with "[Hl Hcnt Hcnt']"); simpl. iMod ("Hclose" with "[Hl Hcnt Hcnt']"); simpl.
{ iNext. iExists _. by iFrame. } { iNext. iExists _. by iFrame. }
iApply bin_log_related_val; intros; simpl; eauto. rel_vals. simpl. eauto.
Qed. Qed.
Lemma FG_CG_counter_refinement : Lemma FG_CG_counter_refinement :
FG_counter log CG_counter : {,;Δ;} FG_counter log CG_counter :
TArrow TUnit (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)). TArrow TUnit (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)).
Proof. Proof.
unfold FG_counter, CG_counter. unfold FG_counter, CG_counter.
iApply bin_log_related_arrow; try by (unlock; eauto). iApply bin_log_related_arrow; try by (unlock; eauto).
iAlways. iIntros (? [? ?]) "/= [% %]"; simplify_eq/=. iAlways. iIntros ([? ?]) "/= [% %]"; simplify_eq/=.
unlock. rel_rec_l. rel_rec_r. unlock. rel_rec_l. rel_rec_r.
rel_bind_r (newlock #())%E. rel_bind_r (newlock #())%E.
iApply (bin_log_related_newlock_r); auto; simpl. iApply (bin_log_related_newlock_r); auto; simpl.
...@@ -294,7 +295,6 @@ Section CG_Counter. ...@@ -294,7 +295,6 @@ Section CG_Counter.
rel_rec_r. rel_rec_r.
iApply (counter_read_refinement with "Hinv"). iApply (counter_read_refinement with "Hinv").
Qed. Qed.
End CG_Counter. End CG_Counter.
Theorem counter_ctx_refinement : Theorem counter_ctx_refinement :
......
...@@ -42,10 +42,10 @@ Section Refinement. ...@@ -42,10 +42,10 @@ 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 Δ Γ E1 K ρ t τ :
choiceN E1 choiceN E1
spec_ctx ρ - ( b, {E1,E1;Γ} fill K (# b) log t : τ) spec_ctx ρ - ( b, {E1,E1;Δ;Γ} fill K (# b) log t : τ)
- {E1,E1;Γ} fill K (rand #())%E log t : τ. - {E1,E1;Δ;Γ} fill K (rand #())%E log t : τ.
Proof. Proof.
iIntros (?) "#Hs Hlog". iIntros (?) "#Hs Hlog".
unfold rand. unlock. simpl. unfold rand. unlock. simpl.
...@@ -74,12 +74,12 @@ Section Refinement. ...@@ -74,12 +74,12 @@ Section Refinement.
done. done.
Qed. Qed.
Lemma rand_r b Γ E1 E2 K ρ t τ : Lemma rand_r b Δ Γ E1 E2 K ρ t τ :
specN E1 specN E1
choiceN E1 choiceN E1
spec_ctx ρ - spec_ctx ρ -
{E1,E2;Γ} t log fill K (# b) : τ - {E1,E2;Δ;Γ} t log fill K (# b) : τ -
{E1,E2;Γ} t log fill K (rand #())%E : τ. {E1,E2;Δ;Γ} t log fill K (rand #())%E : τ.
Proof. Proof.
iIntros (??) "#Hs Hlog". iIntros (??) "#Hs Hlog".
unfold rand. unlock. unfold rand. unlock.
...@@ -94,11 +94,11 @@ Section Refinement. ...@@ -94,11 +94,11 @@ Section Refinement.
- by rel_load_r. - by rel_load_r.
Qed. Qed.
Lemma lateChoice_l Γ x v ρ t : Lemma lateChoice_l Δ Γ x v ρ t :
spec_ctx ρ - x ↦ᵢ v - spec_ctx ρ - x ↦ᵢ v -
(x ↦ᵢ (#nv 0) - b, Γ # b log t : TBool) - (x ↦ᵢ (#nv 0) - b, {,;Δ;Γ} # 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.
rel_rec_l. rel_rec_l.
...@@ -109,9 +109,9 @@ Section Refinement. ...@@ -109,9 +109,9 @@ Section Refinement.
by iApply "Hlog". by iApply "Hlog".
Qed. Qed.
Lemma prerefinement Γ x x' n ρ : Lemma prerefinement Δ Γ x x' n ρ :
(spec_ctx ρ - x ↦ᵢ (#nv n) - x' ↦ₛ (#nv n) - (spec_ctx ρ - x ↦ᵢ (#nv n) - x' ↦ₛ (#nv n) -
Γ lateChoice #x log earlyChoice #x' : TBool)%I. {,;Δ;Γ} lateChoice #x log earlyChoice #x' : TBool)%I.
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".
...@@ -124,12 +124,12 @@ Section Refinement. ...@@ -124,12 +124,12 @@ Section Refinement.
rel_rec_r. rel_rec_r.
rel_store_r. simpl. rel_store_r. simpl.
rel_rec_r. rel_rec_r.
rel_vals; eauto. rel_vals; simpl; eauto.
Qed. Qed.
Lemma prerefinement2 Γ x x' n ρ : Lemma prerefinement2 Δ Γ x x' n ρ :
(spec_ctx ρ - x ↦ᵢ (#nv n) - x' ↦ₛ (#nv n) - (spec_ctx ρ - x ↦ᵢ (#nv n) - x' ↦ₛ (#nv n) -
Γ earlyChoice #x log lateChoice #x' : TBool)%I. {,;Δ;Γ} earlyChoice #x log lateChoice #x' : TBool)%I.
Proof. Proof.
iIntros "#Hspec Hx Hx'". iIntros "#Hspec Hx Hx'".
unfold earlyChoice. unlock. unfold earlyChoice. unlock.
...@@ -147,7 +147,7 @@ Section Refinement. ...@@ -147,7 +147,7 @@ Section Refinement.
rel_store_l. simpl. rel_store_l. simpl.
rel_rec_l. rel_rec_l.
rel_vals; eauto. rel_vals; simpl; eauto.
Qed. Qed.
End Refinement. End Refinement.
...@@ -43,6 +43,7 @@ Hint Resolve with_lock_type : typeable. ...@@ -43,6 +43,7 @@ Hint Resolve with_lock_type : typeable.
Section proof. Section proof.
Context `{logrelG Σ}. Context `{logrelG Σ}.
Variable (E1 E2 : coPset). Variable (E1 E2 : coPset).
Variable (Δ : list (prodC valC valC -n> iProp Σ)).
Lemma steps_newlock ρ j K Lemma steps_newlock ρ j K
(Hcl : nclose specN E1) : (Hcl : nclose specN E1) :
...@@ -58,8 +59,8 @@ Section proof. ...@@ -58,8 +59,8 @@ Section proof.
Lemma bin_log_related_newlock_r Γ K t τ Lemma bin_log_related_newlock_r Γ K t τ
(Hcl : nclose specN E1) : (Hcl : nclose specN E1) :
( l : loc, l ↦ₛ (#v false) - {E1,E2;Γ} t log fill K (Loc l) : τ)%I ( l : loc, l ↦ₛ (#v false) - {E1,E2;Δ;Γ} t log fill K (Loc l) : τ)%I
- {E1,E2;Γ} t log fill K (newlock #())%E: τ. - {E1,E2;Δ;Γ} t log fill K (newlock #())%E: τ.
Proof. Proof.
iIntros "Hlog". iIntros "Hlog".
unfold newlock. unlock. unfold newlock. unlock.
...@@ -87,8 +88,8 @@ Section proof. ...@@ -87,8 +88,8 @@ Section proof.
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 E1) :
l ↦ₛ (#v false) - l ↦ₛ (#v false) -
(l ↦ₛ (#v true) - {E1,E2;Γ} t log fill K (Lit Unit) : τ)%I (l ↦ₛ (#v true) - {E1,E2;Δ;Γ} t log fill K (Lit Unit) : τ)%I
- {E1,E2;Γ} t log fill K (App acquire (Loc l)) : τ. - {E1,E2;Δ;Γ} t log fill K (App acquire (Loc l)) : τ.
Proof. Proof.
iIntros "Hl Hlog". iIntros "Hl Hlog".
unfold acquire. unlock. unfold acquire. unlock.
...@@ -115,8 +116,8 @@ Section proof. ...@@ -115,8 +116,8 @@ Section proof.
Lemma bin_log_related_release_r Γ K l t τ b Lemma bin_log_related_release_r Γ K l t τ b
(Hcl : nclose specN E1) : (Hcl : nclose specN E1) :
l ↦ₛ (#v b) - l ↦ₛ (#v b) -
(l ↦ₛ (#v false) - {E1,E2;Γ} t log fill K (Lit Unit) : τ)%I (l ↦ₛ (#v false) - {E1,E2;Δ;Γ} t log fill K (Lit Unit) : τ)%I
- {E1,E2;Γ} t log fill K (App release (Loc l)) : τ. - {E1,E2;Δ;Γ} t log fill K (App release (Loc l)) : τ.
Proof. Proof.
iIntros "Hl Hlog". iIntros "Hl Hlog".
unfold release. unlock. unfold release. unlock.
...@@ -160,11 +161,11 @@ Section proof. ...@@ -160,11 +161,11 @@ Section proof.
(to_val ev = Some v) (to_val ev = Some v)
(to_val ew = Some w) (to_val ew = Some w)
(nclose specN E1) (nclose specN E1)
( K, (Q - {E1,E2;Γ} t log fill K ev : τ) - ( K, (Q - {E1,E2;Δ;Γ} t log fill K ev : τ) -
{E1,E2;Γ} t log fill K (App e ew) : τ) - {E1,E2;Δ;Γ} t log fill K (App e ew) : τ) -
l ↦ₛ (#v false) - l ↦ₛ (#v false) -
(Q - l ↦ₛ (#v false) - {E1,E2;Γ} t log fill K ev : τ)%I (Q - l ↦ₛ (#v false) - {E1,E2;Δ;Γ} t log fill K ev : τ)%I
- {E1,E2;Γ} t log fill K (with_lock e (Loc l) ew) : τ. - {E1,E2;Δ;Γ} t log fill K (with_lock e (Loc l) ew) : τ.
Proof. Proof.
iIntros (????) "HA Hl Hlog". iIntros (????) "HA Hl Hlog".
rel_bind_r (with_lock e). rel_bind_r (with_lock e).
......
...@@ -28,12 +28,12 @@ Hint Resolve par_type : typeable. ...@@ -28,12 +28,12 @@ Hint Resolve par_type : typeable.
Section compatibility. Section compatibility.
Context `{logrelG Σ}. Context `{logrelG Σ}.
Lemma bin_log_related_par Γ E e1 e2 e1' e2' τ1 τ2 : Lemma bin_log_related_par Δ Γ E e1 e2 e1' e2' τ1 τ2 :
specN E specN E
logN E logN E
{E,E;Γ} e1 log e1' : TArrow TUnit τ1 - {E,E;Δ;Γ} e1 log e1' : TArrow TUnit τ1 -
{E,E;Γ} e2 log e2' : TArrow TUnit τ2 - {E,E;Δ;Γ} e2 log e2' : TArrow TUnit τ2 -
{E,E;Γ} par e1 e2 log par e1' e2' : TProd τ1 τ2. {E,E;Δ;Γ} par e1 e2 log par e1' e2' : TProd τ1 τ2.
Proof. Proof.
iIntros (??) "He1 He2". iIntros (??) "He1 He2".
iApply (bin_log_related_app with "[He1] He2"). iApply (bin_log_related_app with "[He1] He2").
......
This diff is collapsed.
...@@ -17,19 +17,19 @@ Section hax. ...@@ -17,19 +17,19 @@ Section hax.
Notation D := (prodC valC valC -n> iProp Σ). Notation D := (prodC valC valC -n> iProp Σ).
Implicit Types Δ : listC D. Implicit Types Δ : listC D.
Lemma bin_log_related_arrow Γ E (f x f' x' : binder) (e e' eb eb' : expr) (τ τ' : type) : Lemma bin_log_related_arrow Δ Γ E (f x f' x' : binder) (e e' eb eb' : expr) (τ τ' : type) :
e = (rec: f x := eb)%E e = (rec: f x := eb)%E
e' = (rec: f' x' := eb')%E e' = (rec: f' x' := eb')%E
Closed e Closed e
Closed e' Closed e'
( Δ vv, τ Δ vv - ( vv, τ Δ vv -
Γ App e (of_val (vv.1)) log App e' (of_val (vv.2)) : τ') - {,;Δ;Γ} App e (of_val (vv.1)) log App e' (of_val (vv.2)) : τ') -
{E,E;Γ} e log e' : TArrow τ τ'. {E,E;Δ;Γ} e log e' : TArrow τ τ'.
Proof. Proof.
iIntros (????) "#H". iIntros (????) "#H".
subst e e'. subst e e'.
rewrite bin_log_related_eq. rewrite bin_log_related_eq.
iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j