Commit 15058014 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Clean up heap_lang and remove some FIXMEs.

Notable changes:
* I am now using the same names for the fields of the language record and the
  instances in heap_lang. In order to deal with shadowing, I have put all
  definitions in heap_lang.v in a module.
* Instead of defining evaluation contexts recursively, these are now defined
  using lists. This way we can easily reuse operations on lists. For example,
  composition of evaluation contexts is just appending lists. Also, it allowed
  me to simplify the rather complicated proof of step_by_val as induction on
  the shape of contexts no longer results in a blow-up of the number of cases.
* Use better automation to prove all lemmas of heap_lang.
* I have introduced tactics to invert steps and to do steps. These tactics
  greatly helped simplifying boring parts of lifting lemmas.
parent f3ff3b28
......@@ -64,6 +64,7 @@ iris/language.v
iris/functor.v
iris/tests.v
barrier/heap_lang.v
barrier/heap_lang_tactics.v
barrier/lifting.v
barrier/sugar.v
barrier/tests.v
Require Export Autosubst.Autosubst.
Require Import prelude.option prelude.gmap iris.language.
Require Export iris.language.
Require Import prelude.gmap.
(** Expressions and values. *)
Module heap_lang.
(** Expressions and vals. *)
Definition loc := positive. (* Really, any countable type. *)
Inductive expr :=
(* Base lambda calculus *)
| Var (x : var)
| Rec (e : {bind 2 of expr}) (* These are recursive lambdas. The *inner* binder is the recursive call! *)
| App (e1 e2 : expr)
(* Natural numbers *)
| LitNat (n : nat)
| Plus (e1 e2 : expr)
| Le (e1 e2 : expr)
(* Unit *)
| LitUnit
(* Products *)
| Pair (e1 e2 : expr)
| Fst (e : expr)
| Snd (e : expr)
(* Sums *)
| InjL (e : expr)
| InjR (e : expr)
| Case (e0 : expr) (e1 : {bind expr}) (e2 : {bind expr})
(* Concurrency *)
| Fork (e : expr)
(* Heap *)
| Loc (l : loc)
| Alloc (e : expr)
| Load (e : expr)
| Store (e1 : expr) (e2 : expr)
| Cas (e0 : expr) (e1 : expr) (e2 : expr)
.
(* Base lambda calculus *)
| Var (x : var)
| Rec (e : {bind 2 of expr}) (* These are recursive lambdas.
The *inner* binder is the recursive call! *)
| App (e1 e2 : expr)
(* Natural numbers *)
| LitNat (n : nat)
| Plus (e1 e2 : expr)
| Le (e1 e2 : expr)
(* Unit *)
| LitUnit
(* Products *)
| Pair (e1 e2 : expr)
| Fst (e : expr)
| Snd (e : expr)
(* Sums *)
| InjL (e : expr)
| InjR (e : expr)
| Case (e0 : expr) (e1 : {bind expr}) (e2 : {bind expr})
(* Concurrency *)
| Fork (e : expr)
(* Heap *)
| Loc (l : loc)
| Alloc (e : expr)
| Load (e : expr)
| Store (e1 : expr) (e2 : expr)
| Cas (e0 : expr) (e1 : expr) (e2 : expr).
Instance Ids_expr : Ids expr. derive. Defined.
Instance Rename_expr : Rename expr. derive. Defined.
Instance Subst_expr : Subst expr. derive. Defined.
Instance SubstLemmas_expr : SubstLemmas expr. derive. Qed.
(* This sugar is used by primitive reduction riles (<=, CAS) and hence defined here. *)
Definition LitTrue := InjL LitUnit.
Definition LitFalse := InjR LitUnit.
Inductive value :=
| RecV (e : {bind 2 of expr})
| LitNatV (n : nat) (* These are recursive lambdas. The *inner* binder is the recursive call! *)
| LitUnitV
| PairV (v1 v2 : value)
| InjLV (v : value)
| InjRV (v : value)
| LocV (l : loc)
.
(* This sugar is used by primitive reduction riles (<=, CAS) and hence
defined here. *)
Notation LitTrue := (InjL LitUnit).
Notation LitFalse := (InjR LitUnit).
Inductive val :=
| RecV (e : {bind 2 of expr}) (* These are recursive lambdas.
The *inner* binder is the recursive call! *)
| LitNatV (n : nat)
| LitUnitV
| PairV (v1 v2 : val)
| InjLV (v : val)
| InjRV (v : val)
| LocV (l : loc).
Definition LitTrueV := InjLV LitUnitV.
Definition LitFalseV := InjRV LitUnitV.
Fixpoint v2e (v : value) : expr :=
Fixpoint of_val (v : val) : expr :=
match v with
| RecV e => Rec e
| RecV e => Rec e
| LitNatV n => LitNat n
| LitUnitV => LitUnit
| PairV v1 v2 => Pair (v2e v1) (v2e v2)
| InjLV v => InjL (v2e v)
| InjRV v => InjR (v2e v)
| PairV v1 v2 => Pair (of_val v1) (of_val v2)
| InjLV v => InjL (of_val v)
| InjRV v => InjR (of_val v)
| LocV l => Loc l
end.
Fixpoint e2v (e : expr) : option value :=
Fixpoint to_val (e : expr) : option val :=
match e with
| Rec e => Some (RecV e)
| LitNat n => Some (LitNatV n)
| LitUnit => Some LitUnitV
| Pair e1 e2 => v1 e2v e1;
v2 e2v e2;
Some (PairV v1 v2)
| InjL e => InjLV <$> e2v e
| InjR e => InjRV <$> e2v e
| Pair e1 e2 => v1 to_val e1; v2 to_val e2; Some (PairV v1 v2)
| InjL e => InjLV <$> to_val e
| InjR e => InjRV <$> to_val e
| Loc l => Some (LocV l)
| _ => None
end.
Lemma v2v v:
e2v (v2e v) = Some v.
Proof.
induction v; simpl; rewrite ?IHv ?IHv1 /= ?IHv2; reflexivity.
Qed.
Section e2e. (* To get local tactics. *)
Lemma e2e e v:
e2v e = Some v v2e v = e.
Proof.
Ltac case0 := case =><-; simpl; eauto using f_equal, f_equal2.
Ltac case1 e1 := destruct (e2v e1); simpl; [|discriminate];
case0.
Ltac case2 e1 e2 := destruct (e2v e1); simpl; [|discriminate];
destruct (e2v e2); simpl; [|discriminate];
case0.
revert v; induction e; intros v; simpl; try discriminate;
by (case2 e1 e2 || case1 e || case0).
Qed.
End e2e.
Lemma v2e_inj v1 v2:
v2e v1 = v2e v2 v1 = v2.
Proof.
revert v2; induction v1=>v2; destruct v2; simpl; try done;
case; eauto using f_equal, f_equal2.
Qed.
(** The state: heaps of values. *)
Definition state := gmap loc value.
(** The state: heaps of vals. *)
Definition state := gmap loc val.
(** Evaluation contexts *)
Inductive ectx :=
| EmptyCtx
| AppLCtx (K1 : ectx) (e2 : expr)
| AppRCtx (v1 : value) (K2 : ectx)
| PlusLCtx (K1 : ectx) (e2 : expr)
| PlusRCtx (v1 : value) (K2 : ectx)
| LeLCtx (K1 : ectx) (e2 : expr)
| LeRCtx (v1 : value) (K2 : ectx)
| PairLCtx (K1 : ectx) (e2 : expr)
| PairRCtx (v1 : value) (K2 : ectx)
| FstCtx (K : ectx)
| SndCtx (K : ectx)
| InjLCtx (K : ectx)
| InjRCtx (K : ectx)
| CaseCtx (K : ectx) (e1 : {bind expr}) (e2 : {bind expr})
| AllocCtx (K : ectx)
| LoadCtx (K : ectx)
| StoreLCtx (K1 : ectx) (e2 : expr)
| StoreRCtx (v1 : value) (K2 : ectx)
| CasLCtx (K0 : ectx) (e1 : expr) (e2 : expr)
| CasMCtx (v0 : value) (K1 : ectx) (e2 : expr)
| CasRCtx (v0 : value) (v1 : value) (K2 : ectx)
.
Fixpoint fill (K : ectx) (e : expr) :=
match K with
| EmptyCtx => e
| AppLCtx K1 e2 => App (fill K1 e) e2
| AppRCtx v1 K2 => App (v2e v1) (fill K2 e)
| PlusLCtx K1 e2 => Plus (fill K1 e) e2
| PlusRCtx v1 K2 => Plus (v2e v1) (fill K2 e)
| LeLCtx K1 e2 => Le (fill K1 e) e2
| LeRCtx v1 K2 => Le (v2e v1) (fill K2 e)
| PairLCtx K1 e2 => Pair (fill K1 e) e2
| PairRCtx v1 K2 => Pair (v2e v1) (fill K2 e)
| FstCtx K => Fst (fill K e)
| SndCtx K => Snd (fill K e)
| InjLCtx K => InjL (fill K e)
| InjRCtx K => InjR (fill K e)
| CaseCtx K e1 e2 => Case (fill K e) e1 e2
| AllocCtx K => Alloc (fill K e)
| LoadCtx K => Load (fill K e)
| StoreLCtx K1 e2 => Store (fill K1 e) e2
| StoreRCtx v1 K2 => Store (v2e v1) (fill K2 e)
| CasLCtx K0 e1 e2 => Cas (fill K0 e) e1 e2
| CasMCtx v0 K1 e2 => Cas (v2e v0) (fill K1 e) e2
| CasRCtx v0 v1 K2 => Cas (v2e v0) (v2e v1) (fill K2 e)
end.
Fixpoint comp_ctx (Ko : ectx) (Ki : ectx) :=
match Ko with
| EmptyCtx => Ki
| AppLCtx K1 e2 => AppLCtx (comp_ctx K1 Ki) e2
| AppRCtx v1 K2 => AppRCtx v1 (comp_ctx K2 Ki)
| PlusLCtx K1 e2 => PlusLCtx (comp_ctx K1 Ki) e2
| PlusRCtx v1 K2 => PlusRCtx v1 (comp_ctx K2 Ki)
| LeLCtx K1 e2 => LeLCtx (comp_ctx K1 Ki) e2
| LeRCtx v1 K2 => LeRCtx v1 (comp_ctx K2 Ki)
| PairLCtx K1 e2 => PairLCtx (comp_ctx K1 Ki) e2
| PairRCtx v1 K2 => PairRCtx v1 (comp_ctx K2 Ki)
| FstCtx K => FstCtx (comp_ctx K Ki)
| SndCtx K => SndCtx (comp_ctx K Ki)
| InjLCtx K => InjLCtx (comp_ctx K Ki)
| InjRCtx K => InjRCtx (comp_ctx K Ki)
| CaseCtx K e1 e2 => CaseCtx (comp_ctx K Ki) e1 e2
| AllocCtx K => AllocCtx (comp_ctx K Ki)
| LoadCtx K => LoadCtx (comp_ctx K Ki)
| StoreLCtx K1 e2 => StoreLCtx (comp_ctx K1 Ki) e2
| StoreRCtx v1 K2 => StoreRCtx v1 (comp_ctx K2 Ki)
| CasLCtx K0 e1 e2 => CasLCtx (comp_ctx K0 Ki) e1 e2
| CasMCtx v0 K1 e2 => CasMCtx v0 (comp_ctx K1 Ki) e2
| CasRCtx v0 v1 K2 => CasRCtx v0 v1 (comp_ctx K2 Ki)
Inductive ectx_item :=
| AppLCtx (e2 : expr)
| AppRCtx (v1 : val)
| PlusLCtx (e2 : expr)
| PlusRCtx (v1 : val)
| LeLCtx (e2 : expr)
| LeRCtx (v1 : val)
| PairLCtx (e2 : expr)
| PairRCtx (v1 : val)
| FstCtx
| SndCtx
| InjLCtx
| InjRCtx
| CaseCtx (e1 : {bind expr}) (e2 : {bind expr})
| AllocCtx
| LoadCtx
| StoreLCtx (e2 : expr)
| StoreRCtx (v1 : val)
| CasLCtx (e1 : expr) (e2 : expr)
| CasMCtx (v0 : val) (e2 : expr)
| CasRCtx (v0 : val) (v1 : val).
Notation ectx := (list ectx_item).
Implicit Types Ki : ectx_item.
Implicit Types K : ectx.
Definition ectx_item_fill (Ki : ectx_item) (e : expr) : expr :=
match Ki with
| AppLCtx e2 => App e e2
| AppRCtx v1 => App (of_val v1) e
| PlusLCtx e2 => Plus e e2
| PlusRCtx v1 => Plus (of_val v1) e
| LeLCtx e2 => Le e e2
| LeRCtx v1 => Le (of_val v1) e
| PairLCtx e2 => Pair e e2
| PairRCtx v1 => Pair (of_val v1) e
| FstCtx => Fst e
| SndCtx => Snd e
| InjLCtx => InjL e
| InjRCtx => InjR e
| CaseCtx e1 e2 => Case e e1 e2
| AllocCtx => Alloc e
| LoadCtx => Load e
| StoreLCtx e2 => Store e e2
| StoreRCtx v1 => Store (of_val v1) e
| CasLCtx e1 e2 => Cas e e1 e2
| CasMCtx v0 e2 => Cas (of_val v0) e e2
| CasRCtx v0 v1 => Cas (of_val v0) (of_val v1) e
end.
Instance ectx_fill : Fill ectx expr :=
fix go K e := let _ : Fill _ _ := @go in
match K with [] => e | Ki :: K => ectx_item_fill Ki (fill K e) end.
Lemma fill_empty e :
fill EmptyCtx e = e.
Proof.
reflexivity.
Qed.
Lemma fill_comp K1 K2 e :
fill K1 (fill K2 e) = fill (comp_ctx K1 K2) e.
Proof.
revert K2 e; induction K1 => K2 e /=; rewrite ?IHK1 ?IHK2; reflexivity.
Qed.
Lemma fill_inj_r K e1 e2 :
fill K e1 = fill K e2 e1 = e2.
Proof.
revert e1 e2; induction K => el er /=;
(move=><-; reflexivity) || (case => /IHK <-; reflexivity).
Qed.
Lemma fill_value K e v':
e2v (fill K e) = Some v' is_Some (e2v e).
Proof.
revert v'; induction K => v' /=; try discriminate;
try destruct (e2v (fill K e)); rewrite ?v2v; eauto.
Qed.
(** The stepping relation *)
Inductive head_step : expr -> state -> expr -> state -> option expr -> Prop :=
| BetaS e1 e2 v2 σ :
to_val e2 = Some v2
head_step (App (Rec e1) e2) σ e1.[(Rec e1),e2/] σ None
| PlusS n1 n2 σ:
head_step (Plus (LitNat n1) (LitNat n2)) σ (LitNat (n1 + n2)) σ None
| LeTrueS n1 n2 σ :
n1 n2
head_step (Le (LitNat n1) (LitNat n2)) σ LitTrue σ None
| LeFalseS n1 n2 σ :
n1 > n2
head_step (Le (LitNat n1) (LitNat n2)) σ LitFalse σ None
| FstS e1 v1 e2 v2 σ :
to_val e1 = Some v1 to_val e2 = Some v2
head_step (Fst (Pair e1 e2)) σ e1 σ None
| SndS e1 v1 e2 v2 σ :
to_val e1 = Some v1 to_val e2 = Some v2
head_step (Snd (Pair e1 e2)) σ e2 σ None
| CaseLS e0 v0 e1 e2 σ :
to_val e0 = Some v0
head_step (Case (InjL e0) e1 e2) σ e1.[e0/] σ None
| CaseRS e0 v0 e1 e2 σ :
to_val e0 = Some v0
head_step (Case (InjR e0) e1 e2) σ e2.[e0/] σ None
| ForkS e σ:
head_step (Fork e) σ LitUnit σ (Some e)
| AllocS e v σ l :
to_val e = Some v σ !! l = None
head_step (Alloc e) σ (Loc l) (<[l:=v]>σ) None
| LoadS l v σ :
σ !! l = Some v
head_step (Load (Loc l)) σ (of_val v) σ None
| StoreS l e v σ :
to_val e = Some v is_Some (σ !! l)
head_step (Store (Loc l) e) σ LitUnit (<[l:=v]>σ) None
| CasFailS l e1 v1 e2 v2 vl σ :
to_val e1 = Some v1 to_val e2 = Some v2
σ !! l = Some vl vl v1
head_step (Cas (Loc l) e1 e2) σ LitFalse σ None
| CasSucS l e1 v1 e2 v2 σ :
to_val e1 = Some v1 to_val e2 = Some v2
σ !! l = Some v1
head_step (Cas (Loc l) e1 e2) σ LitTrue (<[l:=v2]>σ) None.
Lemma fill_not_value e K :
e2v e = None e2v (fill K e) = None.
Proof.
intros Hnval. induction K =>/=; by rewrite ?v2v /= ?IHK /=.
Qed.
(** Atomic expressions *)
Definition atomic (e: expr) :=
match e with
| Alloc e => is_Some (to_val e)
| Load e => is_Some (to_val e)
| Store e1 e2 => is_Some (to_val e1) is_Some (to_val e2)
| Cas e0 e1 e2 => is_Some (to_val e0) is_Some (to_val e1) is_Some (to_val e2)
| _ => False
end.
Lemma fill_not_value2 e K v :
e2v e = None e2v (fill K e) = Some v -> False.
(** Close reduction under evaluation contexts.
We could potentially make this a generic construction. *)
Inductive prim_step
(e1 : expr) (σ1 : state) (e2 : expr) (σ2: state) (ef: option expr) : Prop :=
Ectx_step (K : ectx) e1' e2' :
e1 = fill K e1' e2 = fill K e2'
head_step e1' σ1 e2' σ2 ef prim_step e1 σ1 e2 σ2 ef.
(** Basic properties about the language *)
Lemma to_of_val v : to_val (of_val v) = Some v.
Proof. by induction v; simplify_option_equality. Qed.
Lemma of_to_val e v : to_val e = Some v of_val v = e.
Proof.
intros Hnval Hval. erewrite fill_not_value in Hval by assumption. discriminate.
revert v; induction e; intros; simplify_option_equality; auto with f_equal.
Qed.
Lemma comp_empty K K' :
EmptyCtx = comp_ctx K K'
K = EmptyCtx K' = EmptyCtx.
Instance: Injective (=) (=) of_val.
Proof. by intros ?? Hv; apply (injective Some); rewrite -!to_of_val Hv. Qed.
Instance ectx_item_fill_inj Ki : Injective (=) (=) (ectx_item_fill Ki).
Proof. destruct Ki; intros ???; simplify_equality'; auto with f_equal. Qed.
Instance ectx_fill_inj K : Injective (=) (=) (fill K).
Proof. red; induction K as [|Ki K IH]; naive_solver. Qed.
Lemma fill_app K1 K2 e : fill (K1 ++ K2) e = fill K1 (fill K2 e).
Proof. revert e; induction K1; simpl; auto with f_equal. Qed.
Lemma fill_val K e : is_Some (to_val (fill K e)) is_Some (to_val e).
Proof.
destruct K; try discriminate.
destruct K'; try discriminate.
done.
intros [v' Hv']; revert v' Hv'.
induction K as [|[]]; intros; simplify_option_equality; eauto.
Qed.
(** The stepping relation *)
Inductive prim_step : expr -> state -> expr -> state -> option expr -> Prop :=
| BetaS e1 e2 v2 σ (Hv2 : e2v e2 = Some v2):
prim_step (App (Rec e1) e2) σ e1.[(Rec e1),e2/] σ None
| PlusS n1 n2 σ:
prim_step (Plus (LitNat n1) (LitNat n2)) σ (LitNat (n1 + n2)) σ None
| LeTrueS n1 n2 σ (Hle : n1 n2):
prim_step (Le (LitNat n1) (LitNat n2)) σ LitTrue σ None
| LeFalseS n1 n2 σ (Hle : n1 > n2):
prim_step (Le (LitNat n1) (LitNat n2)) σ LitFalse σ None
| FstS e1 v1 e2 v2 σ (Hv1 : e2v e1 = Some v1) (Hv2 : e2v e2 = Some v2):
prim_step (Fst (Pair e1 e2)) σ e1 σ None
| SndS e1 v1 e2 v2 σ (Hv1 : e2v e1 = Some v1) (Hv2 : e2v e2 = Some v2):
prim_step (Snd (Pair e1 e2)) σ e2 σ None
| CaseLS e0 v0 e1 e2 σ (Hv0 : e2v e0 = Some v0):
prim_step (Case (InjL e0) e1 e2) σ e1.[e0/] σ None
| CaseRS e0 v0 e1 e2 σ (Hv0 : e2v e0 = Some v0):
prim_step (Case (InjR e0) e1 e2) σ e2.[e0/] σ None
| ForkS e σ:
prim_step (Fork e) σ LitUnit σ (Some e)
| AllocS e v σ l (Hv : e2v e = Some v) (Hfresh : σ !! l = None):
prim_step (Alloc e) σ (Loc l) (<[l:=v]>σ) None
| LoadS l v σ (Hlookup : σ !! l = Some v):
prim_step (Load (Loc l)) σ (v2e v) σ None
| StoreS l e v σ (Hv : e2v e = Some v) (Halloc : is_Some (σ !! l)):
prim_step (Store (Loc l) e) σ LitUnit (<[l:=v]>σ) None
| CasFailS l e1 v1 e2 v2 vl σ (Hv1 : e2v e1 = Some v1) (Hv2 : e2v e2 = Some v2)
(Hlookup : σ !! l = Some vl) (Hne : vl <> v1):
prim_step (Cas (Loc l) e1 e2) σ LitFalse σ None
| CasSucS l e1 v1 e2 v2 σ (Hv1 : e2v e1 = Some v1) (Hv2 : e2v e2 = Some v2)
(Hlookup : σ !! l = Some v1):
prim_step (Cas (Loc l) e1 e2) σ LitTrue (<[l:=v2]>σ) None
.
Definition reducible e σ : Prop :=
e' σ' ef, prim_step e σ e' σ' ef.
Lemma reducible_not_value e σ :
reducible e σ e2v e = None.
Lemma fill_not_val K e : to_val e = None to_val (fill K e) = None.
Proof. rewrite !eq_None_not_Some; eauto using fill_val. Qed.
Lemma values_head_stuck e1 σ1 e2 σ2 ef :
head_step e1 σ1 e2 σ2 ef to_val e1 = None.
Proof. destruct 1; naive_solver. Qed.
Lemma values_stuck e1 σ1 e2 σ2 ef : prim_step e1 σ1 e2 σ2 ef to_val e1 = None.
Proof. intros [??? -> -> ?]; eauto using fill_not_val, values_head_stuck. Qed.
Lemma atomic_not_val e : atomic e to_val e = None.
Proof. destruct e; naive_solver. Qed.
Lemma atomic_fill K e : atomic (fill K e) to_val e = None K = [].
Proof.
intros (e' & σ' & ef & Hstep). destruct Hstep; simpl in *; reflexivity.
rewrite eq_None_not_Some.
destruct K as [|[]]; naive_solver eauto using fill_val.
Qed.
Definition stuck (e : expr) σ : Prop :=
K e', e = fill K e' ~reducible e' σ.
Lemma values_stuck v σ :
stuck (v2e v) σ.
Lemma atomic_head_step e1 σ1 e2 σ2 ef :
atomic e1 head_step e1 σ1 e2 σ2 ef is_Some (to_val e2).
Proof. destruct 2; simpl; rewrite ?to_of_val; naive_solver. Qed.
Lemma atomic_step e1 σ1 e2 σ2 ef :
atomic e1 prim_step e1 σ1 e2 σ2 ef is_Some (to_val e2).
Proof.
intros ?? Heq.
edestruct (fill_value K) as [v' Hv'].
{ by rewrite <-Heq, v2v. }
clear -Hv' => Hred. apply reducible_not_value in Hred.
destruct (e2v e'); discriminate.
intros Hatomic [K e1' e2' -> -> Hstep].
assert (K = []) as -> by eauto 10 using atomic_fill, values_head_stuck.
naive_solver eauto using atomic_head_step.
Qed.
Section step_by_value.
(* When something does a step, and another decomposition of the same
expression has a non-value e in the hole, then K is a left
sub-context of K' - in other words, e also contains the reducible
expression *)
Lemma step_by_value {K K' e e' σ} :
fill K e = fill K' e'
reducible e' σ
e2v e = None
K'', K' = comp_ctx K K''.
Lemma head_ctx_step_val Ki e σ1 e2 σ2 ef :
head_step (ectx_item_fill Ki e) σ1 e2 σ2 ef is_Some (to_val e).
Proof. destruct Ki; inversion_clear 1; simplify_option_equality; eauto. Qed.
Lemma fill_item_inj Ki1 Ki2 e1 e2 :
to_val e1 = None to_val e2 = None
ectx_item_fill Ki1 e1 = ectx_item_fill Ki2 e2 Ki1 = Ki2.
Proof.
Ltac bad_fill := intros; exfalso; subst;
(eapply values_stuck; eassumption) ||
(eapply fill_not_value2; first eassumption;
try match goal with
[ H : fill _ _ = _ |- _ ] => erewrite ->H
end;