Commit 3ae7284d authored by Marianna Rapoport's avatar Marianna Rapoport
Browse files

Adding support for prophecy resolution to heap_lang.CAS

parent fb2b152a
......@@ -116,7 +116,7 @@ Section tests.
Lemma wp_cas l v :
val_is_unboxed v
l v - WP CAS #l v v {{ _, True }}.
l v - WP cas: #l, v, v {{ _, True }}.
Proof.
iIntros (?) "?". wp_cas as ? | ?. done. done.
Qed.
......
......@@ -121,7 +121,7 @@ Definition newcounter : val := λ: <>, ref #0.
Definition incr : val :=
rec: "incr" "l" :=
let: "n" := !"l" in
if: CAS "l" "n" (#1 + "n") then #() else "incr" "l".
if: cas: "l", "n", #1 + "n" then #() else "incr" "l".
Definition read : val := λ: "l", !"l".
(** The CMRA we need. *)
......@@ -222,7 +222,7 @@ Section counter_proof.
iDestruct 1 as (c) "[Hl Hγ]".
wp_load. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
wp_let. wp_op.
wp_bind (CAS _ _ _). iApply wp_inv_open; last iFrame "Hinv"; auto.
wp_bind (cas: _, _, _)%E. iApply wp_inv_open; last iFrame "Hinv"; auto.
iDestruct 1 as (c') ">[Hl Hγ]".
destruct (decide (c' = c)) as [->|].
- iCombine "Hγ" "Hγf" as "Hγ".
......
......@@ -8,7 +8,7 @@ Set Default Proof Using "Type".
Definition one_shot_example : val := λ: <>,
let: "x" := ref NONE in (
(* tryset *) (λ: "n",
CAS "x" NONE (SOME "n")),
cas: "x", NONE, SOME "n"),
(* check *) (λ: <>,
let: "y" := !"x" in λ: <>,
match: "y" with
......
......@@ -83,7 +83,7 @@ Inductive expr :=
| Alloc (e : expr)
| Load (e : expr)
| Store (e1 : expr) (e2 : expr)
| CAS (e0 : expr) (e1 : expr) (e2 : expr)
| CAS (e0 : expr) (e1 : expr) (e2 : expr) (e3 : expr) (e4 : expr)
| FAA (e1 : expr) (e2 : expr)
(* Prophecy *)
| NewProph
......@@ -190,8 +190,9 @@ Proof.
| Load e, Load e' => cast_if (decide (e = e'))
| Store e1 e2, Store e1' e2' =>
cast_if_and (decide (e1 = e1')) (decide (e2 = e2'))
| CAS e0 e1 e2, CAS e0' e1' e2' =>
cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2'))
| CAS e0 e1 e2 e3 e4, CAS e0' e1' e2' e3' e4' =>
cast_if_and5 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2'))
(decide (e3 = e3')) (decide (e4 = e4'))
| FAA e1 e2, FAA e1' e2' =>
cast_if_and (decide (e1 = e1')) (decide (e2 = e2'))
| NewProph, NewProph => left _
......@@ -251,7 +252,7 @@ Proof.
Qed.
Instance expr_countable : Countable expr.
Proof.
set (enc :=
set (enc :=
fix go e :=
match e with
| Val v => GenNode 0 [gov v]
......@@ -271,7 +272,7 @@ Proof.
| Alloc e => GenNode 13 [go e]
| Load e => GenNode 14 [go e]
| Store e1 e2 => GenNode 15 [go e1; go e2]
| CAS e0 e1 e2 => GenNode 16 [go e0; go e1; go e2]
| CAS e0 e1 e2 e3 e4 => GenNode 16 [go e0; go e1; go e2; go e3; go e4]
| FAA e1 e2 => GenNode 17 [go e1; go e2]
| NewProph => GenNode 18 []
| ResolveProph e1 e2 => GenNode 19 [go e1; go e2]
......@@ -306,7 +307,7 @@ Proof.
| GenNode 13 [e] => Alloc (go e)
| GenNode 14 [e] => Load (go e)
| GenNode 15 [e1; e2] => Store (go e1) (go e2)
| GenNode 16 [e0; e1; e2] => CAS (go e0) (go e1) (go e2)
| GenNode 16 [e0; e1; e2; e3; e4] => CAS (go e0) (go e1) (go e2) (go e3) (go e4)
| GenNode 17 [e1; e2] => FAA (go e1) (go e2)
| GenNode 18 [] => NewProph
| GenNode 19 [e1; e2] => ResolveProph (go e1) (go e2)
......@@ -359,9 +360,11 @@ Inductive ectx_item :=
| LoadCtx
| StoreLCtx (v2 : val)
| StoreRCtx (e1 : expr)
| CasLCtx (v1 : val) (v2 : val)
| CasMCtx (e0 : expr) (v2 : val)
| CasRCtx (e0 : expr) (e1 : expr)
| CasLCtx (v1 : val) (v2 : val) (v3 : val) (v4 : val)
| CasM1Ctx (e0 : expr) (v2 : val) (v3 : val) (v4 : val)
| CasM2Ctx (e0 : expr) (e1 : expr) (v3 : val) (v4 : val)
| CasM3Ctx (e0 : expr) (e1 : expr) (e2 : expr) (v4 : val)
| CasRCtx (e0 : expr) (e1 : expr) (e2 : expr) (e3 : expr)
| FaaLCtx (v2 : val)
| FaaRCtx (e1 : expr)
| ProphLCtx (v2 : val)
......@@ -386,9 +389,11 @@ Definition fill_item (Ki : ectx_item) (e : expr) : expr :=
| LoadCtx => Load e
| StoreLCtx v2 => Store e (Val v2)
| StoreRCtx e1 => Store e1 e
| CasLCtx v1 v2 => CAS e (Val v1) (Val v2)
| CasMCtx e0 v2 => CAS e0 e (Val v2)
| CasRCtx e0 e1 => CAS e0 e1 e
| CasLCtx v1 v2 v3 v4 => CAS e (Val v1) (Val v2) (Val v3) (Val v4)
| CasM1Ctx e0 v2 v3 v4 => CAS e0 e (Val v2) (Val v3) (Val v4)
| CasM2Ctx e0 e1 v3 v4 => CAS e0 e1 e (Val v3) (Val v4)
| CasM3Ctx e0 e1 e2 v4 => CAS e0 e1 e2 e (Val v4)
| CasRCtx e0 e1 e2 e3 => CAS e0 e1 e2 e3 e
| FaaLCtx v2 => FAA e (Val v2)
| FaaRCtx e1 => FAA e1 e
| ProphLCtx v2 => ResolveProph e (of_val v2)
......@@ -416,7 +421,7 @@ Fixpoint subst (x : string) (v : val) (e : expr) : expr :=
| Alloc e => Alloc (subst x v e)
| Load e => Load (subst x v e)
| Store e1 e2 => Store (subst x v e1) (subst x v e2)
| CAS e0 e1 e2 => CAS (subst x v e0) (subst x v e1) (subst x v e2)
| CAS e0 e1 e2 e3 e4 => CAS (subst x v e0) (subst x v e1) (subst x v e2) (subst x v e3) (subst x v e4)
| FAA e1 e2 => FAA (subst x v e1) (subst x v e2)
| NewProph => NewProph
| ResolveProph e1 e2 => ResolveProph (subst x v e1) (subst x v e2)
......@@ -485,6 +490,31 @@ Definition state_upd_used_proph_id (f: gset proph_id → gset proph_id) (σ: sta
{| heap := σ.(heap); used_proph_id := f σ.(used_proph_id) |}.
Arguments state_upd_used_proph_id _ !_ /.
(** We extend CAS to support atomic resolution of prophecy variables as follows:
[CAS p e1 e1 pv1 pv2]
where [pv1] and [pv2] are values of type [option (proph * val)].
If [CAS p e1 e2] succeeds, and if [pv1 = Some (p, v)], we atomically resolve the
prophecy variable [p] to [v]. If the [CAS] fails, we do the same of [pv2]:
[let b = CAS p e1 e2 ;;
match (if b then pv1 else pv2) with
| Some (p, v) => resolve p to v
| None => ()
end]
The following function takes a value and extracts its encoding
of an optional prophecy-value pair.
*)
Definition extract_proph_resolve (v : val) : option (option (proph_id * val)) :=
match v with
| InjLV (LitV LitUnit) =>
Some None
| InjRV (PairV (LitV (LitProphecy p)) v') =>
Some (Some (p, v'))
| _ =>
None
end.
Inductive head_step : expr state list observation expr state list (expr) Prop :=
| RecS f x e σ :
head_step (Rec f x e) σ [] (Val $ RecV f x e) σ []
......@@ -532,16 +562,22 @@ Inductive head_step : expr → state → list observation → expr → state →
[]
(Val $ LitV LitUnit) (state_upd_heap <[l:=v]> σ)
[]
| CasFailS l v1 v2 vl σ :
| CasFailS l v1 v2 v3 v4 pv pvs vl σ :
extract_proph_resolve v4 = Some pv
pvs = option_list pv
σ.(heap) !! l = Some vl vl v1
vals_cas_compare_safe vl v1
head_step (CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2)) σ []
(Val $ LitV $ LitBool false) σ []
| CasSucS l v1 v2 σ :
head_step (CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4)) σ
pvs
(Val $ LitV $ LitBool false) σ
[]
| CasSucS l v1 v2 v3 v4 pv pvs σ :
extract_proph_resolve v3 = Some pv
pvs = option_list pv
σ.(heap) !! l = Some v1
vals_cas_compare_safe v1 v1
head_step (CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2)) σ
[]
head_step (CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4)) σ
pvs
(Val $ LitV $ LitBool true) (state_upd_heap <[l:=v2]> σ)
[]
| FaaS l i1 i2 σ :
......
......@@ -32,11 +32,23 @@ Class atomic_heap {Σ} `{!heapG Σ} := AtomicHeap {
*or* [v] to be unboxed. However, by writing it this way the [val_is_unboxed]
is outside the atomic triple, which makes it much easier to use -- and the
spec is still good enough for all our applications. *)
cas_spec (l : loc) (w1 w2 : val) :
cas_spec (l : loc) (w1 w2 w3 w4 : val) :
extract_proph_resolve w3 = Some None
extract_proph_resolve w4 = Some None
val_is_unboxed w1
<<< v, mapsto l 1 v >>> cas #l w1 w2 @
<<< v, mapsto l 1 v >>> cas #l w1 w2 w3 w4 @
<<< if decide (v = w1) then mapsto l 1 w2 else mapsto l 1 v,
RET #(if decide (v = w1) then true else false) >>>;
RET #(if decide (v = w1) then true else false) >>>;
cas_suc_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) :
extract_proph_resolve w3 = Some (Some (p, w))
val_is_unboxed w1
<<< mapsto l 1 w1 proph p v >>> cas #l w1 w2 w3 w4 @
<<< mapsto l 1 w2 v = Some w, RET #true>>>;
cas_fail_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) :
extract_proph_resolve w4 = Some (Some (p, w))
val_is_unboxed w1
<<< v', v' w1 mapsto l 1 v' proph p v >>> cas #l w1 w2 w3 w4 @
<<< mapsto l 1 v' v = Some w, RET #false>>>;
}.
Arguments atomic_heap _ {_}.
......@@ -54,7 +66,7 @@ Notation "'ref' e" := (alloc e) : expr_scope.
Notation "! e" := (load e) : expr_scope.
Notation "e1 <- e2" := (store e1 e2) : expr_scope.
Notation CAS e1 e2 e3 := (cas e1 e2 e3).
Notation CAS e1 e2 e3 e4 e5 := (cas e1 e2 e3 e4 e5).
End notation.
......@@ -66,7 +78,7 @@ Definition primitive_load : val :=
Definition primitive_store : val :=
λ: "l" "x", "l" <- "x".
Definition primitive_cas : val :=
λ: "l" "e1" "e2", CAS "l" "e1" "e2".
λ: "l" "e1" "e2" "e3" "e4", CAS "l" "e1" "e2" "e3" "e4".
Section proof.
Context `{!heapG Σ}.
......@@ -95,18 +107,46 @@ Section proof.
wp_store. iMod ("Hclose" with "H↦") as "HΦ". by iApply "HΦ".
Qed.
Lemma primitive_cas_spec (l : loc) (w1 w2 : val) :
Lemma primitive_cas_spec (l : loc) (w1 w2 w3 w4: val) :
extract_proph_resolve w3 = Some None
extract_proph_resolve w4 = Some None
val_is_unboxed w1
<<< (v : val), l v >>>
primitive_cas #l w1 w2 @
primitive_cas #l w1 w2 w3 w4 @
<<< if decide (v = w1) then l w2 else l v,
RET #(if decide (v = w1) then true else false) >>>.
Proof.
iIntros (? Q Φ) "? AU". wp_lam. wp_let. wp_let.
iIntros (??? Q Φ) "? AU". wp_lam. repeat wp_let.
iMod "AU" as (v) "[H↦ [_ Hclose]]".
destruct (decide (v = w1)) as [<-|Hv]; [wp_cas_suc|wp_cas_fail];
iMod ("Hclose" with "H↦") as "HΦ"; by iApply "HΦ".
Qed.
Lemma primitive_cas_suc_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) :
extract_proph_resolve w3 = Some (Some (p, w))
val_is_unboxed w1
<<< l w1 proph p v >>>
primitive_cas #l w1 w2 w3 w4 @
<<< l w2 v = Some w, RET #true>>>.
Proof.
iIntros (?? Q Φ) "? AU". wp_lam. repeat wp_let.
iMod "AU" as "[[H↦ Hp] [_ Hclose]]".
wp_apply (wp_cas_suc_proph with "[H↦ Hp]"); eauto with iFrame; first by left.
iIntros "H". iMod ("Hclose" with "H") as "HΦ". by iApply "HΦ".
Qed.
Lemma primitive_cas_fail_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) :
extract_proph_resolve w4 = Some (Some (p, w))
val_is_unboxed w1
<<< v', v' w1 l v' proph p v >>>
primitive_cas #l w1 w2 w3 w4 @
<<< l v' v = Some w, RET #false>>>.
Proof.
iIntros (? ? Q Φ) "? AU". wp_lam. repeat wp_let.
iMod "AU" as (v') "[(Hn & H↦ & Hp) [_ Hclose]]". iDestruct "Hn" as %Hn.
wp_apply (wp_cas_fail_proph with "[H↦ Hp]"); eauto with iFrame; first by right.
iIntros "H". iMod ("Hclose" with "H") as "HΦ". by iApply "HΦ".
Qed.
End proof.
(* NOT an instance because users should choose explicitly to use it
......@@ -116,4 +156,6 @@ Definition primitive_atomic_heap `{!heapG Σ} : atomic_heap Σ :=
load_spec := primitive_load_spec;
store_spec := primitive_store_spec;
cas_spec := primitive_cas_spec;
mapsto_agree := gen_heap.mapsto_agree |}.
cas_suc_proph_spec := primitive_cas_suc_proph_spec;
cas_fail_proph_spec := primitive_cas_fail_proph_spec;
mapsto_agree := gen_heap.mapsto_agree |}.
From iris.algebra Require Import excl auth gmap agree.
From iris.heap_lang Require Export lifting notation.
From iris.base_logic.lib Require Export invariants.
From iris.program_logic Require Export atomic.
From iris.proofmode Require Import tactics.
From iris.heap_lang Require Import proofmode notation par.
From iris.bi.lib Require Import fractional.
Set Default Proof Using "Type".
(** Specifying snapshots with histories
Implementing atomic pair snapshot data structure from Sergey et al. (ESOP 2015) *)
(** The CMRA & functor we need. *)
Definition timestampUR := gmapUR Z $ agreeR valC.
Class atomic_snapshotG Σ := AtomicSnapshotG {
atomic_snapshot_stateG :> inG Σ $ authR $ optionUR $ exclR $ prodC valC valC;
atomic_snapshot_timestampG :> inG Σ $ authR $ timestampUR
}.
Definition atomic_snapshotΣ : gFunctors :=
#[GFunctor (authR $ optionUR $ exclR $ prodC valC valC); GFunctor (authR timestampUR)].
Instance subG_atomic_snapshotΣ {Σ} : subG atomic_snapshotΣ Σ atomic_snapshotG Σ.
Proof. solve_inG. Qed.
Section atomic_snapshot.
Context {Σ} `{!heapG Σ, !atomic_snapshotG Σ}.
(*
newPair x y :=
(ref (ref (x, 0)), ref y)
*)
Definition newPair : val :=
λ: "args",
let: "x" := Fst "args" in
let: "y" := Snd "args" in
(ref (ref ("x", #0)), ref "y").
(*
writeY (xp, yp) y :=
yp <- y
*)
Definition writeY : val :=
λ: "args",
let: "p" := Fst "args" in
Snd "p" <- Snd "args".
(*
writeX (xp, yp) x :=
let xp1 = !xp in
let v = (!xp1).2
let xp2 = ref (x, v + 1)
if CAS xp xp1 xp2
then ()
else writeX (xp, yp) x
*)
Definition writeX : val :=
rec: "writeX" "args" :=
let: "p" := Fst "args" in
let: "x" := Snd "args" in
let: "xp" := Fst "p" in
let: "xp1" := !"xp" in
let: "v" := Snd (!"xp1") in
let: "xp2" := ref ("x", "v" + #1) in
if: cas: "xp", "xp1", "xp2"
then #()
else "writeX" "args".
(*
readX (xp, yp) :=
!!xp
*)
Definition readX : val :=
λ: "p",
let: "xp" := Fst "p" in
!(!"xp").
Definition readY : val :=
λ: "p",
let: "yp" := Snd "p" in
!"yp".
(*
readPair l :=
let (x, v) = readX l in
let y = readY l in
let (_, v') = readX l in
if v = v'
then (x, y)
else readPair l
*)
Definition readPair : val :=
rec: "readPair" "l" :=
let: "x" := readX "l" in
let: "y" := readY "l" in
let: "x'" := readX "l" in
if: Snd "x" = Snd "x'"
then (Fst "x", Fst "y")
else "readPair" "l".
Definition readPair_proph : val :=
rec: "readPair" "l" :=
let: "xv1" := readX "l" in
let: "proph" := new prophecy in
let: "y" := readY "l" in
let: "xv2" := readX "l" in
let: "v2" := Snd "xv2" in
let: "v_eq" := Snd "xv1" = "v2" in
resolve "proph" to "v_eq" ;;
if: "v_eq"
then (Fst "xv1", "y")
else "readPair" "l".
Variable N: namespace.
Definition gmap_to_UR T : timestampUR := to_agree <$> T.
Definition pair_inv γ1 γ2 l1 l2 : iProp Σ :=
( q (l1':loc) (T : gmap Z val) x y (t : Z),
(* we add the q to make the l1' map fractional. that way,
we can take a fraction of the l1' map out of the invariant
and do a case analysis on whether the pointer is the same
throughout invariant openings *)
l1 #l1' l1' {q} (x, #t) l2 y
own γ1 ( Excl' (x, y)) own γ2 ( gmap_to_UR T)
T !! t = Some x
forall (t' : Z), t' dom (gset Z) T -> (t' <= t)%Z)%I.
Definition is_pair (γs: gname * gname) (p : val) :=
( (l1 l2 : loc), p = (#l1, #l2)%V inv N (pair_inv γs.1 γs.2 l1 l2))%I.
Global Instance is_pair_persistent γs p : Persistent (is_pair γs p) := _.
Definition pair_content (γs : gname * gname) (a : val * val) :=
(own γs.1 ( Excl' a))%I.
Global Instance pair_content_timeless γs a : Timeless (pair_content γs a) := _.
Lemma pair_content_exclusive γs a1 a2 :
pair_content γs a1 - pair_content γs a2 - False.
Proof.
iIntros "H1 H2". iDestruct (own_valid_2 with "H1 H2") as %[].
Qed.
Definition new_timestamp t v : gmap Z val := {[ t := v ]}.
Lemma newPair_spec (e : expr) (v1 v2 : val) :
IntoVal e (v1, v2) ->
{{{ True }}}
newPair e
{{{ γs p, RET p; is_pair γs p pair_content γs (v1, v2) }}}.
Proof.
iIntros (<- Φ _) "Hp". rewrite /newPair. wp_lam.
repeat (wp_proj; wp_let).
iApply wp_fupd.
wp_alloc lx' as "Hlx'".
wp_alloc lx as "Hlx".
wp_alloc ly as "Hly".
set (Excl' (v1, v2)) as p.
iMod (own_alloc ( p p)) as (γ1) "[Hp⚫ Hp◯]". {
rewrite /p. apply auth_valid_discrete_2. split; done.
}
set (new_timestamp 0 v1) as t.
iMod (own_alloc ( gmap_to_UR t gmap_to_UR t)) as (γ2) "[Ht⚫ Ht◯]". {
rewrite /t /new_timestamp. apply auth_valid_discrete_2.
split; first done. rewrite /gmap_to_UR map_fmap_singleton. apply singleton_valid. done.
}
iApply ("Hp" $! (γ1, γ2)).
iMod (inv_alloc N _ (pair_inv γ1 γ2 lx ly) with "[-Hp◯ Ht◯]") as "#Hinv". {
iNext. rewrite /pair_inv. iExists _, _, _, _, _. iExists 0. iFrame.
iPureIntro. split; first done. intros ?. subst t. rewrite /new_timestamp dom_singleton.
rewrite elem_of_singleton. lia.
}
iModIntro. iSplitR. rewrite /is_pair. repeat (iExists _). iSplitL; eauto.
rewrite /pair_content. rewrite /p. iApply "Hp◯".
Qed.
Lemma excl_update γ n' n m :
own γ ( (Excl' n)) - own γ ( (Excl' m)) ==
own γ ( (Excl' n')) own γ ( (Excl' n')).
Proof.
iIntros "Hγ● Hγ◯".
iMod (own_update_2 _ _ _ ( Excl' n' Excl' n') with "Hγ● Hγ◯") as "[$$]".
{ by apply auth_update, option_local_update, exclusive_local_update. }
done.
Qed.
Lemma excl_sync γ n m :
own γ ( (Excl' n)) - own γ ( (Excl' m)) - m = n.
Proof.
iIntros "Hγ● Hγ◯".
iDestruct (own_valid_2 with "Hγ● Hγ◯") as
%[H%Excl_included%leibniz_equiv _]%auth_valid_discrete_2.
done.
Qed.
Lemma timestamp_dupl γ T:
own γ ( T) == own γ ( T) own γ ( T).
Proof.
iIntros "Ht". iApply own_op. iApply (own_update with "Ht").
apply auth_update_alloc. apply local_update_unital_discrete => f Hv. rewrite left_id => <-.
split; first done. apply core_id_dup. apply _.
Qed.
Lemma timestamp_update γ (T : gmap Z val) (t : Z) x :
T !! t = None ->
own γ ( gmap_to_UR T) == own γ ( gmap_to_UR (<[ t := x ]> T)).
Proof.
iIntros (HT) "Ht".
set (<[ t := x ]> T) as T'.
iDestruct (own_update _ _ ( gmap_to_UR T' gmap_to_UR {[ t := x ]}) with "Ht") as "Ht". {
apply auth_update_alloc. rewrite /T' /gmap_to_UR map_fmap_singleton. rewrite fmap_insert.
apply alloc_local_update; last done. rewrite lookup_fmap HT. done.
}
iMod (own_op with "Ht") as "[Ht● Ht◯]". iModIntro. iFrame.
Qed.
Lemma timestamp_sub γ (T1 T2 : gmap Z val):
own γ ( gmap_to_UR T1) own γ ( gmap_to_UR T2) -
forall t x, T2 !! t = Some x -> T1 !! t = Some x.
Proof.
iIntros "[Hγ⚫ Hγ◯]".
iDestruct (own_valid_2 with "Hγ⚫ Hγ◯") as
%[H Hv]%auth_valid_discrete_2. iPureIntro. intros t x HT2.
pose proof (iffLR (lookup_included (gmap_to_UR T2) (gmap_to_UR T1)) H t) as Ht.
rewrite !lookup_fmap HT2 /= in Ht.
destruct (is_Some_included _ _ Ht) as [? [t2 [Ht2 ->]]%fmap_Some_1]; first by eauto.
revert Ht.
rewrite Ht2 Some_included_total to_agree_included. fold_leibniz.
by intros ->.
Qed.
Lemma writeY_spec e (y2: val) γ p :
IntoVal e y2 ->
is_pair γ p -
<<< x y : val, pair_content γ (x, y) >>>