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 :=
Section bin_log_related_under_typed_ctx.
Context `{logrelG Σ}.
Ltac fundamental :=
Ltac fundamental := simpl;
try (solve_ndisj);
lazymatch goal with
| [ H : _ ⊢ₜ ?e : _ |- (_ ?Γ ?e log ?e : _)] =>
| [ H : _ ⊢ₜ ?e : _ |- (_ {_,_;_;?Γ} ?e log ?e : _)] =>
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.
Ltac solve_closed_typed :=
lazymatch goal with
......@@ -247,30 +250,32 @@ Section bin_log_related_under_typed_ctx.
(Closed (dom _ Γ) e)
(Closed (dom _ Γ) e')
typed_ctx K Γ τ Γ' τ'
(Γ e log e' : τ) - Γ' fill_ctx K e log fill_ctx K e' : τ'.
Proof.
( ( Δ, ({,;Δ;Γ} e log e' : τ)) -
Δ, ({,;Δ;Γ'} fill_ctx K e log fill_ctx K e' : τ'))%I.
Proof.
revert Γ τ Γ' τ' e e'.
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].
iIntros "#Hrel".
specialize (IHK _ _ _ _ e e' H1 H2 Hx2).
inversion Hx1; subst; simpl; try fold_interp.
+ iApply (bin_log_related_rec with "[]"); auto;
inversion Hx1; subst; simpl; try fold_interp; iIntros "#Hrel";
iIntros (Δ) "!#".
+ iApply (bin_log_related_rec with "[-]"); auto;
rewrite ?cons_binder_union.
replace ({[x]} ({[f]} dom (gset string) Γ'))
with (dom _ (<[x:=τ0]> (<[f:=TArrow τ0 τ2]> Γ')));
last by rewrite ?dom_insert_binder.
replace ({[x]} ({[f]} dom (gset string) _))
with (dom _ (<[x:=τ0]> (<[f:=TArrow τ0 τ2]> Γ'))); last first.
{ by rewrite !dom_insert_binder. }
eapply typed_ctx_closed; eauto.
replace ({[x]} ({[f]} dom (gset string) Γ'))
with (dom _ (<[x:=τ0]> (<[f:=TArrow τ0 τ2]> Γ')));
last by rewrite ?dom_insert_binder.
replace ({[x]} ({[f]} dom (gset string) _))
with (dom _ (<[x:=τ0]> (<[f:=TArrow τ0 τ2]> Γ'))); last first.
{ by rewrite !dom_insert_binder. }
eapply typed_ctx_closed; eauto.
iAlways. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_app with "[]").
iApply (IHK with "[Hrel]"); auto.
fundamental.
+ iApply (bin_log_related_app with "[]"); try fundamental.
+ iApply (bin_log_related_app _ _ _ _ _ _ _ τ2 with "[]"); try fundamental.
iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_pair with "[]"); try fundamental.
iApply (IHK with "[Hrel]"); auto.
......@@ -298,15 +303,15 @@ Section bin_log_related_under_typed_ctx.
end.
iApply (bin_log_related_case with "[] []"); try fundamental.
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 (bin_log_related_if with "[] []"); try fundamental.
iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_if with "[] []"); try fundamental.
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 (bin_log_related_nat_binop with "[]"); try fundamental.
+ iApply (bin_log_related_nat_binop with "[]"); try fundamental; eauto.
iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_fold with "[]"); try fundamental.
iApply (IHK with "[Hrel]"); auto.
......@@ -314,16 +319,17 @@ Section bin_log_related_under_typed_ctx.
iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_tlam with "[]"); try fundamental.
(* TODO something wrong with setoids here *)
replace (dom (gset string) Γ')
replace (dom (gset string) _)
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.
replace (dom (gset string) Γ')
replace (dom (gset string) _)
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.
iAlways. iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_tapp with "[]"); try fundamental.
iIntros (τi) "%". iAlways.
iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_tapp' with "[]"); try fundamental.
iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_fork with "[]"); try fundamental.
iApply (IHK with "[Hrel]"); auto.
......@@ -341,5 +347,5 @@ Section bin_log_related_under_typed_ctx.
iApply (IHK with "[Hrel]"); auto.
+ iApply (bin_log_related_CAS with "[] []"); try fundamental.
iApply (IHK with "[Hrel]"); auto.
Qed.
Qed.
End bin_log_related_under_typed_ctx.
......@@ -31,6 +31,7 @@ Definition FG_counter : val := λ: <>,
Section CG_Counter.
Context `{logrelG Σ}.
Variable (Δ : list (prodC valC valC -n> iProp Σ)).
(* Coarse-grained increment *)
Lemma CG_increment_type Γ :
......@@ -43,8 +44,8 @@ Section CG_Counter.
nclose specN E1
(x ↦ₛ (#nv 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 ((CG_increment $/ LocV x $/ LocV l) Unit)%E : τ)%I.
({E1,E2;Δ;Γ} t log fill K (Lit Unit) : τ)) -
{E1,E2;Δ;Γ} t log fill K ((CG_increment $/ LocV x $/ LocV l) Unit)%E : τ)%I.
Proof.
iIntros (?) "Hx Hl Hlog".
unfold CG_increment. unlock. simpl_subst/=.
......@@ -81,8 +82,8 @@ Section CG_Counter.
Lemma bin_log_FG_increment_l Γ K E x n t τ :
x ↦ᵢ (#nv n) -
(x ↦ᵢ (#nv (S n)) - {E,E;Γ} fill K (Lit Unit) log t : τ) -
{E,E;Γ} fill K (FG_increment (Loc x) 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 : τ.
Proof.
iIntros "Hx Hlog".
iApply bin_log_related_wp_l.
......@@ -123,8 +124,8 @@ Section CG_Counter.
(Hspec : nclose specN E1) :
x ↦ₛ (#nv n)
- (x ↦ₛ (#nv n)
- {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 (#n n)%E : τ)%I
- {E1,E2;Δ;Γ} t log fill K (lamsubst counter_read (LocV x) #())%E : τ.
Proof.
iIntros "Hx Hlog".
unfold counter_read. unlock. simpl.
......@@ -140,8 +141,8 @@ Section CG_Counter.
(|={E1,E2}=> n, x ↦ᵢ (#nv n) R(n)
(( n, x ↦ᵢ (#nv n) R(n)) ={E2,E1}= True)
( m, x ↦ᵢ (#nv (S m)) R(m) -
{E2,E1;Γ} fill K (Lit Unit) log t : τ))
- ({E1,E1;Γ} fill K ((FG_increment $/ LocV x) Unit)%E log t : τ).
{E2,E1;Δ;Γ} fill K (Lit Unit) log t : τ))
- ({E1,E1;Δ;Γ} fill K ((FG_increment $/ LocV x) Unit)%E log t : τ).
Proof.
iIntros "#H".
unfold FG_increment. unlock. simpl.
......@@ -167,12 +168,12 @@ Section CG_Counter.
iIntros "_ !> Hx". simpl.
iDestruct "HQ" as "[_ HQ]".
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.
iSplitL; eauto; last first.
{ iDestruct 1 as %Hfoo. exfalso. simplify_eq. }
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 _]".
iMod ("HQ" with "[Hx HR]").
{ iExists _; iFrame. }
......@@ -184,13 +185,13 @@ Section CG_Counter.
(|={E1,E2}=> n, x ↦ᵢ (#nv n) R(n)
(( n, x ↦ᵢ (#nv n) R(n)) ={E2,E1}= True)
( m, x ↦ᵢ (#nv m) R(m) -
{E2,E1;Γ} fill K (#n m) log t : τ))
- {E1,E1;Γ} fill K ((counter_read $/ LocV x) #())%E log t : τ.
{E2,E1;Δ;Γ} fill K (#n m) log t : τ))
- {E1,E1;Δ;Γ} fill K ((counter_read $/ LocV x) #())%E log t : τ.
Proof.
iIntros "#H".
unfold counter_read. unlock. simpl.
rel_rec_l.
iApply (bin_log_related_load_l).
iApply bin_log_related_load_l.
iMod "H" as (n) "[Hx [HR Hfin]]". iModIntro.
iExists _; iFrame "Hx". iNext.
iIntros "Hx".
......@@ -201,7 +202,7 @@ Section CG_Counter.
(* TODO: try to use with_lock rules *)
Lemma FG_CG_increment_refinement 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.
iIntros "#Hinv".
iApply bin_log_related_arrow.
......@@ -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 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]").
iAlways.
iInv counterN as ">Hcnt" "Hcl". iModIntro.
......@@ -232,7 +233,7 @@ Section CG_Counter.
Lemma counter_read_refinement 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.
iIntros "#Hinv".
iApply bin_log_related_arrow.
......@@ -240,7 +241,7 @@ Section CG_Counter.
{ unfold counter_read. unlock. simpl. reflexivity. }
{ 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]").
iAlways. iInv counterN as (n) "[>Hl [>Hcnt >Hcnt']]" "Hclose".
iModIntro.
......@@ -254,16 +255,16 @@ Section CG_Counter.
iIntros "Hcnt'".
iMod ("Hclose" with "[Hl Hcnt Hcnt']"); simpl.
{ iNext. iExists _. by iFrame. }
iApply bin_log_related_val; intros; simpl; eauto.
rel_vals. simpl. eauto.
Qed.
Lemma FG_CG_counter_refinement :
FG_counter log CG_counter :
{,;Δ;} FG_counter log CG_counter :
TArrow TUnit (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)).
Proof.
unfold FG_counter, CG_counter.
iApply bin_log_related_arrow; try by (unlock; eauto).
iAlways. iIntros (? [? ?]) "/= [% %]"; simplify_eq/=.
iAlways. iIntros ([? ?]) "/= [% %]"; simplify_eq/=.
unlock. rel_rec_l. rel_rec_r.
rel_bind_r (newlock #())%E.
iApply (bin_log_related_newlock_r); auto; simpl.
......@@ -294,7 +295,6 @@ Section CG_Counter.
rel_rec_r.
iApply (counter_read_refinement with "Hinv").
Qed.
End CG_Counter.
Theorem counter_ctx_refinement :
......
......@@ -42,10 +42,10 @@ Section Refinement.
iIntros "Hy"; iMod ("Hcl" with "[Hy]"); eauto.
Qed.
Lemma rand_l Γ E1 K ρ t τ :
Lemma rand_l Δ Γ E1 K ρ t τ :
choiceN E1
spec_ctx ρ - ( b, {E1,E1;Γ} fill K (# b) log t : τ)
- {E1,E1;Γ} fill K (rand #())%E log t : τ.
spec_ctx ρ - ( b, {E1,E1;Δ;Γ} fill K (# b) log t : τ)
- {E1,E1;Δ;Γ} fill K (rand #())%E log t : τ.
Proof.
iIntros (?) "#Hs Hlog".
unfold rand. unlock. simpl.
......@@ -74,12 +74,12 @@ Section Refinement.
done.
Qed.
Lemma rand_r b Γ E1 E2 K ρ t τ :
Lemma rand_r b Δ Γ E1 E2 K ρ t τ :
specN E1
choiceN E1
spec_ctx ρ -
{E1,E2;Γ} t log fill K (# b) : τ -
{E1,E2;Γ} t log fill K (rand #())%E : τ.
{E1,E2;Δ;Γ} t log fill K (# b) : τ -
{E1,E2;Δ;Γ} t log fill K (rand #())%E : τ.
Proof.
iIntros (??) "#Hs Hlog".
unfold rand. unlock.
......@@ -94,11 +94,11 @@ Section Refinement.
- by rel_load_r.
Qed.
Lemma lateChoice_l Γ x v ρ t :
Lemma lateChoice_l Δ Γ x v ρ t :
spec_ctx ρ - x ↦ᵢ v -
(x ↦ᵢ (#nv 0) - b, Γ # b log t : TBool) -
Γ lateChoice #x log t : TBool.
Proof.
(x ↦ᵢ (#nv 0) - b, {,;Δ;Γ} # b log t : TBool) -
{,;Δ;Γ} lateChoice #x log t : TBool.
Proof.
iIntros "#Hs Hx Hlog".
unfold lateChoice. unlock.
rel_rec_l.
......@@ -109,9 +109,9 @@ Section Refinement.
by iApply "Hlog".
Qed.
Lemma prerefinement Γ x x' n ρ :
Lemma prerefinement Δ Γ x x' n ρ :
(spec_ctx ρ - x ↦ᵢ (#nv n) - x' ↦ₛ (#nv n) -
Γ lateChoice #x log earlyChoice #x' : TBool)%I.
{,;Δ;Γ} lateChoice #x log earlyChoice #x' : TBool)%I.
Proof.
iIntros "#Hspec Hx Hx'".
iApply (lateChoice_l with "Hspec Hx"). iIntros "Hx".
......@@ -124,12 +124,12 @@ Section Refinement.
rel_rec_r.
rel_store_r. simpl.
rel_rec_r.
rel_vals; eauto.
rel_vals; simpl; eauto.
Qed.
Lemma prerefinement2 Γ x x' n ρ :
Lemma prerefinement2 Δ Γ x x' n ρ :
(spec_ctx ρ - x ↦ᵢ (#nv n) - x' ↦ₛ (#nv n) -
Γ earlyChoice #x log lateChoice #x' : TBool)%I.
{,;Δ;Γ} earlyChoice #x log lateChoice #x' : TBool)%I.
Proof.
iIntros "#Hspec Hx Hx'".
unfold earlyChoice. unlock.
......@@ -147,7 +147,7 @@ Section Refinement.
rel_store_l. simpl.
rel_rec_l.
rel_vals; eauto.
rel_vals; simpl; eauto.
Qed.
End Refinement.
......@@ -43,6 +43,7 @@ Hint Resolve with_lock_type : typeable.
Section proof.
Context `{logrelG Σ}.
Variable (E1 E2 : coPset).
Variable (Δ : list (prodC valC valC -n> iProp Σ)).
Lemma steps_newlock ρ j K
(Hcl : nclose specN E1) :
......@@ -58,8 +59,8 @@ Section proof.
Lemma bin_log_related_newlock_r Γ K t τ
(Hcl : nclose specN E1) :
( l : loc, l ↦ₛ (#v false) - {E1,E2;Γ} t log fill K (Loc l) : τ)%I
- {E1,E2;Γ} t log fill K (newlock #())%E: τ.
( l : loc, l ↦ₛ (#v false) - {E1,E2;Δ;Γ} t log fill K (Loc l) : τ)%I
- {E1,E2;Δ;Γ} t log fill K (newlock #())%E: τ.
Proof.
iIntros "Hlog".
unfold newlock. unlock.
......@@ -87,8 +88,8 @@ Section proof.
Lemma bin_log_related_acquire_r Γ K l t τ
(Hcl : nclose specN E1) :
l ↦ₛ (#v false) -
(l ↦ₛ (#v true) - {E1,E2;Γ} t log fill K (Lit Unit) : τ)%I
- {E1,E2;Γ} t log fill K (App acquire (Loc l)) : τ.
(l ↦ₛ (#v true) - {E1,E2;Δ;Γ} t log fill K (Lit Unit) : τ)%I
- {E1,E2;Δ;Γ} t log fill K (App acquire (Loc l)) : τ.
Proof.
iIntros "Hl Hlog".
unfold acquire. unlock.
......@@ -115,8 +116,8 @@ Section proof.
Lemma bin_log_related_release_r Γ K l t τ b
(Hcl : nclose specN E1) :
l ↦ₛ (#v b) -
(l ↦ₛ (#v false) - {E1,E2;Γ} t log fill K (Lit Unit) : τ)%I
- {E1,E2;Γ} t log fill K (App release (Loc l)) : τ.
(l ↦ₛ (#v false) - {E1,E2;Δ;Γ} t log fill K (Lit Unit) : τ)%I
- {E1,E2;Δ;Γ} t log fill K (App release (Loc l)) : τ.
Proof.
iIntros "Hl Hlog".
unfold release. unlock.
......@@ -160,11 +161,11 @@ Section proof.
(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) : τ) -
( K, (Q - {E1,E2;Δ;Γ} t log fill K ev : τ) -
{E1,E2;Δ;Γ} t log fill K (App e ew) : τ) -
l ↦ₛ (#v false) -
(Q - l ↦ₛ (#v false) - {E1,E2;Γ} t log fill K ev : τ)%I
- {E1,E2;Γ} t log fill K (with_lock e (Loc l) ew) : τ.
(Q - l ↦ₛ (#v false) - {E1,E2;Δ;Γ} t log fill K ev : τ)%I
- {E1,E2;Δ;Γ} t log fill K (with_lock e (Loc l) ew) : τ.
Proof.
iIntros (????) "HA Hl Hlog".
rel_bind_r (with_lock e).
......
......@@ -28,12 +28,12 @@ Hint Resolve par_type : typeable.
Section compatibility.
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
logN E
{E,E;Γ} e1 log e1' : TArrow TUnit τ1 -
{E,E;Γ} e2 log e2' : TArrow TUnit τ2 -
{E,E;Γ} par e1 e2 log par e1' e2' : TProd τ1 τ2.
{E,E;Δ;Γ} e1 log e1' : TArrow TUnit τ1 -
{E,E;Δ;Γ} e2 log e2' : TArrow TUnit τ2 -
{E,E;Δ;Γ} par e1 e2 log par e1' e2' : TProd τ1 τ2.
Proof.
iIntros (??) "He1 He2".
iApply (bin_log_related_app with "[He1] He2").
......
......@@ -30,12 +30,12 @@ Section masked.
try (iMod vh);
iDestruct vh as (w) (String.append "[Hj " (String.append Hv " ]")); simpl.
Lemma bin_log_related_var Γ x τ :
Lemma bin_log_related_var Δ Γ x τ :
Γ !! x = Some τ
{E,E;Γ} Var x log Var x : τ.
{E,E;Δ;Γ} Var x log Var x : τ.
Proof.
rewrite bin_log_related_eq.
iIntros (? Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj".
iIntros (? vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj".
iDestruct (interp_env_Some_l with "HΓ") as ([v v']) "[Hvv' ?]"; first done.
iDestruct "Hvv'" as %Hvv'.
cbn-[env_subst].
......@@ -46,37 +46,37 @@ Section masked.
iModIntro. value_case; eauto.
Qed.
Lemma bin_log_related_unit Γ : {E,E;Γ} Unit log Unit : TUnit.
Lemma bin_log_related_unit Δ Γ : {E,E;Δ;Γ} Unit log Unit : TUnit.
Proof.
rewrite bin_log_related_eq.
iIntros (Δ vvs ρ) "#Hs HΓ"; iIntros (j K) "Hj /=".
iIntros (vvs ρ) "#Hs HΓ"; iIntros (j K) "Hj /=".
value_case.
iExists UnitV; eauto.
Qed.
Lemma bin_log_related_nat Γ n : {E,E;Γ} #n n log #n n : TNat.
Lemma bin_log_related_nat Δ Γ n : {E,E;Δ;Γ} #n n log #n n : TNat.
Proof.
rewrite bin_log_related_eq.
iIntros (Δ vvs ρ) "#Hs HΓ"; iIntros (j K) "Hj /=".
iIntros (vvs ρ) "#Hs HΓ"; iIntros (j K) "Hj /=".
value_case.
iExists (#nv _); eauto.
Qed.
Lemma bin_log_related_bool Γ b : {E,E;Γ} # b log # b : TBool.
Lemma bin_log_related_bool Δ Γ b : {E,E;Δ;Γ} # b log # b : TBool.
Proof.
rewrite bin_log_related_eq.
iIntros (Δ vvs ρ) "#Hs HΓ"; iIntros (j K) "Hj /=".
iIntros (vvs ρ) "#Hs HΓ"; iIntros (j K) "Hj /=".
value_case.
iExists (#v _); eauto.
Qed.
Lemma bin_log_related_pair Γ e1 e2 e1' e2' τ1 τ2 :
{E,E;Γ} e1 log e1' : τ1 -
{E,E;Γ} e2 log e2' : τ2 -
{E,E;Γ} Pair e1 e2 log Pair e1' e2' : TProd τ1 τ2.
Lemma bin_log_related_pair Δ Γ e1 e2 e1' e2' τ1 τ2 :
{E,E;Δ;Γ} e1 log e1' : τ1 -
{E,E;Δ;Γ} e2 log e2' : τ2 -
{E,E;Δ;Γ} Pair e1 e2 log Pair e1' e2' : TProd τ1 τ2.
Proof.
rewrite bin_log_related_eq.
iIntros "IH1 IH2". iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
iIntros "IH1 IH2". iIntros (vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
cbn.
smart_bind j (env_subst _ e1) (env_subst _ e1') "IH1" v1 w1 "IH1".
smart_bind j (env_subst _ e2) (env_subst _ e2') "IH2" v2 w2 "IH2".
......@@ -86,14 +86,14 @@ Section masked.
iSplit; simpl; eauto. auto.
Qed.
Lemma bin_log_related_fst Γ e e' τ1 τ2 :
Lemma bin_log_related_fst Δ Γ e e' τ1 τ2 :
specN E
{E,E;Γ} e log e' : TProd τ1 τ2 -
{E,E;Γ} Fst e log Fst e' : τ1.
{E,E;Δ;Γ} e log e' : TProd τ1 τ2 -
{E,E;Δ;Γ} Fst e log Fst e' : τ1.
Proof.
rewrite bin_log_related_eq.
iIntros (?) "IH".
iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
iIntros (vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
cbn.
smart_bind j (env_subst _ e) (env_subst _ e') "IH" v w "IH".
iDestruct "IH" as ([v1 v2] [w1 w2]) "[% [IHw IHw']]".
......@@ -103,14 +103,14 @@ Section masked.
tp_fst j; eauto.
Qed.
Lemma bin_log_related_snd Γ e e' τ1 τ2 :
Lemma bin_log_related_snd Δ Γ e e' τ1 τ2 :
specN E
{E,E;Γ} e log e' : TProd τ1 τ2 -
{E,E;Γ} Snd e log Snd e' : τ2.
{E,E;Δ;Γ} e log e' : TProd τ1 τ2 -
{E,E;Δ;Γ} Snd e log Snd e' : τ2.
Proof.
rewrite bin_log_related_eq.
iIntros (?) "IH".
iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
iIntros (vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
cbn.
smart_bind j (env_subst _ e) (env_subst _ e') "IH" v w "IH".
iDestruct "IH" as ([v1 v2] [w1 w2]) "[% [IHw IHw']]".
......@@ -120,29 +120,29 @@ Section masked.
tp_snd j; eauto.
Qed.
Lemma bin_log_related_app Γ e1 e2 e1' e2' τ1 τ2 :
{E,E;Γ} e1 log e1' : TArrow τ1 τ2 -
{E,E;Γ} e2 log e2' : τ1 -
{E,E;Γ} App e1 e2 log App e1' e2' : τ2.
Lemma bin_log_related_app Δ Γ e1 e2 e1' e2' τ1 τ2 :
{E,E;Δ;Γ} e1 log e1' : TArrow τ1 τ2 -
{E,E;Δ;Γ} e2 log e2' : τ1 -
{E,E;Δ;Γ} App e1 e2 log App e1' e2' : τ2.
Proof.
rewrite bin_log_related_eq.
iIntros "IH1 IH2".
iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
iIntros (vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
smart_bind j (env_subst _ e1) (env_subst _ e1') "IH1" f f' "#IH1".
smart_bind j (env_subst _ e2) (env_subst _ e2') "IH2" v v' "IH2".
iSpecialize ("IH1" with "IH2 Hj").
by iMod "IH1".
Qed.
Lemma bin_log_related_rec (Γ : stringmap type) (f x : binder) (e e' : expr) τ1 τ2 :
Lemma bin_log_related_rec Δ (Γ : stringmap type) (f x : binder) (e e' : expr) τ1 τ2 :
Closed (x :b: f :b: dom _ Γ) e
Closed (x :b: f :b: dom _ Γ) e'
({E,E;<[x:=τ1]>(<[f:=TArrow τ1 τ2]>Γ)} e log e' : τ2) -
{E,E;Γ} Rec f x e log Rec f x e' : TArrow τ1 τ2.
({E,E;Δ;<[x:=τ1]>(<[f:=TArrow τ1 τ2]>Γ)} e log e' : τ2) -
{E,E;Δ;Γ} Rec f x e log Rec f x e' : TArrow τ1 τ2.
Proof.
rewrite bin_log_related_eq.
iIntros (??) "#Ht".
iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=". cbn.
iIntros (vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=". cbn.
iDestruct (interp_env_dom with "HΓ") as %Hdom.
(* TODO: how to get rid of/ simplify those proofs? *)
assert (Closed (x :b: f :b: )
......@@ -209,44 +209,44 @@ Section masked.
iApply ("Ht" with "Hj").
Qed.
Lemma bin_log_related_injl Γ e e' τ1 τ2 :
Lemma bin_log_related_injl Δ Γ e e' τ1 τ2 :
specN E
{E,E;Γ} e log e' : τ1 -
{E,E;Γ} InjL e log InjL e' : (TSum τ1 τ2).
{E,E;Δ;Γ} e log e' : τ1 -
{E,E;Δ;Γ} InjL e log InjL e' : (TSum τ1 τ2).
Proof.
rewrite bin_log_related_eq.
iIntros (?) "IH".
iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
iIntros (vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
smart_bind j (env_subst _ e) (env_subst _ e') "IH" v w "IH".
value_case.
iExists (InjLV w); iFrame.
iLeft. iExists (_,_); eauto 10.
Qed.
Lemma bin_log_related_injr Γ e e' τ1 τ