Initialize repository

26 files changed, 7390 insertions, 0 deletions

diff --git a/theories/dune b/theories/dune
new file mode 100644
index 0000000..0034b5d
--- /dev/null
+++ b/theories/dune
@@ -0,0 +1,8 @@
+(include_subdirs qualified)
+
+(coq.theory
+ (name mininix)
+ ; This ensures that all files are checked when using the install alias.
+ ; (This does not happen otherwise when just compiling the front-end.)
+ (package mininix)
+ (theories Flocq stdpp))
diff --git a/theories/dynlang/equiv.v b/theories/dynlang/equiv.v
new file mode 100644
index 0000000..aa0b7f3
--- /dev/null
+++ b/theories/dynlang/equiv.v
@@ -0,0 +1,154 @@
+From mininix Require Export lambda.interp_proofs dynlang.interp_proofs.
+From stdpp Require Import options.
+
+Class Lift A B := lift : A → B.
+Global Hint Mode Lift ! - : typeclass_instances.
+Arguments lift {_ _ _} !_ /.
+Notation "⌜ x ⌝" := (lift x) (at level 0).
+Notation "⌜* x ⌝" := (fmap lift x) (at level 0).
+
+Module lambda.
+  Global Instance lambda_expr_lift : Lift lambda.expr dynlang.expr :=
+    fix go e := let _ : Lift _ _ := go in
+    match e with
+    | lambda.EString s => dynlang.EString s
+    | lambda.EId x => dynlang.EId ∅ (dynlang.EString x)
+    | lambda.EAbs x e => dynlang.EAbs (dynlang.EString x) ⌜e⌝
+    | lambda.EApp e1 e2 => dynlang.EApp ⌜e1⌝ ⌜e2⌝
+    end.
+
+  Global Instance lambda_thunk_lift : Lift lambda.thunk dynlang.thunk :=
+    fix go t := let _ : Lift _ _ := go in
+    dynlang.Thunk ⌜*lambda.thunk_env t⌝ ⌜lambda.thunk_expr t⌝.
+
+  Global Instance lambda_val_lift : Lift lambda.val dynlang.val := λ v,
+    match v with
+    | lambda.VString s => dynlang.VString s
+    | lambda.VClo x E e => dynlang.VClo x ⌜*E⌝ ⌜e⌝
+    end.
+End lambda.
+
+Lemma interp_open_lambda_dynlang E e mv n :
+  lambda.closed_env E → lambda.closed (dom E) e →
+  lambda.interp n E e = Res mv →
+  ∃ m, dynlang.interp m ⌜*E⌝ ⌜e⌝ = Res ⌜*mv⌝.
+Proof.
+  revert E e mv. induction n as [|n IH]; [done|]; intros E e mv HE He Hinterp.
+  rewrite lambda.interp_S in Hinterp. destruct e as [s|z|ex e|e1 e2]; simplify_res.
+  - (* EString *) by exists 1.
+  - (* EId *)
+    apply elem_of_dom in He as [[Et et] Hz]. rewrite Hz /= in Hinterp.
+    apply lambda.closed_env_lookup in Hz as He; last done.
+    rewrite lambda.closed_thunk_eq/= in He. destruct He as [HEtclosed Hetclosed].
+    apply IH in Hinterp as [m Hinterp]; [|done..].
+    exists (S (S m)). rewrite !dynlang.interp_S /= -dynlang.interp_S.
+    rewrite lookup_empty /= right_id_L lookup_fmap Hz /=.
+    eauto using dynlang.interp_le with lia.
+  - (* EAbs *) by exists 2.
+  - (* EApp *)
+    destruct He as [He1 He2].
+    destruct (lambda.interp _ _ e1) as [mw|] eqn:Hinterp1; simplify_res.
+    pose proof Hinterp1 as Hinterp1'.
+    apply lambda.interp_closed in Hinterp1' as Hmw; [|done..].
+    eapply IH in Hinterp1 as [m1 Hinterp1]; [|done..].
+    destruct mw as [w|]; simplify_res; last first.
+    { exists (S m1). by rewrite dynlang.interp_S /= Hinterp1. }
+    destruct (maybe3 lambda.VClo w) eqn:?; simplify_res; last first.
+    { exists (S m1). rewrite dynlang.interp_S /= Hinterp1 /=. by destruct w. }
+    destruct w; simplify_res.
+    apply IH in Hinterp as [m2 Hinterp2].
+    + exists (S (m1 + m2)). rewrite dynlang.interp_S /=.
+      rewrite (dynlang.interp_le Hinterp1) /=; last lia.
+      rewrite fmap_insert /= in Hinterp2.
+      rewrite (dynlang.interp_le Hinterp2) /=; last lia. done.
+    + apply lambda.closed_env_insert; [by split|naive_solver].
+    + rewrite dom_insert_L. set_solver.
+Qed.
+Lemma interp_lambda_dynlang e mv n :
+  lambda.closed ∅ e →
+  lambda.interp n ∅ e = Res mv →
+  ∃ m, dynlang.interp m ∅ ⌜e⌝ = Res ⌜*mv⌝.
+Proof. intro. by apply interp_open_lambda_dynlang. Qed.
+
+Lemma interp_open_dynlang_lambda E e mv n :
+  lambda.closed_env E → lambda.closed (dom E) e →
+  dynlang.interp n ⌜*E⌝ ⌜e⌝ = Res mv →
+  ∃ mw, lambda.interp n E e = Res mw ∧ mv = ⌜*mw⌝.
+Proof.
+  revert E e mv. induction n as [|n IH]; [done|]; intros E e mv HE He Hinterp.
+  rewrite dynlang.interp_S in Hinterp. destruct e as [s|z|ex e|e1 e2]; simplify_res.
+  - (* EString *) rewrite lambda.interp_S /=. by eexists.
+  - (* EId *)
+    destruct n as [|n]; [done|].
+    rewrite dynlang.interp_S /= -dynlang.interp_S in Hinterp.
+    apply elem_of_dom in He as [[Et et] Hz].
+    pose proof (f_equal (fmap lift) Hz) as Hz'.
+    rewrite -lookup_fmap /= in Hz'. rewrite Hz' lookup_empty /= {Hz'} in Hinterp.
+    pose proof Hz as Hz'.
+    apply lambda.closed_env_lookup in Hz' as [HEt Het]; simpl in *; last done.
+    apply IH in Hinterp as (mw & Hinterp & ->); [|done..].
+    exists mw. rewrite lambda.interp_S /= Hz /=. done.
+  - (* EAbs *)
+    destruct n as [|n]; [done|].
+    rewrite dynlang.interp_S /= in Hinterp; simplify_res.
+    rewrite lambda.interp_S /=. by eexists.
+  - (* EApp *)
+    destruct He as [He1 He2].
+    destruct (dynlang.interp _ _ _) as [mw1|] eqn:Hinterp1; simplify_res.
+    eapply IH in Hinterp1 as (mv1 & Hinterp1 & ->); [|done..].
+    destruct mv1 as [v1|]; simplify_res; last first.
+    { exists None. by rewrite lambda.interp_S /= Hinterp1. }
+    destruct (maybe3 dynlang.VClo _) eqn:?; simplify_res; last first.
+    { exists None. rewrite lambda.interp_S /= Hinterp1 /=. by destruct v1. }
+    destruct v1; simplify_res.
+    change (dynlang.Thunk ⌜*E⌝ ⌜e2⌝) with ⌜lambda.Thunk E e2⌝ in Hinterp.
+    rewrite -fmap_insert in Hinterp.
+    apply lambda.interp_closed in Hinterp1 as Hmw; [|done..].
+    apply IH in Hinterp as (mv2 & Hinterp2 & ->).
+    + exists mv2. rewrite lambda.interp_S /= Hinterp1 /=. done.
+    + apply lambda.closed_env_insert; [by split|]. naive_solver.
+    + rewrite dom_insert_L. set_solver.
+Qed.
+Lemma interp_dynlang_lambda e mv n :
+  lambda.closed ∅ e →
+  dynlang.interp n ∅ ⌜e⌝ = Res mv →
+  ∃ mw, lambda.interp n ∅ e = Res mw ∧ mv = ⌜*mw⌝.
+Proof. intros. by apply interp_open_dynlang_lambda. Qed.
+
+(* The following equivalences about the semantics trivially follow: *)
+
+Theorem interp_equiv_ret_string e s :
+  lambda.closed ∅ e →
+  rtc lambda.step e (lambda.EString s)
+  ↔ rtc dynlang.step ⌜e⌝ (dynlang.EString s).
+Proof.
+  intros. rewrite -lambda.interp_sound_complete_ret_string //.
+  rewrite -dynlang.interp_sound_complete_ret_string. split; intros [n Hinterp].
+  + by apply interp_lambda_dynlang in Hinterp.
+  + apply interp_dynlang_lambda in Hinterp as ([[]|] & ?); naive_solver.
+Qed.
+
+Theorem interp_equiv_fail e :
+  lambda.closed ∅ e →
+  (∃ e', rtc lambda.step e e' ∧ lambda.stuck e')
+  ↔ (∃ e', rtc dynlang.step ⌜e⌝ e' ∧ dynlang.stuck e').
+Proof.
+  intros. rewrite -lambda.interp_sound_complete_fail //.
+  rewrite -dynlang.interp_sound_complete_fail. split; intros [n Hinterp].
+  + by apply interp_lambda_dynlang in Hinterp.
+  + apply interp_dynlang_lambda in Hinterp as ([] & ?); naive_solver.
+Qed.
+
+Theorem interp_equiv_no_fuel e :
+  lambda.closed ∅ e →
+  all_loop lambda.step e ↔ all_loop dynlang.step ⌜e⌝.
+Proof.
+  intros He. rewrite -lambda.interp_sound_complete_no_fuel; last done.
+  rewrite -dynlang.interp_sound_complete_no_fuel. split; intros Hnofuel n.
+  - destruct (dynlang.interp n ∅ _) as [mv|] eqn:Hinterp; [|done].
+    apply interp_dynlang_lambda in Hinterp as (? & Hinterp & _); [|done].
+    by rewrite Hnofuel in Hinterp.
+  - destruct (lambda.interp n ∅ _) as [mv|] eqn:Hinterp; [|done].
+    apply interp_lambda_dynlang in Hinterp as [m Hinterp]; [|done..].
+    by rewrite Hnofuel in Hinterp.
+Qed.
diff --git a/theories/dynlang/interp.v b/theories/dynlang/interp.v
new file mode 100644
index 0000000..dcf6b95
--- /dev/null
+++ b/theories/dynlang/interp.v
@@ -0,0 +1,49 @@
+From mininix Require Export res dynlang.operational_props.
+From stdpp Require Import options.
+
+Module Import dynlang.
+Export dynlang.
+
+Inductive thunk := Thunk { thunk_env : gmap string thunk; thunk_expr : expr }.
+Add Printing Constructor thunk.
+Notation env := (gmap string thunk).
+
+Inductive val :=
+  | VString (s : string)
+  | VClo (x : string) (E : env) (e : expr).
+
+Global Instance maybe_VString : Maybe VString := λ v,
+  if v is VString s then Some s else None.
+Global Instance maybe_VClo : Maybe3 VClo := λ v,
+  if v is VClo x E e then Some (x, E, e) else None.
+
+Definition interp1 (interp : env → expr → res val) (E : env) (e : expr) : res val :=
+  match e with
+  | EString s =>
+      mret (VString s)
+  | EId ds e =>
+      v ← interp E e;
+      x ← Res $ maybe VString v;
+      t ← Res $ (E !! x) ∪ (Thunk ∅ <$> ds !! x);
+      interp (thunk_env t) (thunk_expr t)
+  | EAbs ex e =>
+      v ← interp E ex;
+      x ← Res $ maybe VString v;
+      mret (VClo x E e)
+  | EApp e1 e2 =>
+      v1 ← interp E e1;
+      '(x, E', e') ← Res (maybe3 VClo v1);
+      interp (<[x:=Thunk E e2]> E') e'
+  end.
+
+Fixpoint interp (n : nat) (E : env) (e : expr) : res val :=
+  match n with
+  | O => NoFuel
+  | S n => interp1 (interp n) E e
+  end.
+
+Global Opaque interp.
+
+End dynlang.
+
+Add Printing Constructor dynlang.thunk.
diff --git a/theories/dynlang/interp_proofs.v b/theories/dynlang/interp_proofs.v
new file mode 100644
index 0000000..f18a91c
--- /dev/null
+++ b/theories/dynlang/interp_proofs.v
@@ -0,0 +1,426 @@
+From mininix Require Export dynlang.interp.
+From stdpp Require Import options.
+
+Module Import dynlang.
+Export dynlang.
+
+Lemma interp_S n : interp (S n) = interp1 (interp n).
+Proof. done. Qed.
+
+Fixpoint thunk_size (t : thunk) : nat :=
+  S (map_sum_with thunk_size (thunk_env t)).
+Definition env_size (E : env) : nat :=
+  map_sum_with thunk_size E.
+
+Lemma env_ind (P : env → Prop) :
+  (∀ E, map_Forall (λ i, P ∘ thunk_env) E → P E) →
+  ∀ E : env, P E.
+Proof.
+  intros Pbs E.
+  induction (Nat.lt_wf_0_projected env_size E) as [E _ IH].
+  apply Pbs, map_Forall_lookup=> y [E' e'] Hy.
+  apply (map_sum_with_lookup_le thunk_size) in Hy.
+  apply IH. by rewrite -Nat.le_succ_l.
+Qed.
+
+(** Correspondence to operational semantics *)
+Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr :=
+  subst (thunk_to_expr <$> E).
+Fixpoint thunk_to_expr (t : thunk) : expr :=
+  subst_env' thunk_to_expr (thunk_env t) (thunk_expr t).
+Notation subst_env := (subst_env' thunk_to_expr).
+
+Lemma subst_env_eq e E :
+  subst_env E e =
+    match e with
+    | EString s => EString s
+    | EId ds e => EId ((thunk_to_expr <$> E) ∪ ds) (subst_env E e)
+    | EAbs ex e => EAbs (subst_env E ex) (subst_env E e)
+    | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2)
+    end.
+Proof. by destruct e. Qed.
+
+Lemma subst_env_alt E e : subst_env E e = subst (thunk_to_expr <$> E) e.
+Proof. done. Qed.
+
+(* Use the unfolding lemmas, don't rely on conversion *)
+Opaque subst_env'.
+
+Definition val_to_expr (v : val) : expr :=
+  match v with
+  | VString s => EString s
+  | VClo x E e => EAbs (EString x) (subst_env E e)
+  end.
+
+Lemma val_final v : final (val_to_expr v).
+Proof. by destruct v. Qed.
+
+Lemma subst_empty e : subst ∅ e = e.
+Proof. induction e; f_equal/=; auto. by rewrite left_id_L. Qed.
+
+Lemma subst_env_empty e : subst_env ∅ e = e.
+Proof. rewrite subst_env_alt. apply subst_empty. Qed.
+
+Lemma interp_le {n1 n2 E e mv} :
+  interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv.
+Proof.
+  revert n2 E e mv.
+  induction n1 as [|n1 IH]; intros [|n2] E e mv He ?; [by (done || lia)..|].
+  rewrite interp_S in He; rewrite interp_S; destruct e;
+    repeat match goal with
+    | _ => case_match
+    | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res
+    | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
+    | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
+    | |- interp ?n ?E ?e ≫= _ = _ => erewrite (IH n E e) by (done || lia)
+    | _ => progress simplify_res
+    | _ => progress simplify_option_eq
+    end; eauto with lia.
+Qed.
+
+Lemma interp_agree {n1 n2 E e mv1 mv2} :
+  interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2.
+Proof.
+  intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2).
+  - rewrite -He2. symmetry. eauto using interp_le. 
+  - rewrite -He1. eauto using interp_le.
+Qed.
+
+Lemma subst_env_union E1 E2 e :
+  subst_env (E1 ∪ E2) e = subst_env E1 (subst_env E2 e).
+Proof.
+  revert E1 E2. induction e; intros E1 E2; rewrite subst_env_eq /=.
+  - done.
+  - rewrite !(subst_env_eq (EId _ _)) IHe. f_equal.
+    by rewrite assoc_L map_fmap_union.
+  - rewrite !(subst_env_eq (EAbs _ _)) /=. f_equal; auto.
+  - rewrite !(subst_env_eq (EApp _ _)) /=. f_equal; auto.
+Qed.
+
+Lemma subst_env_insert E x e t :
+  subst_env (<[x:=t]> E) e = subst {[x:=thunk_to_expr t]} (subst_env E e).
+Proof.
+  rewrite insert_union_singleton_l subst_env_union subst_env_alt.
+  by rewrite map_fmap_singleton.
+Qed.
+
+Lemma subst_env_insert_eq e1 e2 E1 E2 x E1' E2' e1' e2' :
+  subst_env E1 e1 = subst_env E2 e2 →
+  subst_env E1' e1' = subst_env E2' e2' →
+  subst_env (<[x:=Thunk E1' e1']> E1) e1 = subst_env (<[x:=Thunk E2' e2']> E2) e2.
+Proof. intros He He'. by rewrite !subst_env_insert //= He' He. Qed.
+
+Lemma interp_proper n E1 E2 e1 e2 mv :
+  subst_env E1 e1 = subst_env E2 e2 →
+  interp n E1 e1 = Res mv →
+  ∃ mw m, interp m E2 e2 = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  revert n E1 E2 e1 e2 mv. induction n as [|n IHn]; [done|].
+  intros E1 E2 e1 e2 mv Hsubst Hinterp.
+  rewrite 2!subst_env_eq in Hsubst.
+  rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done.
+  - eexists (Some (VString _)), 1. by rewrite interp_S.
+  - destruct (interp n _ e1) as [mv1|] eqn:Hinterp'; simplify_eq/=.
+    eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
+    destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe VString v1) as [x|] eqn:Hv1;
+      simplify_res; last first.
+    { exists None, (S m1). split; [|done]. rewrite interp_S /= Hinterp1 /=.
+      destruct v1, w1; repeat destruct select base_lit; by simplify_eq/=. }
+    destruct v1, w1; repeat destruct select base_lit; simplify_eq/=.
+    assert (∀ (ds : stringmap expr) (E : env) x,
+      thunk_to_expr <$> (E !! x) ∪ (Thunk ∅ <$> ds !! x)
+      = ((thunk_to_expr <$> E) ∪ ds) !! x) as HE.
+    { intros ds' E x. rewrite lookup_union lookup_fmap.
+      repeat destruct (_ !! _); f_equal/=; by rewrite subst_env_empty. }
+    pose proof (f_equal (.!! s0) Hsubst) as Hs. rewrite -!HE {HE} in Hs.
+    destruct (E1 !! s0 ∪ _) as [[E1' e1']|],
+      (E2 !! s0 ∪ _) as [[E2' e2']|] eqn:HE2; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. by rewrite HE2. }
+    eapply IHn in Hinterp as (mw & m2 & Hinterp2 & ?); [|by eauto..].
+    exists mw, (S (m1 `max` m2)). split; [|done]. rewrite interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia. rewrite HE2 /=.
+    eauto using interp_le with lia.
+  - destruct (interp n _ _) as [mv1|] eqn:Hinterp'; simplify_eq/=.
+    eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
+    destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe VString _) eqn:Hstring; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe VString w1 = None) as -> by (by destruct v1, w1). }
+    destruct v1, w1; simplify_eq/=.
+    eexists (Some (VClo _ _ _)), (S m1).
+    rewrite interp_S /= Hinterp1 /=. split; [done|]. by do 2 f_equal/=.
+  - destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+    eapply IHn in Hinterp' as (mw' & m1 & Hinterp1 & ?); last done.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). }
+    destruct v', w'; simplify_eq/=.
+    eapply IHn with (E2 := <[x0:=Thunk E2 e2_2]> E0) in Hinterp
+      as (w & m2 & Hinterp2 & ?); last by apply subst_env_insert_eq.
+    exists w, (S (m1 `max` m2)). rewrite interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    rewrite (interp_le Hinterp2) /=; last lia. done.
+Qed.
+
+Lemma subst_as_subst_env x e1 e2 :
+  subst {[x:=e2]} e1 = subst_env (<[x:=Thunk ∅ e2]> ∅) e1.
+Proof. rewrite subst_env_insert //= !subst_env_empty //. Qed.
+
+Lemma interp_subst n x e1 e2 mv :
+  interp n ∅ (subst {[x:=e2]} e1) = Res mv →
+  ∃ mw m, interp m (<[x:=Thunk ∅ e2]> ∅) e1 = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  apply interp_proper.
+  by rewrite subst_env_empty subst_as_subst_env.
+Qed.
+
+Lemma interp_step e1 e2 n mv :
+  e1 --> e2 →
+  interp n ∅ e2 = Res mv →
+  ∃ mw m, interp m ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  intros Hstep. revert mv n.
+  induction Hstep; intros mv n Hinterp.
+  - apply interp_subst in Hinterp as (w & [|m] & Hinterp & Hv);
+      simplify_eq/=; [|done..].
+    exists w, (S (S (S m))). rewrite !interp_S /= -!interp_S.
+    eauto using interp_le with lia.
+  - exists mv, (S (S n)). rewrite !interp_S /= -interp_S.
+    rewrite lookup_empty left_id_L H /=. eauto using interp_le with lia.
+  - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+    apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe VString _) eqn:Hstring; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe VString w' = None) as -> by (by destruct v', w'). }
+    destruct v', w'; simplify_eq/=.
+    eexists (Some (VClo _ _ _)), (S m1). rewrite !interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia. done.
+  - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+    apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). }
+    destruct v', w'; simplify_eq/=.
+    eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & Hv);
+      last apply subst_env_insert_eq; try done.
+    exists mw, (S (m1 `max` m2)). rewrite !interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    by rewrite (interp_le Hinterp2) /=; last lia.
+  - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n _ e1') as [mv1|] eqn:Hinterp1; simplify_eq/=.
+    apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1).
+    destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+    { exists None, (S m). by rewrite interp_S /= Hinterp1. }
+    exists mv, (S (n `max` m)). split; [|done].
+    rewrite interp_S /= (interp_le Hinterp1) /=; last lia.
+    assert (maybe VString w1 = maybe VString v1) as ->.
+    { destruct v1, w1; naive_solver. }
+    destruct (maybe VString v1); simplify_res; [|done].
+    destruct (_ ∪ _); simplify_res; eauto using interp_le with lia.
+Qed.
+
+Lemma final_interp e :
+  final e →
+  ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w.
+Proof.
+  induction e as [| |[]|]; inv 1.
+  - eexists (VString _), 1. by rewrite interp_S /=.
+  - eexists (VClo _ _ _), 2. rewrite interp_S /=. split; [done|].
+    by rewrite subst_env_empty.
+Qed.
+
+Lemma red_final_interp e :
+  red step e ∨ final e ∨ ∃ m, interp m ∅ e = mfail.
+Proof.
+  induction e.
+  - (* ENat *) right; left. constructor.
+  - (* EId *) destruct IHe as [[??]|[Hfinal|[m Hinterp]]].
+    + left. by repeat econstructor.
+    + apply final_interp in Hfinal as (w & m & Hinterp & ->).
+      destruct (maybe VString w) as [x|] eqn:Hw; last first.
+      { do 2 right. eexists (S m). rewrite interp_S /= Hinterp /=.
+        by rewrite Hw. }
+      destruct w; simplify_eq/=.
+      destruct (ds !! x) as [e|] eqn:Hx; last first.
+      { do 2 right. eexists (S m). rewrite interp_S /= Hinterp /=.
+        by rewrite Hx. }
+      left. by repeat econstructor.
+    + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done.
+  - (* EAbs *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]].
+    + left. by repeat econstructor.
+    + apply final_interp in Hfinal as (w & m & Hinterp & ->).
+      destruct (maybe VString w) as [x|] eqn:Hw; last first.
+      { do 2 right. eexists (S m). rewrite interp_S /= Hinterp /=.
+        by rewrite Hw. }
+      destruct w; naive_solver.
+    + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done.
+  - (* EApp *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]].
+    + left. by repeat econstructor.
+    + apply final_interp in Hfinal as (w & m & Hinterp & ->).
+      destruct (maybe3 VClo w) eqn:Hw.
+      { destruct w; simplify_eq/=. left. by repeat econstructor. }
+      do 2 right. exists (S m). by rewrite interp_S /= Hinterp /= Hw.
+    + do 2 right. exists (S m). by rewrite interp_S /= Hinterp.
+Qed.
+
+Lemma interp_complete e1 e2 :
+  e1 -->* e2 →
+  nf step e2 →
+  ∃ mw m, interp m ∅ e1 = Res mw ∧
+    if mw is Some w then e2 = val_to_expr w else ¬final e2.
+Proof.
+  intros Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH].
+  { destruct (red_final_interp e) as [?|[Hfinal|[m Hinterp]]]; [done|..].
+    - apply final_interp in Hfinal as (w & m & ? & ?).
+      by exists (Some w), m.
+    - exists None, m. split; [done|]. intros Hfinal.
+      apply final_interp in Hfinal as (w & m' & ? & _).
+      by assert (mfail = mret w) by eauto using interp_agree. }
+  destruct IH as (mw & m & Hinterp & ?); try done.
+  eapply interp_step in Hinterp as (mw' & m' & ? & ?); last done.
+  destruct mw, mw'; naive_solver.
+Qed.
+
+Lemma interp_complete_ret e1 e2 :
+  e1 -->* e2 → final e2 →
+  ∃ w m, interp m ∅ e1 = mret w ∧ e2 = val_to_expr w.
+Proof.
+  intros Hsteps Hfinal. apply interp_complete in Hsteps
+    as ([w|] & m & ? & ?); naive_solver eauto using final_nf.
+Qed.
+Lemma interp_complete_fail e1 e2 :
+  e1 -->* e2 → nf step e2 → ¬final e2 →
+  ∃ m, interp m ∅ e1 = mfail.
+Proof.
+  intros Hsteps Hnf Hforce.
+  apply interp_complete in Hsteps as ([w|] & m & ? & ?); simplify_eq/=; try by eauto.
+  destruct Hforce. apply val_final.
+Qed.
+
+Lemma interp_sound_open E e n mv :
+  interp n E e = Res mv →
+  ∃ e', subst_env E e -->* e' ∧
+    if mv is Some v then e' = val_to_expr v else stuck e'.
+Proof.
+  revert E e mv.
+  induction n as [|n IH]; intros E e mv Hinterp; first done.
+  rewrite subst_env_eq. rewrite interp_S in Hinterp.
+  destruct e; simplify_res.
+  - (* EString *) by eexists.
+  - (* EId *)
+    destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res.
+    apply IH in Hinterp1 as (e1' & Hsteps1 & He1').
+    destruct mv1 as [v1|]; simplify_res; last first.
+    { eexists; split; [by eapply SId_rtc|]. split; [|inv 1].
+      intros [??]. destruct He1' as [Hnf []].
+      inv_step; simpl; eauto. destruct Hnf; eauto. }
+    destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first.
+    { eexists; split; [by eapply SId_rtc|]. split; [|inv 1].
+      intros [??]. destruct v1; inv_step. }
+    destruct v1; simplify_eq/=.
+    assert (thunk_to_expr <$> (E !! x) ∪ (Thunk ∅ <$> ds !! x)
+      = ((thunk_to_expr <$> E) ∪ ds) !! x).
+    { rewrite lookup_union lookup_fmap.
+      repeat destruct (_ !! _); f_equal/=; by rewrite subst_env_empty. }
+    destruct (_ ∪ _) as [[E' e']|] eqn:Hx; simplify_res.
+    * apply IH in Hinterp as (e'' & Hsteps & He'').
+      exists e''; split; [|done]. etrans; [by eapply SId_rtc|].
+      eapply rtc_l; [|done]. by econstructor.
+    * eexists; split; [by eapply SId_rtc|]. split; [|inv 1].
+      intros [? Hstep]. inv_step; simplify_eq/=; congruence.
+  - (* EAbs *)
+    destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res.
+    apply IH in Hinterp1 as (e1' & Hsteps1 & He1').
+    destruct mv1 as [v1|]; simplify_res; last first.
+    { eexists; split; [by eapply SAbsL_rtc|]. split.
+      + intros [??]. destruct He1' as [Hnf []].
+        inv_step; simpl; eauto. destruct Hnf; eauto.
+      + intros ?. destruct He1' as [_ []]. by destruct e1'. }
+    eexists; split; [by eapply SAbsL_rtc|].
+    destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first.
+    { split; [|destruct v1; inv 1]. intros [??]. destruct v1; inv_step. }
+    by destruct v1; simplify_eq/=.
+  - (* EApp *) destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+    apply IH in Hinterp' as (e' & Hsteps & He'); try done.
+    destruct mv' as [v'|]; simplify_res; last first.
+    { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
+      intros [e'' Hstep]. destruct He' as [Hnf Hfinal].
+      inv Hstep; [by destruct Hfinal; constructor|]. destruct Hnf. eauto. }
+    destruct (maybe3 VClo v') eqn:?; simplify_res; last first.
+    { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
+      intros [e'' Hstep]. inv Hstep; destruct v'; by repeat inv_step. }
+    destruct v'; simplify_res.
+    apply IH in Hinterp as (e'' & Hsteps' & He'').
+    eexists; split; [|done]. etrans; [by apply SAppL_rtc|].
+    eapply rtc_l; first by constructor.
+    rewrite subst_env_insert // in Hsteps'.
+Qed.
+
+Lemma interp_sound n e mv :
+  interp n ∅ e = Res mv →
+  ∃ e', e -->* e' ∧ if mv is Some v then e' = val_to_expr v else stuck e'.
+Proof.
+  intros Hsteps%interp_sound_open; try done.
+  by rewrite subst_env_empty in Hsteps.
+Qed.
+
+(** Final theorems *)
+Theorem interp_sound_complete_ret e v :
+  (∃ w n, interp n ∅ e = mret w ∧ val_to_expr v = val_to_expr w)
+  ↔ e -->* val_to_expr v.
+Proof.
+  split.
+  - by intros (n & w & (e' & ? & ->)%interp_sound & ->).
+  - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?);
+      eauto using val_final.
+Qed.
+
+Theorem interp_sound_complete_ret_string e s :
+  (∃ n, interp n ∅ e = mret (VString s)) ↔ e -->* EString s.
+Proof.
+  split.
+  - by intros [n (e' & ? & ->)%interp_sound].
+  - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?);
+      simplify_eq/=; eauto.
+Qed.
+
+Theorem interp_sound_complete_fail e :
+  (∃ n, interp n ∅ e = mfail) ↔ ∃ e', e -->* e' ∧ stuck e'.
+Proof.
+  split.
+  - by intros [n ?%interp_sound].
+  - intros (e' & Hsteps & Hnf & Hforced). by eapply interp_complete_fail.
+Qed.
+
+Theorem interp_sound_complete_no_fuel e :
+  (∀ n, interp n ∅ e = NoFuel) ↔ all_loop step e.
+Proof.
+  rewrite all_loop_alt. split.
+  - intros Hnofuel e' Hsteps.
+    destruct (red_final_interp e') as [|[|He']]; [done|..].
+    + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); last done.
+      by rewrite Hnofuel in Hinterp.
+    + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]).
+      destruct (interp_complete e e'') as (mv & n & Hinterp & _); [by etrans|done|].
+      by rewrite Hnofuel in Hinterp.
+  - intros Hred n. destruct (interp n ∅ e) as [mv|] eqn:Hinterp; [|done].
+    apply interp_sound in Hinterp as (e' & Hsteps%Hred & Hstuck).
+    destruct mv as [v|]; simplify_eq/=.
+    + apply final_nf in Hsteps as []. apply val_final.
+    + by destruct Hstuck as [[] ?].
+Qed.
+
+End dynlang.
diff --git a/theories/dynlang/operational.v b/theories/dynlang/operational.v
new file mode 100644
index 0000000..34cca7b
--- /dev/null
+++ b/theories/dynlang/operational.v
@@ -0,0 +1,41 @@
+From mininix Require Export utils.
+From stdpp Require Import options.
+
+Module Import dynlang.
+
+Inductive expr :=
+  | EString (s : string)
+  | EId (ds : gmap string expr) (ex : expr)
+  | EAbs (ex e : expr)
+  | EApp (e1 e2 : expr).
+
+Fixpoint subst (ds : gmap string expr) (e : expr) : expr :=
+  match e with
+  | EString s => EString s
+  | EId ds' e => EId (ds ∪ ds') (subst ds e)
+  | EAbs ex e => EAbs (subst ds ex) (subst ds e)
+  | EApp e1 e2 => EApp (subst ds e1) (subst ds e2)
+  end.
+
+Reserved Infix "-->" (right associativity, at level 55).
+Inductive step : expr → expr → Prop :=
+  | Sβ x e1 e2 : EApp (EAbs (EString x) e1) e2 --> subst {[x:=e2]} e1
+  | SIdString ds x e : ds !! x = Some e → EId ds (EString x) --> e
+  | SAbsL ex1 ex1' e : ex1 --> ex1' → EAbs ex1 e --> EAbs ex1' e
+  | SAppL e1 e1' e2 : e1 --> e1' → EApp e1 e2 --> EApp e1' e2
+  | SId ds e1 e1' : e1 --> e1' → EId ds e1 --> EId ds e1'
+where "e1 --> e2" := (step e1 e2).
+
+Infix "-->*" := (rtc step) (right associativity, at level 55).
+
+Definition final (e : expr) : Prop :=
+  match e with
+  | EString _ => True
+  | EAbs (EString _) _ => True
+  | _ => False
+  end.
+
+Definition stuck (e : expr) : Prop :=
+  nf step e ∧ ¬final e.
+
+End dynlang.
diff --git a/theories/dynlang/operational_props.v b/theories/dynlang/operational_props.v
new file mode 100644
index 0000000..9e8028c
--- /dev/null
+++ b/theories/dynlang/operational_props.v
@@ -0,0 +1,33 @@
+From mininix Require Export dynlang.operational.
+From stdpp Require Import options.
+
+Module Import dynlang.
+Export dynlang.
+
+(** Properties of operational semantics *)
+Lemma step_not_final e1 e2 : e1 --> e2 → ¬final e1.
+Proof. induction 1; simpl; repeat case_match; naive_solver. Qed.
+Lemma final_nf e : final e → nf step e.
+Proof. by intros ? [??%step_not_final]. Qed.
+
+Lemma SAbsL_rtc ex1 ex1' e : ex1 -->* ex1' → EAbs ex1 e -->* EAbs ex1' e.
+Proof. induction 1; econstructor; eauto using step. Qed.
+Lemma SAppL_rtc e1 e1' e2 : e1 -->* e1' → EApp e1 e2 -->* EApp e1' e2.
+Proof. induction 1; econstructor; eauto using step. Qed.
+Lemma SId_rtc ds e1 e1' : e1 -->* e1' → EId ds e1 -->* EId ds e1'.
+Proof. induction 1; econstructor; eauto using step. Qed.
+
+Ltac inv_step := repeat
+  match goal with H : ?e --> _ |- _ => assert_fails (is_var e); inv H end.
+
+Lemma step_det e d1 d2 :
+  e --> d1 →
+  e --> d2 →
+  d1 = d2.
+Proof.
+  intros Hred1. revert d2.
+  induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step;
+    f_equal; by apply IHHred1.
+Qed.
+
+End dynlang.
diff --git a/theories/evallang/interp.v b/theories/evallang/interp.v
new file mode 100644
index 0000000..d98b87f
--- /dev/null
+++ b/theories/evallang/interp.v
@@ -0,0 +1,52 @@
+From mininix Require Export res evallang.operational_props.
+From stdpp Require Import options.
+
+Module Import evallang.
+Export evallang.
+
+Inductive thunk := Thunk { thunk_env : gmap string thunk; thunk_expr : expr }.
+Add Printing Constructor thunk.
+Notation env := (gmap string thunk).
+
+Inductive val :=
+  | VString (s : string)
+  | VClo (x : string) (E : env) (e : expr).
+
+Global Instance maybe_VString : Maybe VString := λ v,
+  if v is VString s then Some s else None.
+Global Instance maybe_VClo : Maybe3 VClo := λ v,
+  if v is VClo x E e then Some (x, E, e) else None.
+
+Definition interp1 (interp : env → expr → res val) (E : env) (e : expr) : res val :=
+  match e with
+  | EString s =>
+      mret (VString s)
+  | EId ds x =>
+      t ← Res $ (E !! x) ∪ (Thunk ∅ <$> ds);
+      interp (thunk_env t) (thunk_expr t)
+  | EEval ds e =>
+      v ← interp E e;
+      s ← Res $ maybe VString v;
+      e ← Res $ parse s;
+      interp (E ∪ (Thunk ∅ <$> ds)) e
+  | EAbs ex e =>
+      v ← interp E ex;
+      x ← Res $ maybe VString v;
+      mret (VClo x E e)
+  | EApp e1 e2 =>
+      v1 ← interp E e1;
+      '(x, E', e') ← Res (maybe3 VClo v1);
+      interp (<[x:=Thunk E e2]> E') e'
+  end.
+
+Fixpoint interp (n : nat) (E : env) (e : expr) : res val :=
+  match n with
+  | O => NoFuel
+  | S n => interp1 (interp n) E e
+  end.
+
+Global Opaque interp.
+
+End evallang.
+
+Add Printing Constructor evallang.thunk.
diff --git a/theories/evallang/interp_proofs.v b/theories/evallang/interp_proofs.v
new file mode 100644
index 0000000..0a26dd1
--- /dev/null
+++ b/theories/evallang/interp_proofs.v
@@ -0,0 +1,478 @@
+From mininix Require Export evallang.interp.
+From stdpp Require Import options.
+
+Module Import evallang.
+Export evallang.
+
+Lemma interp_S n : interp (S n) = interp1 (interp n).
+Proof. done. Qed.
+
+Fixpoint thunk_size (t : thunk) : nat :=
+  S (map_sum_with thunk_size (thunk_env t)).
+Definition env_size (E : env) : nat :=
+  map_sum_with thunk_size E.
+
+Lemma env_ind (P : env → Prop) :
+  (∀ E, map_Forall (λ i, P ∘ thunk_env) E → P E) →
+  ∀ E : env, P E.
+Proof.
+  intros Pbs E.
+  induction (Nat.lt_wf_0_projected env_size E) as [E _ IH].
+  apply Pbs, map_Forall_lookup=> y [E' e'] Hy.
+  apply (map_sum_with_lookup_le thunk_size) in Hy.
+  apply IH. by rewrite -Nat.le_succ_l.
+Qed.
+
+(** Correspondence to operational semantics *)
+Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr :=
+  subst (thunk_to_expr <$> E).
+Fixpoint thunk_to_expr (t : thunk) : expr :=
+  subst_env' thunk_to_expr (thunk_env t) (thunk_expr t).
+Notation subst_env := (subst_env' thunk_to_expr).
+
+Lemma subst_env_eq e E :
+  subst_env E e =
+    match e with
+    | EString s => EString s
+    | EId ds x => EId ((thunk_to_expr <$> E !! x) ∪ ds) x
+    | EEval ds e => EEval ((thunk_to_expr <$> E) ∪ ds) (subst_env E e)
+    | EAbs ex e => EAbs (subst_env E ex) (subst_env E e)
+    | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2)
+    end.
+Proof. destruct e; rewrite /subst_env' /= ?lookup_fmap //. Qed.
+
+Lemma subst_env_alt E e : subst_env E e = subst (thunk_to_expr <$> E) e.
+Proof. done. Qed.
+
+(* Use the unfolding lemmas, don't rely on conversion *)
+Opaque subst_env'.
+
+Definition val_to_expr (v : val) : expr :=
+  match v with
+  | VString s => EString s
+  | VClo x E e => EAbs (EString x) (subst_env E e)
+  end.
+
+Lemma final_val_to_expr v : final (val_to_expr v).
+Proof. by destruct v. Qed.
+Lemma step_not_val_to_expr v e : val_to_expr v --> e → False.
+Proof. intros []%step_not_final. apply final_val_to_expr. Qed.
+
+Lemma subst_empty e : subst ∅ e = e.
+Proof. induction e; f_equal/=; rewrite ?lookup_empty ?left_id_L //. Qed.
+
+Lemma subst_env_empty e : subst_env ∅ e = e.
+Proof. rewrite subst_env_alt. apply subst_empty. Qed.
+
+Lemma interp_le {n1 n2 E e mv} :
+  interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv.
+Proof.
+  revert n2 E e mv.
+  induction n1 as [|n1 IH]; intros [|n2] E e mv He ?; [by (done || lia)..|].
+  rewrite interp_S in He; rewrite interp_S; destruct e;
+    repeat match goal with
+    | _ => case_match
+    | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res
+    | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
+    | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
+    | |- interp ?n ?E ?e ≫= _ = _ => erewrite (IH n E e) by (done || lia)
+    | _ => progress simplify_res
+    | _ => progress simplify_option_eq
+    end; eauto with lia.
+Qed.
+
+Lemma interp_agree {n1 n2 E e mv1 mv2} :
+  interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2.
+Proof.
+  intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2).
+  - rewrite -He2. symmetry. eauto using interp_le. 
+  - rewrite -He1. eauto using interp_le.
+Qed.
+
+Lemma subst_env_union E1 E2 e :
+  subst_env (E1 ∪ E2) e = subst_env E1 (subst_env E2 e).
+Proof.
+  revert E1 E2. induction e; intros E1 E2; rewrite subst_env_eq /=.
+  - done.
+  - rewrite !subst_env_eq lookup_union. by destruct (E1 !! _), (E2 !! _), ds.
+  - rewrite !(subst_env_eq (EEval _ _)) IHe. f_equal.
+    by rewrite assoc_L map_fmap_union.
+  - rewrite !(subst_env_eq (EAbs _ _)) /=. f_equal; auto.
+  - rewrite !(subst_env_eq (EApp _ _)) /=. f_equal; auto.
+Qed.
+
+Lemma subst_env_insert E x e t :
+  subst_env (<[x:=t]> E) e = subst {[x:=thunk_to_expr t]} (subst_env E e).
+Proof.
+  rewrite insert_union_singleton_l subst_env_union subst_env_alt.
+  by rewrite map_fmap_singleton.
+Qed.
+
+Lemma subst_env_insert_eq e1 e2 E1 E2 x E1' E2' e1' e2' :
+  subst_env E1 e1 = subst_env E2 e2 →
+  subst_env E1' e1' = subst_env E2' e2' →
+  subst_env (<[x:=Thunk E1' e1']> E1) e1 = subst_env (<[x:=Thunk E2' e2']> E2) e2.
+Proof. intros He He'. by rewrite !subst_env_insert //= He' He. Qed.
+
+Lemma option_fmap_thunk_to_expr_Thunk (me : option expr) :
+  thunk_to_expr <$> (Thunk ∅ <$> me) = me.
+Proof. destruct me; f_equal/=. by rewrite subst_env_empty. Qed.
+
+Lemma map_fmap_thunk_to_expr_Thunk (es : gmap string expr) :
+  thunk_to_expr <$> (Thunk ∅ <$> es) = es.
+Proof.
+  apply map_eq=> x. by rewrite !lookup_fmap option_fmap_thunk_to_expr_Thunk.
+Qed.
+
+Lemma subst_env_eval_eq E1 E2 ds1 ds2 e :
+  (thunk_to_expr <$> E1) ∪ ds1 = (thunk_to_expr <$> E2) ∪ ds2 →
+  subst_env (E1 ∪ (Thunk ∅ <$> ds1)) e = subst_env (E2 ∪ (Thunk ∅ <$> ds2)) e.
+Proof.
+  intros HE.
+  by rewrite !subst_env_alt !map_fmap_union !map_fmap_thunk_to_expr_Thunk HE.
+Qed.
+
+Lemma interp_proper n E1 E2 e1 e2 mv :
+  subst_env E1 e1 = subst_env E2 e2 →
+  interp n E1 e1 = Res mv →
+  ∃ mw m, interp m E2 e2 = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  revert n E1 E2 e1 e2 mv. induction n as [|n IHn]; [done|].
+  intros E1 E2 e1 e2 mv Hsubst Hinterp.
+  rewrite 2!subst_env_eq in Hsubst.
+  rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done.
+  - eexists (Some (VString _)), 1. by rewrite interp_S.
+  - assert (thunk_to_expr <$> E1 !! x0 ∪ (Thunk ∅ <$> ds) =
+      thunk_to_expr <$> E2 !! x0 ∪ (Thunk ∅ <$> ds0)).
+    { destruct (E1 !! _), (E2 !! _), ds, ds0; simplify_eq/=;
+        f_equal/=; by rewrite ?subst_env_empty. }
+    destruct (E1 !! x0 ∪ (Thunk ∅ <$> ds)) as [[E1' e1']|],
+      (E2 !! x0 ∪ (Thunk ∅ <$> ds0)) as [[E2' e2']|] eqn:HE2;
+      simplify_res; last first.
+    { exists None, 1. by rewrite interp_S /= HE2. }
+    eapply IHn in Hinterp as (mw & m & Hinterp2 & ?); [|by eauto..].
+    exists mw, (S m). split; [|done]. rewrite interp_S /= HE2 /=. done.
+  - destruct (interp n _ e1) as [mv1|] eqn:Hinterp'; simplify_eq/=.
+    eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
+    destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe VString v1) as [x|] eqn:Hv1;
+      simplify_res; last first.
+    { exists None, (S m1). split; [|done]. rewrite interp_S /= Hinterp1 /=.
+      destruct v1, w1; repeat destruct select base_lit; by simplify_eq/=. }
+    destruct v1, w1; repeat destruct select base_lit; simplify_eq/=.
+    destruct (parse _) as [e|] eqn:Hparse; simplify_res; last first.
+    { exists None, (S m1). split; [|done]. rewrite interp_S /= Hinterp1 /=.
+      by rewrite Hparse. }
+    eapply IHn in Hinterp
+      as (mw & m2 & Hinterp2 & ?); last by apply subst_env_eval_eq.
+    exists mw, (S (m1 `max` m2)). split; [|done]. rewrite interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia. rewrite Hparse /=.
+    eauto using interp_le with lia.
+  - destruct (interp n _ _) as [mv1|] eqn:Hinterp'; simplify_eq/=.
+    eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
+    destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe VString _) eqn:Hstring; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe VString w1 = None) as -> by (by destruct v1, w1). }
+    destruct v1, w1; simplify_eq/=.
+    eexists (Some (VClo _ _ _)), (S m1).
+    rewrite interp_S /= Hinterp1 /=. split; [done|]. by do 2 f_equal/=.
+  - destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+    eapply IHn in Hinterp' as (mw' & m1 & Hinterp1 & ?); last done.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). }
+    destruct v', w'; simplify_eq/=.
+    eapply IHn with (E2 := <[x0:=Thunk E2 e2_2]> E0) in Hinterp
+      as (w & m2 & Hinterp2 & ?); last by apply subst_env_insert_eq.
+    exists w, (S (m1 `max` m2)). rewrite interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    rewrite (interp_le Hinterp2) /=; last lia. done.
+Qed.
+
+Lemma subst_as_subst_env x e1 e2 :
+  subst {[x:=e2]} e1 = subst_env (<[x:=Thunk ∅ e2]> ∅) e1.
+Proof. rewrite subst_env_insert //= !subst_env_empty //. Qed.
+
+Lemma interp_subst_abs n x e1 e2 mv :
+  interp n ∅ (subst {[x:=e2]} e1) = Res mv →
+  ∃ mw m, interp m (<[x:=Thunk ∅ e2]> ∅) e1 = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  apply interp_proper. by rewrite subst_env_empty subst_as_subst_env.
+Qed.
+
+Lemma interp_subst_eval n e ds mv :
+  interp n ∅ (subst ds e) = Res mv →
+  ∃ mw m, interp m (Thunk ∅ <$> ds) e = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  apply interp_proper.
+  by rewrite subst_env_empty subst_env_alt map_fmap_thunk_to_expr_Thunk.
+Qed.
+
+Lemma interp_step e1 e2 n mv :
+  e1 --> e2 →
+  interp n ∅ e2 = Res mv →
+  ∃ mw m, interp m ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  intros Hstep. revert mv n.
+  induction Hstep; intros mv n Hinterp.
+  - apply interp_subst_abs in Hinterp as (mw & [|m] & Hinterp & Hv);
+      simplify_eq/=; [|done..].
+    exists mw, (S (S (S m))). rewrite !interp_S /= -!interp_S.
+    eauto using interp_le with lia.
+  - exists mv, (S n). rewrite !interp_S /=.
+    rewrite lookup_empty left_id_L /=. done.
+  - apply interp_subst_eval in Hinterp as (mw & [|m] & Hinterp & Hv);
+      simplify_eq/=; [|done..].
+    exists mw, (S (S m)). rewrite !interp_S /= -interp_S.
+    rewrite left_id_L H /=. done.
+  - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+    apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe VString _) eqn:Hstring; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe VString w' = None) as -> by (by destruct v', w'). }
+    destruct v', w'; simplify_eq/=.
+    eexists (Some (VClo _ _ _)), (S m1). rewrite !interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia. done.
+  - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+    apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). }
+    destruct v', w'; simplify_eq/=.
+    eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & Hv);
+      last apply subst_env_insert_eq; try done.
+    exists mw, (S (m1 `max` m2)). rewrite !interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    by rewrite (interp_le Hinterp2) /=; last lia.
+  - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n _ e1') as [mv1|] eqn:Hinterp1; simplify_eq/=.
+    apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1).
+    destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+    { exists None, (S m). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe VString _) eqn:Hstring; simplify_res; last first.
+    { exists None, (S m). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe VString w1 = None) as -> by (by destruct v1, w1). }
+    destruct v1, w1; simplify_eq/=.
+    exists mv, (S (n `max` m)). split; [|done]. rewrite interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    destruct (parse _); simplify_res; eauto using interp_le with lia.
+Qed.
+
+Lemma final_interp e :
+  final e →
+  ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w.
+Proof.
+  induction e as [| | |[]|]; inv 1.
+  - eexists (VString _), 1. by rewrite interp_S /=.
+  - eexists (VClo _ _ _), 2. rewrite interp_S /=. split; [done|].
+    by rewrite subst_env_empty.
+Qed.
+
+Lemma red_final_interp e :
+  red step e ∨ final e ∨ ∃ m, interp m ∅ e = mfail.
+Proof.
+  induction e.
+  - (* ENat *) right; left. constructor.
+  - (* EId *) destruct ds as [e|].
+    + left. by repeat econstructor.
+    + do 2 right. by exists 1.
+  - (* EEval *) destruct IHe as [[??]|[Hfinal|[m Hinterp]]].
+    + left. by repeat econstructor.
+    + apply final_interp in Hfinal as (w & m & Hinterp & ->).
+      destruct (maybe VString w) as [x|] eqn:Hw; last first.
+      { do 2 right. exists (S m). rewrite interp_S /= Hinterp /=.
+        by rewrite Hw. }
+      destruct w; simplify_eq/=.
+      destruct (parse x) as [e|] eqn:Hparse; last first.
+      { do 2 right. exists (S m). rewrite interp_S /= Hinterp /=.
+        by rewrite Hparse. }
+      left. by repeat econstructor.
+    + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done.
+  - (* EAbs *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]].
+    + left. by repeat econstructor.
+    + apply final_interp in Hfinal as (w & m & Hinterp & ->).
+      destruct (maybe VString w) as [x|] eqn:Hw; last first.
+      { do 2 right. exists (S m). rewrite interp_S /= Hinterp /=.
+        by rewrite Hw. }
+      destruct w; naive_solver.
+    + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done.
+  - (* EApp *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]].
+    + left. by repeat econstructor.
+    + apply final_interp in Hfinal as (w & m & Hinterp & ->).
+      destruct (maybe3 VClo w) eqn:Hw.
+      { destruct w; simplify_eq/=. left. by repeat econstructor. }
+      do 2 right. exists (S m). by rewrite interp_S /= Hinterp /= Hw.
+    + do 2 right. exists (S m). by rewrite interp_S /= Hinterp.
+Qed.
+
+Lemma interp_complete e1 e2 :
+  e1 -->* e2 →
+  nf step e2 →
+  ∃ mw m, interp m ∅ e1 = Res mw ∧
+    if mw is Some w then e2 = val_to_expr w else ¬final e2.
+Proof.
+  intros Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH].
+  { destruct (red_final_interp e) as [?|[Hfinal|[m Hinterp]]]; [done|..].
+    - apply final_interp in Hfinal as (w & m & ? & ?).
+      by exists (Some w), m.
+    - exists None, m. split; [done|]. intros Hfinal.
+      apply final_interp in Hfinal as (w & m' & ? & _).
+      by assert (mfail = mret w) by eauto using interp_agree. }
+  destruct IH as (mw & m & Hinterp & ?); try done.
+  eapply interp_step in Hinterp as (mw' & m' & ? & ?); last done.
+  destruct mw, mw'; naive_solver.
+Qed.
+
+Lemma interp_complete_ret e1 e2 :
+  e1 -->* e2 → final e2 →
+  ∃ w m, interp m ∅ e1 = mret w ∧ e2 = val_to_expr w.
+Proof.
+  intros Hsteps Hfinal. apply interp_complete in Hsteps
+    as ([w|] & m & ? & ?); naive_solver eauto using final_nf.
+Qed.
+Lemma interp_complete_fail e1 e2 :
+  e1 -->* e2 → nf step e2 → ¬final e2 →
+  ∃ m, interp m ∅ e1 = mfail.
+Proof.
+  intros Hsteps Hnf Hforce.
+  apply interp_complete in Hsteps as ([w|] & m & ? & ?); simplify_eq/=; try by eauto.
+  destruct Hforce. apply final_val_to_expr.
+Qed.
+
+Lemma interp_sound_open E e n mv :
+  interp n E e = Res mv →
+  ∃ e', subst_env E e -->* e' ∧
+    if mv is Some v then e' = val_to_expr v else stuck e'.
+Proof.
+  revert E e mv.
+  induction n as [|n IH]; intros E e mv Hinterp; first done.
+  rewrite subst_env_eq. rewrite interp_S in Hinterp.
+  destruct e; simplify_res.
+  - (* EString *) by eexists.
+  - (* EId *)
+    assert (thunk_to_expr <$> (E !! x) ∪ (Thunk ∅ <$> ds)
+      = (thunk_to_expr <$> E !! x) ∪ ds).
+    { destruct (_ !! _), ds; f_equal/=. by rewrite subst_env_empty. }
+    destruct (_ ∪ (_ <$> _)) as [[E1 e1]|], (_ ∪ _) as [e2|]; simplify_res.
+    * apply IH in Hinterp as (e'' & Hsteps & He'').
+      exists e''; split; [|done].
+      eapply rtc_l; [|done]. by econstructor.
+    * eexists; split; [done|]. split; [|inv 1].
+      intros [? Hstep]. inv_step; simplify_eq/=; congruence.
+  - (* EEval *)
+    destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res.
+    apply IH in Hinterp1 as (e1' & Hsteps1 & He1').
+    destruct mv1 as [v1|]; simplify_res; last first.
+    { eexists; split; [by eapply SEval_rtc|]. split; [|inv 1].
+      intros [??]. destruct He1' as [Hnf []].
+      inv_step; simpl; eauto. destruct Hnf; eauto. }
+    destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first.
+    { eexists; split; [by eapply SEval_rtc|]. split; [|inv 1].
+      intros [??]. destruct v1; inv_step. }
+    destruct v1; simplify_eq/=.
+    destruct (parse x) as [ex|] eqn:Hparse; simplify_res; last first.
+    { eexists; split; [by eapply SEval_rtc|].
+      split; [|inv 1]. intros [??]. inv_step. }
+    apply IH in Hinterp as (e'' & Hsteps & He'').
+    exists e''; split; [|done]. etrans; [by eapply SEval_rtc|].
+    eapply rtc_l; [by econstructor|].
+    by rewrite subst_env_alt map_fmap_union
+      map_fmap_thunk_to_expr_Thunk in Hsteps.
+  - (* EAbs *)
+    destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res.
+    apply IH in Hinterp1 as (e1' & Hsteps1 & He1').
+    destruct mv1 as [v1|]; simplify_res; last first.
+    { eexists; split; [by eapply SAbsL_rtc|]. split.
+      + intros [??]. destruct He1' as [Hnf []].
+        inv_step; simpl; eauto. destruct Hnf; eauto.
+      + intros ?. destruct He1' as [_ []]. by destruct e1'. }
+    eexists; split; [by eapply SAbsL_rtc|].
+    destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first.
+    { split; [|destruct v1; inv 1]. intros [??]. destruct v1; inv_step. }
+    by destruct v1; simplify_eq/=.
+  - (* EApp *) destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+    apply IH in Hinterp' as (e' & Hsteps & He'); try done.
+    destruct mv' as [v'|]; simplify_res; last first.
+    { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
+      intros [e'' Hstep]. destruct He' as [Hnf Hfinal].
+      inv Hstep; [by destruct Hfinal; constructor|]. destruct Hnf. eauto. }
+    destruct (maybe3 VClo v') eqn:?; simplify_res; last first.
+    { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
+      intros [e'' Hstep]. inv Hstep; destruct v'; by repeat inv_step. }
+    destruct v'; simplify_res.
+    apply IH in Hinterp as (e'' & Hsteps' & He'').
+    eexists; split; [|done]. etrans; [by apply SAppL_rtc|].
+    eapply rtc_l; first by constructor.
+    rewrite subst_env_insert // in Hsteps'.
+Qed.
+
+Lemma interp_sound n e mv :
+  interp n ∅ e = Res mv →
+  ∃ e', e -->* e' ∧ if mv is Some v then e' = val_to_expr v else stuck e'.
+Proof.
+  intros Hsteps%interp_sound_open; try done.
+  by rewrite subst_env_empty in Hsteps.
+Qed.
+
+(** Final theorems *)
+Theorem interp_sound_complete_ret e v :
+  (∃ w n, interp n ∅ e = mret w ∧ val_to_expr v = val_to_expr w)
+    ↔ e -->* val_to_expr v.
+Proof.
+  split.
+  - by intros (n & w & (e' & ? & ->)%interp_sound & ->).
+  - intros Hsteps. apply interp_complete in Hsteps as ([] & ? & ? & ?);
+      unfold nf, red;
+      naive_solver eauto using final_val_to_expr, step_not_val_to_expr.
+Qed.
+
+Theorem interp_sound_complete_ret_string e s :
+  (∃ n, interp n ∅ e = mret (VString s)) ↔ e -->* EString s.
+Proof.
+  split.
+  - by intros [n (e' & ? & ->)%interp_sound].
+  - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?);
+      simplify_eq/=; eauto.
+Qed.
+
+Theorem interp_sound_complete_fail e :
+  (∃ n, interp n ∅ e = mfail) ↔ ∃ e', e -->* e' ∧ stuck e'.
+Proof.
+  split.
+  - by intros [n ?%interp_sound].
+  - intros (e' & Hsteps & Hnf & Hforced). by eapply interp_complete_fail.
+Qed.
+
+Theorem interp_sound_complete_no_fuel e :
+  (∀ n, interp n ∅ e = NoFuel) ↔ all_loop step e.
+Proof.
+  rewrite all_loop_alt. split.
+  - intros Hnofuel e' Hsteps.
+    destruct (red_final_interp e') as [|[|He']]; [done|..].
+    + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); last done.
+      by rewrite Hnofuel in Hinterp.
+    + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]).
+      destruct (interp_complete e e'') as (mv & n & Hinterp & _); [by etrans|done|].
+      by rewrite Hnofuel in Hinterp.
+  - intros Hred n. destruct (interp n ∅ e) as [mv|] eqn:Hinterp; [|done].
+    apply interp_sound in Hinterp as (e' & Hsteps%Hred & Hstuck).
+    destruct mv as [v|]; simplify_eq/=.
+    + apply final_nf in Hsteps as []. apply final_val_to_expr.
+    + by destruct Hstuck as [[] ?].
+Qed.
+
+End evallang.
diff --git a/theories/evallang/operational.v b/theories/evallang/operational.v
new file mode 100644
index 0000000..79174dd
--- /dev/null
+++ b/theories/evallang/operational.v
@@ -0,0 +1,140 @@
+From Coq Require Import Ascii.
+From mininix Require Export utils.
+From stdpp Require Import options.
+
+Module Import evallang.
+
+Inductive expr :=
+  | EString (s : string)
+  | EId (ds : option expr) (x : string)
+  | EEval (ds : gmap string expr) (ee : expr)
+  | EAbs (ex e : expr)
+  | EApp (e1 e2 : expr).
+
+Module parser.
+  Inductive token :=
+    | TId (s : string)
+    | TString (s : string)
+    | TColon
+    | TExclamation
+    | TParenL
+    | TParenR.
+
+  Inductive token_state :=
+    TSString (s : string) | TSId (s : string) | TSOther.
+
+  Definition token_state_push (st : token_state) (k : list token) : list token :=
+    match st with
+    | TSId s => TId (String.rev s) :: k
+    | _ => k
+    end.
+
+  Fixpoint tokenize_go (sin : string) (st : token_state)
+      (k : list token) : option (list token) :=
+    match sin, st with
+    | "", TSString _ => None (* no closing "" *)
+    | "", _ => Some (reverse (token_state_push st k))
+    | String "\" (String """" sin), TSString s =>
+        tokenize_go sin (TSString (String """" s)) k
+    | String """" sin, TSString s =>
+        tokenize_go sin TSOther (TString (String.rev s) :: k)
+    | String a sin, TSString s => tokenize_go sin (TSString (String a s)) k
+    | String ":" sin, _ => tokenize_go sin TSOther (TColon :: token_state_push st k)
+    | String "!" sin, _ => tokenize_go sin TSOther (TExclamation :: token_state_push st k)
+    | String "(" sin, _ => tokenize_go sin TSOther (TParenL :: token_state_push st k)
+    | String ")" sin, _ => tokenize_go sin TSOther (TParenR :: token_state_push st k)
+    | String """" sin, _ => tokenize_go sin (TSString "") k
+    | String a sin, TSOther =>
+       if Ascii.is_space a then tokenize_go sin TSOther k
+       else tokenize_go sin (TSId (String a EmptyString)) k
+    | String a sin, TSId s =>
+       if Ascii.is_space a then tokenize_go sin TSOther (TId (String.rev s) :: k)
+       else tokenize_go sin (TSId (String a s)) k
+    end.
+  Definition tokenize (sin : string) : option (list token) :=
+    tokenize_go sin TSOther [].
+
+  Inductive stack_item :=
+    | SExpr (e : expr)
+    | SAbsR (e : expr)
+    | SEval
+    | SParenL.
+
+  Definition stack_push (e : expr) (k : list stack_item) : list stack_item :=
+    match k with
+    | SExpr e1 :: k => SExpr (EApp e1 e) :: k
+    | SEval :: k => SExpr (EEval ∅ e) :: k
+    | _ => SExpr e :: k
+    end.
+
+  Fixpoint stack_pop_go (e : expr)
+      (k : list stack_item) : option (expr * list stack_item) :=
+    match k with
+    | SAbsR e1 :: k => stack_pop_go (EAbs e1 e) k
+    | _ => Some (e, k)
+    end.
+
+  Definition stack_pop (k : list stack_item) : option (expr * list stack_item) :=
+    match k with
+    | SExpr e :: k => stack_pop_go e k
+    | _ => None
+    end.
+
+  Fixpoint parse_go (ts : list token) (k : list stack_item) : option expr :=
+    match ts with
+    | [] => '(e, k) ← stack_pop k; guard (k = []);; Some e
+    | TString x :: ts => parse_go ts (stack_push (EString x) k)
+    | TId "eval" :: TExclamation :: ts => parse_go ts (SEval :: k)
+    | TId x :: TColon :: ts => parse_go ts (SAbsR (EString x) :: k)
+    | TId x :: ts => parse_go ts (stack_push (EId None x) k)
+    | TColon :: ts =>
+       '(e, k) ← stack_pop k;
+       parse_go ts (SAbsR e :: k)
+    | TParenL :: ts => parse_go ts (SParenL :: k)
+    | TParenR :: ts =>
+       '(e, k) ← stack_pop k;
+       match k with
+       | SParenL :: k => parse_go ts (stack_push e k)
+       | _ => None
+       end
+    | _ => None
+    end.
+
+  Definition parse (sin : string) : option expr :=
+    ts ← tokenize sin; parse_go ts [].
+End parser.
+
+Definition parse := parser.parse.
+
+Fixpoint subst (ds : gmap string expr) (e : expr) : expr :=
+  match e with
+  | EString s => EString s
+  | EId ds' x => EId (ds !! x ∪ ds') x
+  | EEval ds' ee => EEval (ds ∪ ds') (subst ds ee)
+  | EAbs ex e => EAbs (subst ds ex) (subst ds e)
+  | EApp e1 e2 => EApp (subst ds e1) (subst ds e2)
+  end.
+
+Reserved Infix "-->" (right associativity, at level 55).
+Inductive step : expr → expr → Prop :=
+  | Sβ x e1 e2 : EApp (EAbs (EString x) e1) e2 --> subst {[x:=e2]} e1
+  | SId e x : EId (Some e) x --> e
+  | SEvalString ds s e : parse s = Some e → EEval ds (EString s) --> subst ds e
+  | SAbsL ex1 ex1' e : ex1 --> ex1' → EAbs ex1 e --> EAbs ex1' e
+  | SAppL e1 e1' e2 : e1 --> e1' → EApp e1 e2 --> EApp e1' e2
+  | SEval ds e1 e1' : e1 --> e1' → EEval ds e1 --> EEval ds e1'
+where "e1 --> e2" := (step e1 e2).
+
+Infix "-->*" := (rtc step) (right associativity, at level 55).
+
+Definition final (e : expr) : Prop :=
+  match e with
+  | EString _ => True
+  | EAbs (EString _) _ => True
+  | _ => False
+  end.
+
+Definition stuck (e : expr) : Prop :=
+  nf step e ∧ ¬final e.
+
+End evallang.
diff --git a/theories/evallang/operational_props.v b/theories/evallang/operational_props.v
new file mode 100644
index 0000000..31724c0
--- /dev/null
+++ b/theories/evallang/operational_props.v
@@ -0,0 +1,33 @@
+From mininix Require Export evallang.operational.
+From stdpp Require Import options.
+
+Module Import evallang.
+Export evallang.
+
+(** Properties of operational semantics *)
+Lemma step_not_final e1 e2 : e1 --> e2 → ¬final e1.
+Proof. induction 1; simpl; repeat case_match; naive_solver. Qed.
+Lemma final_nf e : final e → nf step e.
+Proof. by intros ? [??%step_not_final]. Qed.
+
+Lemma SAbsL_rtc ex1 ex1' e : ex1 -->* ex1' → EAbs ex1 e -->* EAbs ex1' e.
+Proof. induction 1; econstructor; eauto using step. Qed.
+Lemma SAppL_rtc e1 e1' e2 : e1 -->* e1' → EApp e1 e2 -->* EApp e1' e2.
+Proof. induction 1; econstructor; eauto using step. Qed.
+Lemma SEval_rtc ds e1 e1' : e1 -->* e1' → EEval ds e1 -->* EEval ds e1'.
+Proof. induction 1; econstructor; eauto using step. Qed.
+
+Ltac inv_step := repeat
+  match goal with H : ?e --> _ |- _ => assert_fails (is_var e); inv H end.
+
+Lemma step_det e d1 d2 :
+  e --> d1 →
+  e --> d2 →
+  d1 = d2.
+Proof.
+  intros Hred1. revert d2.
+  induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step;
+    f_equal; by apply IHHred1.
+Qed.
+
+End evallang.
diff --git a/theories/evallang/tests.v b/theories/evallang/tests.v
new file mode 100644
index 0000000..eaba8a0
--- /dev/null
+++ b/theories/evallang/tests.v
@@ -0,0 +1,33 @@
+From mininix Require Export evallang.interp.
+From stdpp Require Import options.
+
+Import evallang.
+
+Definition interp' (n : nat) (s : string) : res val :=
+  interp n ∅ (EEval ∅ (EString s)).
+
+Lemma test_1_a : interp' 1000 ("(x: x) ""s""") = mret (VString "s").
+Proof. by vm_compute. Qed.
+Lemma test_1_b : interp' 1000 ("(""x"": x) ""s""") = mret (VString "s").
+Proof. by vm_compute. Qed.
+Lemma test_1_c : interp' 1000 ("((y:y) ""x"": x) ""s""") = mret (VString "s").
+Proof. by vm_compute. Qed.
+Lemma test_1_d : interp' 1000 ("(((y:y) ""x""): x) ""s""") = mret (VString "s").
+Proof. by vm_compute. Qed.
+
+Lemma test_2 : interp' 1000 ("(x: y: eval! y) ""s"" ""x""") = mret (VString "s").
+Proof. by vm_compute. Qed.
+
+Lemma test_3 : interp' 1000 ("eval! ""x: x"" ""s""") = mret (VString "s").
+Proof. by vm_compute. Qed.
+
+Lemma test_4_a :
+  interp' 1000 ("(x: y: eval! y) ""s"" ""x""") = mret (VString "s").
+Proof. by vm_compute. Qed.
+Lemma test_4_b :
+  interp' 1000 ("eval! ""(x: y: eval! y) \""s\"" \""x\""""") = mret (VString "s").
+Proof. by vm_compute. Qed.
+
+Lemma test_5 :
+  interp' 1000 ("(x: y: eval! ""x: x"" (eval! y)) ""s"" ""x""") = mret (VString "s").
+Proof. by vm_compute. Qed.
diff --git a/theories/lambda/interp.v b/theories/lambda/interp.v
new file mode 100644
index 0000000..5bc60d1
--- /dev/null
+++ b/theories/lambda/interp.v
@@ -0,0 +1,44 @@
+From mininix Require Export res lambda.operational_props.
+From stdpp Require Import options.
+
+Module Import lambda.
+Export lambda.
+
+Inductive thunk :=
+  Thunk { thunk_env : gmap string thunk; thunk_expr : expr }.
+Add Printing Constructor thunk.
+Notation env := (gmap string thunk).
+
+Inductive val :=
+  | VString (s : string)
+  | VClo (x : string) (E : env) (e : expr).
+
+Global Instance maybe_VClo : Maybe3 VClo := λ v,
+  if v is VClo x E e then Some (x, E, e) else None.
+
+Definition interp1 (interp : env → expr → res val) (E : env) (e : expr) : res val :=
+  match e with
+  | EString s =>
+      mret (VString s)
+  | EId x =>
+      t ← Res (E !! x);
+      interp (thunk_env t) (thunk_expr t)
+  | EAbs x e =>
+      mret (VClo x E e)
+  | EApp e1 e2 =>
+      v1 ← interp E e1;
+      '(x, E', e') ← Res (maybe3 VClo v1);
+      interp (<[x:=Thunk E e2]> E') e'
+  end.
+
+Fixpoint interp (n : nat) (E : env) (e : expr) : res val :=
+  match n with
+  | O => NoFuel
+  | S n => interp1 (interp n) E e
+  end.
+
+Global Opaque interp.
+
+End lambda.
+
+Add Printing Constructor lambda.thunk.
diff --git a/theories/lambda/interp_proofs.v b/theories/lambda/interp_proofs.v
new file mode 100644
index 0000000..efd0982
--- /dev/null
+++ b/theories/lambda/interp_proofs.v
@@ -0,0 +1,614 @@
+From mininix Require Export lambda.interp.
+From stdpp Require Import options.
+
+Module Import lambda.
+Export lambda.
+
+Lemma interp_S n : interp (S n) = interp1 (interp n).
+Proof. done. Qed.
+
+Fixpoint thunk_size (t : thunk) : nat :=
+  S (map_sum_with thunk_size (thunk_env t)).
+Definition env_size (E : env) : nat :=
+  map_sum_with thunk_size E.
+
+Lemma env_ind (P : env → Prop) :
+  (∀ E, map_Forall (λ i, P ∘ thunk_env) E → P E) →
+  ∀ E : env, P E.
+Proof.
+  intros Pbs E.
+  induction (Nat.lt_wf_0_projected env_size E) as [E _ IH].
+  apply Pbs, map_Forall_lookup=> y [E' e'] Hy.
+  apply (map_sum_with_lookup_le thunk_size) in Hy.
+  apply IH. by rewrite -Nat.le_succ_l.
+Qed.
+
+(** Correspondence to operational semantics *)
+Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr :=
+  subst (thunk_to_expr <$> E).
+Fixpoint thunk_to_expr (t : thunk) : expr :=
+  subst_env' thunk_to_expr (thunk_env t) (thunk_expr t).
+Notation subst_env := (subst_env' thunk_to_expr).
+
+Lemma subst_env_eq e E :
+  subst_env E e =
+    match e with
+    | EString s => EString s
+    | EId x => if E !! x is Some t then thunk_to_expr t else EId x
+    | EAbs x e => EAbs x (subst_env (delete x E) e)
+    | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2)
+    end.
+Proof.
+  rewrite /subst_env. destruct e; simpl; try done.
+  - rewrite lookup_fmap. by destruct (E !! x) as [[]|].
+  - by rewrite fmap_delete.
+Qed.
+Lemma subst_env_id x E :
+  subst_env E (EId x) = if E !! x is Some t then thunk_to_expr t else EId x.
+Proof. by rewrite subst_env_eq. Qed.
+
+Lemma subst_env_alt E e : subst_env E e = subst (thunk_to_expr <$> E) e.
+Proof. done. Qed.
+
+(* Use the unfolding lemmas, don't rely on conversion *)
+Opaque subst_env'.
+
+Definition val_to_expr (v : val) : expr :=
+  match v with
+  | VString s => EString s
+  | VClo x E e => EAbs x (subst_env (delete x E) e)
+  end.
+
+Lemma final_val_to_expr v : final (val_to_expr v).
+Proof. by destruct v. Qed.
+Lemma step_not_val_to_expr v e : val_to_expr v --> e → False.
+Proof. intros []%step_not_final. apply final_val_to_expr. Qed.
+
+Lemma subst_empty e : subst ∅ e = e.
+Proof. induction e; f_equal/=; auto. Qed.
+
+Lemma subst_env_empty e : subst_env ∅ e = e.
+Proof. rewrite subst_env_alt. apply subst_empty. Qed.
+
+Lemma interp_le {n1 n2 E e mv} :
+  interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv.
+Proof.
+  revert n2 E e mv.
+  induction n1 as [|n1 IH]; intros [|n2] E e mv He ?; [by (done || lia)..|].
+  rewrite interp_S in He; rewrite interp_S; destruct e;
+    repeat match goal with
+    | _ => case_match
+    | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res
+    | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
+    | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
+    | |- interp ?n ?E ?e ≫= _ = _ => erewrite (IH n E e) by (done || lia)
+    | _ => progress simplify_res
+    | _ => progress simplify_option_eq
+    end; eauto with lia.
+Qed.
+
+Lemma interp_agree {n1 n2 E e mv1 mv2} :
+  interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2.
+Proof.
+  intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2).
+  - rewrite -He2. symmetry. eauto using interp_le. 
+  - rewrite -He1. eauto using interp_le.
+Qed.
+
+Definition is_not_id (e : expr) : Prop :=
+  match e with EId _ => False | _ => True end.
+
+Lemma id_or_not e : (∃ x, e = EId x) ∨ is_not_id e.
+Proof. destruct e; naive_solver. Qed.
+
+Lemma interp_not_id n E e v :
+  interp n E e = mret v → is_not_id (subst_env E e).
+Proof.
+  revert E e v. induction n as [|n IH]; intros E e v; [done|].
+  rewrite interp_S. destruct e; simpl; try done.
+  rewrite subst_env_id. destruct (_ !! _) as [[[]]|]; naive_solver.
+Qed.
+
+Fixpoint closed (X : stringset) (e : expr) : Prop :=
+  match e with
+  | EString _ => True
+  | EId x => x ∈ X
+  | EAbs x e => closed ({[ x ]} ∪ X) e
+  | EApp e1 e2 => closed X e1 ∧ closed X e2
+  end.
+
+Inductive closed_thunk (t : thunk) : Prop := {
+  closed_thunk_env : map_Forall (λ _, closed_thunk) (thunk_env t);
+  closed_thunk_expr : closed (dom (thunk_env t)) (thunk_expr t);
+}.
+Notation closed_env := (map_Forall (M:=env) (λ _, closed_thunk)).
+
+Definition closed_val (v : val) : Prop :=
+  match v with
+  | VString _ => True
+  | VClo x E e => closed_env E ∧ closed ({[x]} ∪ dom E) e
+  end.
+
+Lemma closed_thunk_eq E e :
+  closed_thunk (Thunk E e) ↔ closed_env E ∧ closed (dom E) e.
+Proof. split; inv 1; constructor; done. Qed.
+
+Lemma closed_env_delete x E : closed_env E → closed_env (delete x E).
+Proof. apply map_Forall_delete. Qed.
+
+Lemma closed_env_insert x t E :
+  closed_thunk t → closed_env E → closed_env (<[x:=t]> E).
+Proof. apply: map_Forall_insert_2. Qed.
+
+Lemma closed_env_lookup E x t :
+  closed_env E → E !! x = Some t → closed_thunk t.
+Proof. apply map_Forall_lookup_1. Qed.
+
+Lemma closed_subst E ds e :
+  dom ds ## E → closed E e → subst ds e = e.
+Proof.
+  revert E ds.
+  induction e; intros E ds Hdisj Heclosed; simplify_eq/=; first done.
+  - assert (Hxds : x ∉ dom ds) by set_solver.
+    by rewrite (not_elem_of_dom_1 _ _ Hxds).
+  - f_equal. by apply IHe with (E := {[x]} ∪ E); first set_solver.
+  - f_equal; naive_solver.
+Qed.
+
+Lemma closed_weaken X Y e : closed X e → X ⊆ Y → closed Y e.
+Proof. revert X Y; induction e; naive_solver eauto with set_solver. Qed.
+
+Lemma subst_closed ds X e :
+  map_Forall (λ _, closed ∅) ds →
+  closed (dom ds ∪ X) e →
+  closed X (subst ds e).
+Proof.
+  revert X ds. induction e; intros X ds; repeat (case_decide || simplify_eq/=).
+  - done.
+  - intros. case_match.
+    + apply H in H1. by eapply closed_weaken.
+    + apply not_elem_of_dom in H1. set_solver.
+  - intros. apply IHe.
+    + by apply map_Forall_delete.
+    + by rewrite dom_delete_L assoc_L difference_union_L
+                 [dom _ ∪ _]comm_L -assoc_L.
+  - naive_solver.
+Qed.
+
+Lemma subst_env_delete_closed E X e x :
+  closed_env E →
+  closed ({[x]} ∪ X) (subst_env E e) →
+  closed ({[x]} ∪ X) (subst_env (delete x E) e).
+Proof.
+  revert E X x.
+  induction e as [s | z | z e IHe | e1 IHe1 e2 IHe2]; intros E X x.
+  - rewrite !subst_env_eq //.
+  - rewrite !subst_env_eq /=. case_match.
+    + destruct (decide (x = z)) as [->|?].
+      * rewrite lookup_delete. set_solver.
+      * rewrite lookup_delete_ne // H //.
+    + destruct (decide (x = z)) as [->|?].
+      * rewrite delete_notin // H //.
+      * rewrite lookup_delete_ne // H //.
+  - intros HE.
+    rewrite [subst_env (delete _ _) _]subst_env_eq subst_env_eq /=
+            delete_commute comm_L -assoc_L.
+    by apply IHe, map_Forall_delete.
+  - rewrite [subst_env (delete _ _) _]subst_env_eq subst_env_eq /=.
+    naive_solver.
+Qed.
+
+Lemma subst_env_closed E X e :
+  closed_env E → closed (dom E ∪ X) e → closed X (subst_env E e).
+Proof.
+  revert e X. induction E using env_ind.
+  induction e; intros X Hcenv Hclosed; simplify_eq/=.
+  - done.
+  - rewrite subst_env_eq. case_match.
+    + destruct t as [Et et]; simpl.
+      apply closed_env_lookup in H0 as Htclosed; last done.
+      apply closed_thunk_eq in Htclosed as [HEtclosed Hetclosed].
+      apply (H _ _ H0); simpl.
+      * exact HEtclosed.
+      * eapply closed_weaken; set_solver.
+    + simpl in *. apply not_elem_of_dom in H0. set_solver.
+  - rewrite subst_env_eq. simpl in *.
+    rewrite comm_L -assoc_L in Hclosed.
+    apply IHe in Hclosed; last exact Hcenv.
+    apply subst_env_delete_closed; first done.
+    by rewrite comm_L.
+  - rewrite subst_env_eq. naive_solver.
+Qed.
+
+Lemma thunk_to_expr_closed t : closed_thunk t → closed ∅ (thunk_to_expr t).
+Proof.
+  destruct t as [E e]. intros [HEclosed Heclosed]%closed_thunk_eq.
+  by apply subst_env_closed; last rewrite union_empty_r_L.
+Qed.
+
+Lemma subst_env_insert E x e t :
+  closed_env E → 
+  subst_env (<[x:=t]> E) e
+  = subst {[x:=thunk_to_expr t]} (subst_env (delete x E) e).
+Proof.
+  revert E. induction e; intros E HEclosed; simpl.
+  - done.
+  - destruct (decide (x = x0)) as [->|?].
+    + rewrite subst_env_eq lookup_insert subst_env_id
+        lookup_delete /= lookup_singleton. done.
+    + rewrite subst_env_eq lookup_insert_ne // subst_env_id.
+      destruct (E !! x0) eqn:Elookup.
+      * apply closed_env_lookup in Elookup as Hc0closed; last done.
+        apply thunk_to_expr_closed in Hc0closed.
+        rewrite lookup_delete_ne // Elookup.
+        by erewrite closed_subst with (E := ∅).
+      * by rewrite lookup_delete_ne // Elookup /= lookup_singleton_ne.
+  - rewrite (subst_env_eq (EAbs x0 e)) (subst_env_eq (EAbs _ _)) /=. f_equal.
+    destruct (decide (x0 = x)) as [->|?].
+    + by rewrite delete_insert_delete delete_idemp
+                 delete_singleton subst_empty.
+    + rewrite delete_insert_ne // delete_singleton_ne // delete_commute.
+      apply IHe. by apply closed_env_delete.
+  - rewrite (subst_env_eq (EApp _ _)) [subst_env (delete x E) _]subst_env_eq /=.
+    f_equal; auto.
+Qed.
+
+Lemma subst_env_insert_eq e1 e2 E1 E2 x E1' E2' e1' e2' :
+  closed_env E1 → closed_env E2 →
+  subst_env (delete x E1) e1 = subst_env (delete x E2) e2 →
+  subst_env E1' e1' = subst_env E2' e2' →
+  subst_env (<[x:=Thunk E1' e1']> E1) e1
+  = subst_env (<[x:=Thunk E2' e2']> E2) e2.
+Proof.
+  intros HE1closed HE2closed He' He.
+  rewrite !subst_env_insert //=. by rewrite He' He.
+Qed.
+
+Lemma interp_closed n E e mv :
+  closed_env E → closed (dom E) e → interp n E e = Res mv →
+  if mv is Some v then closed_val v else True.
+Proof.
+  revert E e mv.
+  induction n; first done; intros E e mv HEclosed Heclosed Hinterp.
+  destruct e.
+  - rewrite interp_S /= in Hinterp. by destruct mv; simplify_res.
+  - rewrite interp_S /= in Hinterp. simplify_option_eq.
+    destruct (E !! x) eqn:Hlookup; simplify_res; try done.
+    apply closed_env_lookup in Hlookup; last assumption.
+    destruct t as [E' e']. apply closed_thunk_eq in Hlookup as [Henv Hexpr].
+    by apply IHn with (E := E') (e := e').
+  - rewrite interp_S /= in Hinterp. simplify_option_eq.
+    destruct mv as [v|]; simplify_res. split_and!.
+    + set_solver.
+    + done.
+  - rewrite interp_S /= in Hinterp. simplify_option_eq.
+    destruct Heclosed as [He1closed He2closed].
+    destruct (interp n E e1) as [[[]|]|] eqn:Einterp; simplify_res; try done.
+    apply IHn in Einterp; try done.
+    simpl in Einterp. destruct Einterp as [Hinterp1 Hinterp2].
+    apply IHn in Hinterp; first done.
+    + rewrite <-insert_delete_insert.
+      apply map_Forall_insert; first apply lookup_delete. split.
+      * by split.
+      * by apply closed_env_delete.
+    + by rewrite dom_insert_L.
+Qed.
+
+Lemma interp_proper n E1 E2 e1 e2 mv :
+  closed_env E1 → closed_env E2 →
+  closed (dom E1) e1 → closed (dom E2) e2 →
+  subst_env E1 e1 = subst_env E2 e2 →
+  interp n E1 e1 = Res mv →
+  ∃ mw m, interp m E2 e2 = Res mw ∧
+         val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  revert n E2 E1 e1 e2 mv. induction n as [|n IHn]; [done|].
+  intros E2. induction E2 as [E2 IH] using env_ind.
+  intros E1 e1 e2 mv HE1closed HE2closed He1closed He2closed Hsubst Hinterp.
+  destruct (id_or_not e1) as [[x ->]|?].
+  { rewrite interp_S /= in Hinterp.
+    destruct (E1 !! x) as [[E' e']|] eqn:Hx; simplify_eq/=;
+      last by apply not_elem_of_dom in Hx.
+    rewrite subst_env_id Hx in Hsubst.
+    apply closed_env_lookup in Hx; last done.
+    rewrite closed_thunk_eq in Hx.
+    destruct Hx as [HE'close He'closed].
+    eauto. }
+  destruct (id_or_not e2) as [[x ->]|?].
+  { rewrite subst_env_id in Hsubst.
+    destruct (E2 !! x) as [[E' e']|] eqn:Hx; simplify_eq/=.
+    - apply closed_env_lookup in Hx as Hclosed; last done.
+      rewrite closed_thunk_eq in Hclosed.
+      destruct Hclosed as [HE'closed He'closed].
+      rewrite map_Forall_lookup in IH.
+      odestruct (IH _ _ Hx) as (w & m & Hinterp' & Hw);
+        first apply HE1closed; try done.
+      exists w, (S m). by rewrite interp_S /= Hx /=.
+    - destruct mv as [v|].
+      + apply interp_not_id in Hinterp. by rewrite Hsubst in Hinterp.
+      + exists None, 1. by rewrite interp_S /= Hx. }
+  rewrite (subst_env_eq e1) (subst_env_eq e2) in Hsubst.
+  rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done.
+  - eexists (Some (VString _)), 1. by rewrite interp_S.
+  - eexists (Some (VClo _ _ _)), 1. split; first by rewrite interp_S.
+    by do 2 f_equal/=.
+  - destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+    destruct He1closed as [He1_1closed He1_2closed],
+             He2closed as [He2_1closed He2_2closed].
+    apply interp_closed in Hinterp' as Hclosed; [|done..].
+    eapply IHn with (e2 := e2_1) in Hinterp' as (mw' & m1 & Hinterp1 & ?);
+      try done.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). }
+    destruct v', w'; simplify_eq/=.
+    eapply IHn with (E2 := <[x0:=Thunk E2 e2_2]> E0) in Hinterp
+      as (w & m2 & Hinterp2 & ?).
+    + exists w, (S (m1 `max` m2)). rewrite interp_S /=.
+      rewrite (interp_le Hinterp1) /=; last lia.
+      rewrite (interp_le Hinterp2) /=; last lia. done.
+    + rewrite -insert_delete_insert.
+      apply map_Forall_insert; first apply lookup_delete.
+      split; first done. apply closed_env_delete. naive_solver.
+    + apply interp_closed in Hinterp1; [|done..].
+      rewrite /closed_val in Hinterp1. destruct Hinterp1 as [??].
+      by apply map_Forall_insert_2.
+    + rewrite dom_insert_L. naive_solver.
+    + rewrite dom_insert_L.
+      apply interp_closed in Hinterp1; [|done..].
+      rewrite /closed_val in Hinterp1. by destruct Hinterp1 as [_ ?].
+    + apply interp_closed in Hinterp1; [|done..].
+      rewrite /closed_val in Hinterp1. destruct Hinterp1 as [? _].
+      apply subst_env_insert_eq; try naive_solver.
+Qed.
+
+Lemma subst_as_subst_env x e1 e2 :
+  subst {[x:=e2]} e1 = subst_env (<[x:=Thunk ∅ e2]> ∅) e1.
+Proof. rewrite subst_env_insert //= !subst_env_empty //. Qed.
+
+Lemma interp_subst n x e1 e2 mv :
+  closed {[x]} e1 → closed ∅ e2 →
+  interp n ∅ (subst {[x:=e2]} e1) = Res mv →
+  ∃ mw m, interp m (<[x:=Thunk ∅ e2]> ∅) e1 = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  intros He1 He2.
+  apply interp_proper.
+  - done.
+  - by apply closed_env_insert.
+  - apply subst_closed.
+    + by apply map_Forall_singleton.
+    + by rewrite dom_singleton_L dom_empty_L union_empty_r_L.
+  - by rewrite insert_empty dom_singleton_L.
+  - by rewrite subst_env_empty subst_as_subst_env.
+Qed.
+
+Lemma closed_step e1 e2 : closed ∅ e1 → e1 --> e2 → closed ∅ e2.
+Proof.
+  intros Hclosed Hstep. revert Hclosed.
+  induction Hstep; intros He1closed.
+  - simplify_eq/=. destruct He1closed.
+    apply subst_closed.
+    + by eapply map_Forall_singleton.
+    + by rewrite dom_singleton_L.
+  - simplify_eq/=. destruct He1closed. auto.
+Qed.
+
+Lemma closed_steps e1 e2 : closed ∅ e1 → e1 -->* e2 → closed ∅ e2.
+Proof. induction 2; eauto using closed_step. Qed.
+
+Lemma interp_step e1 e2 n v :
+  closed ∅ e1 →
+  e1 --> e2 →
+  interp n ∅ e2 = Res v →
+  ∃ w m, interp m ∅ e1 = Res w ∧ val_to_expr <$> v = val_to_expr <$> w.
+Proof.
+  intros He1closed Hstep. revert v n He1closed.
+  induction Hstep as [|???? IH]; intros v n He1closed Hinterp.
+  { rewrite /= union_empty_r_L in He1closed.
+    destruct He1closed as [He1closed He2closed].
+    apply interp_subst in Hinterp as (w & [|m] & Hinterp & Hv);
+      simplify_eq/=; [|done..].
+    exists w, (S (S m)). by rewrite !interp_S /= -interp_S. }
+  simpl in He1closed. destruct He1closed as [He1closed He2closed].
+  destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+  destruct (interp n _ _) eqn:Hinterp'; simplify_res.
+  destruct x; simplify_res; last first.
+  { apply IH in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res; last done.
+    destruct mw'; try done. exists None, (S m1).
+    by rewrite interp_S /= Hinterp1. }
+  apply closed_step in Hstep as He1'closed; last done.
+  apply interp_closed in Hinterp' as Hcloclosed;
+    [|done|by rewrite dom_empty_L].
+  apply IH in Hinterp' as ([] & m1 & Hinterp1 & ?); simplify_eq/=; last done.
+  destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first.
+  { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+    by assert (maybe3 VClo v1 = None) as -> by (by destruct v1, v0). }
+  simplify_option_eq.
+  simpl in Hcloclosed. destruct Hcloclosed as [HEclosed Heclosed].
+  apply interp_closed in Hinterp1 as Hcloclosed;
+    [|done|by rewrite dom_empty_L]. simpl in Hcloclosed.
+  destruct v1; simplify_option_eq.
+  destruct Hcloclosed as [HE0closed He0closed].
+  eapply interp_proper with (E2 := <[x0:=Thunk ∅ e2]> E0) (e2 := e0)
+    in Hinterp as (w & m2 & Hinterp2 & Hv); last apply subst_env_insert_eq.
+  { exists w, (S (m1 `max` m2)). rewrite !interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    by rewrite (interp_le Hinterp2) /=; last lia. }
+  - by apply closed_env_insert.
+  - by apply closed_env_insert.
+  - by rewrite dom_insert_L.
+  - by rewrite dom_insert_L.
+  - done.
+  - done.
+  - done.
+  - done.
+Qed.
+
+Lemma final_interp e :
+  final e →
+  ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w.
+Proof.
+  induction e; inv 1.
+  - eexists (VString _), 1. by rewrite interp_S /=.
+  - eexists (VClo _ _ _), 1. rewrite interp_S /=. split; [done|].
+    by rewrite delete_empty subst_env_empty.
+Qed.
+
+Lemma red_final_interp e :
+  red step e ∨ final e ∨ ∃ m, interp m ∅ e = mfail.
+Proof.
+  induction e.
+  - (* ENat *) right; left. constructor.
+  - (* EId *) do 2 right. by exists 1.
+  - (* EAbs *) right; left. constructor.
+  - (* EApp *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]].
+    + left. by repeat econstructor.
+    + apply final_interp in Hfinal as (w & m & Hinterp & ->).
+      destruct (maybe3 VClo w) eqn:Hw.
+      { destruct w; simplify_eq/=. left. by repeat econstructor. }
+      do 2 right. exists (S m). by rewrite interp_S /= Hinterp /= Hw.
+    + do 2 right. exists (S m). by rewrite interp_S /= Hinterp.
+Qed.
+
+Lemma interp_complete e1 e2 :
+  closed ∅ e1 →
+  e1 -->* e2 →
+  nf step e2 →
+  ∃ mw m, interp m ∅ e1 = Res mw ∧
+    if mw is Some w then e2 = val_to_expr w else ¬final e2.
+Proof.
+  intros He1 Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH].
+  { destruct (red_final_interp e) as [?|[Hfinal|[m Hinterp]]]; [done|..].
+    - apply final_interp in Hfinal as (w & m & ? & ?).
+      by exists (Some w), m.
+    - exists None, m. split; [done|]. intros Hfinal.
+      apply final_interp in Hfinal as (w & m' & ? & _).
+      by assert (mfail = mret w) by eauto using interp_agree. }
+  apply closed_step in Hstep as He2; last assumption.
+  destruct IH as (mw & m & Hinterp & ?); try done.
+  eapply interp_step in Hinterp as (mw' & m' & ? & ?).
+  - destruct mw, mw'; naive_solver.
+  - done.
+  - done.
+Qed.
+
+Lemma interp_complete_ret e1 e2 :
+  closed ∅ e1 →
+  e1 -->* e2 → final e2 →
+  ∃ w m, interp m ∅ e1 = mret w ∧ e2 = val_to_expr w.
+Proof.
+  intros Hclosed Hsteps Hfinal. apply interp_complete in Hsteps
+    as ([w|] & m & ? & ?); naive_solver eauto using final_nf.
+Qed.
+Lemma interp_complete_fail e1 e2 :
+  closed ∅ e1 →
+  e1 -->* e2 → nf step e2 → ¬final e2 →
+  ∃ m, interp m ∅ e1 = mfail.
+Proof.
+  intros Hclosed Hsteps Hnf Hforce.
+  apply interp_complete in Hsteps as ([w|] & m & ? & ?); simplify_eq/=; try by eauto.
+  destruct Hforce. apply final_val_to_expr.
+Qed.
+
+Lemma interp_sound_open E e n mv :
+  closed_env E → closed (dom E) e →
+  interp n E e = Res mv →
+  ∃ e', subst_env E e -->* e' ∧
+    if mv is Some v then e' = val_to_expr v else stuck e'.
+Proof.
+  revert E e mv.
+  induction n as [|n IH]; intros E e mv HEclosed Heclosed Hinterp; first done.
+  rewrite subst_env_eq. rewrite interp_S in Hinterp.
+  destruct e; simplify_res.
+  - (* ENat *) by eexists.
+  - (* EId *) destruct (_ !! _) as [[E' e]|] eqn:Hx; simplify_res.
+    + apply closed_env_lookup in Hx as Hxclosed; last done.
+      rewrite closed_thunk_eq in Hxclosed. destruct_and!.
+      apply IH in Hinterp as (e' & Hsteps & He'); naive_solver.
+    + eexists; repeat split; [done| |inv 1]. intros [? Hstep]. inv Hstep.
+  - (* EAbs *) by eexists.
+  - (* EApp *) destruct_and!.
+    destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+    apply interp_closed in Hinterp' as Hvclosed; [|done..].
+    apply IH in Hinterp' as (e' & Hsteps & He'); [|done..].
+    destruct mv' as [v'|]; simplify_res; last first.
+    { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
+      intros [e'' Hstep]. destruct He' as [Hnf Hfinal].
+      inv Hstep; [by destruct Hfinal; constructor|]. destruct Hnf. eauto. }
+    destruct (maybe3 VClo v') eqn:?; simplify_res; last first.
+    { eexists; repeat split; [by apply SAppL_rtc| |inv 1].
+      intros [e'' Hstep]. inv Hstep; destruct v'; by repeat inv_step. }
+    destruct v'; simplify_res. destruct_and!.
+    apply IH in Hinterp as (e'' & Hsteps' & He'').
+    + eexists; split; [|done]. etrans; [by apply SAppL_rtc|].
+      eapply rtc_l; first by constructor.
+      rewrite subst_env_insert // in Hsteps'.
+    + by apply closed_env_insert.
+    + by rewrite dom_insert_L.
+Qed.
+
+Lemma interp_sound n e mv :
+  closed ∅ e →
+  interp n ∅ e = Res mv →
+  ∃ e', e -->* e' ∧ if mv is Some v then e' = val_to_expr v else stuck e'.
+Proof.
+  intros He Hsteps%interp_sound_open; try done.
+  by rewrite subst_env_empty in Hsteps.
+Qed.
+
+(** Final theorems *)
+Theorem interp_sound_complete_ret e v :
+  closed ∅ e →
+  (∃ w n, interp n ∅ e = mret w ∧ val_to_expr v = val_to_expr w)
+    ↔ e -->* val_to_expr v.
+Proof.
+  split.
+  - by intros (n & w & (e' & ? & ->)%interp_sound & ->).
+  - intros Hsteps. apply interp_complete in Hsteps as ([] & ? & ? & ?);
+      unfold nf, red;
+      naive_solver eauto using final_val_to_expr, step_not_val_to_expr.
+Qed.
+
+Theorem interp_sound_complete_ret_string e s :
+  closed ∅ e →
+  (∃ n, interp n ∅ e = mret (VString s)) ↔ e -->* EString s.
+Proof.
+  split.
+  - by intros [n (e' & ? & ->)%interp_sound].
+  - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?);
+      simplify_eq/=; eauto.
+Qed.
+
+Theorem interp_sound_complete_fail e :
+  closed ∅ e →
+  (∃ n, interp n ∅ e = mfail) ↔ ∃ e', e -->* e' ∧ stuck e'.
+Proof.
+  split.
+  - by intros [n ?%interp_sound].
+  - intros (e' & Hsteps & Hnf & Hforced). by eapply interp_complete_fail.
+Qed.
+
+Theorem interp_sound_complete_no_fuel e :
+  closed ∅ e →
+  (∀ n, interp n ∅ e = NoFuel) ↔ all_loop step e.
+Proof.
+  rewrite all_loop_alt. split.
+  - intros Hnofuel e' Hsteps.
+    destruct (red_final_interp e') as [|[|He']]; [done|..].
+    + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); [|done..].
+      by rewrite Hnofuel in Hinterp.
+    + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]);
+        last by eauto using closed_steps.
+      destruct (interp_complete e e'') as (mv & n & Hinterp & _); [done|by etrans|done|].
+      by rewrite Hnofuel in Hinterp.
+  - intros Hred n. destruct (interp n ∅ e) as [mv|] eqn:Hinterp; [|done].
+    apply interp_sound in Hinterp as (e' & Hsteps%Hred & Hstuck); [|done].
+    destruct mv as [v|]; simplify_eq/=.
+    + apply final_nf in Hsteps as []. apply final_val_to_expr.
+    + by destruct Hstuck as [[] ?].
+Qed.
+
+End lambda.
diff --git a/theories/lambda/operational.v b/theories/lambda/operational.v
new file mode 100644
index 0000000..b0fa366
--- /dev/null
+++ b/theories/lambda/operational.v
@@ -0,0 +1,38 @@
+From mininix Require Export utils.
+From stdpp Require Import options.
+
+Module Import lambda.
+
+Inductive expr :=
+  | EString (s : string)
+  | EId (x : string)
+  | EAbs (x : string) (e : expr)
+  | EApp (e1 e2 : expr).
+
+Fixpoint subst (ds : gmap string expr) (e : expr) : expr :=
+  match e with
+  | EString s => EString s
+  | EId x => if ds !! x is Some d then d else EId x
+  | EAbs x e => EAbs x (subst (delete x ds) e)
+  | EApp e1 e2 => EApp (subst ds e1) (subst ds e2)
+  end.
+
+Reserved Infix "-->" (right associativity, at level 55).
+Inductive step : expr → expr → Prop :=
+  | Sβ x e1 e2 : EApp (EAbs x e1) e2 --> subst {[x:=e2]} e1
+  | SAppL e1 e1' e2 : e1 --> e1' → EApp e1 e2 --> EApp e1' e2
+where "e1 --> e2" := (step e1 e2).
+
+Infix "-->*" := (rtc step) (right associativity, at level 55).
+
+Definition final (e : expr) : Prop :=
+  match e with
+  | EString _ => True
+  | EAbs _ _ => True
+  | _ => False
+  end.
+
+Definition stuck (e : expr) : Prop :=
+  nf step e ∧ ¬final e.
+
+End lambda.
diff --git a/theories/lambda/operational_props.v b/theories/lambda/operational_props.v
new file mode 100644
index 0000000..c331924
--- /dev/null
+++ b/theories/lambda/operational_props.v
@@ -0,0 +1,29 @@
+From mininix Require Export lambda.operational.
+From stdpp Require Import options.
+
+Module Import lambda.
+Export lambda.
+
+(** Properties of operational semantics *)
+Lemma step_not_final e1 e2 : e1 --> e2 → ¬final e1.
+Proof. induction 1; inv 1; naive_solver. Qed.
+Lemma final_nf e : final e → nf step e.
+Proof. by intros ? [??%step_not_final]. Qed.
+
+Lemma SAppL_rtc e1 e1' e2 : e1 -->* e1' → EApp e1 e2 -->* EApp e1' e2.
+Proof. induction 1; repeat (done || econstructor). Qed.
+
+Ltac inv_step := repeat
+  match goal with H : ?e --> _ |- _ => assert_fails (is_var e); inv H end.
+
+Lemma step_det e d1 d2 :
+  e --> d1 →
+  e --> d2 →
+  d1 = d2.
+Proof.
+  intros Hred1. revert d2.
+  induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step.
+  f_equal. by apply IHHred1.
+Qed.
+
+End lambda.
diff --git a/theories/nix/floats.v b/theories/nix/floats.v
new file mode 100644
index 0000000..246e0c3
--- /dev/null
+++ b/theories/nix/floats.v
@@ -0,0 +1,85 @@
+From stdpp Require Import prelude ssreflect.
+From Flocq.IEEE754 Require Import
+  Binary BinarySingleNaN (mode_NE, mode_DN, mode_UP) Bits.
+From stdpp Require Import options.
+
+Global Arguments B754_zero {_ _}.
+Global Arguments B754_infinity {_ _}.
+Global Arguments B754_nan {_ _}.
+Global Arguments B754_finite {_ _}.
+
+(** The bit representation of floats is not observable in Nix, and it appears
+that only negative NaNs are ever produced. So we setup the Flocq floats in
+the way that it always produces [-NaN], i.e., [indef_nan]. *)
+Definition float := binary64.
+
+Variant round_mode := Floor | Ceil | NearestEven.
+Global Instance round_mode_eq_dec : EqDecision round_mode.
+Proof. solve_decision. Defined.
+
+Module Float.
+  Definition prec : Z := 53.
+  Definition emax : Z := 1024.
+
+  Lemma Hprec : (0 < 53)%Z.
+  Proof. done. Qed.
+  Lemma Hprec_emax : (53 < 1024)%Z.
+  Proof. done. Qed.
+
+  Global Instance inhabited : Inhabited float := populate (B754_zero false).
+
+  Global Instance eq_dec : EqDecision float.
+  Proof.
+    refine (λ f1 f2,
+      match f1, f2 with
+      | B754_zero s1, B754_zero s2 => cast_if (decide (s1 = s2))
+      | B754_infinity s1, B754_infinity s2 => cast_if (decide (s1 = s2))
+      | B754_nan s1 pl1 _, B754_nan s2 pl2 _ =>
+          cast_if_and (decide (s1 = s2)) (decide (pl1 = pl2))
+      | B754_finite s1 m1 e1 _, B754_finite s2 m2 e2 _ =>
+          cast_if_and3 (decide (s1 = s2)) (decide (m1 = m2)) (decide (e1 = e2))
+      | _, _ => right _
+      end); abstract naive_solver (f_equal; apply (proof_irrel _)).
+  Defined.
+
+  Definition of_Z (x : Z) : float :=
+    binary_normalize prec emax (refl_equal _) (refl_equal _) mode_NE x 0 false.
+
+  Definition to_Z (f : float) : option Z :=
+    match f with
+    | B754_zero _ => Some 0
+    | B754_finite s m e _ => Some (Zaux.cond_Zopp s (Zpos m) ≪ e)
+    | _ => None
+    end%Z.
+
+  (** QNaN Floating-Point Indefinite; see Table 4-3. Floating-Point Number and
+  NaN Encodings. *)
+  Definition indef_nan : { f | is_nan prec emax f = true } :=
+    @B754_nan prec emax true (2^51) (refl_equal _) ↾ eq_refl _.
+
+  Definition to_flocq_round_mode (m : round_mode) : BinarySingleNaN.mode :=
+    match m with Floor => mode_DN | Ceil => mode_UP | NearestEven => mode_NE end.
+
+  Definition round (m : round_mode) : float → float :=
+    Bnearbyint prec emax (refl_equal _) (λ _, indef_nan) (to_flocq_round_mode m).
+
+  (* For add: not [mode_DN]; otherwise [+0.0 + -0.0] would yield [-0.0], but
+  [inf / (+0.0 + -0.0)] yields [inf] in C++, so this cannot be the case. *)
+  (* C++ compiles floating point addition to the x86 ADDSD instruction. Looking
+  at the Intel x86 Software Developer's Manual, it seems that the default
+  rounding mode on x86 is Round to Nearest (even); see table 4-8. (In §4.8.4.) *)
+  Definition add : float → float → float :=
+    Bplus _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE.
+  Definition sub : float → float → float :=
+    Bminus _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE.
+  Definition mul : float → float → float :=
+    Bmult _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE.
+  Definition div : float → float → float :=
+    Bdiv _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE.
+
+  Definition eqb (f1 f2 : float) : bool :=
+    bool_decide (b64_compare f1 f2 = Some Eq).
+
+  Definition ltb (f1 f2 : float) : bool :=
+    bool_decide (b64_compare f1 f2 = Some Lt).
+End Float.
diff --git a/theories/nix/interp.v b/theories/nix/interp.v
new file mode 100644
index 0000000..bb4e815
--- /dev/null
+++ b/theories/nix/interp.v
@@ -0,0 +1,351 @@
+From Coq Require Import Ascii.
+From mininix Require Export res nix.operational_props.
+From stdpp Require Import options.
+
+Section val.
+  Local Unset Elimination Schemes.
+  Inductive val :=
+    | VLit (bl : base_lit) (Hbl : base_lit_ok bl)
+    | VClo (x : string) (E : gmap string (kind * thunk)) (e : expr)
+    | VCloMatch (E : gmap string (kind * thunk))
+                (ms : gmap string (option expr))
+                (strict : bool) (e : expr)
+    | VList (ts : list thunk)
+    | VAttr (ts : gmap string thunk)
+  with thunk :=
+    | Forced (v : val) : thunk
+    | Thunk (E : gmap string (kind * thunk)) (e : expr) : thunk
+    | Indirect (x : string)
+               (E : gmap string (kind * thunk))
+               (tαs : gmap string (expr + thunk)).
+End val.
+
+Notation VLitI bl := (VLit bl I).
+
+Notation tattr := (expr + thunk)%type.
+Notation env := (gmap string (kind * thunk)).
+
+Definition maybe_VLit (v : val) : option base_lit :=
+  if v is VLit bl _ then Some bl else None.
+Global Instance maybe_VList : Maybe VList := λ v,
+  if v is VList ts then Some ts else None.
+Global Instance maybe_VAttr : Maybe VAttr := λ v,
+  if v is VAttr ts then Some ts else None.
+
+Fixpoint interp_eq_list_body (i : nat) (ts1 ts2 : list thunk) : expr :=
+  match ts1, ts2 with
+  | [], [] => ELit (LitBool true)
+  | _ :: ts1, _ :: ts2 =>
+      EIf (EBinOp EqOp (EId' ("1" +:+ pretty i)) (EId' ("2" +:+ pretty i)))
+          (interp_eq_list_body (S i) ts1 ts2) (ELit (LitBool false))
+  | _, _ => ELit (LitBool false)
+  end.
+
+Definition interp_eq_list (ts1 ts2 : list thunk) : thunk :=
+  Thunk (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪
+         kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2)) $
+    interp_eq_list_body 0 ts1 ts2.
+
+Fixpoint interp_lt_list_body (i : nat) (ts1 ts2 : list thunk) : expr :=
+  match ts1, ts2 with
+  | [], _ => ELit (LitBool true)
+  | _ :: ts1, _ :: ts2 =>
+      EIf (EBinOp LtOp (EId' ("1" +:+ pretty i)) (EId' ("2" +:+ pretty i)))
+          (ELit (LitBool true))
+          (EIf (EBinOp EqOp (EId' ("1" +:+ pretty i)) (EId' ("2" +:+ pretty i)))
+            (interp_lt_list_body (S i) ts1 ts2) (ELit (LitBool false)))
+  | _ :: _, [] => ELit (LitBool false)
+  end.
+
+Definition interp_lt_list (ts1 ts2 : list thunk) : thunk :=
+  Thunk (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪
+         kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2)) $
+    interp_lt_list_body 0 ts1 ts2.
+
+Definition interp_eq_attr (ts1 ts2 : gmap string thunk) : thunk :=
+  Thunk (kmap (String "1") ((ABS,.) <$> ts1) ∪
+         kmap (String "2") ((ABS,.) <$> ts2)) $
+    sem_and_attr $ map_imap (λ x _,
+      Some (EBinOp EqOp (EId' ("1" +:+ x)) (EId' ("2" +:+ x)))) ts1.
+
+Definition interp_eq (v1 v2 : val) : option thunk :=
+  match v1, v2 with
+  | VLit bl1 _, VLit bl2 _ =>
+      Some $ Forced $ VLitI (LitBool $ sem_eq_base_lit bl1 bl2)
+  | VClo _ _ _, VClo _ _ _ => None
+  | VList ts1, VList ts2 => Some $
+      if decide (length ts1 = length ts2) then interp_eq_list ts1 ts2
+      else Forced $ VLitI (LitBool false)
+  | VAttr ts1, VAttr ts2 => Some $
+      if decide (dom ts1 = dom ts2) then interp_eq_attr ts1 ts2
+      else Forced $ VLitI (LitBool false)
+  | _, _ => Some $ Forced $ VLitI (LitBool false)
+  end.
+
+Definition type_of_val (v : val) : string :=
+  match v with
+  | VLit bl _ => type_of_base_lit bl
+  | VClo _ _ _ | VCloMatch _ _ _ _ => "lambda"
+  | VList _ => "list"
+  | VAttr _ => "set"
+  end.
+
+Global Instance val_inhabited : Inhabited val := populate (VLitI inhabitant).
+Global Instance thunk_inhabited : Inhabited thunk := populate (Forced inhabitant).
+
+Definition interp_bin_op (op : bin_op) (v1 : val) : option (val → option thunk) :=
+  if decide (op = EqOp) then
+    Some (interp_eq v1)
+  else if decide (op = TypeOfOp) then
+    Some $ λ v2,
+      guard (maybe_VLit v2 = Some LitNull);;
+      Some $ Forced $ VLitI (LitString $ type_of_val v1)
+  else
+    match v1 with
+    | VLit (LitNum n1) Hn1 =>
+        if maybe RoundOp op is Some m then
+          Some $ λ v2,
+            guard (maybe_VLit v2 = Some LitNull);;
+            Some $ Forced $ VLit
+              (LitNum $ NInt $ float_to_bounded_Z $ Float.round m $ num_to_float n1)
+              (float_to_bounded_Z_ok _)
+        else
+          '(f ↾ Hf) ← option_to_eq_Some (sem_bin_op_num op n1);
+          Some $ λ v2,
+            if v2 is VLit (LitNum n2) Hn2 then
+              '(bl ↾ Hbl) ← option_to_eq_Some (f n2);
+              Some $ Forced $ VLit bl (sem_bin_op_num_ok Hn1 Hn2 Hf Hbl)
+            else None
+    | VLit (LitString s1) _ =>
+        match op with
+        | SingletonAttrOp => Some $ λ v2,
+            guard (maybe_VLit v2 = Some LitNull);;
+            Some $ Forced $ VClo "t" ∅ (EAttr {[ s1 := AttrN (EId' "t") ]})
+        | MatchStringOp => Some $ λ v2,
+            guard (maybe_VLit v2 = Some LitNull);;
+            match s1 with
+            | EmptyString => Some $ Forced $ VAttr {[
+                "empty" := Forced (VLitI (LitBool true));
+                "head" := Forced (VLitI LitNull);
+                "tail" := Forced (VLitI LitNull) ]}
+            | String a s1 => Some $ Forced $ VAttr {[
+                "empty" := Forced (VLitI (LitBool false));
+                "head" := Forced (VLitI (LitString (String a EmptyString)));
+                "tail" := Forced (VLitI (LitString s1)) ]}
+            end
+        | _ =>
+            '(f ↾ Hf) ← option_to_eq_Some (sem_bin_op_string op);
+            Some $ λ v2,
+              bl2 ← maybe_VLit v2;
+              s2 ← maybe LitString bl2;
+              Some $ Forced $ VLit (f s1 s2) (sem_bin_op_string_ok Hf)
+        end
+    | VClo _ _ _ =>
+       match op with
+       | FunctionArgsOp => Some $ λ v2,
+            guard (maybe_VLit v2 = Some LitNull);;
+            Some (Forced (VAttr ∅))
+        | _ => None
+        end
+    | VCloMatch _ ms _ _ =>
+        match op with
+        | FunctionArgsOp => Some $ λ v2,
+            guard (maybe_VLit v2 = Some LitNull);;
+            Some $ Forced $ VAttr $
+              (λ m, Forced $ VLitI (LitBool (from_option (λ _, true) false m))) <$> ms
+        | _ => None
+        end
+    | VList ts1 =>
+        match op with
+        | LtOp => Some $ λ v2,
+            ts2 ← maybe VList v2;
+            Some (interp_lt_list ts1 ts2)
+        | MatchListOp => Some $ λ v2,
+            guard (maybe_VLit v2 = Some LitNull);;
+            match ts1 with
+            | [] => Some $ Forced $ VAttr {[
+                "empty" := Forced (VLitI (LitBool true));
+                "head" := Forced (VLitI LitNull);
+                "tail" := Forced (VLitI LitNull) ]}
+            | t :: ts1 => Some $ Forced $ VAttr {[
+                "empty" := Forced (VLitI (LitBool false));
+                "head" := t;
+                "tail" := Forced (VList ts1) ]}
+            end
+        | AppendListOp => Some $ λ v2,
+            ts2 ← maybe VList v2;
+            Some (Forced (VList (ts1 ++ ts2)))
+        | _ => None
+        end
+    | VAttr ts1 =>
+        match op with
+        | SelectAttrOp => Some $ λ v2,
+            bl ← maybe_VLit v2;
+            x ← maybe LitString bl;
+            ts1 !! x
+        | UpdateAttrOp => Some $ λ v2,
+            ts2 ← maybe VAttr v2;
+            Some $ Forced $ VAttr $ ts2 ∪ ts1
+        | HasAttrOp => Some $ λ v2,
+            bl ← maybe_VLit v2;
+            x ← maybe LitString bl;
+            Some $ Forced $ VLitI (LitBool $ bool_decide (is_Some (ts1 !! x)))
+        | DeleteAttrOp => Some $ λ v2,
+            bl ← maybe_VLit v2;
+            x ← maybe LitString bl;
+            Some $ Forced $ VAttr $ delete x ts1
+        | MatchAttrOp => Some $ λ v2,
+            guard (maybe_VLit v2 = Some LitNull);;
+            match map_minimal_key attr_le ts1 with
+            | None => Some $ Forced $ VAttr {[
+                "empty" := Forced (VLitI (LitBool true));
+                "key" := Forced (VLitI LitNull);
+                "head" := Forced (VLitI LitNull);
+                "tail" := Forced (VLitI LitNull) ]}
+            | Some x => Some $ Forced $ VAttr {[
+                "empty" := Forced (VLitI (LitBool false));
+                "key" := Forced (VLitI (LitString x));
+                "head" := ts1 !!! x;
+                "tail" := Forced (VAttr (delete x ts1)) ]}
+            end
+        | _ => None
+        end
+    | _ => None
+    end.
+
+Definition interp_match
+    (ts : gmap string thunk) (mds : gmap string (option expr))
+    (strict : bool) : option (gmap string tattr) :=
+  map_mapM id $ merge (λ mt mmd,
+    (* Some (Some _) means keep, Some None means fail, None means skip *)
+    match mt, mmd with
+    | Some t, Some _ => Some $ Some (inr t)
+    | None, Some (Some e) => Some $ Some (inl e)
+    | None, Some _ => Some None (* bad *)
+    | Some _, None => guard strict;; Some None
+    | _, _ => None (* skip *)
+    end) ts mds.
+
+Definition force_deep1
+    (force_deep : val → res val)
+    (interp_thunk : thunk → res val) (v : val) : res val :=
+  match v with
+  | VList ts => VList ∘ fmap Forced <$>
+      mapM (mbind force_deep ∘ interp_thunk) ts
+  | VAttr ts => VAttr ∘ fmap Forced <$>
+      map_mapM_sorted attr_le (mbind force_deep ∘ interp_thunk) ts
+  | _ => mret v
+  end.
+
+Definition indirects_env (E : env) (tαs : gmap string tattr) : env :=
+  map_imap (λ y _, Some (ABS, Indirect y E tαs)) tαs ∪ E.
+
+Definition attr_to_tattr (E : env) (α : attr) : tattr :=
+  from_attr inl (inr ∘ Thunk E) α.
+
+Definition interp1
+    (force_deep : val → res val)
+    (interp : env → expr → res val)
+    (interp_thunk : thunk → res val)
+    (interp_app : val → thunk → res val)
+    (E : env) (e : expr) : res val :=
+  match e with
+  | ELit bl =>
+      bl_ok ← guard (base_lit_ok bl);
+      mret (VLit bl bl_ok)
+  | EId x mke =>
+      '(_,t) ← Res $ union_kinded (E !! x) (prod_map id (Thunk ∅) <$> mke);
+      interp_thunk t
+  | EAbs x e => mret (VClo x E e)
+  | EAbsMatch ms strict e => mret (VCloMatch E ms strict e)
+  | EApp e1 e2 =>
+      v1 ← interp E e1;
+      interp_app v1 (Thunk E e2)
+  | ESeq μ' e1 e2 =>
+      v ← interp E e1;
+      (if μ' is DEEP then force_deep else mret) v;;
+      interp E e2
+  | EList es => mret (VList (Thunk E <$> es))
+  | EAttr αs =>
+      let E' := indirects_env E (attr_to_tattr E <$> αs) in
+      mret (VAttr (from_attr (Thunk E') (Thunk E) <$> αs))
+  | ELetAttr k e1 e2 =>
+      v1 ← interp E e1;
+      ts ← Res (maybe VAttr v1);
+      interp (union_kinded ((k,.) <$> ts) E) e2
+  | EBinOp op e1 e2 =>
+      v1 ← interp E e1;
+      f ← Res (interp_bin_op op v1);
+      v2 ← interp E e2;
+      t2 ← Res (f v2);
+      interp_thunk t2
+  | EIf e1 e2 e3 =>
+      v1 ← interp E e1;
+      '(b : bool) ← Res (maybe_VLit v1 ≫= maybe LitBool);
+      interp E (if b then e2 else e3)
+  end.
+
+Definition interp_thunk1
+    (interp : env → expr → res val)
+    (interp_thunk : thunk → res val)
+    (t : thunk) : res val :=
+  match t with
+  | Forced v => mret v
+  | Thunk E e => interp E e
+  | Indirect x E tαs =>
+      tα ← Res $ tαs !! x;
+      match tα with
+      | inl e => interp (indirects_env E tαs) e
+      | inr t => interp_thunk t
+      end
+  end.
+
+Definition interp_app1
+    (interp : env → expr → res val)
+    (interp_thunk : thunk → res val)
+    (interp_app : val → thunk → res val)
+    (v1 : val) (t2 : thunk) : res val :=
+  match v1 with
+  | VClo x E e =>
+      interp (<[x:=(ABS, t2)]> E) e
+  | VCloMatch E ms strict e =>
+      vt ← interp_thunk t2;
+      ts ← Res (maybe VAttr vt);
+      tαs ← Res $ interp_match ts ms strict;
+      interp (indirects_env E tαs) e
+  | VAttr ts =>
+      t ← Res (ts !! "__functor");
+      vt ← interp_thunk t;
+      v ← interp_app vt (Forced v1);
+      interp_app v t2
+  | _ => mfail
+  end.
+
+Fixpoint force_deep (n : nat) (v : val) : res val :=
+  match n with
+  | O => NoFuel
+  | S n => force_deep1 (force_deep n) (interp_thunk n) v
+  end
+with interp (n : nat) (E : env) (e : expr) : res val :=
+  match n with
+  | O => NoFuel
+  | S n => interp1 (force_deep n) (interp n) (interp_thunk n) (interp_app n) E e
+  end
+with interp_thunk (n : nat) (t : thunk) : res val :=
+  match n with
+  | O => NoFuel
+  | S n => interp_thunk1 (interp n) (interp_thunk n) t
+  end
+with interp_app (n : nat) (v1 : val) (t2 : thunk) : res val :=
+  match n with
+  | O => NoFuel
+  | S n => interp_app1 (interp n) (interp_thunk n) (interp_app n) v1 t2
+  end.
+
+Definition force_deep' (n : nat) (μ : mode) : val → res val :=
+  match μ with SHALLOW => mret | DEEP => force_deep n end.
+
+Definition interp' (n : nat) (μ : mode) (E : env) (e : expr) : res val :=
+  interp n E e ≫= force_deep' n μ.
+
+Global Opaque force_deep interp interp_thunk interp_app.
diff --git a/theories/nix/interp_proofs.v b/theories/nix/interp_proofs.v
new file mode 100644
index 0000000..5780e48
--- /dev/null
+++ b/theories/nix/interp_proofs.v
@@ -0,0 +1,2690 @@
+From Coq Require Import Ascii.
+From mininix Require Export nix.interp.
+From stdpp Require Import options.
+
+Lemma force_deep_S n :
+  force_deep (S n) = force_deep1 (force_deep n) (interp_thunk n).
+Proof. done. Qed.
+Lemma interp_S n :
+  interp (S n) = interp1 (force_deep n) (interp n) (interp_thunk n) (interp_app n).
+Proof. done. Qed.
+Lemma interp_thunk_S n :
+  interp_thunk (S n) = interp_thunk1 (interp n) (interp_thunk n).
+Proof. done. Qed.
+Lemma interp_app_S n :
+  interp_app (S n) = interp_app1 (interp n) (interp_thunk n) (interp_app n).
+Proof. done. Qed.
+
+Lemma interp_shallow' m E e : interp' m SHALLOW E e = interp m E e.
+Proof. rewrite /interp'. by destruct (interp _ _ _) as [[]|]. Qed.
+
+Lemma interp_lit n E bl (Hbl : base_lit_ok bl) :
+  interp (S n) E (ELit bl) = mret (VLit bl Hbl).
+Proof.
+  rewrite interp_S /=. case_guard; simpl; [|done].
+  do 2 f_equal. apply (proof_irrel _).
+Qed.
+
+(** Induction *)
+Fixpoint val_size (v : val) : nat :=
+  match v with
+  | VLit _ _ => 1
+  | VClo _ E _ | VCloMatch E _ _ _ => S (map_sum_with (thunk_size ∘ snd) E)
+  | VList ts => S (sum_list_with thunk_size ts)
+  | VAttr ts => S (map_sum_with thunk_size ts)
+  end
+with thunk_size (t : thunk) : nat :=
+  match t with
+  | Forced v => S (val_size v)
+  | Thunk E _ => S (map_sum_with (thunk_size ∘ snd) E)
+  | Indirect _ E tαs => S (map_sum_with (thunk_size ∘ snd) E +
+      map_sum_with (from_sum (λ _, 1) thunk_size) tαs)
+  end.
+Notation env_size := (map_sum_with (thunk_size ∘ snd)).
+
+Definition from_thunk {A} (f : val → A) (g : env → expr → A)
+    (h : string → env → gmap string tattr → A) (t : thunk) : A :=
+  match t with
+  | Forced v => f v
+  | Thunk E e => g E e
+  | Indirect x E tαs => h x E tαs
+  end.
+
+Lemma env_val_ind (P : env → Prop) (Q : val → Prop) :
+  (∀ E,
+    map_Forall (λ _, from_thunk Q (λ E _, P E) (λ _ E _, P E) ∘ snd) E → P E) →
+  (∀ b Hbl, Q (VLit b Hbl)) →
+  (∀ x E e, P E → Q (VClo x E e)) →
+  (∀ E ms strict e, P E → Q (VCloMatch E ms strict e)) →
+  (∀ ts, Forall (from_thunk Q (λ E _, P E) (λ _ E _, P E)) ts → Q (VList ts)) →
+  (∀ ts, map_Forall (λ _, from_thunk Q (λ E _, P E) (λ _ E _, P E)) ts → Q (VAttr ts)) →
+  (∀ E, P E) ∧ (∀ v, Q v).
+Proof.
+  intros Penv Qlit Qclo Qmatch Qlist Qattr.
+  cut (∀ n, (∀ E, env_size E < n → P E) ∧ (∀ v, val_size v < n → Q v)).
+  { intros Hhelp; split.
+    - intros E. apply (Hhelp (S (env_size E))); lia.
+    - intros v. apply (Hhelp (S (val_size v))); lia. }
+  intros n. induction n as [|n IH]; [by auto with lia|]. split.
+  - intros E ?. apply Penv, map_Forall_lookup=> y [k ei] Hy.
+    apply (map_sum_with_lookup_le (thunk_size ∘ snd)) in Hy; simpl in *.
+    destruct ei as [v|E' e'|x E' tαs]; simplify_eq/=; try apply IH; eauto with lia.
+  - intros [] ?; simpl in *.
+    + apply Qlit.
+    + apply Qclo, IH. lia.
+    + apply Qmatch, IH. lia.
+    + apply Qlist, Forall_forall=> t Hy.
+      apply (sum_list_with_in _ thunk_size) in Hy.
+      destruct t; simpl in *; try apply IH; lia.
+    + apply Qattr, map_Forall_lookup=> y t Hy.
+      apply (map_sum_with_lookup_le thunk_size) in Hy.
+      destruct t; simpl in *; try apply IH; lia.
+Qed.
+
+Lemma env_ind (P : env → Prop) :
+  (∀ E,
+    map_Forall (λ i, from_thunk (λ _, True) (λ E _, P E) (λ _ E _, P E) ∘ snd) E →
+    P E) →
+  ∀ E : env, P E.
+Proof. intros. apply (env_val_ind P (λ _, True)); auto. Qed.
+
+Lemma val_ind (Q : val → Prop) :
+  (∀ bl Hbl, Q (VLit bl Hbl)) →
+  (∀ x E e, Q (VClo x E e)) →
+  (∀ ms strict E e, Q (VCloMatch ms strict E e)) →
+  (∀ ts, Forall (from_thunk Q (λ _ _, True) (λ _ _ _, True)) ts → Q (VList ts)) →
+  (∀ ts,
+    map_Forall (λ _, from_thunk Q (λ _ _, True) (λ _ _ _, True)) ts → Q (VAttr ts)) →
+  (∀ v, Q v).
+Proof. intros. apply (env_val_ind (λ _, True) Q); auto. Qed.
+(** Correspondence to operational semantics *)
+Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr :=
+  subst (prod_map id thunk_to_expr <$> E).
+
+Definition tattr_to_attr'
+    (thunk_to_expr : thunk → expr) (subst_env : env → expr → expr)
+    (E : env) (α : tattr) : attr :=
+  from_sum (AttrR ∘ subst_env E) (AttrN ∘ thunk_to_expr) α.
+
+Fixpoint thunk_to_expr (t : thunk) : expr :=
+  match t with
+  | Forced v => val_to_expr v
+  | Thunk E e => subst_env' thunk_to_expr E e
+  | Indirect x E tαs => ESelect
+      (EAttr (tattr_to_attr' thunk_to_expr (subst_env' thunk_to_expr) E <$> tαs)) x
+  end
+with val_to_expr (v : val) : expr :=
+  match v with
+  | VLit bl _ => ELit bl
+  | VClo x E e => EAbs x (subst_env' thunk_to_expr E e)
+  | VCloMatch E ms strict e => EAbsMatch
+      (fmap (M:=option) (subst_env' thunk_to_expr E) <$> ms)
+      strict
+      (subst_env' thunk_to_expr E e)
+  | VList ts => EList (thunk_to_expr <$> ts)
+  | VAttr ts => EAttr (AttrN ∘ thunk_to_expr <$> ts)
+  end.
+
+Notation subst_env := (subst_env' thunk_to_expr).
+Notation tattr_to_attr := (tattr_to_attr' thunk_to_expr subst_env).
+Notation attr_subst_env E := (attr_map (subst_env E)).
+
+Lemma subst_env_eq e E :
+  subst_env E e =
+    match e with
+    | ELit n => ELit n
+    | EId x mkd => EId x $
+        union_kinded (prod_map id thunk_to_expr <$> E !! x) mkd
+    | EAbs x e => EAbs x (subst_env E e)
+    | EAbsMatch ms strict e =>
+        EAbsMatch (fmap (M:=option) (subst_env E) <$> ms) strict (subst_env E e)
+    | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2)
+    | ESeq μ e1 e2 => ESeq μ (subst_env E e1) (subst_env E e2)
+    | EList es => EList (subst_env E <$> es)
+    | EAttr αs => EAttr (attr_subst_env E <$> αs)
+    | ELetAttr k e1 e2 => ELetAttr k (subst_env E e1) (subst_env E e2)
+    | EBinOp op e1 e2 => EBinOp op (subst_env E e1) (subst_env E e2)
+    | EIf e1 e2 e3 => EIf (subst_env E e1) (subst_env E e2) (subst_env E e3)
+    end.
+Proof. rewrite /subst_env. destruct e; by rewrite /= ?lookup_fmap. Qed.
+
+Lemma subst_env_alt E e : subst_env E e = subst (prod_map id thunk_to_expr <$> E) e.
+Proof. done. Qed.
+
+(* Use the unfolding lemmas, don't rely on conversion *)
+Opaque subst_env'.
+
+Lemma subst_env_empty e : subst_env ∅ e = e.
+Proof. rewrite subst_env_alt. apply subst_empty. Qed.
+
+Lemma final_val_to_expr v : final SHALLOW (val_to_expr v).
+Proof. induction v; simpl; constructor; auto. Qed.
+Local Hint Resolve final_val_to_expr | 0 : core.
+Lemma step_not_val_to_expr v e : val_to_expr v -{SHALLOW}-> e → False.
+Proof. intros []%step_not_final. done. Qed.
+
+Lemma final_force_deep n t v :
+  force_deep n t = mret v → final DEEP (val_to_expr v).
+Proof.
+  revert t v. induction n as [|n IH]; intros v w; [done|].
+  rewrite force_deep_S /=.
+  intros; destruct v; simplify_res; eauto using final.
+  + destruct (mapM _ _) as [[vs|]|] eqn:Hmap; simplify_res; eauto.
+    constructor. revert vs Hmap.
+    induction ts as [|t ts IHts]; intros; simplify_res; [by constructor|..].
+    destruct (interp_thunk _ _) as [[w|]|]; simplify_res.
+    destruct (force_deep _ _) as [[w'|]|] eqn:?; simplify_res.
+    destruct (mapM _ _) as [[ws|]|]; simplify_res; eauto.
+  + destruct (map_mapM_sorted _ _ _) as [[vs|]|] eqn:Hmap; simplify_res.
+    constructor; [done|].
+    revert vs Hmap. induction ts as [|x t ts ?? IHts]
+      using (map_sorted_ind attr_le); intros ts' Hts.
+    { rewrite map_mapM_sorted_empty in Hts; simplify_res. done. }
+    rewrite map_mapM_sorted_insert //= in Hts.
+    destruct (interp_thunk _ _) as [[w|]|] eqn:?; simplify_res.
+    destruct (force_deep _ _) as [[w'|]|] eqn:?; simplify_res.
+    destruct (map_mapM_sorted _ _ _) as [[ws|]|] eqn:Hmap; simplify_res.
+    rewrite !fmap_insert /=. apply map_Forall_insert_2, IHts; eauto.
+Qed.
+
+Lemma interp_bin_op_Some_1 op v1 f :
+  interp_bin_op op v1 = Some f →
+  ∃ Φ, sem_bin_op op (val_to_expr v1) Φ.
+Proof.
+  intros Hinterp. unfold interp_bin_op, interp_eq in *.
+  repeat (case_match || simplify_option_eq);
+    eexists; by repeat econstructor; eauto using final.
+Qed.
+
+Lemma interp_bin_op_Some_2 op v1 Φ :
+  sem_bin_op op (val_to_expr v1) Φ →
+  is_Some (interp_bin_op op v1).
+Proof.
+  unfold interp_bin_op; destruct v1; inv 1;
+    repeat (case_match || simplify_option_eq); eauto.
+  destruct (option_to_eq_Some _) as [[??]|] eqn:Ho; simplify_eq/=; eauto.
+  by rewrite H2 in Ho.
+Qed.
+
+Lemma interp_eq_list_correct ts1 ts2 :
+  thunk_to_expr (interp_eq_list ts1 ts2) =D=>
+  sem_eq_list (thunk_to_expr <$> ts1) (thunk_to_expr <$> ts2).
+Proof.
+  simpl.
+  remember (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪
+    kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2))
+    as E eqn:HE.
+  assert (∀ (i : nat) t, ts1 !! i = Some t →
+    E !! String "1" (pretty (i + 0)) = Some (ABS, t)) as Hts1.
+  { intros x t Hxt. rewrite Nat.add_0_r.
+    rewrite HE lookup_union (lookup_kmap _) lookup_fmap.
+    rewrite lookup_map_seq_0 Hxt /= union_Some_l. done. }
+  assert (∀ (i : nat) t, ts2 !! i = Some t →
+    E !! String "2" (pretty (i + 0)) = Some (ABS, t)) as Hts2.
+  { intros x t Hxt. rewrite Nat.add_0_r.
+    rewrite HE lookup_union_r; last by apply (lookup_kmap_None _).
+    rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0 Hxt /=. done. }
+  clear HE. revert ts2 Hts1 Hts2. generalize 0.
+  induction ts1 as [|t1 ts1 IH]; intros n [|t2 ts2] Hts1 Hts2; csimpl; [done..|].
+  rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /=. rewrite /String.app.
+  rewrite (Hts1 0 t1) // (Hts2 0 t2) //=.
+  constructor; [repeat constructor| |done].
+  apply IH; intros i t; rewrite Nat.add_succ_r;
+    [apply (Hts1 (S i))|apply (Hts2 (S i))].
+Qed.
+
+Lemma interp_lt_list_correct ts1 ts2 :
+  thunk_to_expr (interp_lt_list ts1 ts2) =D=>
+  sem_lt_list (thunk_to_expr <$> ts1) (thunk_to_expr <$> ts2).
+Proof.
+  simpl.
+  remember (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪
+    kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2))
+    as E eqn:HE.
+  assert (∀ (i : nat) t, ts1 !! i = Some t →
+    E !! String "1" (pretty (i + 0)) = Some (ABS, t)) as Hts1.
+  { intros x t Hxt. rewrite Nat.add_0_r.
+    rewrite HE lookup_union (lookup_kmap _) lookup_fmap.
+    rewrite lookup_map_seq_0 Hxt /= union_Some_l. done. }
+  assert (∀ (i : nat) t, ts2 !! i = Some t →
+    E !! String "2" (pretty (i + 0)) = Some (ABS, t)) as Hts2.
+  { intros x t Hxt. rewrite Nat.add_0_r.
+    rewrite HE lookup_union_r; last by apply (lookup_kmap_None _).
+    rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0 Hxt /=. done. }
+  clear HE. revert ts2 Hts1 Hts2. generalize 0.
+  induction ts1 as [|t1 ts1 IH]; intros n [|t2 ts2] Hts1 Hts2; csimpl; [done..|].
+  rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /=. rewrite /String.app.
+  rewrite (Hts1 0 t1) // (Hts2 0 t2) //=.
+  constructor; [repeat constructor..|].
+  rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /=.
+  rewrite (Hts1 0 t1) // (Hts2 0 t2) //=.
+  constructor; [repeat constructor| |done].
+  apply IH; intros i t; rewrite Nat.add_succ_r;
+    [apply (Hts1 (S i))|apply (Hts2 (S i))].
+Qed.
+
+Lemma interp_eq_attr_correct ts1 ts2 :
+  dom ts1 = dom ts2 →
+  thunk_to_expr (interp_eq_attr ts1 ts2) =D=>
+  sem_eq_attr (AttrN ∘ thunk_to_expr <$> ts1) (AttrN ∘ thunk_to_expr <$> ts2).
+Proof.
+  intros Hdom. simpl.
+  remember (kmap (String "1") ((ABS,.) <$> ts1) ∪
+    kmap (String "2") ((ABS,.) <$> ts2)) as E eqn:HE.
+  assert (map_Forall (λ x t, E !! String "1" x = Some (ABS, t)) ts1) as Hts1.
+  { intros x t Hxt.
+    rewrite HE lookup_union (lookup_kmap (String "1")) lookup_fmap.
+    by rewrite Hxt /= union_Some_l. }
+  assert (map_Forall (λ x t, E !! String "2" x = Some (ABS, t)) ts2) as Hts2.
+  { intros x t Hxt.
+    rewrite HE lookup_union_r; last by apply (lookup_kmap_None _).
+    by rewrite (lookup_kmap (String "2")) lookup_fmap Hxt. }
+  clear HE. revert ts2 Hdom Hts1 Hts2.
+  induction ts1 as [|x t1 ts1 Hts1x IH] using (map_sorted_ind attr_le);
+    intros ts2 Hdom Hts1 Hts2.
+  { apply symmetry, dom_empty_inv_L in Hdom as ->. done. }
+  rewrite dom_insert_L in Hdom.
+  assert (is_Some (ts2 !! x)) as [t2 Hxt2] by (apply elem_of_dom; set_solver).
+  assert (dom ts1 = dom (delete x ts2)).
+  { rewrite dom_delete_L -Hdom. apply not_elem_of_dom in Hts1x. set_solver. }
+  rewrite -(insert_delete ts2 x t2) //. rewrite -(insert_delete ts2 x t2) // in Hts2.
+  apply map_Forall_insert in Hts1 as [Hx1 Hts1]; last done.
+  apply map_Forall_insert in Hts2 as [Hx2 Hts2]; last by rewrite lookup_delete.
+  rewrite /sem_eq_attr !fmap_insert /=. erewrite <-insert_merge by done.
+  rewrite sem_and_attr_insert; first last.
+  { intros y. rewrite lookup_merge !lookup_fmap /is_Some.
+    destruct (ts1 !! y) eqn:? , (delete x ts2 !! y); naive_solver. }
+  { rewrite lookup_merge !lookup_fmap lookup_delete /=. by destruct (ts1 !! x). }
+  rewrite map_imap_insert sem_and_attr_insert; first last.
+  { intros y. rewrite map_lookup_imap /is_Some.
+    destruct (ts1 !! y) eqn:?; naive_solver. }
+  { by rewrite map_lookup_imap Hts1x. }
+  rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /= Hx1 Hx2 /=.
+  constructor; [|apply IHts1; by auto|done]. by do 2 constructor.
+Qed.
+
+Lemma interp_bin_op_Some_Some_1 op v1 f Φ v2 t3 :
+  interp_bin_op op v1 = Some f →
+  sem_bin_op op (val_to_expr v1) Φ →
+  f v2 = Some t3 →
+  ∃ e3, Φ (val_to_expr v2) e3 ∧ thunk_to_expr t3 =D=> e3.
+Proof.
+  unfold interp_bin_op, interp_eq, type_of_val, type_of_expr;
+    destruct v1, v2; inv 2; intros;
+    repeat match goal with
+    | _ => progress simplify_option_eq
+    | H : _ <$> _ = ∅ |- _ => apply fmap_empty_inv in H
+    | H : context [dom (_ <$> _)] |- _ => rewrite !dom_fmap_L in H
+    | H : context [length (_ <$> _)] |- _ => rewrite !length_fmap in H
+    | _ => case_match
+    | _ => eexists; split; [done|]
+    | _ => by apply interp_eq_list_correct
+    | _ => eexists; split; [|by apply: interp_lt_list_correct]
+    | _ => by apply: interp_eq_attr_correct
+    | _ => eexists; split; [|done]
+    | _ => split; [|done]
+    | _ => rewrite map_fmap_singleton
+    | _ => rewrite fmap_delete
+    | _ => rewrite subst_env_empty
+    | _ => rewrite fmap_app
+    | _ => rewrite lookup_fmap
+    | _ => by constructor
+    end; eauto using final.
+  - apply reflexive_eq. f_equal. apply map_eq=> x.
+    rewrite !lookup_fmap. by destruct (_ !! _) as [[]|].
+  - by destruct (ts !! _).
+  - apply (map_minimal_key_Some _) in H as [[t Hx] ?].
+    split; [done|]. right. eexists s, _; split_and!.
+    + by rewrite lookup_fmap Hx.
+    + intros y. rewrite lookup_fmap fmap_is_Some. auto.
+    + rewrite 3!fmap_insert map_fmap_singleton /=.
+      by rewrite lookup_total_alt Hx fmap_delete.
+  - apply map_minimal_key_None in H as ->. auto.
+  - split; [done|]. by rewrite map_fmap_union.
+Qed.
+
+Lemma interp_bin_op_Some_Some_2 op v1 f Φ v2 e3 :
+  interp_bin_op op v1 = Some f →
+  sem_bin_op op (val_to_expr v1) Φ →
+  Φ (val_to_expr v2) e3 →
+  ∃ t3, f v2 = Some t3 ∧ thunk_to_expr t3 =D=> e3.
+Proof.
+  unfold interp_bin_op, interp_eq; destruct v1; inv 2; intros;
+    repeat match goal with
+    | H : ∃ _, _ |- _ => destruct H
+    | H : _ ∧ _ |- _ => destruct H
+    | H : _ <$> _ = ∅ |- _ => apply fmap_empty_inv in H
+    | H : context [(_ <$> _) !! _ = _] |- _ => rewrite lookup_fmap in H
+    | H : context [dom (_ <$> _)] |- _ => rewrite !dom_fmap_L in H
+    | H : context [length (_ <$> _)] |- _ => rewrite !length_fmap in H
+    | _ => progress simplify_option_eq
+    | H : val_to_expr ?v2 = _ |- _ => destruct v2
+    | _ => case_match
+    | _ => eexists; split; [|by apply interp_eq_attr_correct]
+    | _ => eexists; split; [|by apply interp_eq_list_correct]
+    | _ => eexists; split; [|by apply interp_lt_list_correct]
+    | _ => eexists; split; [done|]
+    | _ => rewrite map_fmap_singleton
+    | _ => rewrite fmap_delete
+    | _ => rewrite subst_env_empty
+    | _ => rewrite fmap_app
+    | _ => rewrite map_fmap_union
+    end; eauto.
+  - rewrite (option_to_eq_Some_Some _ _ H1) /=. by eexists.
+  - apply reflexive_eq. f_equal. apply map_eq=> x.
+    rewrite !lookup_fmap. by destruct (_ !! _) as [[]|].
+  - rewrite lookup_fmap. by destruct (_ !! _).
+  - destruct H1 as [[Hemp _]|(x & e' & Hx & Hleast & ->)].
+    { by apply fmap_empty_inv in Hemp as ->. }
+    rewrite lookup_fmap fmap_Some in Hx. destruct Hx as (t & Hx & [= ->]).
+    setoid_rewrite lookup_fmap in Hleast. setoid_rewrite fmap_is_Some in Hleast.
+    apply (map_minimal_key_Some _) in H as [??].
+    assert (s = x) as -> by (apply (anti_symm attr_le); naive_solver).
+    rewrite 3!fmap_insert map_fmap_singleton /= fmap_delete.
+    rewrite lookup_total_alt Hx. done.
+  - apply map_minimal_key_None in H as ->. naive_solver.
+Qed.
+
+Lemma interp_match_subst E ts ms strict :
+  interp_match ts (fmap (M:=option) (subst_env E) <$> ms) strict =
+  fmap (M:=gmap string) (sum_map (subst_env E) id) <$> interp_match ts ms strict.
+Proof.
+  unfold interp_match. set (f mt mme := match mt with _ => _ end).
+  revert ts. induction ms as [|x mt ms Hmsx IH] using map_ind; intros ts.
+  { rewrite fmap_empty merge_empty_r.
+    induction ts as [|x t ts Hmsx IH] using map_ind; [done|].
+    rewrite omap_insert /=. destruct strict; simplify_eq/=.
+    { rewrite map_mapM_insert_option //= lookup_omap Hmsx. done. }
+    rewrite -omap_delete delete_notin //. }
+  destruct (ts !! x) as [t|] eqn:Htsx.
+  { rewrite -(insert_delete ts x t) // fmap_insert.
+    rewrite -!(insert_merge _ _ _ _ (Some (inr t))) //.
+    rewrite !map_mapM_insert_option /=;
+      [|by rewrite lookup_merge lookup_delete ?lookup_fmap Hmsx..].
+    rewrite IH. destruct (map_mapM id _); rewrite /= ?fmap_insert //. }
+  rewrite -(insert_merge_r _ _ _ _ (inl <$> mt)) /=; last first.
+  { rewrite Htsx /=. by destruct mt. }
+  rewrite fmap_insert.
+  rewrite -(insert_merge_r _ _ _ _ (inl <$> (subst_env E <$> mt))) /=; last first.
+  { rewrite Htsx /=. by destruct mt. }
+    rewrite !map_mapM_insert_option /=;
+      [|by rewrite lookup_merge ?lookup_fmap Htsx Hmsx..].
+  rewrite IH. destruct mt, (map_mapM id _); rewrite /= ?fmap_insert //.
+Qed.
+
+Lemma interp_match_Some_1 ts ms strict tαs :
+  interp_match ts ms strict = Some tαs →
+  matches (thunk_to_expr <$> ts) ms strict (tattr_to_attr ∅ <$> tαs).
+Proof.
+  unfold interp_match. set (f mt mme := match mt with _ => _ end).
+  revert ts tαs.
+  induction ms as [|x mt ms Hmsx IH] using map_ind; intros ts αs Hmatch.
+  { rewrite merge_empty_r in Hmatch. revert αs Hmatch.
+    induction ts as [|x t ts Hmsx IH] using map_ind; intros ts' Hmatch.
+    { rewrite omap_empty map_mapM_empty in Hmatch. injection Hmatch as <-.
+      rewrite !fmap_empty. constructor. }
+    rewrite omap_insert /= in Hmatch. destruct strict; simplify_eq/=.
+    { rewrite map_mapM_insert_option //= in Hmatch. by rewrite lookup_omap Hmsx. }
+    rewrite fmap_insert.
+    rewrite -omap_delete delete_notin // in Hmatch. apply IH in Hmatch.
+    apply matches_strict; rewrite ?lookup_fmap ?Hmsx; eauto. }
+  destruct (ts !! x) as [t|] eqn:Htsx.
+  { rewrite -(insert_delete ts x t) //.
+    rewrite -(insert_delete ts x t) // in Hmatch.
+    rewrite -(insert_merge _ _ _ _ (Some (inr t))) // in Hmatch.
+    rewrite map_mapM_insert_option /= in Hmatch;
+      last (by rewrite lookup_merge lookup_delete Hmsx).
+    destruct (map_mapM id _) as [E''|] eqn:?; simplify_eq/=.
+    injection Hmatch as <-.
+    rewrite !fmap_insert /=. constructor.
+    - by rewrite lookup_fmap lookup_delete.
+    - done.
+    - by apply IH. }
+  rewrite -(insert_merge_r _ _ _ _ (inl <$> mt)) /= in Hmatch; last first.
+  { rewrite Htsx /=. by destruct mt. }
+  rewrite map_mapM_insert_option /= in Hmatch;
+    last (by rewrite lookup_merge Htsx Hmsx).
+  destruct mt as [t|]; simplify_eq/=.
+  destruct (map_mapM id _) as [E''|] eqn:?; simplify_eq/=.
+  injection Hmatch as <-. rewrite !fmap_insert /= subst_env_empty. constructor.
+  - by rewrite lookup_fmap Htsx.
+  - done.
+  - by apply IH.
+Qed.
+
+Lemma interp_match_Some_2 es ms strict αs :
+  matches es ms strict αs →
+  interp_match (Thunk ∅ <$> es) ms strict = Some (attr_to_tattr ∅ <$> αs).
+Proof.
+  unfold interp_match. set (f mt mme := match mt with _ => _ end).
+  induction 1; [done|..].
+  - rewrite fmap_empty merge_empty_r.
+    induction es as [|x e es ? IH] using map_ind; [done|].
+    rewrite fmap_insert omap_insert /= -omap_delete -fmap_delete delete_notin //.
+  - rewrite !fmap_insert /=.
+    rewrite -(insert_merge _ _ _ _ (Some (inr (Thunk ∅ e)))) //.
+    rewrite map_mapM_insert_option /=; last first.
+    { by rewrite lookup_merge !lookup_fmap H H0. }
+    by rewrite IHmatches.
+  - rewrite !fmap_insert /=.
+    rewrite -(insert_merge_r _ _ _ _ (Some (inl d))) /=; last first.
+    { by rewrite lookup_fmap H. }
+    rewrite map_mapM_insert_option /=; last first.
+    { by rewrite lookup_merge !lookup_fmap H H0. }
+    by rewrite IHmatches /=.
+Qed.
+
+Lemma force_deep_le {n1 n2 v mv} :
+  force_deep n1 v = Res mv → n1 ≤ n2 → force_deep n2 v = Res mv
+with interp_le {n1 n2 E e mv} :
+  interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv
+with interp_thunk_le {n1 n2 t mvs} :
+  interp_thunk n1 t = Res mvs → n1 ≤ n2 → interp_thunk n2 t = Res mvs
+with interp_app_le {n1 n2 v t mv} :
+  interp_app n1 v t = Res mv → n1 ≤ n2 → interp_app n2 v t = Res mv.
+Proof.
+  - destruct n1 as [|n1], n2 as [|n2]; intros Ht ?; [done || lia..|].
+    rewrite force_deep_S in Ht; rewrite force_deep_S; simpl in *.
+    destruct v as []; simplify_res; try done.
+    + destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_res.
+      erewrite mapM_Res_impl; [done..|]. intros t mw Hinterp; simpl in *.
+      destruct (interp_thunk n1 _) as [mw'|] eqn:Hinterp'; simplify_res.
+      rewrite (interp_thunk_le _ _ _ _ Hinterp') /=; last lia.
+      destruct mw'; simplify_res; eauto with lia.
+    + destruct (map_mapM_sorted _ _ _) eqn:?; simplify_res.
+      erewrite (map_mapM_sorted_Res_impl attr_le); [done..|].
+      clear dependent ts. intros t mw Hinterp; simpl in *.
+      destruct (interp_thunk n1 _) as [mw'|] eqn:Hinterp'; simplify_res.
+      rewrite (interp_thunk_le _ _ _ _ Hinterp') /=; last lia.
+      destruct mw'; simplify_res; eauto with lia.
+  - destruct n1 as [|n1], n2 as [|n2]; intros He ?; [done || lia..|].
+    rewrite interp_S in He; rewrite interp_S; destruct e;
+      repeat match goal with
+      | _ => case_match
+      | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res
+      | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
+      | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res
+      | H : interp ?n' _ _ = Res ?mv |- interp ?n ?E ?e ≫= _ = _ =>
+        rewrite (interp_le n' n E e mv); [|done || lia..]
+      | H : interp_app ?n' _ _ = Res ?mv |- interp_app ?n ?E ?e ≫= _ = _ =>
+        rewrite (interp_app_le n' n E e mv); [|done || lia..]
+      | H : force_deep ?n' _ = Res ?mv |- force_deep ?n ?t ≫= _ = _ =>
+        rewrite (force_deep_le n' n t mv); [|done || lia..]
+      | _ => progress simplify_res
+      | _ => progress simplify_option_eq
+      end; eauto with lia.
+  - destruct n1 as [|n1], n2 as [|n2]; intros He ?; [by (done || lia)..|].
+    rewrite interp_thunk_S in He. rewrite interp_thunk_S.
+    destruct t; repeat (case_match || destruct (_ !! _)
+                        || simplify_res); eauto with lia.
+  - destruct n1 as [|n1], n2 as [|n2]; intros He ?; [by (done || lia)..|].
+    rewrite interp_app_S /= in He; rewrite interp_app_S /=.
+    destruct v; simplify_res; eauto with lia.
+    + destruct (interp_thunk n1 t) as [mw|] eqn:?; simplify_res.
+      erewrite interp_thunk_le by eauto with lia. simpl.
+      destruct mw as [w|]; simplify_res; [|done].
+      destruct (maybe VAttr w) as [ts|]; simplify_res; [|done].
+      destruct (interp_match _ _ _); simplify_res; eauto with lia.
+    + destruct (_ !! "__functor") as [tf|]; simplify_res; [|done].
+      destruct (interp_thunk n1 tf) as [mw|] eqn:?; simplify_res.
+      erewrite interp_thunk_le by eauto with lia. simpl.
+      destruct mw as [w|]; simplify_res; [|done].
+      destruct (interp_app n1 _ _) as [mw|] eqn:?; simplify_res.
+      erewrite interp_app_le by eauto with lia; simpl.
+      destruct mw; simplify_res; eauto with lia.
+Qed.
+
+Lemma mapM_interp_le {n1 n2 ts mvs} :
+  mapM (mbind (force_deep n1) ∘ interp_thunk n1) ts = Res mvs →
+  n1 ≤ n2 →
+  mapM (mbind (force_deep n2) ∘ interp_thunk n2) ts = Res mvs.
+Proof.
+  intros. eapply mapM_Res_impl; [done|]; simpl; intros t mv ?.
+  destruct (interp_thunk _ _) as [mw|] eqn:Hthunk; simplify_res.
+  rewrite (interp_thunk_le Hthunk) //=.
+  destruct mw; simplify_res; eauto using force_deep_le.
+Qed.
+Lemma map_mapM_interp_le {n1 n2 ts mvs} :
+  map_mapM_sorted attr_le (mbind (force_deep n1) ∘ interp_thunk n1) ts = Res mvs →
+  n1 ≤ n2 →
+  map_mapM_sorted attr_le (mbind (force_deep n2) ∘ interp_thunk n2) ts = Res mvs.
+Proof.
+  intros. eapply (map_mapM_sorted_Res_impl attr_le); [done|]; simpl.
+  intros t mv ?. destruct (interp_thunk _ _) as [mw|] eqn:Hthunk; simplify_res.
+  rewrite (interp_thunk_le Hthunk) //=.
+  destruct mw; simplify_res; eauto using force_deep_le.
+Qed.
+
+Lemma interp_agree {n1 n2 E e mv1 mv2} :
+  interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2.
+Proof.
+  intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2).
+  - rewrite -He2. symmetry. eauto using interp_le.
+  - rewrite -He1. eauto using interp_le.
+Qed.
+
+Lemma subst_env_union E1 E2 e :
+  subst_env (union_kinded E1 E2) e = subst_env E1 (subst_env E2 e).
+Proof.
+  rewrite !subst_env_alt -subst_union. f_equal. apply map_eq=> x.
+  rewrite lookup_union_with !lookup_fmap lookup_union_with.
+  by repeat destruct (_ !! _) as [[[]]|].
+Qed.
+
+Lemma union_kinded_union {A} (E1 E2 : gmap string (kind * A)) :
+  map_Forall (λ _ ka, ka.1 = ABS) E1 → union_kinded E1 E2 = E1 ∪ E2.
+Proof.
+  rewrite map_Forall_lookup; intros.
+  apply map_eq=> x. rewrite lookup_union_with lookup_union.
+  destruct (E1 !! x) as [[[] a]|] eqn:?; naive_solver.
+Qed.
+
+Lemma subst_abs_env_insert E x e t :
+  subst_env (<[x:=(ABS, t)]> E) e
+  = subst {[x:=(ABS, thunk_to_expr t)]} (subst_env E e).
+Proof.
+  assert (<[x:=(ABS, t)]> E =
+    union_kinded {[x:=(ABS, t)]} E) as ->.
+  { apply map_eq=> y. rewrite lookup_union_with.
+    destruct (decide (x = y)) as [->|].
+    - rewrite lookup_insert lookup_singleton /=. by destruct (_ !! _).
+    - rewrite lookup_insert_ne // lookup_singleton_ne //. by destruct (_ !! _). }
+  rewrite subst_env_union subst_env_alt. by rewrite map_fmap_singleton.
+Qed.
+
+Lemma subst_abs_as_subst_env x e1 e2 :
+  subst {[x:=(ABS, e2)]} e1 = subst_env (<[x:=(ABS, Thunk ∅ e2)]> ∅) e1.
+Proof. rewrite subst_abs_env_insert //= !subst_env_empty //. Qed.
+
+Lemma subst_env_insert_proper e1 e2 E1 E2 x t1 t2 :
+  subst_env E1 e1 = subst_env E2 e2 →
+  thunk_to_expr t1 = thunk_to_expr t2 →
+  subst_env (<[x:=(ABS, t1)]> E1) e1 = subst_env (<[x:=(ABS, t2)]> E2) e2.
+Proof. rewrite !subst_abs_env_insert //. auto with f_equal. Qed.
+
+Lemma subst_env_insert_proper' e1 e2 E1 E2 x E1' E2' e1' e2' :
+  subst_env E1 e1 = subst_env E2 e2 →
+  subst_env E1' e1' = subst_env E2' e2' →
+  subst_env (<[x:=(ABS, Thunk E1' e1')]> E1) e1
+  = subst_env (<[x:=(ABS, Thunk E2' e2')]> E2) e2.
+Proof. intros. by apply subst_env_insert_proper. Qed.
+
+Lemma subst_env_union_fmap_proper k e1 e2 E1 E2 ts1 ts2 :
+  subst_env E1 e1 = subst_env E2 e2 →
+  AttrN ∘ thunk_to_expr <$> ts1 = AttrN ∘ thunk_to_expr <$> ts2 →
+  subst_env (union_kinded ((k,.) <$> ts1) E1) e1
+  = subst_env (union_kinded ((k,.) <$> ts2) E2) e2.
+Proof.
+  intros He Hes. rewrite !subst_env_union; [|by apply env_unionable_with..].
+  rewrite He !subst_env_alt /=. f_equal.
+  apply map_eq=> x. rewrite !lookup_fmap.
+  apply (f_equal (.!! x)) in Hes. rewrite !lookup_fmap in Hes.
+  destruct (ts1 !! x), (ts2 !! x); simplify_eq/=; auto with f_equal.
+Qed.
+
+Lemma subst_env_fmap_proper k e ts1 ts2 :
+  AttrN ∘ thunk_to_expr <$> ts1 = AttrN ∘ thunk_to_expr <$> ts2 →
+  subst_env ((k,.) <$> ts1) e = subst_env ((k,.) <$> ts2) e.
+Proof.
+  intros. rewrite -(right_id_L ∅ (union_kinded) (_ <$> ts1))
+    -(right_id_L ∅ (union_kinded) (_ <$> ts2)).
+  by apply subst_env_union_fmap_proper.
+Qed.
+
+Lemma tattr_to_attr_from_attr E (αs : gmap string attr) :
+  tattr_to_attr E <$> (attr_to_tattr E <$> αs) = attr_subst_env E <$> αs.
+Proof.
+  apply map_eq=> x. rewrite /tattr_to_attr !lookup_fmap.
+  destruct (αs !! x) as [[[] ]|] eqn:?; auto.
+Qed.
+
+Lemma tattr_to_attr_from_attr_empty (αs : gmap string attr) :
+  tattr_to_attr ∅ <$> (attr_to_tattr ∅ <$> αs) = αs.
+Proof.
+  rewrite tattr_to_attr_from_attr. apply map_eq=> x. rewrite !lookup_fmap.
+  destruct (αs !! x) as [[[] ]|] eqn:?; f_equal/=; by rewrite subst_env_empty.
+Qed.
+
+Lemma indirects_env_proper E1 E2 tαs1 tαs2 e1 e2 :
+  tattr_to_attr E1 <$> tαs1 = tattr_to_attr E2 <$> tαs2 →
+  subst_env E1 e1 = subst_env E2 e2 →
+  subst_env (indirects_env E1 tαs1) e1 = subst_env (indirects_env E2 tαs2) e2.
+Proof.
+  intros Htαs HE. rewrite /indirects_env -!union_kinded_union;
+    [|intros ??; rewrite map_lookup_imap=> ?; by simplify_option_eq..].
+  rewrite !subst_env_union HE !subst_env_alt. f_equal.
+  apply map_eq=> x. rewrite !lookup_fmap !map_lookup_imap.
+  pose proof (f_equal (.!! x) Htαs) as Hx. rewrite !lookup_fmap in Hx.
+  repeat destruct (_ !! x) as [[]|]; simplify_eq/=; auto with f_equal.
+Qed.
+
+Lemma subst_env_indirects_env E tαs e :
+  subst_env (indirects_env E tαs) e
+  = subst_env (indirects_env ∅ (attr_to_tattr ∅ <$> (tattr_to_attr E <$> tαs)))
+    (subst_env E e).
+Proof.
+  rewrite /indirects_env -!union_kinded_union;
+    [|intros ??; rewrite map_lookup_imap=> ?; by simplify_option_eq..].
+  rewrite !subst_env_union subst_env_empty !subst_env_alt.
+  f_equal. apply map_eq=> x. rewrite !lookup_fmap !map_lookup_imap !lookup_fmap.
+  destruct (_ !! _) as [[]|];
+    do 4 f_equal/=; auto using tattr_to_attr_from_attr_empty.
+Qed.
+
+Lemma subst_env_indirects_env_attr_to_tattr E αs e :
+  subst_env (indirects_env E (attr_to_tattr E <$> αs)) e
+  = subst (indirects (attr_subst_env E <$> αs)) (subst_env E e).
+Proof.
+  rewrite /indirects_env -!union_kinded_union;
+    [|intros ??; rewrite map_lookup_imap=> ?; by simplify_option_eq..].
+  rewrite subst_env_union !subst_env_alt. f_equal.
+  apply map_eq=> x. rewrite !lookup_fmap !map_lookup_imap !lookup_fmap.
+  repeat destruct (_ !! x) as [[]|]; simplify_eq/=; do 4 f_equal/=.
+  by rewrite tattr_to_attr_from_attr.
+Qed.
+
+Lemma subst_env_indirects_env_attr_to_tattr_empty αs e :
+  subst_env (indirects_env ∅ (attr_to_tattr ∅ <$> αs)) e =
+  subst (indirects αs) e.
+Proof.
+  rewrite subst_env_indirects_env_attr_to_tattr subst_env_empty. do 3 f_equal.
+  apply map_eq=> x. rewrite !lookup_fmap.
+  destruct (_ !! x) as [[]|]; do 2 f_equal/=; auto using subst_env_empty.
+Qed.
+
+Lemma interp_val_to_expr E e v :
+  subst_env E e = val_to_expr v →
+  ∃ w m, interp m E e = mret w ∧ val_to_expr v = val_to_expr w.
+Proof.
+  revert v. induction e; intros [];
+    rewrite subst_env_eq; intros; simplify_eq/=.
+  - eexists (VLit _ ltac:(done)), 1. split; [|done]. by rewrite interp_lit.
+  - eexists (VClo _ _ _), 1. rewrite interp_S /=. auto with f_equal.
+  - eexists (VCloMatch _ _ _ _), 1. rewrite interp_S /=. auto with f_equal.
+  - eexists (VList _), 1. rewrite interp_S /=. split; [done|].
+    f_equal. rewrite -H0. clear.
+    induction es; f_equal/=; auto.
+  - eexists (VAttr _), 1. rewrite interp_S /=. split; [done|].
+    assert (no_recs αs) as Hrecs.
+    { intros y α Hy.
+      apply (f_equal (.!! y)) in H0. rewrite !lookup_fmap Hy /= in H0.
+      destruct (ts !! y), α; by simplify_eq/=. }
+    rewrite from_attr_no_recs // -H0.
+    f_equal. apply map_eq=> y.
+    rewrite !lookup_fmap. destruct (αs !! y) as [[]|] eqn:?; do 2 f_equal/=.
+    eauto using no_recs_lookup.
+Qed.
+
+Lemma interp_val_to_expr_Res m E e v mw :
+  subst_env E e = val_to_expr v →
+  interp m E e = Res mw →
+  Some (val_to_expr v) = val_to_expr <$> mw.
+Proof.
+  intros (mw' & m' & Hinterp' & ->)%interp_val_to_expr Hinterp.
+  by assert (mw = Some mw') as -> by eauto using interp_agree.
+Qed.
+
+Lemma interp_empty_val_to_expr v :
+  ∃ w m, interp m ∅ (val_to_expr v) = mret w ∧ val_to_expr v = val_to_expr w.
+Proof. apply interp_val_to_expr. by rewrite subst_env_empty. Qed.
+
+Lemma interp_empty_val_to_expr_Res m v mw :
+  interp m ∅ (val_to_expr v) = Res mw →
+  Some (val_to_expr v) = val_to_expr <$> mw.
+Proof. apply interp_val_to_expr_Res. by rewrite subst_env_empty. Qed.
+
+Lemma interp_eq_list_proper ts1 ts2 ts1' ts2' :
+  thunk_to_expr <$> ts1 = thunk_to_expr <$> ts1' →
+  thunk_to_expr <$> ts2 = thunk_to_expr <$> ts2' →
+  thunk_to_expr (interp_eq_list ts1 ts2)
+  = thunk_to_expr (interp_eq_list ts1' ts2').
+Proof.
+  intros Hts1 Hts2. rewrite /= !subst_env_alt.
+  f_equal; last first.
+  { revert ts1' ts2 ts2' Hts1 Hts2. generalize 0.
+    induction ts1; intros ? [] [] [] ??; simplify_eq/=; auto with f_equal. }
+  rewrite !map_fmap_union. f_equal; apply map_eq=> y; rewrite !lookup_fmap.
+  - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
+    + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
+      rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0.
+      rewrite lookup_fmap lookup_map_seq_0 in Hy.
+      apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1.
+      repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
+    + rewrite lookup_kmap_None in Hy.
+      apply symmetry, fmap_None, (lookup_kmap_None _).
+      intros y' ->. generalize (Hy _ eq_refl).
+      rewrite !lookup_fmap !lookup_map_seq_0.
+      apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1.
+      intros. repeat destruct (_ !! _); by simplify_eq/=.
+  - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
+    + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
+      rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0.
+      rewrite lookup_fmap lookup_map_seq_0 in Hy.
+      apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2.
+      repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
+    + rewrite lookup_kmap_None in Hy.
+      apply symmetry, fmap_None, (lookup_kmap_None _).
+      intros y' ->. generalize (Hy _ eq_refl).
+      rewrite !lookup_fmap !lookup_map_seq_0.
+      apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2.
+      intros. repeat destruct (_ !! _); by simplify_eq/=.
+Qed.
+
+Lemma interp_lt_list_proper ts1 ts2 ts1' ts2' :
+  thunk_to_expr <$> ts1 = thunk_to_expr <$> ts1' →
+  thunk_to_expr <$> ts2 = thunk_to_expr <$> ts2' →
+  thunk_to_expr (interp_lt_list ts1 ts2)
+  = thunk_to_expr (interp_lt_list ts1' ts2').
+Proof.
+  intros Hts1 Hts2. rewrite /= !subst_env_alt.
+  f_equal; last first.
+  { revert ts1' ts2 ts2' Hts1 Hts2. generalize 0.
+    induction ts1; intros ? [] [] [] ??; simplify_eq/=; auto with f_equal. }
+  rewrite !map_fmap_union. f_equal; apply map_eq=> y; rewrite !lookup_fmap.
+  - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
+    + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
+      rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0.
+      rewrite lookup_fmap lookup_map_seq_0 in Hy.
+      apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1.
+      repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
+    + rewrite lookup_kmap_None in Hy.
+      apply symmetry, fmap_None, (lookup_kmap_None _).
+      intros y' ->. generalize (Hy _ eq_refl).
+      rewrite !lookup_fmap !lookup_map_seq_0.
+      apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1.
+      intros. repeat destruct (_ !! _); by simplify_eq/=.
+  - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
+    + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
+      rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0.
+      rewrite lookup_fmap lookup_map_seq_0 in Hy.
+      apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2.
+      repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
+    + rewrite lookup_kmap_None in Hy.
+      apply symmetry, fmap_None, (lookup_kmap_None _).
+      intros y' ->. generalize (Hy _ eq_refl).
+      rewrite !lookup_fmap !lookup_map_seq_0.
+      apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2.
+      intros. repeat destruct (_ !! _); by simplify_eq/=.
+Qed.
+
+Lemma interp_eq_attr_proper ts1 ts2 ts1' ts2' :
+  thunk_to_expr <$> ts1 = thunk_to_expr <$> ts1' →
+  thunk_to_expr <$> ts2 = thunk_to_expr <$> ts2' →
+  thunk_to_expr (interp_eq_attr ts1 ts2)
+  = thunk_to_expr (interp_eq_attr ts1' ts2').
+Proof.
+  intros Hts1 Hts2. rewrite /= !subst_env_alt.
+  f_equal; last first.
+  { clear Hts2. f_equal. apply map_eq=> y.
+    rewrite !map_lookup_imap. apply (f_equal (.!! y)) in Hts1.
+    rewrite !lookup_fmap in Hts1. by repeat destruct (_ !! _). }
+  rewrite !map_fmap_union. f_equal; apply map_eq=> y; rewrite !lookup_fmap.
+  - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
+    + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
+      rewrite (lookup_kmap (String "1")) lookup_fmap.
+      rewrite lookup_fmap in Hy.
+      apply (f_equal (.!! y')) in Hts1. rewrite !lookup_fmap in Hts1.
+      repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
+    + rewrite lookup_kmap_None in Hy.
+      apply symmetry, fmap_None, (lookup_kmap_None _).
+      intros y' ->. generalize (Hy _ eq_refl). rewrite !lookup_fmap.
+      apply (f_equal (.!! y')) in Hts1. rewrite !lookup_fmap in Hts1.
+      intros. repeat destruct (_ !! _); by simplify_eq/=.
+  - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=.
+    + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy).
+      rewrite (lookup_kmap (String "2")) lookup_fmap.
+      rewrite lookup_fmap in Hy.
+      apply (f_equal (.!! y')) in Hts2. rewrite !lookup_fmap in Hts2.
+      repeat destruct (_ !! _); simplify_eq/=; auto with f_equal.
+    + rewrite lookup_kmap_None in Hy.
+      apply symmetry, fmap_None, (lookup_kmap_None _).
+      intros y' ->. generalize (Hy _ eq_refl). rewrite !lookup_fmap.
+      apply (f_equal (.!! y')) in Hts2. rewrite !lookup_fmap in Hts2.
+      intros. repeat destruct (_ !! _); by simplify_eq/=.
+Qed.
+
+Opaque interp_eq_list interp_lt_list interp_eq_attr.
+
+Lemma interp_bin_op_proper op v1 v2 :
+  val_to_expr v1 = val_to_expr v2 →
+  match interp_bin_op op v1, interp_bin_op op v2 with
+  | None, None => True
+  | Some f1, Some f2 => ∀ v1' v2',
+     val_to_expr v1' = val_to_expr v2' →
+     thunk_to_expr <$> f1 v1' = thunk_to_expr <$> f2 v2'
+  | _, _ => False
+  end.
+Proof.
+  intros. unfold interp_bin_op, interp_eq;
+    repeat (done || case_match || simplify_eq/= || 
+      destruct (option_to_eq_Some _) as [[]|]);
+    intros [] [] ?; simplify_eq/=;
+    repeat match goal with
+    | _ => done
+    | _ => progress simplify_option_eq
+    | _ => rewrite map_fmap_singleton
+    | _ => rewrite map_fmap_union
+    | _ => case_match
+    | |- context[ maybe _ ?x ] => is_var x; destruct x
+    end; auto with congruence.
+  - f_equal. by apply interp_eq_list_proper.
+  - apply (f_equal length) in H, H0. rewrite !length_fmap in H H0. congruence.
+  - apply (f_equal length) in H, H0. rewrite !length_fmap in H H0. congruence.
+  - f_equal. apply interp_eq_attr_proper.
+    + rewrite 2!map_fmap_compose in H. by simplify_eq.
+    + rewrite 2!map_fmap_compose in H0. by simplify_eq.
+  - apply (f_equal dom) in H, H0. rewrite !dom_fmap_L in H H0. congruence.
+  - apply (f_equal dom) in H, H0. rewrite !dom_fmap_L in H H0. congruence.
+  - destruct v1, v2; by simplify_eq/=.
+  - repeat destruct (option_to_eq_Some _) as [[]|]; simplify_eq/=; auto.
+  - do 3 f_equal. apply map_eq=> y. rewrite !lookup_fmap.
+    apply (f_equal (.!! y)) in H. rewrite !lookup_fmap in H.
+    repeat destruct (_ !! _) as [[]|]; naive_solver.
+  - f_equal. by apply interp_lt_list_proper.
+  - rewrite !fmap_insert /=. auto 10 with f_equal.
+  - by rewrite !fmap_app H0 H.
+  - apply (f_equal (.!! s)) in H. rewrite !lookup_fmap in H.
+    repeat destruct (_ !! _); simplify_eq/=; by f_equal.
+  - apply (f_equal (.!! s)) in H. rewrite !lookup_fmap in H.
+    repeat destruct (_ !! _); simplify_eq/=; by f_equal.
+  - rewrite !fmap_delete. congruence.
+  - assert (∀ y, is_Some (ts !! y) ↔ is_Some (ts0 !! y)) as Hx.
+    { intros y. rewrite -!(fmap_is_Some (AttrN ∘ thunk_to_expr)) -!lookup_fmap.
+      by rewrite H. }
+    apply (map_minimal_key_Some _) in H5 as [[t1 Hx1] ?], H8 as [[t2 Hx2] ?].
+    assert (s0 = s) as -> by (apply (anti_symm attr_le); naive_solver).
+    pose proof (f_equal (.!! s) H) as Hs. rewrite !lookup_fmap in Hs.
+    rewrite !fmap_insert !fmap_empty /= !lookup_total_alt Hx1 Hx2 /=.
+    rewrite Hx1 Hx2 /= in Hs. simplify_eq/=. rewrite Hs !fmap_delete H. done.
+  - apply map_minimal_key_None in H8 as ->.
+    rewrite fmap_empty in H. by apply fmap_empty_inv in H as ->.
+  - apply map_minimal_key_None in H5 as ->.
+    rewrite fmap_empty in H. by apply symmetry, fmap_empty_inv in H as ->.
+Qed.
+
+Lemma interp_match_proper E1 E2 ts1 ts2 ms1 ms2 strict :
+  thunk_to_expr <$> ts1 = thunk_to_expr <$> ts2 →
+  fmap (M:=option) (subst_env E1) <$> ms1 = fmap (subst_env E2) <$> ms2 →
+  fmap (M:=gmap string) (tattr_to_attr E1) <$> interp_match ts1 ms1 strict
+  = fmap (tattr_to_attr E2) <$> interp_match ts2 ms2 strict.
+Proof.
+  revert ms2 ts1 ts2.
+  induction ms1 as [|x m1 ms1 Hmsx IH] using map_ind; intros ms2 ts1 ts2 Hts Hms.
+  { rewrite fmap_empty in Hms. apply symmetry, fmap_empty_inv in Hms as ->.
+    rewrite /interp_match !merge_empty_r. revert ts2 Hts.
+    induction ts1 as [|x t1 ts1 Htsx IH] using map_ind; intros ts2 Hts.
+    { rewrite fmap_empty in Hts. by apply symmetry, fmap_empty_inv in Hts as ->. }
+    rewrite fmap_insert in Hts.
+    apply symmetry, fmap_insert_inv in Hts as (t2&ts2'&?&Htsx2&->&Hts);
+      last by rewrite lookup_fmap Htsx.
+    rewrite !omap_insert /=. destruct strict; simpl;
+      rewrite ?map_mapM_insert_option ?delete_notin //= ?lookup_omap ?Htsx ?Htsx2;
+      auto. }
+  rewrite fmap_insert in Hms.
+  apply symmetry, fmap_insert_inv in Hms as (m2&ms2'&?&Hmsx2&->&Hms);
+    last by rewrite lookup_fmap Hmsx.
+  pose proof (f_equal (.!! x) Hts) as Hx. rewrite !lookup_fmap in Hx.
+  destruct (ts1 !! x) as [t1|] eqn:Hts1x, (ts2 !! x) as [t2|] eqn:Hts2x; simplify_eq/=.
+  - rewrite -(insert_delete ts1 x t1) // -(insert_delete ts2 x t2) //.
+    rewrite /interp_match. erewrite <-!insert_merge by done.
+    rewrite !map_mapM_insert_option ?lookup_merge ?lookup_delete ?Hmsx ?Hmsx2 //=.
+    apply (f_equal (delete x)) in Hts. rewrite -!fmap_delete in Hts.
+    eapply IH in Hms; [|done]. rewrite /interp_match in Hms.
+    repeat destruct (map_mapM id _); simplify_eq/=; [|done..].
+    rewrite !fmap_insert /=. auto with f_equal.
+  - rewrite /interp_match.
+    rewrite -!(insert_merge_r _ ts1 _ _ (inl <$> m1));
+      last (rewrite Hts1x; by destruct m1).
+    rewrite -!(insert_merge_r _ ts2 _ _ (inl <$> m2));
+      last (rewrite Hts2x; by destruct m2).
+    rewrite !map_mapM_insert_option ?lookup_merge ?Hts1x ?Hts2x ?Hmsx ?Hmsx2 //.
+    eapply IH in Hms; [|done]. rewrite /interp_match in Hms.
+    destruct m1, m2; simplify_eq/=; auto.
+    repeat destruct (map_mapM id _); simplify_eq/=; [|done..].
+    rewrite !fmap_insert /=. auto with f_equal.
+Qed.
+
+Lemma mapM_interp_proper' n ts1 ts2 mvs :
+  (∀ v1 v2 mv,
+    val_to_expr v1 = val_to_expr v2 →
+    force_deep n v1 = Res mv →
+    ∃ mw m, force_deep m v2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw) →
+  (∀ t1 t2 mv,
+    thunk_to_expr t1 = thunk_to_expr t2 →
+    interp_thunk n t1 = Res mv →
+    ∃ mw m, interp_thunk m t2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw) →
+  thunk_to_expr <$> ts1 = thunk_to_expr <$> ts2 →
+  mapM (mbind (force_deep n) ∘ interp_thunk n) ts1 = Res mvs →
+  ∃ mws m, mapM (mbind (force_deep m) ∘ interp_thunk m) ts2 = Res mws ∧
+           fmap (M:=list) val_to_expr <$> mvs = fmap (M:=list) val_to_expr <$> mws.
+Proof.
+  intros force_deep_proper interp_thunk_proper Hts.
+  revert mvs. rewrite list_eq_Forall2 Forall2_fmap in Hts.
+  induction Hts as [|t1 t2 ts1 ts2 ?? IH]; intros mvs ?; simplify_res.
+  { by exists (Some []), 0. }
+  destruct (interp_thunk _ _) as [mv|] eqn:Hinterp'; simplify_res.
+  eapply interp_thunk_proper in Hinterp'
+    as (mw & m1 & Hinterp1 & Hw); [|by eauto..].
+  destruct mv as [v|], mw as [w|]; simplify_res; last first.
+  { exists None, m1. by rewrite /= Hinterp1. }
+  destruct (force_deep _ _) as [mv'|] eqn:Hforce; simplify_res.
+  eapply force_deep_proper in Hforce as (mw' & m2 & Hforce2 & Hw'); last done.
+  destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+  { exists None, (m1 `max` m2).
+    rewrite (interp_thunk_le Hinterp1) /=; last lia.
+    rewrite (force_deep_le Hforce2) /=; last lia. done. }
+  destruct (mapM _ _) as [mvs'|] eqn:?; simplify_res.
+  destruct (IH _ eq_refl) as (mws & m3 & Hmap3 & ?).
+  exists ((w' ::.) <$> mws), (S (m1 `max` m2 `max` m3)).
+  rewrite (interp_thunk_le Hinterp1) /=; last lia.
+  rewrite (force_deep_le Hforce2) /=; last lia.
+  rewrite (mapM_interp_le Hmap3) /=; last lia. split; [by destruct mws|].
+  destruct mvs', mws; simplify_res; auto 10 with f_equal.
+Qed.
+
+Lemma force_deep_proper n v1 v2 mv :
+  val_to_expr v1 = val_to_expr v2 →
+  force_deep n v1 = Res mv →
+  ∃ mw m, force_deep m v2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw
+with interp_proper n E1 E2 e1 e2 mv :
+  subst_env E1 e1 = subst_env E2 e2 →
+  interp n E1 e1 = Res mv →
+  ∃ mw m, interp m E2 e2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw
+with interp_thunk_proper n t1 t2 mv :
+  thunk_to_expr t1 = thunk_to_expr t2 →
+  interp_thunk n t1 = Res mv →
+  ∃ mw m, interp_thunk m t2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw
+with interp_app_proper n v1 v2 t1' t2' mv :
+  val_to_expr v1 = val_to_expr v2 →
+  thunk_to_expr t1' = thunk_to_expr t2' →
+  interp_app n v1 t1' = Res mv →
+  ∃ mw m, interp_app m v2 t2' = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  (* force_deep_proper *)
+  - destruct n as [|n]; [done|].
+    intros Hv Hinterp. rewrite force_deep_S /force_deep1 in Hinterp.
+    destruct v1 as [| | |ts1|ts1], v2 as [| | |ts2|ts2]; simplify_res.
+    { eexists _, 1; split; [by rewrite force_deep_S|]. done. }
+    { eexists _, 1; split; [by rewrite force_deep_S|]. simpl. auto with f_equal. }
+    { eexists _, 1; split; [by rewrite force_deep_S|]. simpl. auto with f_equal. }
+    { destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_res.
+      eapply mapM_interp_proper' in Hmap as (mws & m & Hmap & Hmvs); [|by eauto..].
+      exists (VList ∘ fmap Forced <$> mws), (S m).
+      rewrite force_deep_S /= Hmap. split; [done|].
+      destruct mvs, mws; simplify_eq/=; do 2 f_equal.
+      rewrite list_eq_Forall2 Forall2_fmap in Hmvs.
+      by rewrite list_eq_Forall2 !Forall2_fmap. }
+    destruct (map_mapM_sorted _ _ _) as [mvs|] eqn:Hmap; simplify_res.
+    assert (∃ mws m,
+      map_mapM_sorted attr_le
+        (mbind (force_deep m) ∘ interp_thunk m) ts2 = Res mws ∧
+      fmap (M:=gmap _) val_to_expr <$> mvs = fmap (M:=gmap _) val_to_expr <$> mws)
+      as (mws & m & Hmap' & Hmvs); last first.
+    { exists (VAttr ∘ fmap Forced <$> mws), (S m).
+      rewrite force_deep_S /= Hmap'. split; [done|].
+      destruct mvs, mws; simplify_eq/=; do 2 f_equal.
+      apply map_eq=> x. rewrite !lookup_fmap.
+      apply (f_equal (.!! x)) in Hmvs. rewrite !lookup_fmap in Hmvs.
+      repeat destruct (_ !! x); simplify_res; auto with f_equal. }
+    revert ts2 mvs Hmap Hv. induction ts1 as [|x t1 ts1 Hx1 ? IH]
+      using (map_sorted_ind attr_le); intros ts2' mvs Hmap Hts.
+    { exists (Some ∅), 0. rewrite fmap_empty in Hts.
+      apply symmetry, fmap_empty_inv in Hts as ->.
+      rewrite map_mapM_sorted_empty in Hmap; simplify_res.
+      by rewrite map_mapM_sorted_empty. }
+    rewrite map_mapM_sorted_insert //= in Hmap. rewrite fmap_insert in Hts.
+    apply symmetry, fmap_insert_inv in Hts as (t2 & ts2 & Ht & ? & -> & Hts);
+      simplify_eq/=; last by rewrite lookup_fmap Hx1.
+    assert (∀ j, is_Some (ts2 !! j) → attr_le x j).
+    { intros j. rewrite -(fmap_is_Some (AttrN ∘ thunk_to_expr)).
+      rewrite -lookup_fmap -Hts lookup_fmap fmap_is_Some. auto. }
+    destruct (interp_thunk _ _) as [mv|] eqn:Hinterp'; simplify_res.
+    eapply interp_thunk_proper in Hinterp'
+      as (mw & m1 & Hinterp1 & Hw); [|by eauto..].
+    destruct mv as [v|], mw as [w|]; simplify_res; last first.
+    { exists None, m1. by rewrite map_mapM_sorted_insert //= Hinterp1. }
+    destruct (force_deep _ _) as [mv'|] eqn:Hforce; simplify_res.
+    eapply force_deep_proper in Hforce as (mw' & m2 & Hforce2 & Hw'); last done.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (m1 `max` m2). rewrite map_mapM_sorted_insert //=.
+      rewrite (interp_thunk_le Hinterp1) /=; last lia.
+      rewrite (force_deep_le Hforce2) /=; last lia. done. }
+    destruct (map_mapM_sorted _ _ _) as [mvs'|] eqn:?; simplify_res.
+    eapply IH in Hts as (mws & m3 & Hmap3 & ?); last done.
+    exists (<[x:=w']> <$> mws), (S (m1 `max` m2 `max` m3)).
+    rewrite map_mapM_sorted_insert //=.
+    rewrite (interp_thunk_le Hinterp1) /=; last lia.
+    rewrite (force_deep_le Hforce2) /=; last lia.
+    rewrite (map_mapM_interp_le Hmap3) /=; last lia.
+    destruct mvs' as [vs'|], mws as [ws'|]; simplify_res; last done.
+    split; [done|]. rewrite !fmap_insert. auto 10 with f_equal.
+  (* interp_proper *)
+  - destruct n as [|n]; [done|]. intros Hsubst Hinterp.
+    rewrite 2!subst_env_eq in Hsubst.
+    rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done.
+    + (* ELit *)
+      case_guard; simplify_res.
+      * eexists (Some (VLit _ ltac:(done))), 1. by rewrite interp_lit.
+      * exists None, 1. split; [|done]. rewrite interp_S /=. by case_guard.
+    + (* EId *)
+      assert (∀ (mke : option (kind * expr)) (E : env) x,
+        prod_map id thunk_to_expr <$>
+          union_kinded (E !! x) (prod_map id (Thunk ∅) <$> mke)
+        = union_kinded (prod_map id thunk_to_expr <$> E !! x) mke) as HE.
+      { intros mke' E x. destruct (E !! _) as [[[] ?]|], mke' as [[[] ?]|];
+          simplify_eq/=; rewrite ?subst_env_empty //. }
+      rewrite -!HE {HE} in H.
+      destruct (union_kinded (E1 !! _) _) as [[k1 t1]|],
+        (union_kinded (E2 !! _) _) as [[k2 t2]|] eqn:HE2; simplify_res; last first.
+      { exists None, (S n). rewrite interp_S /=. by rewrite HE2. }
+      eapply interp_thunk_proper
+        in Hinterp as (mw & m & Hinterp & ?); [|by eauto..].
+      exists mw, (S (n `max` m)). split; [|done]. rewrite interp_S /= HE2 /=.
+      eauto using interp_thunk_le with lia.
+    + (* EAbs *) eexists (Some (VClo _ _ _)), 1; split; [by rewrite interp_S|].
+      simpl. auto with f_equal.
+    + (* EAbsMatch *)
+      eexists (Some (VCloMatch _ _ _ _)), 1; split; [by rewrite interp_S|].
+      simpl. auto with f_equal.
+    + (* EApp *)
+      destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp'; simplify_eq/=.
+      eapply interp_proper in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
+      destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+      { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+      destruct (interp_app n _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+      eapply (interp_app_proper _ _ _ _ (Thunk _ _)) in Hinterp'
+        as (mw & m2 & Hinterp2 & ?); [|done..].
+      exists mw, (S (m1 `max` m2)). rewrite interp_S /=.
+      rewrite (interp_le Hinterp1) /=; last lia.
+      rewrite (interp_app_le Hinterp2) /=; last lia. done.
+    + (* ESeq *)
+      destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp'; simplify_eq/=.
+      eapply interp_proper in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done.
+      destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+      { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+      destruct μ0; simplify_res.
+      { eapply interp_proper in Hinterp as (w2 & m2 & Hinterp2 & ?); last done.
+        exists w2, (S (m1 `max` m2)). rewrite interp_S /=.
+        rewrite (interp_le Hinterp1) /=; last lia.
+        rewrite (interp_le Hinterp2) /=; last lia. done. }
+      destruct (force_deep _ _) as [mv'|] eqn:Hforce; simplify_res.
+      eapply force_deep_proper in Hforce as (mw' & m2 & Hforce & ?); last done.
+      destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+      { exists None, (S (m1 `max` m2)). rewrite interp_S /=.
+        rewrite (interp_le Hinterp1) /=; last lia.
+        rewrite (force_deep_le Hforce) /=; last lia. done. }
+      eapply interp_proper in Hinterp as (w2 & m3 & Hinterp3 & ?); last done.
+      exists w2, (S (m1 `max` m2 `max` m3)). rewrite interp_S /=.
+      rewrite (interp_le Hinterp1) /=; last lia.
+      rewrite (force_deep_le Hforce) /=; last lia.
+      rewrite (interp_le Hinterp3) /=; last lia. done.
+    + (* EList *)
+      eexists (Some (VList _)), 1; rewrite interp_S /=; split; [done|].
+      do 2 f_equal. revert es0 Hsubst.
+      induction es; intros [] ?; simplify_eq/=; f_equal/=; auto.
+    + (* EAttr *)
+      eexists (Some (VAttr _)), 1; rewrite interp_S /=; split; [done|].
+      do 2 f_equal. apply map_eq=> x. rewrite !lookup_fmap.
+      pose proof (f_equal (.!! x) Hsubst) as Hx. rewrite !lookup_fmap in Hx.
+      destruct (αs !! x) as [[[]]|], (αs0 !! x) as [[[]]|];
+        simplify_eq/=; do 2 f_equal; auto.
+      apply indirects_env_proper, Hx. by rewrite !tattr_to_attr_from_attr.
+    + (* ELetAttr *)
+      destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_eq/=.
+      eapply interp_proper in Hinterp' as (mw' & m1 & Hinterp1 & ?); last done.
+      destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+      { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+      destruct (maybe VAttr _) eqn:Hattr; simplify_res; last first.
+      { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+        by assert (maybe VAttr w' = None) as -> by (by destruct v', w'). }
+      destruct v', w'; simplify_res.
+      eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & ?);
+        [|by apply subst_env_union_fmap_proper].
+      exists mw, (S (m1 `max` m2)). rewrite interp_S /=.
+      rewrite (interp_le Hinterp1) /=; last lia.
+      rewrite (interp_le Hinterp2) /=; last lia. done.
+    + (* EBinOp *)
+      destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp1; simplify_res.
+      eapply interp_proper in Hinterp1 as (mw1 & m1 & Hinterp1 & Hw1); last done.
+      destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+      { exists None. exists (S m1). by rewrite interp_S /= Hinterp1. }
+      apply (interp_bin_op_proper op0) in Hw1.
+      destruct (interp_bin_op _ v1) as [f|] eqn:Hop1,
+        (interp_bin_op _ w1) as [g|] eqn:Hop2; simplify_res; try done; last first.
+      { exists None. exists (S m1). by rewrite interp_S /= Hinterp1 /= Hop2. }
+      destruct (interp n _ e1_2) as [mv2|] eqn:Hinterp2; simplify_res.
+      eapply interp_proper in Hinterp2 as (mw2 & m2 & Hinterp2 & Hw2); last done.
+      destruct mv2 as [v2|], mw2 as [w2|]; simplify_res; last first.
+      { exists None. exists (S (m1 `max` m2)). rewrite interp_S /=.
+        rewrite (interp_le Hinterp1) /=; last lia.
+        rewrite Hop2 /= (interp_le Hinterp2) /=; last lia. done. }
+      apply Hw1 in Hw2.
+      destruct (f v2) as [t|] eqn:Hf,
+        (g w2) as [t'|] eqn:Hg; simplify_res; last first.
+      { exists None. exists (S (m1 `max` m2)). rewrite interp_S /=.
+        rewrite (interp_le Hinterp1) /=; last lia.
+        rewrite Hop2 /= (interp_le Hinterp2) /=; last lia. by rewrite Hg. }
+      eapply interp_thunk_proper in Hinterp
+        as (mw & m3 & Hforce3 & Hw); [|by eauto..].
+      exists mw, (S (m1 `max` m2 `max` m3)). rewrite interp_S /=. split; [|done].
+      rewrite (interp_le Hinterp1) /=; last lia.
+      rewrite Hop2 /= (interp_le Hinterp2) /=; last lia.
+      rewrite Hg /=. eauto using interp_thunk_le with lia.
+    + (* EIf *)
+      destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp1; simplify_res.
+      eapply interp_proper in Hinterp1 as (mw1 & m1 & Hinterp1 & Hw1); last done.
+      destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+      { exists None. exists (S m1). by rewrite interp_S /= Hinterp1. }
+      destruct (maybe_VLit _ ≫= maybe LitBool) as [b|] eqn:Hbool;
+        simplify_res; last first.
+      { exists None. exists (S m1). rewrite interp_S /= Hinterp1 /=.
+        destruct v1, w1; repeat destruct select base_lit; naive_solver. }
+      eapply (interp_proper _ _ _ _ (if b then _ else _)) in Hinterp
+        as (mw & m2 & Hinterp & Hw); last by destruct b.
+      exists mw, (S (m1 `max` m2)). split; [|done]. rewrite interp_S /=.
+      rewrite (interp_le Hinterp1) /=; last lia.
+      assert (maybe_VLit w1 ≫= maybe LitBool = Some b) as ->.
+      { destruct v1, w1; repeat destruct select base_lit; naive_solver. }
+      rewrite /=. eauto using interp_le with lia.
+  (* interp_thunk_proper *)
+  - destruct n as [|n]; [done|].
+    intros Ht Hinterp. rewrite interp_thunk_S in Hinterp.
+    destruct t1 as [v1|E1 e1|x1 E1 tαs1], t2 as [v2|E2 e2|x2 E2 tαs2]; simplify_res.
+    + exists (Some v2), 1. rewrite interp_thunk_S /=. auto with f_equal.
+    + destruct (interp_val_to_expr E2 e2 v1) as (w & m & ? & ?); first done.
+      exists (Some w), (S m); simpl; auto with f_equal.
+    + by destruct v1.
+    + exists (Some v2), 1; split; [done|]; simpl.
+      symmetry. eauto using interp_val_to_expr_Res.
+    + eapply interp_proper in Hinterp as (mw & m & ? & ?); eauto.
+      exists mw, (S m). eauto.
+    + assert (∃ αs1, e1 = ESelect (EAttr αs1) x2 ∧
+        attr_subst_env E1 <$> αs1 = tattr_to_attr E2 <$> tαs2) as (αs1 & -> & Hαs).
+      { repeat match goal with
+        | H : subst_env _ ?e = _ |- _ =>
+            rewrite subst_env_eq in H; destruct e; simplify_eq; []
+        end; eauto. }
+      clear Ht. destruct n as [|n]; [done|].
+      rewrite !interp_S /= in Hinterp.
+      (* without [in Hinterp at 2 3] the termination checker loops *)
+      destruct n as [|n'] in Hinterp at 2 3; [done|].
+      rewrite !interp_S /= lookup_fmap in Hinterp.
+      pose proof (f_equal (.!! x2) Hαs) as Hx. rewrite !lookup_fmap in Hx.
+      destruct (αs1 !! x2) as [[[] e1]|],
+        (tαs2 !! x2) as [[e2|t2]|] eqn:Hx2; simplify_res.
+      * rewrite -tattr_to_attr_from_attr in Hαs.
+        destruct n as [|n]; [done|]. rewrite interp_thunk_S in Hinterp.
+        eapply interp_proper in Hinterp as (mw & m & Hinterp & ?);
+          last by apply indirects_env_proper.
+        exists mw, (S m). by rewrite interp_thunk_S /= Hx2.
+      * eapply interp_thunk_proper in Hinterp
+          as (mw & m & Hinterp & ?); last done.
+        exists mw, (S m). rewrite interp_thunk_S /= Hx2. done.
+      * exists None, (S n). by rewrite interp_thunk_S /= Hx2.
+    + by destruct v2.
+    + assert (∃ αs2, e2 = ESelect (EAttr αs2) x1 ∧
+        attr_subst_env E2 <$> αs2 = tattr_to_attr E1 <$> tαs1) as (αs2 & -> & Hαs).
+      { repeat match goal with
+        | H : _ = subst_env _ ?e |- _ =>
+            rewrite subst_env_eq in H; destruct e; simplify_eq; []
+        end; eauto. }
+      clear Ht.
+      pose proof (f_equal (.!! x1) Hαs) as Hx. rewrite !lookup_fmap in Hx.
+      destruct (tαs1 !! x1) as [[e1|t1]|],
+        (αs2 !! x1) as [[[] e2]|] eqn:Hx2; simplify_res.
+      * rewrite -tattr_to_attr_from_attr in Hαs.
+        eapply interp_proper in Hinterp as (mw & m & Hinterp & ?);
+          last by apply indirects_env_proper.
+        exists mw, (S (S (S m))). rewrite interp_thunk_S /= !interp_S /=.
+        rewrite lookup_fmap Hx2 /= interp_thunk_S /=. done.
+      * apply (interp_thunk_proper _ _ (Thunk E2 e2))
+          in Hinterp as (mw & m & Hinterp & ?); last done.
+        destruct m as [|m]; [done|].
+        exists mw, (S (S (S m))). rewrite interp_thunk_S /= !interp_S /=.
+        rewrite lookup_fmap Hx2 /= interp_thunk_S /=. done.
+      * exists None, (S (S (S n))). rewrite interp_thunk_S /= !interp_S /=.
+        rewrite lookup_fmap Hx2 /=. done.
+    + pose proof (f_equal (.!! x2) Ht) as Hx. rewrite !lookup_fmap in Hx.
+      destruct (tαs1 !! x2) as [[e1|t1]|] eqn:Hx1,
+        (tαs2 !! _) as [[e2|t2]|] eqn:Hx2; simplify_res.
+      * eapply interp_proper in Hinterp
+          as (mw & m & Hinterp & ?); [|by apply indirects_env_proper].
+        exists mw, (S m). rewrite interp_thunk_S /= Hx2. done. 
+      * eapply interp_thunk_proper in Hinterp as (mw & m & Hinterp & ?); [|done].
+        exists mw, (S m). rewrite interp_thunk_S /= Hx2. done.
+      * exists None, 1. by rewrite interp_thunk_S /= Hx2.
+  (* interp_app_proper *)
+  - destruct n as [|n]; [done|].
+    intros Hv Ht Hinterp. rewrite interp_app_S /= in Hinterp.
+    destruct v1, v2; simplify_res.
+    + (* VLit *) by eexists None, 1.
+    + (* VClo *)
+      eapply interp_proper in Hinterp as (mw & m & Hinterp' & ?);
+        last by eapply subst_env_insert_proper.
+      eexists _, (S m). rewrite interp_app_S /= Hinterp'. done.
+    + (* VCloMatch *)
+      destruct (interp_thunk n t1') as [mv1|] eqn:Hthunk; simplify_res.
+      eapply interp_thunk_proper in Hthunk as (mw1 & m1 & Hthunk & Hw); [|by eauto..].
+      destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+      { exists None, (S m1). split; [|done].
+        rewrite interp_app_S /= Hthunk /=. done. }
+      destruct (maybe VAttr v1) as [ts1|] eqn:?; simplify_res; last first.
+      { exists None, (S m1). split; [|done].
+        rewrite interp_app_S /= Hthunk /=. destruct v1, w1; naive_solver. }
+      destruct v1, w1; simplify_eq/=.
+      rewrite 2!map_fmap_compose in Hw. apply (inj _) in Hw.
+      eapply (interp_match_proper _ _ _ _ _ _ strict0) in Hw; last done.
+      destruct (interp_match ts1 _ _) as [tαs1|] eqn:Hmatch1,
+        (interp_match ts0 _ _) as [tαs2|] eqn:Hmatch2;
+        simplify_res; try done; last first.
+      { exists None, (S m1). split; [|done].
+        rewrite interp_app_S /= Hthunk /= Hmatch2. done. }
+      eapply interp_proper in Hinterp as (mw & m2 & Hinterp & ?); last first.
+      { by apply indirects_env_proper. }
+      exists mw, (S (m1 `max` m2)). split; [|done].
+      rewrite interp_app_S /=.
+      rewrite (interp_thunk_le Hthunk) /=; last lia.
+      rewrite Hmatch2 /=. eauto using interp_le with lia.
+    + (* VList *) by eexists None, 1.
+    + (* VAttr *)
+      pose proof (f_equal (.!! "__functor") Hv) as Htf.
+      rewrite !lookup_fmap /= in Htf.
+      destruct (ts !! _) as [e|] eqn:Hfunc, (ts0 !! _) as [e'|] eqn:Hfunc';
+        simplify_res; last first.
+      { exists None, 1. by rewrite interp_app_S /= Hfunc'. }
+      destruct (interp_thunk _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+      eapply interp_thunk_proper in Hinterp'
+        as (mw' & m1 & Hinterp1 & Hw'); [|by eauto..].
+      destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+      { exists None, (S m1). by rewrite interp_app_S /= Hfunc' /= Hinterp1. }
+      destruct (interp_app _ _ _) as [mv'|] eqn:Happ; simplify_res.
+      eapply (interp_app_proper _ _ _ _ (Forced (VAttr _))) in Happ
+        as (mw' & m2 & Happ2 & ?); [|done|by rewrite /= Hv].
+      destruct mv', mw'; simplify_res; last first.
+      { exists None, (S (m1 `max` m2)). rewrite interp_app_S /= Hfunc' /=.
+        rewrite (interp_thunk_le Hinterp1) /=; last lia.
+        rewrite (interp_app_le Happ2) /=; last lia. done. }
+      eapply interp_app_proper in Hinterp as (mw' & m3 & Happ3 & ?); [|done..].
+      exists mw', (S (m1 `max` m2 `max` m3)). rewrite interp_app_S /= Hfunc' /=.
+      rewrite (interp_thunk_le Hinterp1) /=; last lia.
+      rewrite (interp_app_le Happ2) /=; last lia.
+      rewrite (interp_app_le Happ3) /=; last lia. done.
+Qed.
+
+Lemma mapM_interp_proper n ts1 ts2 mvs :
+  thunk_to_expr <$> ts1 = thunk_to_expr <$> ts2 →
+  mapM (mbind (force_deep n) ∘ interp_thunk n) ts1 = Res mvs →
+  ∃ mws m, mapM (mbind (force_deep m) ∘ interp_thunk m) ts2 = Res mws ∧
+           fmap (M:=list) val_to_expr <$> mvs = fmap (M:=list) val_to_expr <$> mws.
+Proof. eauto using mapM_interp_proper', force_deep_proper, interp_thunk_proper. Qed.
+
+Lemma interp_thunk_as_interp n t mv :
+  interp_thunk n t = Res mv →
+  ∃ mw m, interp m ∅ (thunk_to_expr t) = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  revert t mv. induction n as [|n IH]; intros t mv Hinterp; [done|].
+  rewrite interp_thunk_S in Hinterp. destruct t as [v|E e|x E tαs]; simplify_res.
+  { destruct (interp_empty_val_to_expr v) as (w & m & Hinterp & ?).
+    exists (Some w), m; simpl; auto using f_equal. }
+  { eapply interp_proper, Hinterp. by rewrite subst_env_empty. }
+  destruct (tαs !! x) as [[e|t]|] eqn:Hx; simplify_res.
+  - eapply interp_proper in Hinterp as (mw & m & Hinterp & ?);
+      last apply subst_env_indirects_env.
+    exists mw, (S (S m)). rewrite !interp_S /=.
+    rewrite !lookup_fmap Hx /= interp_thunk_S /=. done.
+  - apply IH in Hinterp as (mw & m & Hinterp & ?).
+    exists mw, (S (S m)). rewrite !interp_S /=.
+    rewrite !lookup_fmap Hx /= interp_thunk_S //=.
+  - exists None, (S (S n)). rewrite !interp_S /=.
+    by rewrite !lookup_fmap Hx /=.
+Qed.
+
+Lemma interp_as_interp_thunk n t mv :
+  interp n ∅ (thunk_to_expr t) = Res mv →
+  ∃ mw m, interp_thunk m t = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  revert t mv. induction (lt_wf n) as [[|n] _ IH]; intros t mv Hinterp; [done|].
+  destruct t as [v|E e|x E tαs]; simplify_res.
+  { apply interp_empty_val_to_expr_Res in Hinterp. by exists (Some v), 1. }
+  { eapply (interp_proper _ _ E) in Hinterp as (mw & m & Hinterp & ?);
+      [|by rewrite subst_env_empty].
+    exists mw, (S m). by rewrite interp_thunk_S /=. }
+  destruct n as [|n]; [done|]. rewrite !interp_S /= in Hinterp.
+  rewrite !lookup_fmap in Hinterp.
+  destruct (tαs !! x) as [[e|t]|] eqn:Hx; simplify_res.
+  - rewrite interp_thunk_S /= in Hinterp.
+    eapply interp_proper in Hinterp as (mw & m & Hinterp & ?);
+      last apply symmetry, subst_env_indirects_env.
+    exists mw, (S m). rewrite interp_thunk_S /= Hx. done.
+  - rewrite interp_thunk_S /= in Hinterp.
+    eapply IH in Hinterp as (mw & m & Hinterp & ?); last lia.
+    exists mw, (S m). rewrite !interp_thunk_S /= Hx. done.
+  - exists None, (S n). rewrite !interp_thunk_S /= Hx. done.
+Qed.
+
+Lemma delayed_interp n e e' mv :
+  interp n ∅ e' = Res mv →
+  e =D=> e' →
+  ∃ m, interp m ∅ e = Res mv.
+Proof.
+  intros Hinterp Hdel. revert n mv Hinterp. induction Hdel; intros n mv Hinterp.
+  - by eauto.
+  - apply IHHdel in Hinterp as [m Hinterp].
+    exists (S (S m)). rewrite interp_S /= lookup_empty left_id_L /=.
+    by rewrite interp_thunk_S /=.
+  - destruct n as [|n]; [done|]. rewrite interp_S /= in Hinterp.
+    destruct (interp _ _ e1') as [mv1|] eqn:Hinterp1; simplify_res.
+    apply IHHdel1 in Hinterp1 as [m1 Hinterp1].
+    destruct mv1 as [v1|]; simplify_res; last first.
+    { exists (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (interp_bin_op op v1) as [f|] eqn:Hf; simplify_res; last first.
+    { exists (S m1). by rewrite interp_S /= Hinterp1 /= Hf. }
+    destruct (interp _ _ e2') as [mv2|] eqn:Hinterp2; simplify_res.
+    apply IHHdel2 in Hinterp2 as [m2 Hinterp2]. exists (S (n `max` m1 `max` m2)).
+    rewrite interp_S /= (interp_le Hinterp1); last lia.
+    rewrite /= Hf /= (interp_le Hinterp2); last lia.
+    destruct mv2; simplify_res; [|done].
+    destruct (f _); simplify_res; [|done].
+    eauto using interp_thunk_le with lia.
+  - destruct n as [|n]; [done|]. rewrite interp_S /= in Hinterp.
+    destruct (interp _ _ e1') as [mv1|] eqn:Hinterp1; simplify_res.
+    apply IHHdel1 in Hinterp1 as [m1 Hinterp1].
+    destruct mv1 as [v1|]; simplify_res; last first.
+    { exists (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe_VLit v1 ≫= maybe LitBool) as [[]|] eqn: Hbool; simplify_res.
+    + apply IHHdel2 in Hinterp as [m2 Hinterp2]. exists (S (m1 `max` m2)).
+      rewrite interp_S /= (interp_le Hinterp1); last lia.
+      rewrite /= Hbool /=. eauto using interp_le with lia.
+    + apply IHHdel3 in Hinterp as [m3 Hinterp3]. exists (S (m1 `max` m3)).
+      rewrite interp_S /= (interp_le Hinterp1); last lia.
+      rewrite /= Hbool /=. eauto using interp_le with lia.
+    + exists (S m1). rewrite interp_S /= Hinterp1 /= Hbool. done.
+Qed.
+
+Lemma interp_subst_abs n x e1 e2 mv :
+  interp n ∅ (subst {[x:=(ABS, e2)]} e1) = Res mv →
+  ∃ mw m, interp m (<[x:=(ABS, Thunk ∅ e2)]> ∅) e1 = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  apply interp_proper. by rewrite subst_env_empty subst_abs_as_subst_env.
+Qed.
+
+Lemma interp_subst_indirects n e αs mv :
+  interp n ∅ (subst (indirects αs) e) = Res mv →
+  ∃ mw m,
+    interp m (indirects_env ∅ (attr_to_tattr ∅ <$> αs)) e = Res mw ∧
+    val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  apply interp_proper. rewrite subst_env_empty. rewrite subst_env_alt.
+  f_equal. apply map_eq=> x. rewrite !lookup_fmap.
+  destruct (αs !! x) eqn:?; do 2 f_equal/=;
+    rewrite /indirects /indirects_env right_id_L !map_lookup_imap
+      !lookup_fmap !Heqo //=.
+  rewrite tattr_to_attr_from_attr_empty //.
+Qed.
+
+Lemma interp_subst_fmap k n e es mv :
+  interp n ∅ (subst ((k,.) <$> es) e) = Res mv →
+  ∃ mw m, interp m ((k,.) ∘ Thunk ∅ <$> es) e = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  apply interp_proper. rewrite subst_env_empty. rewrite subst_env_alt.
+  f_equal. apply map_eq=> x. rewrite !lookup_fmap.
+  destruct (es !! x) as [d|]; do 2 f_equal/=. by rewrite subst_env_empty.
+Qed.
+
+Lemma final_interp μ e :
+  final μ e →
+  ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w.
+Proof.
+  revert μ. induction e; intros μ'; intros Hfinal; try by inv Hfinal.
+  - inv Hfinal. eexists (VLit _ _), 1. by rewrite interp_lit /=.
+  - eexists (VClo _ _ _), 1. rewrite interp_S /=. split; [done|].
+    by rewrite /= subst_env_empty.
+  - eexists (VCloMatch _ _ _ _), 1. rewrite interp_S /=. split; [done|].
+    rewrite /= subst_env_empty. f_equal.
+    apply map_eq=> x. rewrite lookup_fmap.
+    destruct (ms !! x) as [[]|]; do 2 f_equal/=. by rewrite subst_env_empty.
+  - eexists (VList _), 1. rewrite interp_S /=. split; [done|]. f_equal. clear.
+    induction es; f_equal/=; [|done].
+    by rewrite /= subst_env_empty.
+  - eexists (VAttr _), 1. rewrite interp_S /=. split; [done|].
+    f_equal. apply map_eq=> x.
+    assert (no_recs αs) by (by inv Hfinal).
+    rewrite from_attr_no_recs // !lookup_fmap.
+    destruct (_ !! _) as [[]|] eqn:?; f_equal/=.
+    f_equal; eauto using no_recs_lookup, subst_env_empty.
+Qed.
+
+Lemma final_force_deep' v :
+  final DEEP (val_to_expr v) →
+  ∃ w m, force_deep m v = mret w ∧ val_to_expr v = val_to_expr w.
+Proof.
+  intros Hfinal. remember (val_to_expr v) as e eqn:He.
+  revert v He. induction e; intros [] ?; simplify_eq/=; inv Hfinal.
+  - (* VLit *) eexists (VLit _ _), 1. by rewrite force_deep_S.
+  - (* VClo *)
+    eexists (VClo _ _ _), 1. by rewrite force_deep_S.
+  - (* VCloMatch *)
+    eexists (VCloMatch _ _ _ _), 1. by rewrite force_deep_S.
+  - (* VList *)
+    assert (∃ vs m, mapM (mbind (force_deep m) ∘ interp_thunk m) ts = mret vs ∧
+      val_to_expr <$> vs = thunk_to_expr <$> ts)
+      as (vs & m & Hmap & Hvs); last first.
+    { exists (VList (Forced <$> vs)), (S m). rewrite force_deep_S /= Hmap /=.
+      split; [done|]. f_equal. rewrite -Hvs.
+      clear. by induction vs; by f_equal/=. }
+    rewrite Forall_fmap in H1. induction H1 as [|t ts Ht ? IH]; simplify_eq/=.
+    { by exists [], 0. }
+    apply Forall_cons in H as [IHt IHts].
+    destruct IH as (ws & m1 & Hinterp1 & ?); simplify_eq/=; [done|]. clear IHts.
+    destruct (final_interp DEEP (thunk_to_expr t))
+      as (v' & m & Hinterp & ?); [done|].
+    apply interp_as_interp_thunk in Hinterp
+      as ([v''|] & m' & Hinterp & ?); simplify_res.
+    destruct (IHt Ht v'') as (w & m'' & Hforce & ?); [congruence|].
+    exists (w :: ws), (m1 `max` m' `max` m''); csimpl.
+    rewrite (interp_thunk_le Hinterp) /=; last lia.
+    rewrite (force_deep_le Hforce) /=; last lia.
+    rewrite (mapM_interp_le Hinterp1) /=; last lia. auto with f_equal.
+  - (* VAttr *) clear H1. assert (∃ vs m,
+      map_mapM_sorted attr_le
+        (mbind (force_deep m) ∘ interp_thunk m) ts = mret vs ∧
+      val_to_expr <$> vs = thunk_to_expr <$> ts)
+      as (vs & m & Hmap & Hvs); last first.
+    { exists (VAttr (Forced <$> vs)), (S m). rewrite force_deep_S /= Hmap /=.
+      split; [done|]. rewrite 2!map_fmap_compose -Hvs. f_equal.
+      apply map_eq=> x. rewrite !lookup_fmap. by destruct (vs !! x). }
+    induction ts as [|x t ts Hx ? IH] using (map_sorted_ind attr_le).
+    { exists ∅, 0. by rewrite map_mapM_sorted_empty. }
+    rewrite fmap_insert /= in H, H2.
+    apply map_Forall_insert in H as [IHt IHts]; last by rewrite lookup_fmap Hx.
+    apply map_Forall_insert in H2 as [Ht Hts]; last by rewrite lookup_fmap Hx.
+    apply IH in IHts as (ws & m1 & Hinterp1 & ?); clear IH; simplify_eq/=; last done.
+    destruct (final_interp DEEP (thunk_to_expr t))
+      as (v' & m & Hinterp & ?); [done|].
+    apply interp_as_interp_thunk in Hinterp
+      as ([v''|] & m' & Hinterp & ?); simplify_res.
+    destruct (IHt Ht v'') as (w & m'' & Hforce & ?); [congruence|].
+    exists (<[x:=w]> ws), (m1 `max` m' `max` m'').
+    rewrite fmap_insert map_mapM_sorted_insert //=.
+    rewrite (interp_thunk_le Hinterp) /=; last lia.
+    rewrite (force_deep_le Hforce) /=; last lia.
+    rewrite (map_mapM_interp_le Hinterp1) /=; last lia.
+    rewrite fmap_insert. auto with f_equal.
+Qed.
+
+Lemma interp_step μ e1 e2 :
+  e1 -{μ}-> e2 →
+  (∀ n mv,
+     ¬final SHALLOW e1 →
+     interp n ∅ e2 = Res mv →
+     exists mw m, interp m ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw) ∧
+  (∀ n v1 v2 mv,
+     μ = DEEP →
+     e1 = val_to_expr v1 →
+     e2 = val_to_expr v2 →
+     force_deep n v2 = Res mv →
+     exists mw m, force_deep m v1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw).
+Proof.
+  intros Hstep. induction Hstep; inv_step.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    apply interp_subst_abs in Hinterp as (mw & [|m] & Hinterp & Hv); simplify_eq/=.
+    exists mw, (S (S (S m))). split; [|done].
+    rewrite interp_S /= interp_app_S /= /= !interp_S /=.
+    rewrite -!interp_S /=. rewrite (interp_le Hinterp); last lia. done.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    destruct n as [|n]; simplify_eq/=. apply interp_match_Some_2 in H0.
+    apply interp_subst_indirects in Hinterp as (mw & m & Hinterp & ?).
+    exists mw, (S (S (S (S m)))); split; [|done].
+    rewrite !interp_S /= interp_app_S /= interp_thunk_S /= (interp_S m) /=.
+    rewrite from_attr_no_recs // map_fmap_compose H0 /=.
+    eauto using interp_le with lia.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    destruct n as [|[|[|n]]]; simplify_eq/=.
+    rewrite !interp_S /= -!interp_S in Hinterp.
+    destruct (interp _ _ e1) as [mw|] eqn:Hinterp'; simplify_res.
+    destruct mw as [w|]; simplify_res; last first.
+    { exists None, (S (S (S (S n)))). split; [|done].
+      rewrite 2!interp_S /= interp_app_S /=.
+      rewrite from_attr_no_recs // lookup_fmap H0 /=.
+      rewrite interp_thunk_S /= Hinterp'. done. }
+    destruct (interp_app _ _ _) as [mv'|] eqn:Happ; simplify_res.
+    eapply (interp_app_proper _ _ _ _
+      (Forced (VAttr (Thunk ∅ ∘ attr_expr <$> αs))))
+      in Happ as (mw' & m1 & Happ1 & Hw); [|done|]; last first.
+    { rewrite /= subst_env_eq /=. f_equal.
+      apply map_eq=> y. rewrite !lookup_fmap.
+      destruct (αs !! y) as [[]|] eqn:?; do 2 f_equal/=; eauto using no_recs_lookup. }
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S (S (S (S (n `max` m1))))). split; [|done].
+      rewrite 2!interp_S /= interp_app_S /=.
+      rewrite from_attr_no_recs // lookup_fmap H0 /=.
+      rewrite interp_thunk_S /= (interp_le Hinterp') /=; last lia.
+      rewrite (interp_app_le Happ1); last lia. done. }
+    eapply interp_app_proper in Hinterp as (mw & m2 & ? & Hinterp); [|done..].
+    exists mw, (S (S (S (S (n `max` m1 `max` m2))))). split; [|done].
+    rewrite !interp_S /= interp_app_S /=.
+    rewrite from_attr_no_recs // lookup_fmap H0 /=.
+    rewrite interp_thunk_S /= (interp_le Hinterp') /=; last lia.
+    rewrite (interp_app_le Happ1) /=; last lia.
+    eauto using interp_app_le with lia.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    destruct (final_interp μ' e1) as (v & m & Hinterp' & ->); first done.
+    destruct μ'.
+    { exists mv, (S (n `max` m)). rewrite interp_S /=.
+      rewrite (interp_le Hinterp) /=; last lia.
+      by rewrite (interp_le Hinterp') /=; last lia. }
+    destruct (final_force_deep' v) as (w & m' & Hforce & ?); first done.
+    exists mv, (S (n `max` m `max` m')). rewrite interp_S /=.
+    rewrite (interp_le Hinterp) /=; last lia.
+    rewrite (interp_le Hinterp') /=; last lia.
+    by rewrite (force_deep_le Hforce) /=; last lia.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    rewrite map_fmap_compose in Hinterp.
+    apply interp_subst_fmap in Hinterp as (mw & [|m] & Hinterp & Hv); simplify_eq/=.
+    rewrite map_fmap_compose in Hinterp.
+    exists mw, (S (S m)). rewrite !interp_S /= -interp_S.
+    rewrite from_attr_no_recs // right_id_L map_fmap_compose. done.
+  - split; last first.
+    { intros n [] v2 mv _ Hαs; simplify_eq/=. by destruct H. }
+    intros n mv _ Hinterp. destruct n as [|n]; [done|].
+    rewrite interp_S /= in Hinterp; simplify_res.
+    eexists _, 1; split; [by rewrite interp_S|].
+    do 2 f_equal/=. apply map_eq=> x /=. rewrite !lookup_fmap.
+    destruct (αs !! x) as [[[] ?]|]; do 2 f_equal/=.
+    by rewrite subst_env_indirects_env_attr_to_tattr_empty subst_env_empty.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    apply final_interp in H as (v1 & m1 & Hinterp1 & ->).
+    pose proof H1 as Hsem. apply interp_bin_op_Some_2 in H1 as [f Hf].
+    eapply final_interp in H0 as (v2 & m2 & Hinterp2 & ->).
+    eapply interp_bin_op_Some_Some_2 in H2 as (t3 & Hfv & Hdel); [|done..].
+    eapply delayed_interp in Hinterp as (m3 & Hinterp); [|done].
+    apply interp_as_interp_thunk in Hinterp as (mw & m & Hinterp3 & ?).
+    exists mw, (S (m `max` m1 `max` m2)). split; [|done]. rewrite interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    rewrite Hf /= (interp_le Hinterp2) /=; last lia.
+    rewrite Hfv /= (interp_thunk_le Hinterp3); last lia. done.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    exists mv, (S (S n)). rewrite !interp_S /= -interp_S.
+    eauto using interp_le with lia.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    exists mv, (S (S n)). rewrite !interp_S /= lookup_empty /=. done.
+  - split; [intros ?? []; constructor; by eauto|].
+    intros n [] [] mv _ Hts Hts' Hforce; simplify_eq.
+    destruct n as [|n]; [done|rewrite force_deep_S /= in Hforce].
+    destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_eq/=.
+    destruct IHHstep as [IH1 IH2].
+    apply symmetry, fmap_app_inv in Hts
+      as (ts1 & [|t1 ts1'] & ? & ? & ?); simplify_eq/=.
+    apply symmetry, fmap_app_inv in Hts'
+      as (ts2 & [|t2 ts2'] & Hts & ? & ?); simplify_eq/=.
+    assert (∃ mws m,
+      mapM (mbind (force_deep m) ∘ interp_thunk m) (ts1 ++ t1 :: ts1') = Res mws ∧
+      fmap (M:=list) val_to_expr <$> mvs = fmap (M:=list) val_to_expr <$> mws)
+      as (mws & m & Hmap' & Hmvs); last first.
+    { exists (VList ∘ fmap Forced <$> mws), (S m). rewrite force_deep_S /= Hmap'.
+      split; [done|].
+      destruct mvs as [vs|], mws as [ws|]; simplify_eq/=; do 2 f_equal.
+      rewrite list_eq_Forall2 Forall2_fmap in Hmvs.
+      by rewrite list_eq_Forall2 !Forall2_fmap. }
+    rewrite mapM_res_app in Hmap.
+    destruct (mapM _ ts2) as [mvs1|] eqn:Hmap1; simplify_res.
+    eapply mapM_interp_proper in Hmap1 as (mws1 & m1 & Hmap1 & ?); [|done].
+    destruct mvs1 as [vs1|], mws1 as [ws1|]; simplify_res; last first.
+    { exists None, m1. by rewrite mapM_res_app Hmap1. }
+    destruct (interp_thunk n t2) as [mw|] eqn:Hinterp; simplify_res.
+    apply interp_thunk_as_interp in Hinterp as (mw' & m & Hinterp & Hmw').
+    destruct (default mfail (force_deep n <$> mw))
+      as [mu|] eqn:Hforce; simplify_res.
+    destruct (step_any_shallow  _ _ _ Hstep) as [|Hfinal1].
+    + (* SHALLOW *)
+      apply IH1 in Hinterp as (mw'' & m' & Hinterp & Hmw'');
+        [|by eauto using step_not_final].
+      apply interp_as_interp_thunk in Hinterp as (mw''' & m2 & Hinterp & ?).
+      destruct mw as [w|], mw', mw'', mw''' as [w'''|]; simplify_res; last first.
+      { exists None, (m1 `max` m2). rewrite mapM_res_app.
+        rewrite (mapM_interp_le Hmap1) /=; last lia.
+        rewrite (interp_thunk_le Hinterp) /=; last lia. done. }
+      eapply (force_deep_proper _ _ w''')
+        in Hforce as (mu' & m3 & Hforce & ?); last congruence.
+      destruct mu as [u|], mu' as [u'|]; simplify_res; last first.
+      { exists None, (m1 `max` m2 `max` m3). rewrite mapM_res_app.
+        rewrite (mapM_interp_le Hmap1) /=; last lia.
+        rewrite (interp_thunk_le Hinterp) /=; last lia.
+        rewrite (force_deep_le Hforce) /=; last lia. done. }
+      destruct (mapM _ ts2') as [mvs2|] eqn:Hmap2; simplify_res.
+      eapply mapM_interp_proper in Hmap2 as (mws2 & m4 & Hmap2 & ?); [|done].
+      exists ((ws1 ++.) ∘ (u' ::.) <$> mws2), (m1 `max` m2 `max` m3 `max` m4).
+      rewrite mapM_res_app.
+      rewrite (mapM_interp_le Hmap1) /=; last lia.
+      rewrite (interp_thunk_le Hinterp) /=; last lia.
+      rewrite (force_deep_le Hforce) /=; last lia.
+      rewrite (mapM_interp_le Hmap2) /=; last lia. split; [by destruct mws2|].
+      destruct mvs2, mws2; simplify_res; f_equal. rewrite !fmap_app !fmap_cons.
+      congruence.
+    + (* DEEP *)
+      apply step_final_shallow in Hstep as Hfinal2; last done.
+      apply final_interp in Hfinal1 as (w1 & m2 & Hinterpt1 & ?).
+      apply interp_as_interp_thunk in Hinterpt1 as (mw'' & m3 & Hinterpt1 & ?).
+      apply final_interp in Hfinal2 as (w2' & m4 & Hinterpt2 & ?).
+      eapply interp_agree in Hinterp; last apply Hinterpt2.
+      destruct mw as [w2|], mw'' as [w2''|]; simplify_res.
+      eapply IH2 in Hforce as (mu' & m5 & Hforce & ?); [|by auto with congruence..].
+      eapply (force_deep_proper _ _ w2'')
+        in Hforce as (mu'' & m6 & Hforce & ?); last congruence.
+      destruct mu as [u|], mu' as [u'|], mu'' as [u''|]; simplify_res; last first.
+      { exists None, (m1 `max` m3 `max` m6). rewrite mapM_res_app.
+        rewrite (mapM_interp_le Hmap1) /=; last lia.
+        rewrite (interp_thunk_le Hinterpt1) /=; last lia.
+        rewrite (force_deep_le Hforce) /=; last lia. done. }
+      destruct (mapM _ ts2') as [mvs2|] eqn:Hmap2; simplify_res.
+      eapply mapM_interp_proper in Hmap2 as (mws2 & m7 & Hmap2 & ?); [|done].
+      exists ((ws1 ++.) ∘ (u'' ::.) <$> mws2), (m1 `max` m3 `max` m6 `max` m7).
+      rewrite mapM_res_app.
+      rewrite (mapM_interp_le Hmap1) /=; last lia.
+      rewrite (interp_thunk_le Hinterpt1) /=; last lia.
+      rewrite (force_deep_le Hforce) /=; last lia.
+      rewrite (mapM_interp_le Hmap2) /=; last lia. split; [by destruct mws2|].
+      destruct mvs2, mws2; simplify_res; f_equal. rewrite !fmap_app !fmap_cons.
+      congruence.
+  - split; [intros ?? []; constructor; by eauto using no_recs_insert|].
+    intros n [] [] mv _ Hts Hts' Hforce; simplify_eq.
+    destruct n as [|n]; [done|rewrite force_deep_S /= in Hforce].
+    destruct (map_mapM_sorted _ _ _) as [mvs|] eqn:Hmap; simplify_eq/=.
+    destruct IHHstep as [IH1 IH2].
+    apply symmetry, fmap_insert_inv in Hts
+      as (t1 & ts1 & ? & Hx1 & ? & ?); simplify_eq/=; last done.
+    apply symmetry, fmap_insert_inv in Hts' as (t2 & ts2 & ? & Hx2 & ? & Hts);
+      simplify_eq/=; last by rewrite lookup_fmap Hx1.
+    assert (∃ mws m,
+      map_mapM_sorted attr_le (mbind (force_deep m) ∘ interp_thunk m)
+        (<[x:=t1]> ts1) = Res mws ∧
+      fmap (M:=gmap _) val_to_expr <$> mvs = fmap (M:=gmap _) val_to_expr <$> mws)
+      as (mws & m & Hmap' & Hmvs); last first.
+    { exists (VAttr ∘ fmap Forced <$> mws), (S m). rewrite force_deep_S /= Hmap'.
+      split; [done|].
+      destruct mvs as [vs|], mws as [ws|]; simplify_eq/=; do 2 f_equal.
+      apply map_eq=> y. rewrite !lookup_fmap.
+      apply (f_equal (.!! y)) in Hmvs. rewrite !lookup_fmap in Hmvs.
+      destruct (vs !! _), (ws !! _); simplify_eq/=; auto with f_equal. }
+    destruct (step_any_shallow  _ _ _ Hstep) as [|Hfinal].
+    + (* SHALLOW *) assert (map_Forall2 (λ _ t1 t2, ∀ n mv,
+        interp n ∅ (thunk_to_expr t2) = Res mv →
+        ∃ mw m, interp m ∅ (thunk_to_expr t1) = Res mw ∧
+          val_to_expr <$> mv = val_to_expr <$> mw)
+        (<[x:=t1]> ts1) (<[x:=t2]> ts2)) as IHts.
+      { apply map_Forall2_insert_2; first by eauto using step_not_final.
+        intros y. apply (f_equal (.!! y)) in Hts. rewrite !lookup_fmap in Hts.
+        destruct (ts1 !! y), (ts2 !! y); simplify_eq/=; constructor.
+        rewrite -Hts; eauto. }
+      revert IHts Hmap. generalize (<[x:=t1]> ts1) (<[x:=t2]> ts2). clear.
+      intros ts1. revert n mvs.
+      induction ts1 as [|x t1 ts1 ?? IH] using (map_sorted_ind attr_le);
+        intros n mvs ts2' IHts Hmap.
+      { apply map_Forall2_empty_inv_l in IHts as ->.
+        rewrite map_mapM_sorted_empty in Hmap; simplify_res.
+        by exists (Some ∅), 1. }
+      apply map_Forall2_insert_inv_l in IHts
+        as (t2 & ts2 & -> & ? & IHt & IHts); simplify_eq/=; last done.
+      assert (∀ j, is_Some (ts2 !! j) → attr_le x j).
+      { apply map_Forall2_dom_L in IHts. intros j.
+        rewrite -elem_of_dom -IHts elem_of_dom. auto. }
+      rewrite map_mapM_sorted_insert //= in Hmap.
+      destruct (interp_thunk _ _) as [mv|] eqn:Hinterp; simplify_res.
+      assert (∃ mw m, interp_thunk m t1 = Res mw ∧
+        val_to_expr <$> mv = val_to_expr <$> mw) as (mw & m1 & Hinterp1 & ?).
+      { apply interp_thunk_as_interp in Hinterp as (mw & m & Hinterp & ?).
+        apply IHt in Hinterp as (mw' & m' & Hinterp & ?).
+        eapply interp_as_interp_thunk in Hinterp as (mw'' & m'' & Hinterp & ?).
+        exists mw'', m''. eauto with congruence. }
+      destruct mv as [v|], mw as [w|]; simplify_res; last first.
+      { exists None, m1. split; [|done]. rewrite map_mapM_sorted_insert //=.
+        by rewrite Hinterp1. }
+      destruct (force_deep _ _) as [mv|] eqn:Hforce; simplify_res.
+      eapply force_deep_proper in Hforce as (mw & m2 & Hforce' & ?); last done.
+      destruct mv as [v'|], mw as [w'|]; simplify_res; last first.
+      { exists None, (m1 `max` m2). split; [|done].
+        rewrite map_mapM_sorted_insert //=.
+        rewrite (interp_thunk_le Hinterp1) /=; last lia.
+        rewrite (force_deep_le Hforce') /=; last lia. done. }
+      destruct (map_mapM_sorted _ _ _) as [mvs'|] eqn:Hmap'; simplify_res.
+      apply IH in Hmap' as (mws & m3 & Hmap3 & ?); last done.
+      exists (fmap <[x:=w']> mws), (m1 `max` m2 `max` m3).
+      rewrite map_mapM_sorted_insert //=.
+      rewrite (interp_thunk_le Hinterp1) /=; last lia.
+      rewrite (force_deep_le Hforce') /=; last lia.
+      rewrite (map_mapM_interp_le Hmap3) /=; last lia.
+      destruct mvs', mws; simplify_res; last done.
+      rewrite !fmap_insert. auto with f_equal.
+    + (* DEEP *)
+      assert (map_Forall2 (λ _ t1 t2,
+        thunk_to_expr t1 = thunk_to_expr t2 ∨
+        ∃ v1 v2,
+          thunk_to_expr t1 = val_to_expr v1 ∧
+          thunk_to_expr t2 = val_to_expr v2 ∧
+          ∀ n mv,
+            force_deep n v2 = Res mv →
+            ∃ mw m, force_deep m v1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw)
+        (<[x:=t1]> ts1) (<[x:=t2]> ts2)) as IHts.
+      { apply map_Forall2_insert_2; last first.
+        { intros y. apply (f_equal (.!! y)) in Hts. rewrite !lookup_fmap in Hts.
+          destruct (ts1 !! y), (ts2 !! y); simplify_eq/=; constructor; eauto. }
+        assert (final SHALLOW (thunk_to_expr t2))
+          as (v2 & m2 & Hinterp2 & Ht2)%final_interp
+          by eauto using step_final_shallow.
+        apply final_interp in Hfinal as (v1 & m1 & Hinterp1 & Ht1); eauto 10. }
+      revert IHts Hmap. generalize (<[x:=t1]> ts1) (<[x:=t2]> ts2). clear.
+      intros ts1. revert n mvs.
+      induction ts1 as [|x t1 ts1 ?? IH] using (map_sorted_ind attr_le);
+        intros n mvs ts2' IHts Hmap.
+      { apply map_Forall2_empty_inv_l in IHts as ->.
+        rewrite map_mapM_sorted_empty in Hmap; simplify_res.
+        by exists (Some ∅), 1. }
+      apply map_Forall2_insert_inv_l in IHts
+        as (t2 & ts2 & -> & ? & IHt & IHts); simplify_eq/=; last done.
+      assert (∀ j, is_Some (ts2 !! j) → attr_le x j).
+      { apply map_Forall2_dom_L in IHts. intros j.
+        rewrite -elem_of_dom -IHts elem_of_dom. auto. }
+      rewrite map_mapM_sorted_insert //= in Hmap.
+      destruct (interp_thunk n t2 ≫= force_deep n)
+        as [mv|] eqn:Hinterp; simplify_res.
+      assert (∃ mw m, interp_thunk m t1 ≫= force_deep m = Res mw ∧
+        val_to_expr <$> mv = val_to_expr <$> mw) as (mw & m1 & Hinterp1 & ?).
+      { destruct (interp_thunk _ _) as [mv'|] eqn:Hthunk; simplify_res.
+        destruct IHt as [|(v1 & v2 & Ht1 & Ht2 & IHt)].
+        * eapply interp_thunk_proper in Hthunk
+            as (mw' & m1 & Hthunk1 & ?); last done.
+          destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+          { exists None, m1. by rewrite Hthunk1. }
+          eapply force_deep_proper in Hinterp
+            as (mw & m2 & Hforce2 & ?); last done.
+          exists mw, (m1 `max` m2). split; [|done].
+          rewrite (interp_thunk_le Hthunk1) /=; last lia.
+          eauto using force_deep_le with lia.
+        * destruct (interp_empty_val_to_expr v1) as (v1' & m1 & Hinterp1 & ?).
+          rewrite -Ht1 in Hinterp1.
+          eapply interp_as_interp_thunk in Hinterp1
+            as ([v1''|] & m1' & Hthunk1 & ?); simplify_res.
+          eapply (interp_thunk_proper _ _ (Forced v2)) in Hthunk
+            as (mw2 & m2 & Hthunk2 & ?); simplify_res; [|done].
+          destruct m2 as [|m2]; [done|].
+          rewrite interp_thunk_S in Hthunk2; simplify_res.
+          destruct mv' as [v2'|]; simplify_res.
+          eapply force_deep_proper in Hinterp
+            as (mv' & m2' & Hforce2 & ?); last done.
+          eapply IHt in Hforce2 as (mw' & m2'' & Hforce2 & ?).
+          eapply (force_deep_proper _ _ v1'') in Hforce2
+            as (mw'' & m2''' & Hforce2 & ?); last congruence.
+          exists mw'', (m1' `max` m2''').
+          rewrite (interp_thunk_le Hthunk1) /=; last lia.
+          rewrite (force_deep_le Hforce2) /=; last lia. auto with congruence. }
+      destruct mv as [v|], mw as [w|]; simplify_res; last first.
+      { exists None, m1. split; [|done]. rewrite map_mapM_sorted_insert //=.
+        by rewrite Hinterp1. }
+      destruct (map_mapM_sorted _ _ _) as [mvs'|] eqn:Hmap'; simplify_res.
+      apply IH in Hmap' as (mws & m2 & Hmap2 & ?); last done.
+      exists (fmap <[x:=w]> mws), (m1 `max` m2).
+      rewrite map_mapM_sorted_insert //=.
+      destruct (interp_thunk m1 t1) as [[]|] eqn:Hinterp'; simplify_res.
+      rewrite (interp_thunk_le Hinterp') /=; last lia.
+      rewrite (force_deep_le Hinterp1) /=; last lia.
+      rewrite (map_mapM_interp_le Hmap2) /=; last lia.
+      destruct mvs', mws; simplify_res; last done.
+      rewrite !fmap_insert. auto with f_equal.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    destruct n as [|n]; simplify_eq/=.
+    rewrite interp_S /= in Hinterp.
+    destruct (interp n ∅ e') as [mv'|] eqn:Hinterp'; simplify_res.
+    apply IHHstep in Hinterp'
+      as (mw' & m1 & Hinterp1 & ?); last by eauto using step_not_final.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S m1). split; [|done]. by rewrite interp_S /= Hinterp1. }
+    eapply interp_app_proper in Hinterp as (mw & m2 & Happ2 & ?); [|done..].
+    exists mw, (S (m1 `max` m2)). rewrite interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    rewrite (interp_app_le Happ2) /=; last lia. done.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    destruct n as [|[|[|n]]]; simplify_eq/=.
+    rewrite !interp_S /= interp_app_S /= interp_thunk_S /= in Hinterp.
+    destruct (interp n ∅ e') as [mv'|] eqn:Hinterp'; simplify_res.
+    apply IHHstep in Hinterp'
+      as (mw' & m1 & Hinterp1 & Hw'); last by eauto using step_not_final.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S (S (S m1))). split; [|done].
+      rewrite !interp_S /= interp_app_S /= interp_thunk_S /=.
+      by rewrite Hinterp1. }
+    destruct (maybe VAttr v') as [ts|] eqn:?; simplify_res; last first.
+    { exists None, (S (S (S m1))). split; [|done].
+      rewrite !interp_S /= interp_app_S /= interp_thunk_S /= Hinterp1 /=.
+      assert (maybe VAttr w' = None) as ->; [|done].
+      destruct v', w'; naive_solver. }
+    destruct v', w'; simplify_eq/=.
+    rewrite 2!map_fmap_compose in Hw'. apply (inj _) in Hw'.
+    eapply (interp_match_proper ∅ ∅ _ _ ms ms strict) in Hw'; [|done].
+    destruct (interp_match ts _ strict) as [tαs1|] eqn:Hmatch1,
+      (interp_match ts1 _ strict) as [tαs2|] eqn:Hmatch2;
+      simplify_res; try done; last first.
+    { exists None, (S (S (S m1))). split; [|done].
+      rewrite !interp_S /= interp_app_S /= interp_thunk_S /=.
+      rewrite Hinterp1 /= Hmatch2. done. }
+    eapply interp_proper in Hinterp
+      as (mw & m2 & Hinterp & ?); last first.
+    { by apply indirects_env_proper. }
+    exists mw, (S (S (S (m1 `max` m2)))). split; [|done].
+    rewrite !interp_S /= interp_app_S /= interp_thunk_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    rewrite Hmatch2 /=. eauto using interp_le with lia.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n _ e') as [mv'|] eqn:Hinterp'; simplify_eq/=.
+    destruct (step_any_shallow μ e e') as [|Hfinal]; first done.
+    + apply IHHstep in Hinterp'
+        as (mw' & m & Hinterp' & Hw); last by eauto using step_not_final.
+      destruct mv' as [v|], mw' as [w'|]; simplify_res; last first.
+      { exists None, (S m). by rewrite interp_S /= Hinterp'. }
+      destruct μ; simplify_res.
+      { exists mv, (S (n `max` m)). rewrite interp_S /=.
+        rewrite (interp_le Hinterp') /=; last lia.
+        rewrite (interp_le Hinterp) /=; last lia. done. }
+      destruct (force_deep n v) as [mv'|] eqn:Hforce; simplify_res.
+      eapply force_deep_proper
+        in Hforce as (mw' & m2 & Hforce2 & ?); last done.
+      exists mv, (S (n `max` m `max` m2)). split; [|done]. rewrite interp_S /=.
+      rewrite (interp_le Hinterp') /=; last lia.
+      rewrite (force_deep_le Hforce2) /=; last lia.
+      destruct mv', mw'; simplify_res; eauto using interp_le with lia.
+    + destruct μ; [by odestruct step_not_final|].
+      assert (final SHALLOW e') as (w & m & Hinterp'' & ->)%final_interp
+        by eauto using step_final_shallow.
+      apply interp_empty_val_to_expr_Res in Hinterp'.
+      destruct mv' as [v|]; simplify_res.
+      destruct (force_deep n v) as [mv'|] eqn:Hforce; simplify_res.
+      apply final_interp in Hfinal as (w' & m' & Hinterp''' & ->).
+      eapply IHHstep in Hforce as (mw' & m'' & Hforce' & ?); [|done..].
+      exists mv, (S (n `max` m' `max` m'')). rewrite interp_S /=.
+      rewrite (interp_le Hinterp''') /=; last lia.
+      rewrite (force_deep_le Hforce') /=; last lia.
+      destruct mv', mw'; simplify_res; eauto using interp_le with lia.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_eq/=.
+    apply IHHstep in Hinterp'
+      as (mw' & m1 & Hinterp1 & Hw); last by eauto using step_not_final.
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, (S m1). by rewrite interp_S /= Hinterp1. }
+    destruct (maybe VAttr _) eqn:Hattr; simplify_res; last first.
+    { exists None, (S m1). rewrite interp_S /= Hinterp1 /=.
+      by assert (maybe VAttr w' = None) as -> by (by destruct v', w'). }
+    destruct v', w'; simplify_res.
+    rewrite right_id_L in Hinterp.
+    eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & ?);
+      last by apply subst_env_fmap_proper.
+    exists mw, (S (m1 `max` m2)). rewrite !interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia. rewrite right_id_L.
+    by rewrite (interp_le Hinterp2) /=; last lia.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n _ e') as [mv1|] eqn:Hinterp1; simplify_eq/=.
+    apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1);
+      last by eauto using step_not_final.
+    destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+    { exists None, (S m). by rewrite interp_S /= Hinterp1. }
+    apply (interp_bin_op_proper op) in Hw1.
+    destruct (interp_bin_op _ v1) as [f|] eqn:Hopf; simplify_res; last first.
+    { exists None, (S m). rewrite interp_S /= Hinterp1 /=.
+      by destruct (interp_bin_op _ w1). }
+    destruct (interp_bin_op _ w1) as [g|] eqn:Hopg; simplify_res; [|done].
+    destruct (interp n _ e2) as [mv2|] eqn:Hinterp2; simplify_res.
+    destruct mv2 as [v2|]; simplify_res; last first.
+    { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=.
+      rewrite (interp_le Hinterp1) /=; last lia.
+      rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hopg. }
+    specialize (Hw1 v2 _ eq_refl).
+    destruct (f v2) as [t2|], (g v2) as [t2'|] eqn:Hg; simplify_res; last first.
+    { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=.
+      rewrite (interp_le Hinterp1) /=; last lia.
+      rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hopg /= Hg. }
+    eapply interp_thunk_proper in Hinterp as (mw & m' & Hthunk & ?); last done.
+    exists mw, (S (n `max` m `max` m')). split; [|done]. rewrite interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    rewrite (interp_le Hinterp2) /=; last lia. rewrite Hopg /= Hg /=.
+    rewrite (interp_thunk_le Hthunk) /=; last lia. done.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n ∅ e1) as [mw1|] eqn:Hinterp1; simplify_res.
+    apply final_interp in H0 as (v1 & m1 & Hinterp1' & ->).
+    apply interp_bin_op_Some_2 in H1 as [f Hop].
+    assert (mw1 = Some v1) as -> by eauto using interp_agree.
+    rewrite /= Hop /= in Hinterp.
+    destruct (interp _ _ e') as [mv2|] eqn:Hinterp2; simplify_res; last first.
+    apply IHHstep in Hinterp2 as (mw2 & m & Hinterp2 & Hw);
+      last by eauto using step_not_final.
+    destruct mv2 as [v2|], mw2 as [w2|]; simplify_res; last first.
+    { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=.
+      rewrite (interp_le Hinterp1) /=; last lia.
+      rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hop. }
+    pose proof @eq_refl as Hf%(interp_bin_op_proper op v1). rewrite !Hop in Hf.
+    apply Hf in Hw; clear Hf.
+    destruct (f v2) as [t|] eqn:Hf,
+      (f w2) as [t'|] eqn:Hf'; simplify_res; last first.
+    { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=.
+      rewrite (interp_le Hinterp1) /=; last lia.
+      rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hop /= Hf'. }
+    eapply interp_thunk_proper in Hinterp as (mw & m' & Hthunk & ?); last done.
+    exists mw, (S (n `max` m `max` m')). split; [|done]. rewrite interp_S /=.
+    rewrite (interp_le Hinterp1) /=; last lia.
+    rewrite (interp_le Hinterp2) /=; last lia. rewrite Hop /= Hf' /=.
+    eauto using interp_thunk_le with lia.
+  - split; [|by intros ? []]. intros n mv _ Hinterp.
+    destruct n as [|n]; [done|rewrite interp_S /= in Hinterp].
+    destruct (interp n _ e') as [mv1|] eqn:Hinterp1; simplify_eq/=.
+    apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1);
+      last by eauto using step_not_final.
+    destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first.
+    { exists None, (S m). by rewrite interp_S /= Hinterp1. }
+    exists mv, (S (n `max` m)). split; [|done].
+    rewrite interp_S /= (interp_le Hinterp1) /=; last lia.
+    assert (maybe_VLit w1 ≫= maybe LitBool = maybe_VLit v1 ≫= maybe LitBool) as ->.
+    { destruct v1, w1; repeat destruct select base_lit; naive_solver. }
+    destruct (maybe_VLit v1 ≫= maybe LitBool); simplify_res; [|done].
+    eauto using interp_le with lia.
+Qed.
+
+Lemma final_interp' μ e :
+  final μ e →
+  ∃ w m, interp' m μ ∅ e = mret w ∧ e = val_to_expr w.
+Proof.
+  intros Hfinal. destruct (final_interp _ _ Hfinal) as (w & m & Hinterp & ->).
+  destruct μ.
+  { exists w, m. by rewrite interp_shallow'. }
+  apply final_force_deep' in Hfinal as (w' & m' & Hforce & ?).
+  exists w', (m `max` m'); split; [|done]. rewrite /interp'.
+  rewrite (interp_le Hinterp) /=; last lia. eauto using force_deep_le with lia.
+Qed.
+
+Lemma force_deep_le' {n1 n2 μ v mv} :
+  force_deep' n1 μ v = Res mv → n1 ≤ n2 → force_deep' n2 μ v = Res mv.
+Proof. destruct μ; eauto using force_deep_le. Qed.
+
+Lemma interp_le' {n1 n2 μ E e mv} :
+  interp' n1 μ E e = Res mv → n1 ≤ n2 → interp' n2 μ E e = Res mv.
+Proof.
+  rewrite /interp'. intros.
+  destruct (interp n1 _ _) as [mw|] eqn:Hinterp; simplify_res.
+  rewrite (interp_le Hinterp); last lia.
+  destruct mw; simplify_res; eauto using force_deep_le'.
+Qed.
+
+Lemma interp_agree' {n1 n2 μ E e mv1 mv2} :
+  interp' n1 μ E e = Res mv1 → interp' n2 μ E e = Res mv2 → mv1 = mv2.
+Proof.
+  intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2).
+  - rewrite -He2. symmetry. eauto using interp_le'.
+  - rewrite -He1. eauto using interp_le'.
+Qed.
+
+Lemma interp_step' n μ e1 e2 mv :
+  e1 -{μ}-> e2 →
+  interp' n μ ∅ e2 = Res mv →
+  ∃ mw m, interp' m μ ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw.
+Proof.
+  intros Hstep. destruct μ.
+  { setoid_rewrite interp_shallow'.
+    eapply interp_step; eauto using step_not_final. }
+  intros Hinterp. rewrite /interp' in Hinterp.
+  destruct (interp n ∅ e2) as [mv'|] eqn:Hinterp'; simplify_res.
+  destruct (step_any_shallow _ _ _ Hstep) as [|Hfinal].
+  - eapply interp_step in Hinterp' as (mw' & m & Hinterp' & ?);
+      [|by eauto using step_not_final..].
+    destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first.
+    { exists None, m. by rewrite /interp' Hinterp'. }
+    eapply force_deep_proper in Hinterp as (mw' & m' & Hforce & ?); last done.
+    exists mw', (m `max` m'). rewrite /interp'.
+    rewrite (interp_le Hinterp') /=; last lia.
+    eauto using force_deep_le with lia.
+  - assert (final SHALLOW e2)
+      as (w2 & m2 & Hinterpw2 & ->)%final_interp by eauto using step_final_shallow.
+    apply final_interp in Hfinal as (w1 & m1 & Hinterpw1 & ->).
+    apply interp_empty_val_to_expr_Res in Hinterp'; destruct mv'; simplify_res.
+    eapply interp_step in Hstep as [_ Hstep].
+    eapply Hstep in Hinterp as (mw & m & Hforce & ?); [|done..].
+    exists mw, (m `max` m1). split; [|done]. rewrite /interp'.
+    rewrite (interp_le Hinterpw1) /=; last lia.
+    eauto using force_deep_le with lia.
+Qed.
+
+Lemma final_val_to_expr' n μ E e v :
+  interp' n μ E e = mret v → final μ (val_to_expr v).
+Proof.
+  rewrite /interp'. intros Hinterp.
+  destruct (interp _ _ e) as [[w|]|] eqn:Hinterp'; simplify_res.
+  destruct μ; simplify_res; eauto using final_force_deep.
+Qed.
+
+Lemma red_final_interp μ e :
+  red (step μ) e ∨ final μ e ∨ ∃ m, interp' m μ ∅ e = mfail.
+Proof.
+  revert μ. induction e; intros μ'.
+  - (* ELit *)
+    destruct (decide (base_lit_ok b)).
+    + right; left. by constructor.
+    + do 2 right. exists 1. rewrite /interp' interp_S /=. by case_guard.
+  - (* EId *) destruct mkd as [[k d]|].
+    + left. eexists; constructor.
+    + do 2 right. by exists 1.
+  - (* EAbs *) right; left. constructor.
+  - (* EAbsMatch *) right; left. constructor.
+  - (* EApp *) destruct (IHe1 SHALLOW) as [[??]|[Hfinal|[m Hinterp]]].
+    + left. eexists. by eapply SAppL.
+    + apply final_interp in Hfinal as ([] & m & _ & ->); simplify_res.
+      { do 2 right. exists 3. rewrite /interp' interp_S /= interp_lit //. }
+      { left. by repeat econstructor. }
+      { destruct (IHe2 SHALLOW) as [[??]|[Hfinal|[m2 Hinterp2]]].
+        * left. by repeat econstructor.
+        * apply final_interp in Hfinal as (w2 & m2 & Hinterp2 & ->).
+          destruct (maybe VAttr w2) as [ts|] eqn:Hw2; last first.
+          { do 2 right. exists (S (S (S m2))).
+            rewrite /interp' !interp_S /= interp_app_S /= interp_thunk_S /=.
+            rewrite Hinterp2 /= Hw2. done. }
+          destruct w2; simplify_eq/=.
+          destruct (interp_match ts (fmap (M:=option) (subst_env E) <$> ms) strict)
+            as [E'|] eqn:Hmatch; last first.
+          { do 2 right. exists (S (S (S m2))).
+            rewrite /interp' !interp_S /= interp_app_S /= interp_thunk_S /=.
+            rewrite Hinterp2 /= Hmatch. done. }
+          apply interp_match_Some_1 in Hmatch.
+          left. repeat econstructor; [done|].
+          by rewrite map_fmap_compose fmap_attr_expr_Attr.
+        * rewrite interp_shallow' in Hinterp2.
+          do 2 right. exists (S (S (S m2))).
+          rewrite /interp' !interp_S /= interp_app_S /= interp_thunk_S /=.
+          by rewrite Hinterp2. }
+      { do 2 right. by exists 3. }
+      destruct (ts !! "__functor") as [e|] eqn:Hfunc.
+      { left. repeat econstructor; by simplify_map_eq. }
+      do 2 right. exists (S (S m)). rewrite /interp' !interp_S /=.
+      rewrite interp_app_S /= !lookup_fmap Hfunc. done.
+    + rewrite interp_shallow' in Hinterp.
+      do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp.
+  - (* ESeq *) destruct (IHe1 μ) as [[??]|[Hfinal|[m Hinterp]]].
+    + left. eexists. by eapply SSeq.
+    + left. by repeat econstructor.
+    + do 2 right. exists (S m). rewrite /interp' interp_S /=.
+      rewrite /interp' in Hinterp.
+      destruct (interp _ _ e1) as [[]|], μ; simplify_res; [|done..].
+      by rewrite Hinterp.
+  - (* EList *)
+    destruct μ'.
+    { right; left. by constructor. }
+    assert (red (step DEEP) (EList es) ∨ Forall (final DEEP) es ∨
+      ∃ m, mapM (mbind (force_deep m) ∘ interp_thunk m)
+             (Thunk ∅ <$> es) = mfail) as Hhelp; last first.
+    { destruct Hhelp as [?|[?|[m Hinterp]]]; [by auto using final..|].
+      do 2 right. exists (S m). rewrite /interp' interp_S /=.
+      rewrite force_deep_S /=. by rewrite Hinterp. }
+    induction H as [|e es He Hes IH]; [by right; left|].
+    destruct (He DEEP) as [[??]|[Hfinal|[m Hinterp]]]; simplify_eq/=.
+    + left. eexists. by eapply (SList []).
+    + destruct IH as [[??]|[?|[m2 Hinterp2]]]; [|by eauto|].
+      * left. inv_step. eexists. eapply (SList (_ :: _)); by eauto.
+      * apply final_interp' in Hfinal as (w & m1 & Hinterp1 & _).
+        do 2 right. exists (S (m1 `max` m2)).
+        rewrite /interp' /force_deep' in Hinterp1.
+        destruct (interp m1 _ _) as [[]|] eqn:Hinterp1'; simplify_res.
+        rewrite interp_thunk_S /= (interp_le Hinterp1') /=; last lia.
+        rewrite (force_deep_le Hinterp1) /=; last lia.
+        rewrite (mapM_interp_le Hinterp2) /=; last lia. done.
+    + do 2 right. exists (S m).
+      rewrite /interp' /force_deep' in Hinterp.
+      destruct (interp m _ _) as [mw|] eqn:Hinterp1'; simplify_res.
+      rewrite interp_thunk_S /= Hinterp1' /=.
+      destruct mw as [w|]; simplify_res; [|done].
+      rewrite (force_deep_le Hinterp) /=; last lia. done.
+  - (* EAttr *) destruct (decide (no_recs αs)) as [Hrecs|]; last first.
+    { left. by repeat econstructor. }
+    destruct μ'.
+    { right; left. by constructor. }
+    assert (red (step DEEP) (EAttr αs) ∨
+      map_Forall (λ _, final DEEP ∘ attr_expr) αs ∨
+      ∃ m, map_mapM_sorted attr_le (mbind (force_deep m) ∘ interp_thunk m)
+             (Thunk ∅ ∘ attr_expr <$> αs) = mfail) as Hhelp; last first.
+    { destruct Hhelp as [?|[?|[m Hinterp]]]; [by auto using final..|].
+      do 2 right. exists (S m). rewrite /interp' interp_S /=.
+      rewrite from_attr_no_recs //. rewrite force_deep_S /=. by rewrite Hinterp. }
+    induction αs as [|x [τ e] es Hx ? IH]
+      using (map_sorted_ind attr_le); [by right; left|].
+    rewrite !map_Forall_insert //.
+    apply map_Forall_insert in H as [He Hes%IH]; clear IH;
+      [|by eauto using no_recs_insert_inv..].
+    assert (τ = NONREC) as -> by (by eapply no_recs_lookup, lookup_insert).
+    assert (∀ y, is_Some ((Thunk ∅ ∘ attr_expr <$> es) !! y) → attr_le x y).
+    { intros y. rewrite lookup_fmap fmap_is_Some. eauto. }
+    destruct (He DEEP) as [[??]|[Hfinal|[m Hinterp]]]; simplify_eq/=.
+    + left. eexists; eapply SAttr; naive_solver eauto using no_recs_insert_inv.
+    + destruct Hes as [[??]|[?|[m2 Hinterp2]]]; [|by eauto|].
+      * left. inv_step; first by naive_solver eauto using no_recs_insert_inv.
+        apply lookup_insert_None in Hx as [??].
+        rewrite insert_commute // in Hrecs. rewrite insert_commute //.
+        eexists; eapply SAttr; [|by rewrite lookup_insert_ne| |done].
+        { eapply no_recs_insert_inv; [|done]. by rewrite lookup_insert_ne. }
+        intros ?? [[<- <-]|[??]]%lookup_insert_Some; eauto.
+      * apply final_interp' in Hfinal as (w & m1 & Hinterp1 & _).
+        do 2 right. exists (S (m1 `max` m2)). rewrite fmap_insert /=.
+        rewrite map_mapM_sorted_insert //=; last by rewrite lookup_fmap Hx.
+        rewrite /interp' /force_deep' in Hinterp1.
+        destruct (interp m1 _ _) as [[]|] eqn:Hinterp1'; simplify_res.
+        rewrite interp_thunk_S /= (interp_le Hinterp1') /=; last lia.
+        rewrite (force_deep_le Hinterp1) /=; last lia.
+        rewrite (map_mapM_interp_le Hinterp2) /=; last lia. done.
+    + do 2 right. exists (S m). rewrite fmap_insert /=.
+      rewrite map_mapM_sorted_insert //=; last by rewrite lookup_fmap Hx.
+      rewrite /interp' /force_deep' in Hinterp.
+      destruct (interp m _ _) as [mw|] eqn:Hinterp'; simplify_res.
+      rewrite interp_thunk_S /= (interp_le Hinterp') /=; last lia.
+      destruct mw as [w|]; simplify_res; [|done].
+      rewrite (force_deep_le Hinterp) /=; last lia. done.
+  - (* ELetAttr *) destruct (IHe1 SHALLOW) as [[??]|[Hfinal|[m Hinterp]]].
+    + left. eexists. by eapply SLetAttr.
+    + apply final_interp in Hfinal as (w & m & Hinterp & ->).
+      destruct (maybe VAttr w) eqn:Hw.
+      { destruct w; simplify_eq/=. left. by repeat econstructor. }
+      do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp /= Hw.
+    + do 2 right. exists (S m). rewrite interp_shallow' in Hinterp.
+      by rewrite /interp' interp_S /= Hinterp /=.
+  - (* EBinOp *)
+    destruct (IHe1 SHALLOW) as [[??]|[Hfinal1|[m Hinterp]]].
+    + left. eexists. by eapply SBinOpL.
+    + apply final_interp in Hfinal1 as (w1 & m1 & Hinterp1 & ->).
+      destruct (interp_bin_op op w1) as [f|] eqn:Hop; last first.
+      { do 2 right. exists (S m1). rewrite /interp' interp_S /=.
+        by rewrite Hinterp1 /= Hop. }
+      pose proof Hop as [Φ ?]%interp_bin_op_Some_1.
+      destruct (IHe2 SHALLOW) as [[??]|[Hfinal2|[m Hinterp2]]].
+      * left. by repeat econstructor.
+      * apply final_interp in Hfinal2 as (w2 & m2 & Hinterp2 & ->).
+        destruct (f w2) as [w|] eqn:Hf; last first.
+        ** do 2 right. exists (S (m1 `max` m2)). rewrite /interp' interp_S /=.
+           rewrite (interp_le Hinterp1) /=; last lia.
+           rewrite Hop /= (interp_le Hinterp2) /=; last lia. by rewrite Hf.
+        ** eapply interp_bin_op_Some_Some_1 in Hf as (?&?&?); [|done..].
+           left. by repeat econstructor.
+      * rewrite interp_shallow' in Hinterp2.
+        do 2 right. exists (S (m `max` m1)). rewrite /interp' interp_S /=.
+        rewrite (interp_le Hinterp1) /=; last lia.
+        rewrite Hop /= (interp_le Hinterp2) /=; last lia. done.
+    + rewrite interp_shallow' in Hinterp.
+      do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp.
+  - (* EIf *)
+    destruct (IHe1 SHALLOW) as [[??]|[Hfinal1|[m Hinterp]]].
+    + left. eexists. by eapply SIf.
+    + apply final_interp in Hfinal1 as (w1 & m1 & Hinterp1 & ->).
+      destruct (maybe_VLit w1 ≫= maybe LitBool) as [b|] eqn:Hbool; last first.
+      { do 2 right. exists (S m1).
+        rewrite /interp' interp_S /= Hinterp1 /= Hbool. done. }
+      left. destruct w1; repeat destruct select base_lit; simplify_eq/=.
+      eexists; constructor.
+    + rewrite interp_shallow' in Hinterp.
+      do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp.
+Qed.
+
+Lemma interp_complete μ e1 e2 :
+  e1 -{μ}->* e2 → nf (step μ) e2 →
+  ∃ mw m, interp' m μ ∅ e1 = Res mw ∧
+    if mw is Some w then e2 = val_to_expr w else ¬final μ e2.
+Proof.
+  intros Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH].
+  { destruct (red_final_interp μ  e) as [?|[Hfinal|[m Hinterp]]]; [done|..].
+    - apply final_interp' in Hfinal as (w & m & ? & ?).
+      by exists (Some w), m.
+    - exists None, m. split; [done|]. intros Hfinal.
+      apply final_interp' in Hfinal as (w & m' & Hinterp' & _).
+      rewrite /interp' in Hinterp, Hinterp'.
+      by assert (mfail = mret w) by eauto using interp_agree'. }
+  destruct IH as (mw & m & Hinterp & ?); first done.
+  eapply interp_step' in Hstep as (mw' & m' & ? & ?); last done.
+  destruct mw, mw'; naive_solver.
+Qed.
+
+Lemma interp_complete_ret μ e1 e2 :
+  e1 -{μ}->* e2 → final μ e2 →
+  ∃ w m, interp' m μ ∅ e1 = mret w ∧ e2 = val_to_expr w.
+Proof.
+  intros Hsteps Hfinal. apply interp_complete in Hsteps
+    as ([w|] & m & ? & ?); naive_solver eauto using final_nf.
+Qed.
+Lemma interp_complete_fail μ e1 e2 :
+  e1 -{μ}->* e2 → nf (step μ) e2 → ¬final μ e2 →
+  ∃ m, interp' m μ ∅ e1 = mfail.
+Proof.
+  intros Hsteps Hnf Hfinal.
+  apply interp_complete in Hsteps as ([w|] & m & ? & ?);
+    naive_solver eauto using final_val_to_expr'.
+Qed.
+
+Lemma interp_sound_open n E e mv :
+  interp n E e = Res mv →
+  ∃ e', subst_env E e -{SHALLOW}->* e' ∧
+        if mv is Some v' then e' = val_to_expr v' else stuck SHALLOW e'
+with interp_thunk_sound n t mv :
+  interp_thunk n t = Res mv →
+  ∃ e', thunk_to_expr t -{SHALLOW}->* e' ∧
+        if mv is Some v' then e' = val_to_expr v' else stuck SHALLOW e'
+with interp_app_sound n v1 t2 mv :
+  interp_app n v1 t2 = Res mv →
+  ∃ e', EApp (val_to_expr v1) (thunk_to_expr t2) -{SHALLOW}->* e' ∧
+        if mv is Some v' then e' = val_to_expr v' else stuck SHALLOW e'
+with force_deep_sound n v mv :
+  force_deep n v = Res mv →
+  ∃ e', val_to_expr v -{DEEP}->* e' ∧
+        if mv is Some v' then e' = val_to_expr v' else stuck DEEP e'.
+Proof.
+  - destruct n as [|n]; [done|].
+    rewrite subst_env_eq interp_S. intros Hinterp.
+    destruct e; simplify_res.
+    + (* ELit *) case_guard; simplify_res.
+      * by eexists.
+      * eexists; split; [done|]. split; [|by inv 1]. intros [??]; inv_step.
+    + (* EId *)
+      assert (union_kinded (prod_map id thunk_to_expr <$> E !! x) mke
+      = prod_map id thunk_to_expr <$> (union_kinded (E !! x)
+          (prod_map id (Thunk ∅) <$> mke))) as ->.
+      { destruct (_ !! _) as [[[]]|], mke as [[[]]|];
+          by rewrite /= ?thunk_to_expr_eq /= ?subst_env_empty. }
+      destruct (union_kinded _ _) as [[k t]|]; simplify_res.
+      * apply interp_thunk_sound in Hinterp as (e' & Hsteps & He').
+        exists e'; split; [|done]. eapply rtc_l; [constructor|done].
+      * eexists; split; [done|]. split; [|inv 1]. intros [? Hstep]. inv_step.
+    + (* EAbs *) by eexists.
+    + (* EAbsMatch *) by eexists.
+    + (* EApp *)
+      destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res.
+      apply interp_sound_open in Hinterp1 as (e1' & Hsteps1 & He1').
+      destruct mv1 as [v1|]; simplify_res; last first.
+      { eexists; split; [by eapply SAppL_rtc|]. split; [|inv 1].
+        intros [??]. destruct He1' as [Hnf []].
+        inv_step; eauto using final. destruct Hnf; eauto. }
+      apply interp_app_sound in Hinterp as (e' & Hsteps2 & He').
+      eexists e'; split; [|done]. etrans; [|done]. by eapply SAppL_rtc.
+    + (* ESeq *) destruct (interp _ _ e1) as [mv'|] eqn:Hinterp'; simplify_res.
+      apply interp_sound_open in Hinterp' as (e' & Hsteps & He').
+      destruct mv' as [v'|]; simplify_res; last first.
+      { eexists; repeat split; [by apply SSeq_rtc, steps_shallow_any| |inv 1].
+        intros [e'' Hstep]. destruct He' as [Hnf Hfinal].
+        destruct Hfinal. inv_step; eauto using final_any_shallow.
+        apply step_any_shallow in H2 as []; [|done]. destruct Hnf; eauto. }
+      destruct μ; simplify_res.
+      { apply interp_sound_open in Hinterp as (e'' & Hsteps' & He'').
+        eexists; split; [|done]. etrans; first by apply SSeq_rtc.
+        eapply rtc_l; first by apply SSeqFinal. done. }
+      destruct (force_deep _ _) as [mw|] eqn:Hforce; simplify_res.
+      pose proof Hforce as Hforce'.
+      apply force_deep_sound in Hforce' as (e'' & Hsteps' & He'').
+      destruct mw as [w|]; simplify_res; last first.
+      { eexists. split.
+        { etrans; [by eapply SSeq_rtc, steps_shallow_any|].
+          etrans; [by eapply SSeq_rtc|]. done. }
+        split; [|inv 1]. destruct He''. intros [e''' Hstep].
+        inv_step; eauto using step_not_final. }
+      apply interp_sound_open in Hinterp as (e''' & Hsteps'' & He''').
+      exists e'''. split; [|done].
+      etrans; [by eapply SSeq_rtc, steps_shallow_any|].
+      etrans; [by eapply SSeq_rtc|].
+      eapply rtc_l; first by eapply SSeqFinal, final_force_deep. done.
+    + (* EList *)
+      eexists; split; [done|]. f_equal.
+      induction es; f_equal/=; auto.
+    + (* EAttr *)
+      eexists; split; [apply SAttr_rec_rtc|].
+      f_equal. apply map_eq=> x. rewrite !lookup_fmap.
+      destruct (αs !! x) as [[[] e]|] eqn:?; do 2 f_equal/=.
+      by rewrite subst_env_indirects_env_attr_to_tattr.
+    + (* ELetAttr *) destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res.
+      apply interp_sound_open in Hinterp' as (e' & Hsteps & He').
+      destruct mv' as [v'|]; simplify_res; last first.
+      { eexists; repeat split; [by apply SLetAttr_rtc| |inv 1].
+        intros [e'' Hstep]. destruct He' as [Hnf Hfinal].
+        inv_step; [by destruct Hfinal; constructor|]. destruct Hnf; eauto. }
+      destruct (maybe VAttr v') eqn:?; simplify_res; last first.
+      { eexists; repeat split; [by apply SLetAttr_rtc| |inv 1].
+        intros [e'' Hstep]. destruct v'; inv_step; simplify_eq/=. }
+      destruct v'; simplify_res.
+      apply interp_sound_open in Hinterp as (e'' & Hsteps' & He'').
+      eexists; split; [|done]. etrans; [by apply SLetAttr_rtc|].
+      eapply rtc_l; [by econstructor|].
+      rewrite subst_env_union in Hsteps'.
+      rewrite subst_env_alt -!map_fmap_compose in Hsteps'.
+      by rewrite -map_fmap_compose.
+    + (* EBinOp *)
+      destruct (interp _ _ e1) as [mv1|] eqn:Hinterp1; simplify_res.
+      apply interp_sound_open in Hinterp1 as (e1' & Hsteps1 & He1').
+      destruct mv1 as [v1|]; simplify_res; last first.
+      { eexists; split; [by eapply SBinOpL_rtc|]. split; [|inv 1].
+        intros [? Hstep]. destruct He1'. inv_step; naive_solver. }
+      destruct (interp_bin_op _ v1) as [f|] eqn:Hop; simplify_res; last first.
+      { assert (¬∃ Φ, sem_bin_op op (val_to_expr v1) Φ).
+        { by intros [? ?%interp_bin_op_Some_2%not_eq_None_Some]. }
+        eexists; split; [by eapply SBinOpL_rtc|]. split; [|inv 1].
+        intros [? Hstep]. inv_step; eauto using step_not_val_to_expr. }
+      pose proof Hop as [Φ ?]%interp_bin_op_Some_1.
+      destruct (interp _ _ e2) as [mv2|] eqn:Hinterp2; simplify_res.
+      apply interp_sound_open in Hinterp2 as (e2' & Hsteps2 & He2').
+      destruct mv2 as [v2|]; simplify_res; last first.
+      { eexists; split.
+        { etrans; [by eapply SBinOpL_rtc|].
+          eapply SBinOpR_rtc; eauto using interp_bin_op_Some_1. }
+        split; [|inv 1]. destruct He2'.
+        intros [? Hstep]. inv_step; eauto using step_not_val_to_expr. }
+      destruct (f v2) eqn:Hf; simplify_res; last first.
+      { eexists; split.
+        { etrans; [by eapply SBinOpL_rtc|].
+          eapply SBinOpR_rtc; eauto using interp_bin_op_Some_1. }
+        split; [|inv 1]. pose proof @interp_bin_op_Some_Some_2.
+        intros [? Hstep]. inv_step; naive_solver eauto using step_not_val_to_expr. }
+      apply interp_thunk_sound in Hinterp as (e' & Hsteps3 & He').
+      eapply interp_bin_op_Some_Some_1 in Hf as (e3 & ? & ?); [|done..].
+      eapply delayed_steps_l in Hsteps3
+        as (e'' & Hsteps3 & Hdel); last done.
+      eexists e''; split.
+      { etrans; [by eapply SBinOpL_rtc|].
+        etrans; [eapply SBinOpR_rtc; eauto using interp_bin_op_Some_1|].
+        eapply rtc_l; [by econstructor|]. done. }
+      destruct mv.
+      { subst e'. eapply delayed_final_l in Hdel as <-; done. }
+      destruct He' as [Hnf Hfinal]. split.
+      { intros [e4 Hsteps4]. destruct Hnf.
+        eapply delayed_step_r in Hsteps4 as (e4' & Hstep4' & ?); [|done].
+        destruct Hstep4'; eauto. }
+      intros Hfinal'. eapply Hnf.
+      eapply delayed_final_r in Hfinal' as Hsteps; [|done].
+      destruct Hsteps; by eauto.
+    + (* EIf *)
+      destruct (interp _ _ e1) as [mv1|] eqn:Hinterp1; simplify_res.
+      apply interp_sound_open in Hinterp1 as (e1' & Hsteps1 & He1').
+      destruct mv1 as [v1|]; simplify_res; last first.
+      { eexists; repeat split; [by apply SIf_rtc| |inv 1].
+        intros [e'' Hstep]. destruct He1' as [Hnf Hfinal].
+        destruct Hfinal. inv_step; eauto using final. destruct Hnf; eauto. }
+      destruct (maybe_VLit v1 ≫= maybe LitBool) as [b|] eqn:Hbool;
+        simplify_res; last first.
+      { eexists; repeat split; [by apply SIf_rtc| |inv 1].
+        intros [e'' ?]. destruct v1; inv_step; eauto using final. }
+      apply interp_sound_open in Hinterp as (e' & Hsteps & He').
+      exists e'; split; [|done]. etrans; [by apply SIf_rtc|].
+      assert (val_to_expr v1 = ELit (LitBool b)) as ->.
+      { destruct v1; repeat destruct select base_lit; naive_solver. }
+      eapply rtc_l; [constructor|]. by destruct b.
+  - destruct n as [|n]; [done|]. rewrite interp_thunk_S /=.
+    intros Hthunk. destruct t; simplify_res; [by eauto using rtc..|].
+    destruct (tαs !! x) as [[e|t]|] eqn:Hx; simplify_res.
+    + apply interp_sound_open in Hthunk as (e' & Hsteps & ?).
+      exists e'; split; [|done]. etrans; [eapply SBinOpL_rtc, SAttr_rec_rtc|].
+      eapply rtc_l; [eapply SBinOp; repeat constructor|]; try done; simpl.
+      eexists; split; [done|]. rewrite !lookup_fmap Hx /=.
+      rewrite -subst_env_indirects_env_attr_to_tattr_empty.
+      by rewrite -subst_env_indirects_env.
+    + apply interp_thunk_sound in Hthunk as (e' & Hsteps & ?).
+      exists e'; split; [|done]. etrans; [eapply SBinOpL_rtc, SAttr_rec_rtc|].
+      eapply rtc_l; [eapply SBinOp; repeat constructor|]; try done; simpl.
+      eexists; split; [done|]. by rewrite !lookup_fmap Hx /=.
+    + eexists. split; [eapply SBinOpL_rtc, SAttr_rec_rtc|]. split; [|inv 1].
+      intros [??]. inv_step. inv H7. destruct H8 as (? & ? & Hx'); simplify_eq/=.
+      by rewrite !lookup_fmap Hx in Hx'.
+  - destruct n as [|n]; [done|]. rewrite interp_app_S /=. intros Happ.
+    destruct v1; simplify_res.
+    + eexists; split; [done|]. split; [|inv 1]. intros [??]; inv_step.
+    + eapply interp_sound_open in Happ as (e' & Hsteps & He').
+      eexists; split; [|done]. eapply rtc_l; [constructor|].
+      rewrite subst_abs_env_insert // in Hsteps.
+    + destruct (interp_thunk _ _) as [mv'|] eqn:Hthunk; simplify_res.
+      apply interp_thunk_sound in Hthunk as (et & Htsteps & Het).
+      destruct mv' as [v'|]; simplify_res; last first.
+      { eexists; split; [by eapply SAppR_rtc|].
+        split; [|inv 1]. destruct Het.
+        intros [??]; inv_step; eauto using final. }
+      destruct (maybe VAttr v') as [ts|] eqn:?; simplify_res; last first.
+      { eexists; repeat split; [by apply SAppR_rtc| |inv 1].
+        intros [e'' Hstep]. destruct v'; inv_step; simplify_eq/=. }
+      destruct v'; simplify_res.
+      destruct (interp_match _ _ _) as [tαs|] eqn:Hmatch;
+        simplify_res; last first.
+      { eexists; repeat split; [by apply SAppR_rtc| |inv 1].
+        intros [e'' Hstep]. inv_step.
+        rewrite map_fmap_compose fmap_attr_expr_Attr in H6.
+        apply interp_match_Some_2 in H6. rewrite interp_match_subst in H6.
+        opose proof (interp_match_proper ∅ ∅
+          (Thunk ∅ <$> (thunk_to_expr <$> ts)) ts ms ms strict _ _).
+        { apply map_eq=> x. rewrite !lookup_fmap.
+          destruct (ts !! x); f_equal/=. by rewrite subst_env_empty. }
+        { done. }
+        repeat destruct (interp_match _ _ _); simplify_eq/=. }
+      pose proof (interp_match_subst E ts ms strict) as Hmatch'.
+      rewrite Hmatch /= in Hmatch'.
+      apply interp_match_Some_1 in Hmatch'.
+      apply interp_sound_open in Happ as (e' & Hsteps & ?).
+      exists e'; split; [|done].
+      etrans; [by apply SAppR_rtc|].
+      eapply rtc_l; [constructor; [done|]|].
+      { rewrite map_fmap_compose fmap_attr_expr_Attr. done. }
+      etrans; [|apply Hsteps]. apply reflexive_eq. f_equal.
+      rewrite subst_env_indirects_env.
+      rewrite subst_env_indirects_env_attr_to_tattr_empty.
+      do 2 f_equal. apply map_eq=> y. rewrite !lookup_fmap.
+      destruct (_ !! y) as [[]|]; f_equal/=. by rewrite subst_env_empty.
+    + eexists; split; [done|]. split; [|inv 1]. intros [??]; inv_step.
+    + destruct (ts !! _) eqn:Hfunc; simplify_res; last first.
+      { eexists; split; [by eapply SAppL_rtc|]. split; [|inv 1].
+        intros [??]; inv_step; simplify_map_eq. }
+      destruct (interp_thunk _ _) as [mv'|] eqn:Hthunk; simplify_res.
+      apply interp_thunk_sound in Hthunk as (et & Htsteps & Het).
+      assert (EApp (EAttr (AttrN ∘ thunk_to_expr <$> ts)) (thunk_to_expr t2)
+        -{SHALLOW}->*
+        EApp (EApp et (EAttr (AttrN ∘ thunk_to_expr <$> ts))) (thunk_to_expr t2))
+        as Hsteps; [|clear Htsteps].
+      { eapply rtc_l; [constructor; by simplify_map_eq|].
+        eapply SAppL_rtc, SAppL_rtc, Htsteps. }
+      destruct mv' as [v'|]; simplify_res; last first.
+      { eexists; split; [exact Hsteps|].
+        split; [|inv 1]. intros [??]. destruct Het as [Hnf []].
+        inv_step; eauto using final. destruct Hnf; eauto. }
+      destruct (interp_app _ _ _) as [mv'|] eqn:Happ'; simplify_res.
+      apply interp_app_sound in Happ' as (e' & Hsteps' & He').
+      destruct mv' as [v''|]; simplify_res; last first.
+      { eexists; split; [etrans; [apply Hsteps|apply SAppL_rtc, Hsteps']|].
+        split; [|inv 1]. intros [??]. destruct He' as [Hnf []].
+        inv_step; eauto using final. destruct Hnf; eauto. }
+      apply interp_app_sound in Happ as (e'' & Hsteps'' & He'').
+      eexists e''; split; [|done].
+      etrans; [apply Hsteps|]. etrans; [apply SAppL_rtc, Hsteps'|]. done.
+  - destruct n as [|n]; [done|]. rewrite force_deep_S.
+    intros Hforce. destruct v; simplify_res.
+    + (* VLit *) by eexists.
+    + (* VAbs *) by eexists.
+    + (* VAbsMatch *) by eexists.
+    + (* VList *)
+      destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_res.
+      assert (∃ ts',
+        EList (thunk_to_expr <$> ts) -{DEEP}->* EList (thunk_to_expr <$> ts') ∧
+        if mvs is Some vs then thunk_to_expr <$> ts' = val_to_expr <$> vs
+        else nf (step DEEP) (EList (thunk_to_expr <$> ts')) ∧
+          ¬Forall (final DEEP ∘ thunk_to_expr) ts')
+        as (ts' & Hsteps & Hts'); last first.
+      { eexists; split; [done|]. destruct mvs as [vs|]; simplify_eq/=.
+        * f_equal. rewrite -list_fmap_compose Hts'.
+          clear. induction vs; f_equal/=; auto.
+        * destruct Hts' as [Hnf Hfinal]; split; [done|].
+          inv 1. by apply Hfinal, Forall_fmap. }
+      revert mvs Hmap. induction ts as [|t ts IH]; intros mv' Hmap; simplify_res.
+      { by exists []. }
+      destruct (interp_thunk _ _) as [mv''|] eqn:Hthunk; simplify_res.
+      apply interp_thunk_sound in Hthunk as (et & Htsteps & Het).
+      destruct mv'' as [v''|]; simplify_res; last first.
+      { exists (Thunk ∅ et :: ts); csimpl. rewrite subst_env_empty.
+        apply (stuck_shallow_any DEEP) in Het as [??]. split_and!.
+        * eapply (SList_rtc []); [done|].
+          etrans; [by apply steps_shallow_any|done].
+        * by apply List_nf_cons.
+        * rewrite Forall_cons /= subst_env_empty.
+          naive_solver eauto using final_any_shallow. }
+      destruct (force_deep _ _) as [mvf|] eqn:Hforce; simplify_res.
+      pose proof Hforce as Hforce'.
+      apply force_deep_sound in Hforce' as (e' & Hsteps' & He').
+      destruct mvf as [vf|]; simplify_res; last first.
+      { exists (Thunk ∅ e' :: ts). csimpl. rewrite subst_env_empty.
+        destruct He'. split_and!.
+        * eapply (SList_rtc []); [done|].
+          etrans; [by apply steps_shallow_any|done].
+        * by apply List_nf_cons.
+        * rewrite Forall_cons /= subst_env_empty. naive_solver. }
+      destruct (mapM _ _) as [mvs|] eqn:Hmap'; simplify_res.
+      destruct (IH _ eq_refl) as (ts' & Hsteps'' & Hts').
+      exists (Forced vf :: ts'); csimpl. split.
+      { etrans; [eapply (SList_rtc []); [done..|];
+          etrans; [by apply steps_shallow_any|done]|]; simpl.
+        eapply List_steps_cons; by eauto using final_force_deep. }
+      destruct mvs as [vs|]; simplify_res.
+      { by rewrite Hts'. }
+      split; [|rewrite Forall_cons; naive_solver].
+      apply List_nf_cons_final; naive_solver eauto using final_force_deep.
+    + (* VAttr *)
+      destruct (map_mapM_sorted _ _) as [mvs|] eqn:Hmap; simplify_res.
+      assert (∃ ts',
+        EAttr (AttrN ∘ thunk_to_expr <$> ts) -{DEEP}->*
+          EAttr (AttrN ∘ thunk_to_expr <$> ts') ∧
+        if mvs is Some vs then thunk_to_expr <$> ts' = val_to_expr <$> vs
+        else nf (step DEEP) (EAttr (AttrN ∘ thunk_to_expr <$> ts')) ∧
+          ¬map_Forall (λ _, final DEEP ∘ thunk_to_expr) ts')
+        as (ts' & Hsteps & Hts'); last first.
+      { eexists; split; [done|]. destruct mvs as [vs|]; simplify_eq/=.
+        * f_equal. rewrite map_fmap_compose Hts'.
+          apply map_eq=> x. rewrite !lookup_fmap. by destruct (vs !! x).
+        * destruct Hts' as [Hnf Hfinal]; split; [done|].
+          inv 1. apply Hfinal=> x t Hx /=.
+          ospecialize (H2 x _ _); first by rewrite lookup_fmap Hx. done. }
+      revert mvs Hmap. induction ts as [|x t ts Hx ? IH]
+        using (map_sorted_ind attr_le); intros mv' Hmap.
+      { rewrite map_mapM_sorted_empty in Hmap; simplify_res. by exists ∅. }
+      rewrite map_mapM_sorted_insert //= in Hmap.
+      assert ((AttrN ∘ thunk_to_expr <$> ts) !! x = None).
+      { by rewrite lookup_fmap Hx. }
+      assert (∀ y α, (AttrN ∘ thunk_to_expr <$> ts) !! y = Some α →
+        final DEEP (attr_expr α) ∨ attr_le x y).
+      { intros y α. rewrite lookup_fmap. destruct (ts !! y) eqn:?; naive_solver. }
+      destruct (interp_thunk _ _) as [mv''|] eqn:Hthunk; simplify_res.
+      apply interp_thunk_sound in Hthunk as (et & Htsteps & Het).
+      destruct mv'' as [v''|]; simplify_res; last first.
+      { exists (<[x:=Thunk ∅ et]> ts).
+        rewrite !fmap_insert /= subst_env_empty.
+        apply (stuck_shallow_any DEEP) in Het as [??]. split_and!.
+        * eapply SAttr_lookup_rtc; [done..|].
+          etrans; [by apply steps_shallow_any|done].
+        * apply Attr_nf_insert; auto.
+          intros y. rewrite lookup_fmap fmap_is_Some. eauto.
+        * rewrite map_Forall_insert //= subst_env_empty.
+          naive_solver eauto using final_any_shallow. }
+      destruct (force_deep _ _) as [mvf|] eqn:Hforce; simplify_res.
+      pose proof Hforce as Hforce'.
+      apply force_deep_sound in Hforce' as (e' & Hsteps' & He').
+      destruct mvf as [vf|]; simplify_res; last first.
+      { exists (<[x:=Thunk ∅ e']> ts). rewrite !fmap_insert /= subst_env_empty.
+        destruct He'. split_and!.
+        * eapply SAttr_lookup_rtc; [done..|].
+          etrans; [by apply steps_shallow_any|done].
+        * apply Attr_nf_insert; auto.
+          intros y. rewrite lookup_fmap fmap_is_Some. eauto.
+        * rewrite map_Forall_insert //= subst_env_empty. naive_solver. }
+      destruct (map_mapM_sorted _ _ _) as [mvs|] eqn:Hmap'; simplify_res.
+      destruct (IH _ eq_refl) as (ts' & Hsteps'' & Hts').
+      exists (<[x:=Forced vf]> ts'). split.
+      { rewrite !fmap_insert /=.
+        etrans; [eapply SAttr_lookup_rtc; [done..|];
+          etrans; [by apply steps_shallow_any|done]|].
+        eapply Attr_steps_insert; by eauto using final_force_deep. }
+      destruct mvs as [vs|]; simplify_res.
+      { by rewrite !fmap_insert Hts'. }
+      assert (∀ y, ts !! y = None ↔ ts' !! y = None) as Hdom.
+      { intros y. rewrite -!(fmap_None (AttrN ∘ thunk_to_expr)).
+        rewrite -!lookup_fmap. by eapply Attr_steps_dom. }
+      split; [|rewrite map_Forall_insert; naive_solver].
+      rewrite fmap_insert /=. apply Attr_nf_insert_final;
+        eauto using final_force_deep.
+      * rewrite lookup_fmap fmap_None. naive_solver.
+      * intros y. rewrite lookup_fmap fmap_is_Some.
+        rewrite -not_eq_None_Some -Hdom not_eq_None_Some. auto.
+      * naive_solver.
+Qed.
+
+Lemma interp_sound_open' n μ E e mv :
+  interp' n μ E e = Res mv →
+  ∃ e', subst_env E e -{μ}->* e' ∧
+        if mv is Some v' then e' = val_to_expr v' else stuck μ e'.
+Proof.
+  intros Hinterp. destruct μ.
+  { rewrite interp_shallow' in Hinterp. by eapply interp_sound_open. }
+  rewrite /interp' /= in Hinterp.
+  destruct (interp n E e) as [mv'|] eqn:Hinterp'; simplify_res.
+  apply interp_sound_open in Hinterp' as (e' & Hsteps & He').
+  destruct mv' as [v'|]; simplify_res; last first.
+  { eauto using steps_shallow_any, stuck_shallow_any. }
+  eapply force_deep_sound in Hinterp as (e'' & Hsteps' & He'').
+  eexists; split; [|done]. etrans; [by eapply steps_shallow_any|done].
+Qed.
+
+Lemma interp_sound n μ e mv :
+  interp' n μ ∅ e = Res mv →
+  ∃ e', e -{μ}->* e' ∧
+        if mv is Some v then e' = val_to_expr v else stuck μ e'.
+Proof.
+  intros Hsteps%interp_sound_open'. by rewrite subst_env_empty in Hsteps.
+Qed.
+
+(** Final theorems *)
+Theorem interp_sound_complete_ret e v :
+  (∃ w n, interp' n SHALLOW ∅ e = mret w ∧ val_to_expr v = val_to_expr w)
+    ↔ e -{SHALLOW}->* val_to_expr v.
+Proof.
+  split.
+  - by intros (n & w & (e' & ? & ->)%interp_sound & ->).
+  - intros Hsteps. apply interp_complete in Hsteps as ([] & ? & ? & ?);
+      unfold nf, red;
+      naive_solver eauto using final_val_to_expr, step_not_val_to_expr.
+Qed.
+
+Theorem interp_sound_complete_ret_lit μ e bl (Hbl : base_lit_ok bl) :
+  (∃ n, interp' n μ ∅ e = mret (VLit bl Hbl)) ↔ e -{μ}->* ELit bl.
+Proof.
+  split.
+  - intros [n (e' & ? & ->)%interp_sound]. done.
+  - intros Hsteps. apply interp_complete_ret in Hsteps
+      as ([] & n & ? & Hv); simplify_eq/=; last by constructor.
+    exists n. by rewrite (proof_irrel Hbl Hbl0).
+Qed.
+
+Theorem interp_sound_complete_fail μ e :
+  (∃ n, interp' n μ ∅ e = mfail) ↔ ∃ e', e -{μ}->* e' ∧ stuck μ e'.
+Proof.
+  split.
+  - by intros [n ?%interp_sound].
+  - intros (e' & Hsteps & Hnf & Hfinal). by eapply interp_complete_fail.
+Qed.
+
+Theorem interp_sound_complete_no_fuel μ e :
+  (∀ n, interp' n μ ∅ e = NoFuel) ↔ all_loop (step μ) e.
+Proof.
+  rewrite all_loop_alt. split.
+  - intros Hnofuel e' Hsteps.
+    destruct (red_final_interp μ e') as [|[|He']]; [done|..].
+    + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); last done.
+      by rewrite Hnofuel in Hinterp.
+    + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]).
+      destruct (interp_complete μ e e'')
+        as (mv & n & Hinterp & _); [by etrans|done|].
+      by rewrite Hnofuel in Hinterp.
+  - intros Hred n. destruct (interp' n μ ∅ e) as [mv|] eqn:Hinterp; [|done].
+    destruct (interp_sound _ _ _ _ Hinterp) as (e' & Hsteps & Hstuck).
+    destruct mv as [v|]; simplify_eq/=.
+    + apply Hred in Hsteps as []%final_nf. by eapply final_val_to_expr'.
+    + destruct Hstuck as [[] ?]; eauto.
+Qed.
diff --git a/theories/nix/notations.v b/theories/nix/notations.v
new file mode 100644
index 0000000..e9995b5
--- /dev/null
+++ b/theories/nix/notations.v
@@ -0,0 +1,43 @@
+From mininix Require Export nix.operational.
+
+(* Influenced by
+https://gitlab.mpi-sws.org/iris/iris/-/blob/master/iris_heap_lang/notation.v
+But always uses ":" instead of a scope. *)
+
+Coercion EId' : string >-> expr.
+Coercion NInt : Z >-> num.
+Coercion NFloat : float >-> num.
+Coercion LitNum : num >-> base_lit.
+Coercion LitBool : bool >-> base_lit.
+Coercion ELit : base_lit >-> expr.
+Coercion EApp : expr >-> Funclass.
+
+Notation "λattr: a , e" := (EAbsMatch a true e)
+  (at level 200, e, a at level 200,
+   format "'[' 'λattr:'  a  ,  '/  ' e ']'").
+Notation "λattr: a .., e" := (EAbsMatch a false e)
+  (at level 200, e, a at level 200,
+   format "'[' 'λattr:'  a  ..,  '/  ' e ']'").
+
+Notation "λ: x .. y , e" := (EAbs x .. (EAbs y e) ..)
+  (at level 200, x, y at level 1, e at level 200,
+   format "'[' 'λ:'  x  ..  y ,  '/  ' e ']'").
+Notation "'let:' x := e1 'in' e2" := (ELet x e1 e2)
+  (at level 200, x at level 1, e1, e2 at level 200,
+   format "'[' 'let:'  x  :=  '[' e1 ']'  'in'  '/' e2 ']'").
+Notation "'with:' a 'in' e" := (EWith a e)
+  (at level 200, a, e at level 200,
+   format "'[' 'with:'  a  'in'  '/' e ']'").
+
+Notation "'if:' e1 'then' e2 'else' e3" := (EIf e1 e2 e3)
+  (at level 200, e1, e2, e3 at level 200).
+
+Notation "e1 .: e2" := (ESelect e1 e2) (at level 70, no associativity).
+
+Notation "e1 +: e2" := (EBinOp AddOp e1 e2) (at level 50, left associativity).
+Notation "e1 *: e2" := (EBinOp MulOp e1 e2).
+Notation "e1 -: e2" := (EBinOp SubOp e1 e2) (at level 50, left associativity).
+Notation "e1 /: e2" := (EBinOp DivOp e1 e2) (at level 40).
+Notation "e1 =: e2" := (EBinOp EqOp e1 e2) (at level 70, no associativity).
+Notation "e1 <: e2" := (EBinOp LtOp e1 e2) (at level 70, no associativity).
+Notation "'ceil:' e" := (EBinOp (RoundOp Ceil) e LitNull) (at level 10).
diff --git a/theories/nix/operational.v b/theories/nix/operational.v
new file mode 100644
index 0000000..d3f0777
--- /dev/null
+++ b/theories/nix/operational.v
@@ -0,0 +1,527 @@
+From mininix Require Export utils nix.floats.
+From stdpp Require Import options.
+
+(** Our development does not rely on a particular order on attribute set names.
+It can be any decidable total order. We pick something concrete (lexicographic
+order on strings) to avoid having to parametrize the whole development. *)
+Definition attr_le := String.le.
+Global Instance attr_le_dec : RelDecision attr_le := _.
+Global Instance attr_le_po : PartialOrder attr_le := _.
+Global Instance attr_le_total : Total attr_le := _.
+Global Typeclasses Opaque attr_le.
+
+Inductive mode := SHALLOW | DEEP.
+Inductive kind := ABS | WITH.
+Inductive rec := REC | NONREC.
+
+Global Instance rec_eq_dec : EqDecision rec.
+Proof. solve_decision. Defined.
+
+Inductive num :=
+  | NInt (n : Z)
+  | NFloat (f : float).
+
+Inductive base_lit :=
+  | LitNum (n : num)
+  | LitBool (b : bool)
+  | LitString (s : string)
+  | LitNull.
+
+Global Instance num_inhabited : Inhabited num := populate (NInt 0).
+Global Instance base_lit_inhabited : Inhabited base_lit := populate LitNull.
+
+Global Instance num_eq_dec : EqDecision num.
+Proof. solve_decision. Defined.
+Global Instance base_lit_eq_dec : EqDecision base_lit.
+Proof. solve_decision. Defined.
+
+Global Instance maybe_NInt : Maybe NInt := λ n,
+  if n is NInt i then Some i else None.
+Global Instance maybe_NFloat : Maybe NFloat := λ n,
+  if n is NFloat f then Some f else None.
+Global Instance maybe_LitNum : Maybe LitNum := λ bl,
+  if bl is LitNum n then Some n else None.
+Global Instance maybe_LitBool : Maybe LitBool := λ bl,
+  if bl is LitBool b then Some b else None.
+Global Instance maybe_LitString : Maybe LitString := λ bl,
+  if bl is LitString s then Some s else None.
+
+Inductive bin_op : Set :=
+  | AddOp | SubOp | MulOp | DivOp | AndOp | OrOp | XOrOp (* Arithmetic *)
+  | LtOp | EqOp (* Relations *)
+  | RoundOp (m : round_mode) (* Conversions *)
+  | MatchStringOp (* Strings *)
+  | MatchListOp | AppendListOp (* Lists *)
+  | SelectAttrOp | UpdateAttrOp | HasAttrOp
+  | DeleteAttrOp | SingletonAttrOp | MatchAttrOp (* Attribute sets *)
+  | FunctionArgsOp | TypeOfOp.
+
+Global Instance bin_op_eq_dec : EqDecision bin_op.
+Proof. solve_decision. Defined.
+
+Global Instance maybe_RoundOp : Maybe RoundOp := λ op,
+  if op is RoundOp m then Some m else None.
+
+Section expr.
+  Local Unset Elimination Schemes.
+  Inductive expr :=
+    | ELit (bl : base_lit)
+    | EId (x : string) (mke : option (kind * expr))
+    | EAbs (x : string) (e : expr)
+    | EAbsMatch (ms : gmap string (option expr)) (strict : bool) (e : expr)
+    | EApp (e1 e2 : expr)
+    | ESeq (μ : mode) (e1 e2 : expr)
+    | EList (es : list expr)
+    | EAttr (αs : gmap string attr)
+    | ELetAttr (k : kind) (e1 e2 : expr)
+    | EBinOp (op : bin_op) (e1 e2 : expr)
+    | EIf (e1 e2 e3 : expr)
+  with attr :=
+    | Attr (τ : rec) (e : expr).
+End expr.
+
+Definition EId' x := EId x None.
+Notation AttrR := (Attr REC).
+Notation AttrN := (Attr NONREC).
+Notation ESelect e x := (EBinOp SelectAttrOp e (ELit (LitString x))).
+Notation ELet x e := (ELetAttr ABS (EAttr {[ x := AttrN e ]})).
+Notation EWith := (ELetAttr WITH).
+
+Definition attr_expr (α : attr) : expr := match α with Attr _ e => e end.
+Definition attr_rec (α : attr) : rec := match α with Attr μ _ => μ end.
+Definition attr_map (f : expr → expr) (α : attr) : attr :=
+  match α with Attr μ e => Attr μ (f e) end.
+
+Definition from_attr {A} (f g : expr → A) (α : attr) : A :=
+  match α with AttrR e => f e | AttrN e => g e end.
+
+Definition merge_kinded {A} (new old : kind * A) : option (kind * A) :=
+  match new.1, old.1 with
+  | WITH, ABS => Some old
+  | _, _ => Some new
+  end.
+Arguments merge_kinded {_} !_ !_ / : simpl nomatch.
+Notation union_kinded := (union_with merge_kinded).
+
+Definition no_recs : gmap string attr → Prop :=
+  map_Forall (λ _ α, attr_rec α = NONREC).
+
+Definition indirects (αs : gmap string attr) : gmap string (kind * expr) :=
+  map_imap (λ x _, Some (ABS, ESelect (EAttr αs) x)) αs.
+
+Fixpoint subst (ds : gmap string (kind * expr)) (e : expr) : expr :=
+  match e with
+  | ELit b => ELit b
+  | EId x mkd => EId x $ union_kinded (ds !! x) mkd
+  | EAbs x e => EAbs x (subst ds e)
+  | EAbsMatch ms strict e =>
+      EAbsMatch (fmap (M:=option) (subst ds) <$> ms) strict (subst ds e)
+  | EApp e1 e2 => EApp (subst ds e1) (subst ds e2)
+  | ESeq μ e1 e2 => ESeq μ (subst ds e1) (subst ds e2)
+  | EList es => EList (subst ds <$> es)
+  | EAttr αs => EAttr (attr_map (subst ds) <$> αs)
+  | ELetAttr k e1 e2 => ELetAttr k (subst ds e1) (subst ds e2)
+  | EBinOp op e1 e2 => EBinOp op (subst ds e1) (subst ds e2)
+  | EIf e1 e2 e3 => EIf (subst ds e1) (subst ds e2) (subst ds e3)
+  end.
+
+Notation attr_subst ds := (attr_map (subst ds)).
+
+Definition int_min : Z := -(1 ≪ 63).
+Definition int_max : Z := 1 ≪ 63 - 1.
+
+Definition int_ok (i : Z) : bool := bool_decide (int_min ≤ i ≤ int_max)%Z.
+Definition num_ok (n : num) : bool :=
+  match n with NInt i => int_ok i | _ => true end.
+Definition base_lit_ok (bl : base_lit) : bool :=
+  match bl with LitNum n => num_ok n | _ => true end.
+
+Inductive final : mode → expr → Prop :=
+  | ELitFinal μ bl : base_lit_ok bl → final μ (ELit bl)
+  | EAbsFinal μ x e : final μ (EAbs x e)
+  | EAbsMatchFinal μ ms strict e : final μ (EAbsMatch ms strict e)
+  | EListShallowFinal es : final SHALLOW (EList es)
+  | EListDeepFinal es : Forall (final DEEP) es → final DEEP (EList es)
+  | EAttrShallowFinal αs : no_recs αs → final SHALLOW (EAttr αs)
+  | EAttrDeepFinal αs :
+     no_recs αs →
+     map_Forall (λ _, final DEEP ∘ attr_expr) αs →
+     final DEEP (EAttr αs).
+
+Fixpoint sem_eq_list (es1 es2 : list expr) : expr :=
+  match es1, es2 with
+  | [], [] => ELit (LitBool true)
+  | e1 :: es1, e2 :: es2 =>
+      EIf (EBinOp EqOp e1 e2) (sem_eq_list es1 es2) (ELit (LitBool false))
+  | _, _ => ELit (LitBool false)
+  end.
+
+Fixpoint sem_lt_list (es1 es2 : list expr) : expr :=
+  match es1, es2 with
+  | [], _ => ELit (LitBool true)
+  | e1 :: es1, e2 :: es2 =>
+      EIf (EBinOp LtOp e1 e2) (ELit (LitBool true)) $
+        EIf (EBinOp EqOp e1 e2) (sem_lt_list es1 es2) (ELit (LitBool false))
+  | _ :: _, [] => ELit (LitBool false)
+  end.
+
+Definition sem_and_attr (es : gmap string expr) : expr :=
+  map_fold_sorted attr_le
+    (λ _ e1 e2, EIf e1 e2 (ELit (LitBool false)))
+    (ELit (LitBool true)) es.
+
+Definition sem_eq_attr (αs1 αs2 : gmap string attr) : expr :=
+  sem_and_attr $ merge (λ mα1 mα2,
+    α1 ← mα1; α2 ← mα2; Some (EBinOp EqOp (attr_expr α1) (attr_expr α2))) αs1 αs2.
+
+Definition num_to_float (n : num) : float :=
+  match n with
+  | NInt i => Float.of_Z i
+  | NFloat f => f
+  end.
+
+Definition sem_bin_op_lift
+    (fint : Z → Z → Z) (ffloat : float → float → float)
+    (n1 n2 : num) : option num :=
+  match n1, n2 with
+  | NInt i1, NInt i2 =>
+     let i := fint i1 i2 in
+     guard (int_ok i);;
+     Some (NInt i)
+  | _, _ => Some $ NFloat $ ffloat (num_to_float n1) (num_to_float n2)
+  end.
+
+Definition sem_bin_rel_lift
+    (fint : Z → Z → bool) (ffloat : float → float → bool)
+    (n1 n2 : num) : bool :=
+  match n1, n2 with
+  | NInt i1, NInt i2 => fint i1 i2
+  | _, _ => ffloat (num_to_float n1) (num_to_float n2)
+  end.
+
+Definition sem_eq_base_lit (bl1 bl2 : base_lit) : bool :=
+  match bl1, bl2 with
+  | LitNum n1, LitNum n2 => sem_bin_rel_lift Z.eqb Float.eqb n1 n2
+  | LitBool b1, LitBool b2 => bool_decide (b1 = b2)
+  | LitString s1, LitString s2 => bool_decide (s1 = s2)
+  | LitNull, LitNull => true
+  | _, _ => false
+  end.
+
+(** Precondition e1 and e2 are final *)
+Definition sem_eq (e1 e2 : expr) : option expr :=
+  match e1, e2 with
+  | ELit bl1, ELit bl2 => Some $ ELit (LitBool (sem_eq_base_lit bl1 bl2))
+  | EAbs _ _, EAbs _ _ => None
+  | EList es1, EList es2 => Some $
+      if decide (length es1 = length es2) then sem_eq_list es1 es2
+      else ELit $ LitBool false
+  | EAttr αs1, EAttr αs2 => Some $
+      if decide (dom αs1 = dom αs2) then sem_eq_attr αs1 αs2
+      else ELit $ LitBool false
+  | _, _ => Some $ ELit (LitBool false)
+  end.
+
+Definition div_allowed (n : num) : bool :=
+  match n with
+  | NInt n => bool_decide (n ≠ 0%Z)
+  | NFloat f => negb (Float.eqb f (Float.of_Z 0)) (* TODO: Check NaNs *)
+  end.
+
+Definition sem_bin_op_num (op : bin_op) (n1 : num) : option (num → option base_lit) :=
+  match op with
+  | AddOp => Some $ λ n2,
+      LitNum <$> sem_bin_op_lift Z.add Float.add n1 n2
+  | SubOp => Some $ λ n2,
+      LitNum <$> sem_bin_op_lift Z.sub Float.sub n1 n2
+  | MulOp => Some $ λ n2,
+      LitNum <$> sem_bin_op_lift Z.mul Float.mul n1 n2
+  | DivOp => Some $ λ n2,
+      (* Quot can overflow: [MIN_INT `quot` -1] equals [MAX_INT + 1] *)
+      guard (div_allowed n2);;
+      LitNum <$> sem_bin_op_lift Z.quot Float.div n1 n2
+  | AndOp =>
+      i1 ← maybe NInt n1;
+      Some $ λ n2, i2 ← maybe NInt n2;
+        Some $ LitNum $ NInt $ Z.land i1 i2
+  | OrOp =>
+      i1 ← maybe NInt n1;
+      Some $ λ n2, i2 ← maybe NInt n2;
+        Some $ LitNum $ NInt $ Z.lor i1 i2
+  | XOrOp =>
+      i1 ← maybe NInt n1;
+      Some $ λ n2, i2 ← maybe NInt n2;
+        Some $ LitNum $ NInt $ Z.lxor i1 i2
+  | LtOp => Some $ λ n2,
+      Some $ LitBool (sem_bin_rel_lift Z.ltb Float.ltb n1 n2)
+  | _ => None
+  end%Z.
+
+Definition sem_bin_op_string (op : bin_op) : option (string → string → base_lit) :=
+  match op with
+  | AddOp => Some $ λ s1 s2, LitString (s1 +:+ s2)
+  | LtOp => Some $ λ s1 s2, LitBool (bool_decide (strict attr_le s1 s2))
+  | _ => None
+  end.
+
+Definition type_of_num (n : num) : string :=
+  match n with
+  | NInt _ => "int"
+  | NFloat _ => "float"
+  end.
+
+Definition type_of_base_lit (bl : base_lit) : string :=
+  match bl with
+  | LitNum n => type_of_num n
+  | LitBool _ => "bool"
+  | LitString _ => "string"
+  | LitNull => "null"
+  end.
+
+Definition type_of_expr (e : expr) :=
+  match e with
+  | ELit bl => Some (type_of_base_lit bl)
+  | EAbs _ _ | EAbsMatch _ _ _ => Some "lambda"
+  | EList _ => Some "list"
+  | EAttr _ => Some "set"
+  | _ => None
+  end.
+
+(* Used for [RoundOp] *)
+Definition float_to_bounded_Z (f : float) : Z :=
+  match Float.to_Z f with
+  | Some x => if decide (int_ok x) then x else int_min
+  | None => int_min
+  end.
+
+Inductive sem_bin_op : bin_op → expr → (expr → expr → Prop) → Prop :=
+  | EqSem e1 :
+     sem_bin_op EqOp e1 (λ e2 e, sem_eq e1 e2 = Some e)
+  | LitNumSem op n1 f :
+     sem_bin_op_num op n1 = Some f →
+     sem_bin_op op (ELit (LitNum n1)) (λ e2 e, ∃ n2 bl,
+       e2 = ELit (LitNum n2) ∧ f n2 = Some bl ∧ e = ELit bl)
+  | RoundSem m n1 :
+     sem_bin_op (RoundOp m) (ELit (LitNum n1)) (λ e2 e,
+       e2 = ELit LitNull ∧
+       e = ELit $ LitNum $ NInt $ float_to_bounded_Z $ Float.round m $ num_to_float n1)
+  | LitStringSem op s1 f :
+     sem_bin_op_string op = Some f →
+     sem_bin_op op (ELit (LitString s1)) (λ e2 e, ∃ s2,
+       e2 = ELit (LitString s2) ∧ e = ELit (f s1 s2))
+  | MatchStringSem s :
+     sem_bin_op MatchStringOp (ELit (LitString s)) (λ e2 e,
+       e2 = ELit LitNull ∧
+       match s with
+       | EmptyString => e = EAttr {[
+           "empty" := AttrN (ELit (LitBool true));
+           "head" := AttrN (ELit LitNull);
+           "tail" := AttrN (ELit LitNull) ]}
+       | String a s => e = EAttr {[
+           "empty" := AttrN (ELit (LitBool false));
+           "head" := AttrN (ELit (LitString (String a EmptyString)));
+           "tail" := AttrN (ELit (LitString s)) ]}
+       end)
+  | LtListSem es :
+     sem_bin_op LtOp (EList es) (λ e2 e, ∃ es',
+       e2 = EList es' ∧
+       e = sem_lt_list es es')
+  | MatchListSem es :
+     sem_bin_op MatchListOp (EList es) (λ e2 e,
+       e2 = ELit LitNull ∧
+       match es with
+       | [] => e = EAttr {[
+           "empty" := AttrN (ELit (LitBool true));
+           "head" := AttrN (ELit LitNull);
+           "tail" := AttrN (ELit LitNull) ]}
+       | e' :: es => e = EAttr {[
+           "empty" := AttrN (ELit (LitBool false));
+           "head" := AttrN e';
+           "tail" := AttrN (EList es) ]}
+       end)
+  | AppendListSem es :
+     sem_bin_op AppendListOp (EList es) (λ e2 e, ∃ es',
+       e2 = EList es' ∧
+       e = EList (es ++ es'))
+  | SelectAttrSem αs :
+     no_recs αs →
+     sem_bin_op SelectAttrOp (EAttr αs) (λ e2 e, ∃ x,
+       e2 = ELit (LitString x) ∧ αs !! x = Some (AttrN e))
+  | UpdateAttrSem αs1 :
+     no_recs αs1 →
+     sem_bin_op UpdateAttrOp (EAttr αs1) (λ e2 e, ∃ αs2,
+       e2 = EAttr αs2 ∧ no_recs αs2 ∧ e = EAttr (αs2 ∪ αs1))
+  | HasAttrSem αs :
+     no_recs αs →
+     sem_bin_op HasAttrOp (EAttr αs) (λ e2 e, ∃ x,
+       e2 = ELit (LitString x) ∧ e = ELit (LitBool (bool_decide (is_Some (αs !! x)))))
+  | DeleteAttrSem αs :
+     no_recs αs →
+     sem_bin_op DeleteAttrOp (EAttr αs) (λ e2 e, ∃ x,
+       e2 = ELit (LitString x) ∧ e = EAttr (delete x αs))
+  | SingletonAttrSem x :
+     sem_bin_op SingletonAttrOp (ELit (LitString x)) (λ e2 e,
+       e2 = ELit LitNull ∧
+       e = EAbs "t" (EAttr {[ x := AttrN (EId' "t") ]}))
+  | MatchAttrSem αs :
+     no_recs αs →
+     sem_bin_op MatchAttrOp (EAttr αs) (λ e2 e,
+       e2 = ELit LitNull ∧
+       ((αs = ∅ ∧
+         e = EAttr {[
+           "empty" := AttrN (ELit (LitBool true));
+           "key" := AttrN (ELit LitNull);
+           "head" := AttrN (ELit LitNull);
+           "tail" := AttrN (ELit LitNull) ]}) ∨
+       (∃ x e',
+         αs !! x = Some (AttrN e') ∧
+         (∀ y, is_Some (αs !! y) → attr_le x y) ∧
+         e = EAttr {[
+           "empty" := AttrN (ELit (LitBool false));
+           "key" := AttrN (ELit (LitString x));
+           "head" := AttrN e';
+           "tail" := AttrN (EAttr (delete x αs)) ]})))
+  | FunctionArgsAbsSem x e' :
+     sem_bin_op FunctionArgsOp (EAbs x e') (λ e2 e,
+       e2 = ELit LitNull ∧
+       e = EAttr ∅)
+  | FunctionArgsAbsMatchSem ms strict e' :
+     sem_bin_op FunctionArgsOp (EAbsMatch ms strict e') (λ e2 e,
+       e2 = ELit LitNull ∧
+       e = EAttr (AttrN ∘ ELit ∘ LitBool ∘ from_option (λ _, true) false <$> ms))
+  | TypeOfSem e1 :
+     sem_bin_op TypeOfOp e1 (λ e2 e, ∃ x,
+       e2 = ELit LitNull ∧
+       type_of_expr e1 = Some x ∧
+       e = ELit (LitString x)).
+
+Inductive matches :
+     gmap string expr → gmap string (option expr) → bool → gmap string attr → Prop :=
+  | MatchEmpty strict :
+     matches ∅ ∅ strict ∅
+  | MatchAny es :
+     matches es ∅ false ∅
+  | MatchAvail x e es ms md strict βs :
+     es !! x = None →
+     ms !! x = None →
+     matches es ms strict βs →
+     matches (<[x:=e]> es) (<[x:=md]> ms) strict (<[x:=AttrN e]> βs)
+  | MatchOptDefault x es ms d strict βs :
+     es !! x = None →
+     ms !! x = None →
+     matches es ms strict βs →
+     matches es (<[x:=Some d]> ms) strict (<[x:=AttrR d]> βs).
+
+Reserved Notation "e1 -{ μ }-> e2"
+  (right associativity, at level 55, μ at level 1, format "e1  -{ μ }->  e2").
+
+Inductive ctx1 : mode → mode → (expr → expr) → Prop :=
+  | CList es1 es2 :
+     Forall (final DEEP) es1 →
+     ctx1 DEEP DEEP (λ e, EList (es1 ++ e :: es2))
+  | CAttr αs x :
+     no_recs αs →
+     αs !! x = None →
+     (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) →
+     ctx1 DEEP DEEP (λ e, EAttr (<[x:=AttrN e]> αs))
+  | CAppL μ e2 :
+     ctx1 SHALLOW μ (λ e1, EApp e1 e2)
+  | CAppR μ ms strict e1 :
+     ctx1 SHALLOW μ (EApp (EAbsMatch ms strict e1))
+  | CSeq μ μ' e2 :
+     ctx1 μ' μ (λ e1, ESeq μ' e1 e2)
+  | CLetAttr μ k e2 :
+     ctx1 SHALLOW μ (λ e1, ELetAttr k e1 e2)
+  | CBinOpL μ op e2 :
+     ctx1 SHALLOW μ (λ e1, EBinOp op e1 e2)
+  | CBinOpR μ op e1 Φ :
+     final SHALLOW e1 →
+     sem_bin_op op e1 Φ →
+     ctx1 SHALLOW μ (EBinOp op e1)
+  | CIf μ e2 e3 :
+     ctx1 SHALLOW μ (λ e1, EIf e1 e2 e3).
+
+Inductive step : mode → relation expr :=
+  | Sβ μ x e1 e2 :
+     EApp (EAbs x e1) e2 -{μ}-> subst {[x:=(ABS, e2)]} e1
+  | SβMatch μ ms strict e1 αs βs :
+     no_recs αs →
+     matches (attr_expr <$> αs) ms strict βs →
+     EApp (EAbsMatch ms strict e1) (EAttr αs) -{μ}->
+       subst (indirects βs) e1
+  | SFunctor μ αs e1 e2 :
+     no_recs αs →
+     αs !! "__functor" = Some (AttrN e1) →
+     EApp (EAttr αs) e2 -{μ}-> EApp (EApp e1 (EAttr αs)) e2
+  | SSeqFinal μ μ' e1 e2 :
+     final μ' e1 → ESeq μ' e1 e2 -{μ}-> e2
+  | SLetAttrAttr μ k αs e :
+     no_recs αs →
+     ELetAttr k (EAttr αs) e -{μ}-> subst ((k,.) ∘ attr_expr <$> αs) e
+  | SAttr_rec μ αs :
+     ¬no_recs αs →
+     EAttr αs -{μ}->
+       EAttr (AttrN ∘ from_attr (subst (indirects αs)) id <$> αs)
+  | SBinOp μ op e1 Φ e2 e :
+     final SHALLOW e1 →
+     final SHALLOW e2 →
+     sem_bin_op op e1 Φ → Φ e2 e →
+     EBinOp op e1 e2 -{μ}-> e
+  | SIfBool μ b e2 e3 :
+     EIf (ELit (LitBool b)) e2 e3 -{μ}-> if b then e2 else e3
+  | SId μ x k e :
+     EId x (Some (k,e)) -{μ}-> e
+  | SCtx K μ μ' e e' :
+     ctx1 μ μ' K → e -{μ}-> e' → K e -{μ'}-> K e'
+where "e1 -{ μ }-> e2" := (step μ e1 e2).
+
+Notation "e1 -{ μ }->* e2" := (rtc (step μ) e1 e2)
+  (right associativity, at level 55, μ at level 1, format "e1  -{ μ }->*  e2").
+Notation "e1 -{ μ }->+ e2" := (tc (step μ) e1 e2)
+  (right associativity, at level 55, μ at level 1, format "e1  -{ μ }->+  e2").
+
+Definition stuck (μ : mode) (e : expr) : Prop :=
+  nf (step μ) e ∧ ¬final μ e.
+
+(** Induction *)
+Fixpoint expr_size (e : expr) : nat :=
+  match e with
+  | ELit _ => 1
+  | EId _ mkd => S (from_option (expr_size ∘ snd) 1 mkd)
+  | EAbs _ d => S (expr_size d)
+  | EAbsMatch ms _ e =>
+     S (map_sum_with (from_option expr_size 1) ms + expr_size e)
+  | EApp e1 e2 | ESeq _ e1 e2 => S (expr_size e1 + expr_size e2)
+  | EList es => S (sum_list_with expr_size es)
+  | EAttr eτs => S (map_sum_with (expr_size ∘ attr_expr) eτs)
+  | ELetAttr _ e1 e2 => S (expr_size e1 + expr_size e2)
+  | EBinOp _ e1 e2 => S (expr_size e1 + expr_size e2)
+  | EIf e1 e2 e3 => S (expr_size e1 + expr_size e2 + expr_size e3)
+  end.
+
+Lemma expr_ind (P : expr → Prop) :
+  (∀ b, P (ELit b)) →
+  (∀ x mkd, from_option (P ∘ snd) True mkd → P (EId x mkd)) →
+  (∀ x e, P e → P (EAbs x e)) →
+  (∀ ms strict e,
+    map_Forall (λ _, from_option P True) ms → P e → P (EAbsMatch ms strict e)) →
+  (∀ e1 e2, P e1 → P e2 → P (EApp e1 e2)) →
+  (∀ μ e1 e2, P e1 → P e2 → P (ESeq μ e1 e2)) →
+  (∀ es, Forall P es → P (EList es)) →
+  (∀ αs, map_Forall (λ _, P ∘ attr_expr) αs → P (EAttr αs)) →
+  (∀ k e1 e2, P e1 → P e2 → P (ELetAttr k e1 e2)) →
+  (∀ op e1 e2, P e1 → P e2 → P (EBinOp op e1 e2)) →
+  (∀ e1 e2 e3, P e1 → P e2 → P e3 → P (EIf e1 e2 e3)) →
+  ∀ e, P e.
+Proof.
+  intros Hlit Hid Habs Hmatch Happ Hseq Hlist Hattr Hlet Hop Hif e.
+  induction (Nat.lt_wf_0_projected expr_size e) as [e _ IH].
+  destruct e; repeat destruct select (option _); simpl in *; eauto with lia.
+  - apply Hmatch; [|by eauto with lia]=> y [e'|] Hx //=. apply IH, Nat.lt_succ_r.
+    etrans; [|apply Nat.le_add_r].
+    eapply (map_sum_with_lookup_le (from_option expr_size 1) _ _ _ Hx).
+  - apply Hlist, Forall_forall=> e ?. apply IH, Nat.lt_succ_r.
+    by apply sum_list_with_in.
+  - apply Hattr, map_Forall_lookup=> y e ?. apply IH, Nat.lt_succ_r.
+    by eapply (map_sum_with_lookup_le (expr_size ∘ attr_expr)).
+Qed.
diff --git a/theories/nix/operational_props.v b/theories/nix/operational_props.v
new file mode 100644
index 0000000..4041bfe
--- /dev/null
+++ b/theories/nix/operational_props.v
@@ -0,0 +1,680 @@
+From mininix Require Export utils nix.operational.
+From stdpp Require Import options.
+
+(** Properties of operational semantics *)
+Lemma float_to_bounded_Z_ok f : int_ok (float_to_bounded_Z f).
+Proof.
+  rewrite /float_to_bounded_Z.
+  destruct (Float.to_Z f); simplify_option_eq; done.
+Qed.
+
+Lemma int_ok_alt i :
+  int_ok i ↔ ∀ n, (63 ≤ n)%Z → Z.testbit i n = bool_decide (i < 0)%Z.
+Proof.
+  rewrite -Z.bounded_iff_bits //.
+  rewrite /int_ok bool_decide_spec /int_min /int_max Z.shiftl_1_l. lia.
+Qed.
+
+Lemma int_ok_land i1 i2 : int_ok i1 → int_ok i2 → int_ok (Z.land i1 i2).
+Proof.
+  rewrite !int_ok_alt=> Hi1 Hi2 n ?. rewrite Z.land_spec Hi1 // Hi2 //.
+  apply eq_bool_prop_intro. rewrite andb_True !bool_decide_spec Z.land_neg //.
+Qed.
+
+Lemma int_ok_lor i1 i2 : int_ok i1 → int_ok i2 → int_ok (Z.lor i1 i2).
+Proof.
+  rewrite !int_ok_alt=> Hi1 Hi2 n ?. rewrite Z.lor_spec Hi1 // Hi2 //.
+  apply eq_bool_prop_intro. rewrite orb_True !bool_decide_spec Z.lor_neg //.
+Qed.
+
+Lemma int_ok_lxor i1 i2 : int_ok i1 → int_ok i2 → int_ok (Z.lxor i1 i2).
+Proof.
+  rewrite !int_ok_alt=> Hi1 Hi2 n ?. rewrite Z.lxor_spec Hi1 // Hi2 //.
+  apply eq_bool_prop_intro. rewrite xorb_True !bool_decide_spec.
+  rewrite !Z.lt_nge Z.lxor_nonneg. lia.
+Qed.
+
+Lemma sem_bin_op_num_ok {op f n1 n2 bl} :
+  num_ok n1 → num_ok n2 →
+  sem_bin_op_num op n1 = Some f → f n2 = Some bl → base_lit_ok bl.
+Proof.
+  intros; destruct op, n1, n2; simplify_option_eq;
+    try (by apply (bool_decide_pack _));
+    auto using int_ok_land, int_ok_lor, int_ok_lxor.
+Qed.
+
+Lemma sem_bin_op_string_ok {op f s1 s2} :
+  sem_bin_op_string op = Some f → base_lit_ok (f s1 s2).
+Proof. intros; destruct op; naive_solver. Qed.
+
+Global Hint Extern 0 (no_recs (_ <$> _)) => by apply map_Forall_fmap : core.
+
+Ltac inv_step := repeat
+  match goal with
+  | H : ¬no_recs (_ <$> _) |- _ => destruct H; by apply map_Forall_fmap
+  | H : ?e -{_}-> _ |- _ => assert_succeeds (is_app_constructor e); inv H
+  | H : ctx1 _ _ ?K |- _ => is_var K; inv H
+  end.
+
+Global Instance Attr_inj τ : Inj (=) (=) (Attr τ).
+Proof. by injection 1. Qed.
+
+Lemma fmap_attr_expr_Attr τ (es : gmap string expr) :
+  attr_expr <$> (Attr τ <$> es) = es.
+Proof. apply map_eq=> x. rewrite !lookup_fmap. by destruct (_ !! _). Qed.
+
+Lemma no_recs_insert αs x e : no_recs αs → no_recs (<[x:=AttrN e]> αs).
+Proof. by apply map_Forall_insert_2. Qed.
+Lemma no_recs_insert_inv αs x τ e :
+  αs !! x = None → no_recs (<[x:=Attr τ e]> αs) → no_recs αs.
+Proof. intros ??%map_Forall_insert; naive_solver. Qed.
+Lemma no_recs_lookup αs x τ e : no_recs αs → αs !! x = Some (Attr τ e) → τ = NONREC.
+Proof. intros Hall. apply Hall. Qed.
+
+Lemma no_recs_attr_subst αs ds : no_recs αs → no_recs (attr_subst ds <$> αs).
+Proof.
+  intros. eapply map_Forall_fmap, map_Forall_impl; [done|]. by intros ? [[]] [=].
+Qed.
+
+Lemma from_attr_no_recs {A} (f g : expr → A) (αs : gmap string attr) :
+  no_recs αs → from_attr f g <$> αs = g ∘ attr_expr <$> αs.
+Proof.
+  intros Hrecs. apply map_eq=> x. rewrite !lookup_fmap. specialize (Hrecs x).
+  destruct (αs !! x) as [[]|] eqn:?; naive_solver.
+Qed.
+
+Lemma sem_and_attr_empty : sem_and_attr ∅ = ELit (LitBool true).
+Proof. done. Qed.
+Lemma sem_and_attr_insert es x e :
+  es !! x = None → (∀ y, is_Some (es !! y) → attr_le x y) →
+  sem_and_attr (<[x:=e]> es) = EIf e (sem_and_attr es) (ELit (LitBool false)).
+Proof. intros. by rewrite /sem_and_attr map_fold_sorted_insert. Qed.
+
+Lemma matches_strict es ms ds x e :
+  es !! x = None →
+  ms !! x = None →
+  matches es ms false ds →
+  matches (<[x:=e]> es) ms false ds.
+Proof.
+  remember false as strict.
+  induction 3; simplify_eq/=;
+    repeat match goal with
+    | H : <[ _ := _ ]> _ !! _ = None |- _ => apply lookup_insert_None in H as [??]
+    | _ => rewrite (insert_commute _ x) //
+    | _ => constructor
+    | _ => apply lookup_insert_None
+    end; eauto.
+Qed.
+
+Lemma subst_empty e : subst ∅ e = e.
+Proof.
+  induction e; repeat destruct select (option _); do 2 f_equal/=; auto.
+  - apply map_eq=> x. rewrite lookup_fmap.
+    destruct (_ !! x) as [[e'|]|] eqn:Hx; do 2 f_equal/=. apply (H _ _ Hx).
+  - induction H; f_equal/=; auto.
+  - apply map_eq; intros i. rewrite lookup_fmap.
+    destruct (_ !! i) as [[τ e]|] eqn:?; do 2 f_equal/=.
+    by eapply (H _ (Attr _ _)).
+Qed.
+
+Lemma subst_union ds1 ds2 e :
+  subst (union_kinded ds1 ds2) e = subst ds1 (subst ds2 e).
+Proof.
+  revert ds1 ds2. induction e; intros ds1 ds2; f_equal/=; auto.
+  - rewrite lookup_union_with.
+    destruct mkd as [[[]]|],
+      (ds1 !! x) as [[[] t1]|], (ds2 !! x) as [[[] t2]|]; naive_solver.
+  - apply map_eq=> y. rewrite !lookup_fmap.
+    destruct (_ !! y) as [[e'|]|] eqn:Hy; do 2 f_equal/=.
+    rewrite -(H _ _ Hy) //.
+  - induction H; f_equal/=; auto.
+  - apply map_eq=> y. rewrite !lookup_fmap.
+    destruct (_ !! y) as [[τ e]|] eqn:Hy; do 2 f_equal/=.
+    rewrite -(H _ _ Hy) //.
+Qed.
+
+Lemma SAppL μ e1 e1' e2 :
+  e1 -{SHALLOW}-> e1' → EApp e1 e2 -{μ}-> EApp e1' e2.
+Proof. apply (SCtx (λ e, EApp e _)). constructor. Qed.
+Lemma SAppR μ ms strict e1 e2 e2' :
+  e2 -{SHALLOW}-> e2' →
+  EApp (EAbsMatch ms strict e1) e2 -{μ}-> EApp (EAbsMatch ms strict e1) e2'.
+Proof. apply SCtx. constructor. Qed.
+Lemma SSeq μ μ' e1 e1' e2 :
+  e1 -{μ'}-> e1' → ESeq μ' e1 e2 -{μ}-> ESeq μ' e1' e2.
+Proof. apply (SCtx (λ e, ESeq _ e _)). constructor. Qed.
+Lemma SList es1 e e' es2 :
+  Forall (final DEEP) es1 →
+  e -{DEEP}-> e' →
+  EList (es1 ++ e :: es2) -{DEEP}-> EList (es1 ++ e' :: es2).
+Proof. intros ?. apply (SCtx (λ e, EList (_ ++ e :: _))). by constructor. Qed.
+Lemma SAttr αs x e e' :
+  no_recs αs →
+  αs !! x = None →
+  (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) →
+  e -{DEEP}-> e' →
+  EAttr (<[x:=AttrN e]> αs) -{DEEP}-> EAttr (<[x:=AttrN e']> αs).
+Proof. intros ???. apply (SCtx (λ e, EAttr (<[x:=AttrN e]> _))). by constructor. Qed.
+Lemma SLetAttr μ k e1 e1' e2 :
+  e1 -{SHALLOW}-> e1' → ELetAttr k e1 e2 -{μ}-> ELetAttr k e1' e2.
+Proof. apply (SCtx (λ e, ELetAttr _ e _)). constructor. Qed.
+Lemma SBinOpL μ op e1 e1' e2 :
+  e1 -{SHALLOW}-> e1' → EBinOp op e1 e2 -{μ}-> EBinOp op e1' e2.
+Proof. apply (SCtx (λ e, EBinOp _ e _)). constructor. Qed.
+Lemma SBinOpR μ op e1 Φ e2 e2' :
+  final SHALLOW e1 → sem_bin_op op e1 Φ →
+  e2 -{SHALLOW}-> e2' → EBinOp op e1 e2 -{μ}-> EBinOp op e1 e2'.
+Proof. intros ??. apply SCtx. by econstructor. Qed.
+Lemma SIf μ e1 e1' e2 e3 :
+  e1 -{SHALLOW}-> e1' → EIf e1 e2 e3 -{μ}-> EIf e1' e2 e3.
+Proof. apply (SCtx (λ e, EIf e _ _)). constructor. Qed.
+
+Global Hint Constructors step : step.
+Global Hint Resolve SAppL SAppR SSeq SList SAttr SLetAttr SBinOpL SBinOpR SIf : step.
+
+Lemma step_not_final μ e1 e2 : e1 -{μ}-> e2 → ¬final μ e1.
+Proof.
+  assert (∀ (αs : gmap string attr) x μ e,
+    map_Forall (λ _, final DEEP ∘ attr_expr) (<[x:=Attr μ e]> αs) → final DEEP e).
+  { intros αs x μ' e Hall. eapply (Hall _ (Attr _ _)), lookup_insert. }
+  induction 1; inv 1; inv_step; decompose_Forall; naive_solver.
+Qed.
+Lemma final_nf μ e : final μ e → nf (step μ) e.
+Proof. by intros ? [??%step_not_final]. Qed.
+
+Lemma step_any_shallow μ e1 e2 :
+  e1 -{μ}-> e2 → e1 -{SHALLOW}-> e2 ∨ final SHALLOW e1.
+Proof.
+  induction 1; inv_step;
+    naive_solver eauto using final, no_recs_insert with step.
+Qed.
+
+Lemma step_shallow_any μ e1 e2 : e1 -{SHALLOW}-> e2 → e1 -{μ}-> e2.
+Proof.
+  remember SHALLOW as μ'. induction 1; inv_step; simplify_eq/=; eauto with step.
+Qed.
+Lemma steps_shallow_any μ e1 e2 : e1 -{SHALLOW}->* e2 → e1 -{μ}->* e2.
+Proof. induction 1; eauto using rtc, step_shallow_any. Qed.
+Lemma final_any_shallow μ e : final μ e → final SHALLOW e.
+Proof. destruct μ; [done|]. induction 1; simplify_eq/=; eauto using final. Qed.
+Lemma stuck_shallow_any μ e : stuck SHALLOW e → stuck μ e.
+Proof.
+  intros [Hnf Hfinal]. split; [|naive_solver eauto using final_any_shallow].
+  intros [e' Hstep%step_any_shallow]; naive_solver.
+Qed.
+
+Lemma step_final_shallow μ e1 e2 :
+  final SHALLOW e1 → e1 -{μ}-> e2 → final SHALLOW e2.
+Proof.
+  induction 1; intros; inv_step; decompose_Forall;
+    eauto using step, final, no_recs_insert; try done.
+  - by odestruct step_not_final.
+  - apply map_Forall_insert in H0 as [??]; simpl in *; last done.
+    by odestruct step_not_final.
+Qed.
+
+Lemma SAppL_rtc μ e1 e1' e2 :
+  e1 -{SHALLOW}->* e1' → EApp e1 e2 -{μ}->* EApp e1' e2.
+Proof. induction 1; econstructor; eauto with step. Qed.
+Lemma SAppR_rtc μ ms strict e1 e2 e2' :
+  e2 -{SHALLOW}->* e2' →
+  EApp (EAbsMatch ms strict e1) e2 -{μ}->* EApp (EAbsMatch ms strict e1) e2'.
+Proof. induction 1; econstructor; eauto with step. Qed.
+Lemma SSeq_rtc μ μ' e1 e1' e2 :
+  e1 -{μ'}->* e1' → ESeq μ' e1 e2 -{μ}->* ESeq μ' e1' e2.
+Proof. induction 1; econstructor; eauto with step. Qed.
+Lemma SList_rtc es1 e e' es2 :
+  Forall (final DEEP) es1 →
+  e -{DEEP}->* e' →
+  EList (es1 ++ e :: es2) -{DEEP}->* EList (es1 ++ e' :: es2).
+Proof. induction 2; econstructor; eauto with step. Qed.
+Lemma SLetAttr_rtc μ k e1 e1' e2 :
+  e1 -{SHALLOW}->* e1' → ELetAttr k e1 e2 -{μ}->* ELetAttr k e1' e2.
+Proof. induction 1; econstructor; eauto with step. Qed.
+Lemma SBinOpL_rtc μ op e1 e1' e2 :
+  e1 -{SHALLOW}->* e1' → EBinOp op e1 e2 -{μ}->* EBinOp op e1' e2.
+Proof. induction 1; econstructor; eauto with step. Qed.
+Lemma SBinOpR_rtc μ op e1 Φ e2 e2' :
+  final SHALLOW e1 → sem_bin_op op e1 Φ →
+  e2 -{SHALLOW}->* e2' → EBinOp op e1 e2 -{μ}->* EBinOp op e1 e2'.
+Proof. induction 3; econstructor; eauto with step. Qed.
+Lemma SIf_rtc μ e1 e1' e2 e3 :
+  e1 -{SHALLOW}->* e1' → EIf e1 e2 e3 -{μ}->* EIf e1' e2 e3.
+Proof. induction 1; econstructor; eauto with step. Qed.
+
+Lemma SApp_tc μ e1 e1' e2 :
+  e1 -{SHALLOW}->+ e1' → EApp e1 e2 -{μ}->+ EApp e1' e2.
+Proof. induction 1; by econstructor; eauto with step. Qed.
+Lemma SSeq_tc μ μ' e1 e1' e2 :
+  e1 -{μ'}->+ e1' → ESeq μ' e1 e2 -{μ}->+ ESeq μ' e1' e2.
+Proof. induction 1; by econstructor; eauto with step. Qed.
+Lemma SList_tc es1 e e' es2 :
+  Forall (final DEEP) es1 →
+  e -{DEEP}->+ e' →
+  EList (es1 ++ e :: es2) -{DEEP}->+ EList (es1 ++ e' :: es2).
+Proof. induction 2; by econstructor; eauto with step. Qed.
+Lemma SLetAttr_tc μ k e1 e1' e2 :
+  e1 -{SHALLOW}->+ e1' → ELetAttr k e1 e2 -{μ}->+ ELetAttr k e1' e2.
+Proof. induction 1; by econstructor; eauto with step. Qed.
+Lemma SBinOpL_tc μ op e1 e1' e2 :
+  e1 -{SHALLOW}->+ e1' → EBinOp op e1 e2 -{μ}->+ EBinOp op e1' e2.
+Proof. induction 1; by econstructor; eauto with step. Qed.
+Lemma SBinOpR_tc μ op e1 Φ e2 e2' :
+  final SHALLOW e1 → sem_bin_op op e1 Φ →
+  e2 -{SHALLOW}->+ e2' → EBinOp op e1 e2 -{μ}->+ EBinOp op e1 e2'.
+Proof. induction 3; by econstructor; eauto with step. Qed.
+Lemma SIf_tc μ e1 e1' e2 e3 :
+  e1 -{SHALLOW}->+ e1' → EIf e1 e2 e3 -{μ}->+ EIf e1' e2 e3.
+Proof. induction 1; by econstructor; eauto with step. Qed.
+
+Lemma SList_inv es1 e2 :
+  EList es1 -{DEEP}-> e2 ↔ ∃ ds1 ds2 e e',
+    es1 = ds1 ++ e :: ds2 ∧ e2 = EList (ds1 ++ e' :: ds2) ∧
+    Forall (final DEEP) ds1 ∧
+    e -{DEEP}-> e'.
+Proof. split; intros; inv_step; naive_solver eauto using SList. Qed.
+
+Lemma List_nf_cons_final es e :
+  final DEEP e →
+  nf (step DEEP) (EList es) →
+  nf (step DEEP) (EList (e :: es)).
+Proof.
+  intros Hfinal Hnf [e' (ds1 & ds2 & e1 & e2 & ? & -> & Hds1 & Hstep)%SList_inv].
+  destruct Hds1; simplify_eq/=.
+  - by apply step_not_final in Hstep.
+  - naive_solver eauto with step.
+Qed.
+Lemma List_nf_cons es e :
+  ¬final DEEP e →
+  nf (step DEEP) e →
+  nf (step DEEP) (EList (e :: es)).
+Proof.
+  intros Hfinal Hnf [e' (ds1 & ds2 & e1 & e2 & ? & -> & Hds1 & Hstep)%SList_inv].
+  destruct Hds1; naive_solver.
+Qed.
+
+Lemma List_steps_cons es1 es2 e :
+  final DEEP e →
+  EList es1 -{DEEP}->* EList es2 →
+  EList (e :: es1) -{DEEP}->* EList (e :: es2).
+Proof.
+  intros ? Hstep.
+  remember (EList es1) as e1 eqn:He1; remember (EList es2) as e2 eqn:He2.
+  revert es1 es2 He1 He2.
+  induction Hstep as [|e1 e2 e3 Hstep Hstep' IH];
+    intros es1 es3 ??; simplify_eq/=; [done|].
+  inv_step. eapply rtc_l; [apply (SList (_ :: _))|]; naive_solver.
+Qed.
+
+Lemma SAttr_rec_rtc μ αs :
+  EAttr αs -{μ}->*
+    EAttr (AttrN ∘ from_attr (subst (indirects αs)) id <$> αs).
+Proof.
+  destruct (decide (no_recs αs)) as [Hαs|]; [|by eauto using rtc_once, step].
+  eapply reflexive_eq. f_equal. apply map_eq=> x. rewrite lookup_fmap.
+  destruct (αs !! x) as [[τ e]|] eqn:?; [|done].
+  assert (τ = NONREC) as -> by eauto using no_recs_lookup. done.
+Qed.
+
+Lemma SAttr_lookup_rtc αs x e e' :
+  no_recs αs →
+  αs !! x = None →
+  (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) →
+  e -{DEEP}->* e' →
+  EAttr (<[x:=AttrN e]> αs) -{DEEP}->* EAttr (<[x:=AttrN e']> αs).
+Proof.
+  intros Hrecs Hx Hfirst He. revert αs Hrecs Hx Hfirst.
+  induction He as [e|e1 e2 e3 He12 He23 IH]; intros eτs Hrec Hx Hfirst; [done|].
+  eapply rtc_l; first by eapply SAttr. apply IH; [done..|].
+  apply step_not_final in He12. naive_solver.
+Qed.
+
+Lemma SAttr_inv αs1 e2 :
+  no_recs αs1 →
+  EAttr αs1 -{DEEP}-> e2 ↔ ∃ αs x e e',
+    αs1 = <[x:=AttrN e]> αs ∧ e2 = EAttr (<[x:=AttrN e']> αs) ∧
+    αs !! x = None ∧
+    (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) ∧
+    e -{DEEP}-> e'.
+Proof.
+  split; [intros; inv_step|];
+    naive_solver eauto using SAttr, no_recs_insert_inv.
+Qed.
+
+Lemma Attr_nf_insert_final αs x e :
+  no_recs αs →
+  αs !! x = None →
+  final DEEP e →
+  (∀ y, is_Some (αs !! y) → attr_le x y) →
+  nf (step DEEP) (EAttr αs) →
+  nf (step DEEP) (EAttr (<[x:=AttrN e]> αs)).
+Proof.
+  intros Hrecs Hx Hfinal Hleast Hnf
+    [? (αs'&x'&e'&e''&Hαs&->&Hx'&?&Hstep)%SAttr_inv];
+    last by eauto using no_recs_insert.
+  assert (x ≠ x').
+  { intros ->. apply (f_equal (.!! x')) in Hαs. rewrite !lookup_insert in Hαs.
+    apply step_not_final in Hstep. naive_solver. }
+  destruct Hnf. exists (EAttr (<[x':=AttrN e'']> (delete x αs'))).
+  rewrite -(delete_insert αs x (AttrN e)) // Hαs delete_insert_ne //.
+  refine (SCtx _ _ _ _ _ (CAttr _ _ _ _ _) _);
+    [|by rewrite lookup_delete_ne| |done].
+  - apply (no_recs_insert _ x e) in Hrecs. rewrite Hαs in Hrecs.
+    apply no_recs_insert_inv in Hrecs; last done. by apply map_Forall_delete.
+  - intros ?? ?%lookup_delete_Some; naive_solver.
+Qed.
+Lemma Attr_nf_insert αs x e :
+  no_recs αs →
+  αs !! x = None →
+  ¬final DEEP e →
+  (∀ y, is_Some (αs !! y) → attr_le x y) →
+  nf (step DEEP) e →
+  nf (step DEEP) (EAttr (<[x:=AttrN e]> αs)).
+Proof.
+  intros Hrecs Hx ?? Hnf [? (αs'&x'&e'&e''&Hαs&->&Hx'&Hleast'&Hstep)%SAttr_inv];
+    last eauto using no_recs_insert.
+  assert (x ≠ x') as Hxx'.
+  { intros ->. apply (f_equal (.!! x')) in Hαs. rewrite !lookup_insert in Hαs.
+    naive_solver. }
+  odestruct (Hleast' x (AttrN e)); [|done|].
+  - apply (f_equal (.!! x)) in Hαs.
+    by rewrite lookup_insert lookup_insert_ne in Hαs.
+  - apply (f_equal (.!! x')) in Hαs.
+    rewrite lookup_insert lookup_insert_ne // in Hαs.
+    destruct Hxx'. apply (anti_symm attr_le); naive_solver.
+Qed.
+
+Lemma Attr_step_dom μ αs1 e2 :
+  EAttr αs1 -{μ}-> e2 →
+  ∃ αs2, e2 = EAttr αs2 ∧ ∀ i, αs1 !! i = None ↔ αs2 !! i = None.
+Proof.
+  intros; inv_step; (eexists; split; [done|]).
+  - intros i. by rewrite lookup_fmap fmap_None.
+  - intros i. rewrite !lookup_insert_None; naive_solver.
+Qed.
+Lemma Attr_steps_dom μ αs1 αs2 :
+  EAttr αs1 -{μ}->* EAttr αs2 → ∀ i, αs1 !! i = None ↔ αs2 !! i = None.
+Proof.
+  intros Hstep.
+  remember (EAttr αs1) as e1 eqn:He1; remember (EAttr αs2) as e2 eqn:He2.
+  revert αs1 αs2 He1 He2. induction Hstep as [|e1 e2 e3 Hstep Hstep' IH];
+    intros αs1 αs3 ??; simplify_eq/=; [done|].
+  apply Attr_step_dom in Hstep; naive_solver.
+Qed.
+
+Lemma Attr_step_recs αs1 αs2 :
+  EAttr αs1 -{DEEP}-> EAttr αs2 → no_recs αs1 → no_recs αs2.
+Proof. intros. inv_step; by eauto using no_recs_insert. Qed.
+Lemma Attr_steps_recs αs1 αs2 :
+  EAttr αs1 -{DEEP}->* EAttr αs2 → no_recs αs1 → no_recs αs2.
+Proof.
+  intros Hstep.
+  remember (EAttr αs1) as e1 eqn:He1; remember (EAttr αs2) as e2 eqn:He2.
+  revert αs1 αs2 He1 He2. induction Hstep as [|e1 e2 e3 Hstep Hstep' IH];
+    intros αs1 αs3 ???; simplify_eq/=; [done|].
+  pose proof (Attr_step_dom _ _ _ Hstep) as (es2 & -> & ?).
+  apply Attr_step_recs in Hstep; naive_solver.
+Qed.
+
+Lemma Attr_step_insert αs1 αs2 x e :
+  no_recs αs1 →
+  αs1 !! x = None →
+  final DEEP e →
+  EAttr αs1 -{DEEP}-> EAttr αs2 →
+  EAttr (<[x:=AttrN e]> αs1) -{DEEP}-> EAttr (<[x:=AttrN e]> αs2).
+Proof.
+  intros Hrecs Hx ?
+    (αs' & x' & e1 & e1' & ? & ? & ? & ? & ?)%SAttr_inv; [|done]; simplify_eq.
+  apply lookup_insert_None in Hx as [??]. rewrite !(insert_commute _ x) //.
+  eapply SAttr; [|by rewrite lookup_insert_ne| |done].
+  - by eapply no_recs_insert, no_recs_insert_inv.
+  - intros y e' ?%lookup_insert_Some; naive_solver.
+Qed.
+Lemma Attr_steps_insert αs1 αs2 x e :
+  no_recs αs1 →
+  αs1 !! x = None →
+  final DEEP e →
+  EAttr αs1 -{DEEP}->* EAttr αs2 →
+  EAttr (<[x:=AttrN e]> αs1) -{DEEP}->* EAttr (<[x:=AttrN e]> αs2).
+Proof.
+  intros Hrecs Hx ? Hstep.
+  remember (EAttr αs1) as e1 eqn:He1; remember (EAttr αs2) as e2 eqn:He2.
+  revert αs1 αs2 Hx Hrecs He1 He2.
+  induction Hstep as [|e1 e2 e3 Hstep Hstep' IH];
+    intros αs1 αs3 ????; simplify_eq/=; [done|].
+  pose proof (Attr_step_dom _ _ _ Hstep) as (αs2 & -> & Hdom).
+  eapply rtc_l; first by eapply Attr_step_insert.
+  eapply IH; naive_solver eauto using Attr_step_recs.
+Qed.
+
+Reserved Infix "=D=>" (right associativity, at level 55).
+
+Inductive step_delayed : relation expr :=
+  | RDrefl e :
+      e =D=> e
+  | RDId x e1 e2 :
+      e1 =D=> e2 →
+      EId x (Some (ABS, e1)) =D=> e2
+  | RDBinOp op e1 e1' e2 e2' :
+      e1 =D=> e1' → e2 =D=> e2' → EBinOp op e1 e2 =D=> EBinOp op e1' e2'
+  | RDIf e1 e1' e2 e2' e3 e3' :
+      e1 =D=> e1' → e2 =D=> e2' → e3 =D=> e3' → EIf e1 e2 e3 =D=> EIf e1' e2' e3'
+where "e1 =D=> e2" := (step_delayed e1 e2).
+
+Global Instance step_delayed_po : PreOrder step_delayed.
+Proof.
+  split; [constructor|].
+  intros e1 e2 e3 Hstep. revert e3.
+  induction Hstep; inv 1; eauto using step_delayed.
+Qed.
+Hint Extern 0 (_ =D=> _) => reflexivity : core.
+
+Lemma delayed_final_l e1 e2 :
+  final SHALLOW e1 →
+  e1 =D=> e2 →
+  e1 = e2.
+Proof. intros Hfinal. induction 1; try by inv Hfinal. Qed.
+
+Lemma delayed_final_r μ e1 e2 :
+  final μ e2 →
+  e1 =D=> e2 →
+  e1 -{μ}->* e2.
+Proof.
+  intros Hfinal. induction 1; try by inv Hfinal.
+  eapply rtc_l; [constructor|]. eauto.
+Qed.
+
+Lemma delayed_step_l μ e1 e1' e2 :
+  e1 =D=> e1' →
+  e1 -{μ}-> e2 →
+  ∃ e2', e1' -{μ}->* e2' ∧ e2 =D=> e2'.
+Proof.
+  intros Hrem. revert μ e2.
+  induction Hrem; intros μ ? Hstep.
+  - eauto using rtc_once.
+  - inv_step. by exists e2.
+  - inv_step.
+    + eapply delayed_final_l in Hrem1 as ->, Hrem2 as ->; [|by eauto..].
+      eexists; split; [|done]. eapply rtc_once. by econstructor.
+    + apply IHHrem1 in H2 as (e1'' & ? & ?).
+      eexists; split; [by eapply SBinOpL_rtc|]. by constructor.
+    + eapply delayed_final_l in Hrem1 as ->; [|by eauto..].
+      apply IHHrem2 in H2 as (e2'' & ? & ?).
+      eexists (EBinOp _ e1' e2''); split; [|by constructor].
+      by eapply SBinOpR_rtc.
+  - inv_step.
+    + eapply delayed_final_l in Hrem1 as <-; [|by repeat constructor].
+      eexists; split; [eapply rtc_once; constructor|]. by destruct b.
+    + apply IHHrem1 in H2 as (e1'' & ? & ?).
+      eexists; split; [by eapply SIf_rtc|]. by constructor.
+Qed.
+
+Lemma delayed_steps_l μ e1 e1' e2 :
+  e1 =D=> e1' →
+  e1 -{μ}->* e2 →
+  ∃ e2', e1' -{μ}->* e2' ∧ e2 =D=> e2'.
+Proof.
+  intros Hdel Hsteps. revert e1' Hdel.
+  induction Hsteps as [e|e1 e2 e3 Hstep Hsteps IH]; intros e1' Hdel.
+  { eexists; by split. }
+  eapply delayed_step_l in Hstep as (e2' & Hstep2 & Hdel2); [|done].
+  apply IH in Hdel2 as (e3' & ? & ?). eexists; by split; [etrans|].
+Qed.
+
+Lemma delayed_step_r μ e1 e1' e2 :
+  e1' =D=> e1 →
+  e1 -{μ}-> e2 →
+  ∃ e2', e1' -{μ}->+ e2' ∧ e2' =D=> e2.
+Proof.
+  intros Hrem. revert μ e2.
+  induction Hrem; intros μ ? Hstep.
+  - eauto using tc_once.
+  - apply IHHrem in Hstep as (e1' & ? & ?).
+    eexists. split; [|done]. eapply tc_l; [econstructor|done].
+  - inv_step.
+    + exists e0; split; [|done].
+      eapply tc_rtc_l; [by eapply SBinOpL_rtc, delayed_final_r, Hrem1|].
+      eapply tc_rtc_l; [by eapply SBinOpR_rtc, delayed_final_r, Hrem2|].
+      eapply tc_once. by econstructor.
+    + apply IHHrem1 in H2 as (e1'' & ? & ?).
+      eexists; split; [by eapply SBinOpL_tc|]. by constructor.
+    + apply IHHrem2 in H2 as (e2'' & ? & ?).
+      eexists (EBinOp _ e1' e2''); split; [|by apply RDBinOp].
+      eapply tc_rtc_l; [by eapply SBinOpL_rtc, delayed_final_r, Hrem1|].
+      by eapply SBinOpR_tc.
+  - inv_step.
+    + exists (if b then e2 else e3). split; [|by destruct b].
+      eapply tc_rtc_l;
+        [eapply SIf_rtc, delayed_final_r, Hrem1; by repeat constructor|].
+      eapply tc_once; constructor.
+    + apply IHHrem1 in H2 as (e1'' & ? & ?).
+      eexists; split; [by eapply SIf_tc|]. by constructor.
+Qed.
+
+Lemma delayed_steps_r μ e1 e1' e2 :
+  e1' =D=> e1 →
+  e1 -{μ}->* e2 →
+  ∃ e2', e1' -{μ}->* e2' ∧ e2' =D=> e2.
+Proof.
+  intros Hdel Hsteps. revert e1' Hdel.
+  induction Hsteps as [e|e1 e2 e3 Hstep Hsteps IH]; intros e1' Hdel.
+  { eexists; by split. }
+  eapply delayed_step_r in Hstep as (e2' & Hstep2%tc_rtc & Hdel2); [|done].
+  apply IH in Hdel2 as (e3' & ? & ?). eexists; by split; [etrans|].
+Qed.
+
+(** Determinism *)
+
+Lemma bin_op_det op e Φ Ψ :
+  sem_bin_op op e Φ →
+  sem_bin_op op e Ψ →
+  Φ = Ψ.
+Proof. by destruct 1; inv 1. Qed.
+
+Lemma bin_op_rel_det op e1 Φ e2 d1 d2 :
+  sem_bin_op op e1 Φ →
+  Φ e2 d1 →
+  Φ e2 d2 →
+  d1 = d2.
+Proof.
+  assert (AntiSymm eq attr_le) by apply _.
+  unfold AntiSymm in *. inv 1; repeat case_match; naive_solver.
+Qed.
+
+Lemma matches_present x e md es ms strict βs :
+  es !! x = Some e → ms !! x = Some md →
+  matches es ms strict βs →
+  βs !! x = Some (AttrN e).
+Proof.
+  intros Hes Hms. induction 1; try done.
+  - by apply lookup_insert_Some in Hes as [[]|[]]; simplify_map_eq.
+  - by simplify_map_eq.
+Qed.
+
+Lemma matches_default x es ms d strict βs :
+  es !! x = None →
+  ms !! x = Some (Some d) →
+  matches es ms strict βs →
+  βs !! x = Some (AttrR d).
+Proof.
+  intros Hes Hms. induction 1; try done.
+  - by apply lookup_insert_None in Hes as []; simplify_map_eq.
+  - by apply lookup_insert_Some in Hms as [[]|[]]; simplify_map_eq.
+Qed.
+
+Lemma matches_weaken x es ms strict βs :
+  matches es ms strict βs →
+  matches (delete x es) (delete x ms) strict (delete x βs).
+Proof.
+  induction 1; [constructor|constructor|..]; rename x0 into y;
+    (destruct (decide (x = y)) as [->|Hxy];
+      [ rewrite !delete_insert_delete //
+      | rewrite !delete_insert_ne //; constructor;
+        by simplify_map_eq ]).
+Qed.
+
+Lemma matches_det es ms strict βs1 βs2 :
+  matches es ms strict βs1 →
+  matches es ms strict βs2 →
+  βs1 = βs2.
+Proof.
+  intros Hβs1. revert βs2. induction Hβs1; intros βs2 Hβs2;
+    try (inv Hβs2; done || (by exfalso; eapply (insert_non_empty (M:=stringmap)))).
+  - eapply (matches_weaken x) in Hβs2 as Hβs2'.
+    rewrite !delete_insert // in Hβs2'.
+    rewrite (IHHβs1 _ Hβs2') insert_delete //.
+    eapply matches_present; eauto; apply lookup_insert.
+  - eapply (matches_weaken x) in Hβs2 as Hβs2'.
+    rewrite delete_notin // delete_insert // in Hβs2'.
+    rewrite (IHHβs1 _ Hβs2') insert_delete //.
+    eapply matches_default; eauto. apply lookup_insert.
+Qed.
+
+Lemma ctx_det K1 K2 e1 e2 μ μ1' μ2' :
+  K1 e1 = K2 e2 →
+  ctx1 μ1' μ K1 →
+  ctx1 μ2' μ K2 →
+  red (step μ1') e1 →
+  red (step μ2') e2 →
+  K1 = K2 ∧ e1 = e2 ∧ μ1' = μ2'.
+Proof.
+  intros Hes HK1 HK2 Hred1 Hred2.
+  induction HK1; inv HK2; try done.
+  - apply not_elem_of_app_cons_inv_l in Hes as [<- [<- <-]]; first done.
+    + intros He1. apply (proj1 (Forall_forall _ _) H0) in He1.
+      inv Hred1. by apply step_not_final in H1.
+    + intros He2. apply (proj1 (Forall_forall _ _) H) in He2.
+      inv Hred2. by apply step_not_final in H1.
+  - destruct (decide (x = x0)) as [<-|].
+    { by apply map_insert_inv_eq in Hes as [[= ->] [= ->]]. }
+    apply map_insert_inv_ne in Hes as (Hx0 & Hx & Hαs); try done.
+    apply H1 in Hx0 as [contra | Hxlex0].
+    + inv Hred2. by apply step_not_final in H5.
+    + apply H4 in Hx as [contra | Hx0lex].
+      * inv Hred1. by apply step_not_final in H5.
+      * assert (Hasym : AntiSymm eq attr_le) by apply _.
+        by pose proof (Hasym _ _ Hxlex0 Hx0lex).
+  - inv Hred1. inv_step.
+  - inv Hred2. inv_step.
+  - inv Hred1. by apply step_not_final in H1.
+  - inv Hred2. by apply step_not_final in H1.
+Qed.
+
+Lemma step_det μ e d1 d2 :
+  e -{μ}-> d1 →
+  e -{μ}-> d2 →
+  d1 = d2.
+Proof.
+  intros Hred1. revert d2.
+  induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step.
+  - by apply (matches_det _ _ _ _ _ H0) in H8 as <-.
+  - inv_step. by apply step_not_final in H3.
+  - inv_step. destruct H. by apply no_recs_insert.
+  - assert (Φ = Φ0) as <- by (by eapply bin_op_det).
+    by eapply bin_op_rel_det.
+  - inv_step; by apply step_not_final in H6.
+  - inv_step. by apply step_not_final in Hred1.
+  - inv_step. destruct H2. by apply no_recs_insert.
+  - inv_step; by apply step_not_final in Hred1.
+  - eapply ctx_det in H0 as (?&?&?); [|by eauto..]; naive_solver.
+Qed.
diff --git a/theories/nix/tests.v b/theories/nix/tests.v
new file mode 100644
index 0000000..cbce874
--- /dev/null
+++ b/theories/nix/tests.v
@@ -0,0 +1,185 @@
+From mininix Require Export nix.interp nix.notations.
+From stdpp Require Import options.
+Open Scope Z_scope.
+
+(** Compare base vals without comparing the proofs. Since we do not have
+definitional proof irrelevance, comparing the proofs would fail (and in practice
+make Coq loop). *)
+Definition res_eq (rv : res val) (bl2 : base_lit) :=
+  match rv with
+  | Res (Some (VLit bl1 _)) => bl1 = bl2
+  | _ => False
+  end.
+Infix "=?" := res_eq.
+
+Definition float_1 :=
+  ceil: (Float.of_Z 20 /: 3).
+Goal interp 100 ∅ float_1 =? 7.
+Proof. by vm_compute. Qed.
+
+Definition float_2 :=
+  Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *:
+  Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *:
+  Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *:
+  Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *:
+  Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000.
+Goal interp 100 ∅ float_2 =? NFloat (Binary.B754_infinity false).
+Proof. by vm_compute. Qed.
+
+Definition float_3 := float_2 /: float_2.
+Goal interp 100 ∅ float_3 =? NFloat (`Float.indef_nan).
+Proof. by vm_compute. Qed.
+
+Definition let_let :=
+  let: "x" := 1 in let: "x" := 2 in "x".
+Goal interp 100 ∅ let_let =? 2.
+Proof. by vm_compute. Qed.
+
+Definition with_let :=
+  with: EAttr {[ "x" := AttrN 1 ]} in let: "x" := 2 in "x".
+Goal interp 100 ∅ with_let =? 2.
+Proof. by vm_compute. Qed.
+
+Definition let_with :=
+  let: "x" := 1 in with: EAttr {[ "x" := AttrN 2 ]} in "x".
+Goal interp 100 ∅ let_with =? 1.
+Proof. by vm_compute. Qed.
+
+Definition with_with :=
+  with: EAttr {[ "x" := AttrN 1 ]} in with: EAttr {[ "x" := AttrN 2 ]} in "x".
+Goal interp 100 ∅ with_with =? 2.
+Proof. by vm_compute. Qed.
+
+Definition with_with_inherit :=
+  with: EAttr {[ "x" := AttrN 1 ]} in with: EAttr {[ "x" := AttrN "x" ]} in "x".
+Goal interp 100 ∅ with_with_inherit =? 1.
+Proof. by vm_compute. Qed.
+
+Definition with_loop :=
+  with: EAttr {[ "x" := AttrR "x" ]} in "x".
+Goal interp 100 ∅ with_loop = NoFuel.
+Proof. by vm_compute. Qed.
+
+Definition rec_attr_shadow_1 :=
+  let: "foo" := EAttr {[ "bar" := AttrN 10 ]} in
+  EAttr {[
+    "bar" := AttrR ("foo" .: "bar");
+    "foo" := AttrR (EAttr {[ "bar" := AttrN 20 ]})
+  ]} .: "bar".
+Goal interp 100 ∅ rec_attr_shadow_1 =? 20.
+Proof. by vm_compute. Qed.
+
+Definition rec_attr_shadow_2 :=
+  EAttr {[
+    "y" := AttrR (EAttr {[ "y" := AttrN "z" ]} .: "y");
+    "z" := AttrR 20
+  ]} .: "y".
+Goal interp 100 ∅ rec_attr_shadow_2 =? 20.
+Proof. by vm_compute. Qed.
+
+Definition nested_functor_1 :=
+  EAttr {[ "__functor" := AttrN $ λ: "self",
+    EAttr {[ "__functor" := AttrN $ λ: "self" "x", 10 ]} ]} 10.
+Goal interp 100 ∅ nested_functor_1 =? 10.
+Proof. by vm_compute. Qed.
+
+Definition nested_functor_2 :=
+  EAttr {[ "__functor" := AttrN $
+    EAttr {[ "__functor" := AttrN $ λ: "self" "self" "x", 10 ]} ]} 10.
+Goal interp 100 ∅ nested_functor_2 =? 10.
+Proof. by vm_compute. Qed.
+
+Definition functor_loop_1 :=
+  EAttr {[ "__functor" := AttrN $
+    λ: "self", "self" "self"
+  ]} 10.
+Goal interp 1000 ∅ functor_loop_1 = NoFuel.
+Proof. by vm_compute. Qed.
+
+Definition functor_loop_2 :=
+  EAttr {[ "__functor" := AttrN $
+    λ: "self" "f", "f" ("self" "f")
+  ]} (λ: "go" "x", "go" "x") 10.
+Goal interp 1000 ∅ functor_loop_2 = NoFuel.
+Proof. by vm_compute. Qed.
+
+Fixpoint many_lets (i : nat) (e : expr) : expr :=
+  match i with
+  | O => e
+  | S i => let: "x" +:+ pretty i := 0 in many_lets i e
+  end.
+
+Fixpoint many_adds (i : nat) : expr :=
+  match i with
+  | O => 0
+  | S i => ("x" +:+ pretty i) +: many_adds i
+  end.
+
+Definition big_prog (i : nat) : expr := many_lets i $ many_adds i.
+
+Definition big := big_prog 1000.
+
+Goal interp 5000 ∅ big =? 0.
+Proof. by vm_compute. Qed.
+
+Definition matching_1 :=
+  (λattr: {[ "x" := None; "y" := None ]}, "x" +: "y")
+    (EAttr {[ "x" := AttrN 10; "y" := AttrN 11 ]}).
+Goal interp 1000 ∅ matching_1 =? 21.
+Proof. by vm_compute. Qed.
+
+Definition matching_2 :=
+  (λattr: {[ "x" := None; "y" := Some (EId' "x") ]}, "x" +: "y")
+    (EAttr {[ "x" := AttrN 10 ]}).
+Goal interp 1000 ∅ matching_2 =? 20.
+Proof. by vm_compute. Qed.
+
+Definition matching_3 :=
+  (λattr: {[ "x" := None; "y" := None ]}, "x" +: "y")
+    (EAttr {[ "x" := AttrN 10 ]}).
+Goal interp 1000 ∅ matching_3 = mfail.
+Proof. by vm_compute. Qed.
+
+Definition matching_4 :=
+  (λattr: {[ "x" := None; "y" := None ]}, "x" +: "y")
+    (EAttr {[ "x" := AttrN 10; "y" := AttrN 11; "z" := AttrN 12 ]}).
+Goal interp 1000 ∅ matching_4 = mfail.
+Proof. by vm_compute. Qed.
+
+Definition matching_5 :=
+  (λattr: {[ "x" := None; "y" := None ]} .., "x" +: "y")
+    (EAttr {[ "x" := AttrN 10; "y" := AttrN 11; "z" := AttrN 12 ]}).
+Goal interp 1000 ∅ matching_5 =? 21.
+Proof. by vm_compute. Qed.
+
+Definition matching_6 :=
+  (λattr: {[ "y" := Some (EId' "y") ]}, "y")
+    (EAttr {[ "y" := AttrN 10 ]}).
+Goal interp 1000 ∅ matching_6 =? 10.
+Proof. by vm_compute. Qed.
+
+Definition matching_7 :=
+  (λattr: {[ "y" := Some (EId' "y") ]}, "y") (EAttr ∅).
+Goal interp 1000 ∅ matching_7 = NoFuel.
+Proof. by vm_compute. Qed.
+
+Definition matching_8 :=
+  (λattr: {[ "y" := Some (EId' "y") ]}.., "y")
+  (EAttr {[ "x" := AttrN 10 ]}).
+Goal interp 1000 ∅ matching_8 = NoFuel.
+Proof. by vm_compute. Qed.
+
+Definition list_lt_1 :=
+  EList [ELit 2; ELit 3] <: EList [ELit 3].
+Goal interp 1000 ∅ list_lt_1 =? true.
+Proof. by vm_compute. Qed.
+
+Definition list_lt_2 :=
+  EList [ELit 2; ELit 3] <: EList [ELit 2].
+Goal interp 1000 ∅ list_lt_2 =? false.
+Proof. by vm_compute. Qed.
+
+Definition list_lt_3 :=
+  EList [ELit 2] <: EList [ELit 2; ELit 3].
+Goal interp 1000 ∅ list_lt_3 =? true.
+Proof. by vm_compute. Qed.
diff --git a/theories/nix/wp.v b/theories/nix/wp.v
new file mode 100644
index 0000000..0eca6e1
--- /dev/null
+++ b/theories/nix/wp.v
@@ -0,0 +1,143 @@
+From mininix Require Export nix.operational_props.
+From stdpp Require Import options.
+
+Definition wp (μ : mode) (e : expr) (Φ : expr → Prop) : Prop :=
+  ∃ e', e -{μ}->* e' ∧ final μ e' ∧ Φ e'.
+
+Lemma Lit_wp μ Φ bl :
+  base_lit_ok bl →
+  Φ (ELit bl) →
+  wp μ (ELit bl) Φ.
+Proof. exists (ELit bl). by repeat constructor. Qed.
+
+Lemma Abs_wp μ Φ x e :
+  Φ (EAbs x e) →
+  wp μ (EAbs x e) Φ.
+Proof. exists (EAbs x e). by repeat constructor. Qed.
+
+Lemma AbsMatch_wp μ Φ ms strict e :
+  Φ (EAbsMatch ms strict e) →
+  wp μ (EAbsMatch ms strict e) Φ.
+Proof. exists (EAbsMatch ms strict e). by repeat constructor. Qed.
+
+Lemma LetAttr_no_recs_wp μ Φ k αs e :
+  no_recs αs →
+  wp μ (subst ((k,.) ∘ attr_expr <$> αs) e) Φ →
+  wp μ (ELetAttr k (EAttr αs) e) Φ.
+Proof.
+  intros Hαs (e' & Hsteps & ? & HΦ). exists e'. split; [|done].
+  etrans; [|apply Hsteps]. apply rtc_once. by constructor.
+Qed.
+
+Lemma BinOp_wp μ Φ op e1 e2 :
+  wp SHALLOW e1 (λ e1', ∃ Φop,
+    sem_bin_op op e1' Φop ∧ 
+    wp SHALLOW e2 (λ e2', ∃ e', Φop e2' e' ∧ wp μ e' Φ)) →
+  wp μ (EBinOp op e1 e2) Φ.
+Proof.
+  intros (e1' & Hsteps1 & ? & Φop & Hop1 & e2' & Hsteps2 & ?
+          & e' & Hop2 & e'' & Hsteps & ? & HΦ).
+  exists e''. split; [|done].
+  etrans; [by apply SBinOpL_rtc|].
+  etrans; [by eapply SBinOpR_rtc|].
+  eapply rtc_l; [by econstructor|]. done.
+Qed.
+
+Lemma Id_wp μ Φ x k e :
+  wp μ e Φ →
+  wp μ (EId x (Some (k,e))) Φ.
+Proof.
+  intros (e' & Hsteps & ? & HΦ). exists e'. split; [|done].
+  etrans; [|apply Hsteps]. apply rtc_once. constructor.
+Qed.
+
+Lemma App_wp μ Φ e1 e2 :
+  wp SHALLOW e1 (λ e1', wp μ (EApp e1' e2) Φ) ↔
+  wp μ (EApp e1 e2) Φ.
+Proof.
+  split.
+  - intros (e1' & Hsteps1 & ? & e' & Hsteps2 & ? & HΦ).
+    exists e'; split; [|done]. etrans; [|apply Hsteps2].
+    by apply SAppL_rtc.
+  - intros (e' & Hsteps & Hfinal & HΦ).
+    cut (∃ e1', e1 -{SHALLOW}->* e1' ∧ final SHALLOW e1' ∧ EApp e1' e2 -{μ}->* e').
+    { intros (e1'&?&?&?). exists e1'. split_and!; [done..|]. by exists e'. }
+    clear Φ HΦ. apply rtc_nsteps in Hsteps as [n Hsteps].
+    revert e1 Hsteps. induction n as [|n IH]; intros e1 Hsteps.
+    { inv Hsteps. inv Hfinal. }
+    inv Hsteps. inv H0.
+    + eexists; split_and!; [done|by constructor|].
+      eapply rtc_l; [by constructor|by eapply rtc_nsteps_2].
+    + eexists; split_and!; [done|by constructor|].
+      eapply rtc_l; [by constructor|by eapply rtc_nsteps_2].
+    + eexists; split_and!; [done|by constructor|].
+      eapply rtc_l; [by constructor|by eapply rtc_nsteps_2].
+    + inv H2.
+      * apply IH in H1 as (e'' & Hsteps & ? & ?).
+        exists e''; split; [|done]. by eapply rtc_l.
+      * eexists; split_and!; [done|by constructor|].
+        eapply rtc_l; [by eapply SAppR|]. by eapply rtc_nsteps_2.
+Qed.
+
+Lemma Attr_wp_shallow Φ αs :
+  Φ (EAttr (AttrN ∘ from_attr (subst (indirects αs)) id <$> αs)) →
+  wp SHALLOW (EAttr αs) Φ.
+Proof.
+  eexists (EAttr (AttrN ∘ _ <$> αs)); split_and!; [ |by constructor|done].
+  destruct (decide (no_recs αs)); [|apply rtc_once; by constructor].
+  apply reflexive_eq; f_equal. apply map_eq=> x. rewrite lookup_fmap.
+  destruct (αs !! x) as [[? e]|] eqn:?; f_equal/=.
+  by assert (τ = NONREC) as -> by eauto using no_recs_lookup.
+Qed.
+
+Lemma β_wp μ Φ x e1 e2 :
+  wp μ (subst {[x:=(ABS, e2)]} e1) Φ →
+  wp μ (EApp (EAbs x e1) e2) Φ.
+Proof.
+  intros (e' & Hsteps & ? & ?). exists e'. split; [|done].
+  eapply rtc_l; [|done]. by constructor.
+Qed.
+
+Lemma βMatch_wp μ Φ ms strict e1 αs βs :
+  no_recs αs →
+  matches (attr_expr <$> αs) ms strict βs →
+  wp μ (subst (indirects βs) e1) Φ →
+  wp μ (EApp (EAbsMatch ms strict e1) (EAttr αs)) Φ.
+Proof.
+  intros ?? (e' & Hsteps & ? & ?). exists e'. split; [|done].
+  eapply rtc_l; [|done]. by constructor.
+Qed.
+
+Lemma Functor_wp μ Φ αs e1 e2 :
+  no_recs αs →
+  αs !! "__functor" = Some (AttrN e1) →
+  wp μ (EApp (EApp e1 (EAttr αs)) e2) Φ →
+  wp μ (EApp (EAttr αs) e2) Φ.
+Proof.
+  intros ?? (e' & Hsteps & ? & ?). exists e'. split; [|done].
+  eapply rtc_l; [|done]. by constructor.
+Qed.
+
+Lemma If_wp μ Φ e1 e2 e3 :
+  wp SHALLOW e1 (λ e1', ∃ b : bool,
+    e1' = ELit (LitBool b) ∧ wp μ (if b then e2 else e3) Φ) →
+  wp μ (EIf e1 e2 e3) Φ.
+Proof.
+  intros (e1' & Hsteps & ? & b & -> & e' & Hsteps' & ? & HΦ).
+  exists e'; split; [|done]. etrans; [by apply SIf_rtc|].
+  eapply rtc_l; [|done]. destruct b; constructor.
+Qed.
+
+Lemma wp_mono μ e Φ Ψ :
+  wp μ e Φ →
+  (∀ e', Φ e' → Ψ e') →
+  wp μ e Ψ.
+Proof. intros (e' & ? & ? & ?) ?. exists e'. naive_solver. Qed.
+
+Lemma union_kinded_abs {A} mkv (v2 : A) :
+  union_kinded (pair WITH <$> mkv) (Some (ABS, v2)) = Some (ABS, v2).
+Proof. by destruct mkv. Qed.
+
+Lemma union_kinded_with {A} (v : A) mkv2 :
+  union_kinded (Some (WITH, v)) (pair WITH <$> mkv2) = Some (WITH, v).
+Proof. by destruct mkv2. Qed.
diff --git a/theories/nix/wp_examples.v b/theories/nix/wp_examples.v
new file mode 100644
index 0000000..7bc2109
--- /dev/null
+++ b/theories/nix/wp_examples.v
@@ -0,0 +1,164 @@
+From mininix Require Import nix.wp nix.notations.
+From stdpp Require Import options.
+Local Open Scope Z_scope.
+
+Definition test αs :=
+  let: "x" := 1 in
+  with: EAttr αs in
+  with: EAttr {[ "y" := AttrN 2 ]} in
+  "x" =: "y".
+
+Example test_wp μ αs :
+  no_recs αs →
+  wp μ (test αs) (.= false).
+Proof.
+  intros Hαs. rewrite /test. apply LetAttr_no_recs_wp.
+  { by apply no_recs_insert. }
+  rewrite /= !map_fmap_singleton /= right_id_L lookup_singleton lookup_singleton_ne //=.
+  apply LetAttr_no_recs_wp.
+  { by apply no_recs_attr_subst. }
+  rewrite /= !map_fmap_singleton /= right_id_L.
+  rewrite (map_fmap_compose attr_expr) lookup_fmap union_kinded_abs.
+  rewrite !lookup_fmap.
+  apply LetAttr_no_recs_wp.
+  { by apply no_recs_insert. }
+  rewrite /= map_fmap_singleton lookup_singleton lookup_singleton_ne //=.
+  rewrite union_kinded_with.
+  apply BinOp_wp.
+  apply Id_wp, Lit_wp; first done. eexists; split; [constructor|].
+  apply Id_wp, Lit_wp; first done.
+  eexists; split; [done|]. by apply Lit_wp.
+Qed.
+
+Definition neg := λ: "b", if: "b" then false else true.
+
+Lemma neg_wp μ (Φ : expr → Prop) e :
+  wp SHALLOW e (λ e', ∃ b : bool, e' = b ∧ Φ (negb b)) →
+  wp μ (neg e) Φ.
+Proof.
+  intros Hwp. apply β_wp. rewrite /= lookup_singleton /=.
+  apply If_wp, Id_wp. eapply wp_mono; [done|].
+  intros ? (b & -> & ?). exists b; split; [done|].
+  destruct b; by apply Lit_wp.
+Qed.
+
+(* rec { f = x: if x = 0 then true else !(f (x - 1)); }.f n *)
+Definition even_rec_attr :=
+  EAttr {[ "f" := AttrR (λ: "x", if: "x" =: 0 then true else neg ("f" ("x" -: 1))) ]} .: "f".
+
+Lemma even_rec_attr_wp e n :
+  0 ≤ n ≤ int_max →
+  wp SHALLOW e (.= n) →
+  wp SHALLOW (even_rec_attr e) (.= Z.even n).
+Proof.
+  intros Hn Hwp. apply App_wp.
+  revert e Hwp. induction (Z.lt_wf 0 n) as [n _ IH]; intros e Hwp.
+  apply BinOp_wp. apply Attr_wp_shallow.
+  eexists; split; [by constructor|].
+  apply Lit_wp; [done|]. eexists; split; [by eexists|].
+  rewrite /=. apply Abs_wp, β_wp.
+  rewrite /= !lookup_singleton /= !lookup_singleton_ne //=.
+  rewrite !union_with_None_l !union_with_None_r.
+  rewrite /indirects map_imap_insert map_imap_empty lookup_insert.
+  rewrite -/even_rec_attr -/neg.
+  apply If_wp, BinOp_wp, Id_wp.
+  eapply wp_mono; [apply Hwp|]; intros ? ->.
+  eexists; split; [by constructor|].
+  apply Lit_wp; [done|]. eexists; split; [by eexists|]. simpl.
+  destruct (n =? 0) eqn:Hn0; (apply Lit_wp; [done|]; eexists; split; [done|]; simpl).
+  { apply Lit_wp; [done|]. by apply Z.eqb_eq in Hn0 as ->. }
+  apply neg_wp, App_wp, Id_wp.
+  eapply wp_mono; [apply (IH (n-1))|]; [lia..| |].
+  2:{ intros e' He'. eapply wp_mono; [apply He'|].
+      intros ? ->. eexists; split; [done|].
+      by rewrite Z.negb_even Z.sub_1_r Z.odd_pred. }
+  eapply BinOp_wp, Id_wp. eapply wp_mono; [apply Hwp|]. intros ? ->.
+  eexists; split; [by constructor|]. apply Lit_wp; [done|].
+  eexists; split; [eexists _, _; split_and!; [done| |done]|].
+  - rewrite /= option_guard_True //. apply bool_decide_pack.
+    rewrite /int_min Z.shiftl_mul_pow2 //. lia.
+  - apply Lit_wp; [|done]. apply bool_decide_pack.
+    rewrite /int_min Z.shiftl_mul_pow2 //. lia.
+Qed.
+
+Lemma even_rec_attr_wp' n :
+  0 ≤ n ≤ int_max →
+  wp SHALLOW (even_rec_attr n) (.= Z.even n).
+Proof.
+  intros ?. apply even_rec_attr_wp; [done|]. apply Lit_wp; [|done].
+  rewrite /= /int_ok. apply bool_decide_pack.
+  rewrite /int_min Z.shiftl_mul_pow2 //. lia.
+Qed.
+
+(* { "__functor " = r: x: if x == 0 then true else !(r (x - 1)); } n *)
+Definition even_rec_functor :=
+  EAttr {[ "__functor" :=
+    AttrN (λ: "r" "x", if: "x" =: 0 then true else neg ("r" ("x" -: 1))) ]}.
+
+Lemma even_rec_functor_wp e n :
+  0 ≤ n ≤ int_max →
+  wp SHALLOW e (.= n) →
+  wp SHALLOW (even_rec_functor e) (.= Z.even n).
+Proof.
+  intros Hn Hwp. apply App_wp.
+  revert e Hwp. induction (Z.lt_wf 0 n) as [n _ IH]; intros e Hwp.
+  apply Attr_wp_shallow. rewrite map_fmap_singleton /=. eapply Functor_wp.
+  { by apply no_recs_insert. }
+  { done. }
+  apply App_wp. apply β_wp.
+  rewrite /= !lookup_singleton !lookup_singleton_ne //=. apply Abs_wp, β_wp.
+  rewrite /= !lookup_singleton /= !lookup_singleton_ne //=.
+  rewrite -/even_rec_functor -/neg.
+  apply If_wp, BinOp_wp, Id_wp.
+  eapply wp_mono; [apply Hwp|]; intros ? ->.
+  eexists; split; [by constructor|].
+  apply Lit_wp; [done|]. eexists; split; [by eexists|]. simpl.
+  destruct (n =? 0) eqn:Hn0; (apply Lit_wp; [done|]; eexists; split; [done|]; simpl).
+  { apply Lit_wp; [done|]. by apply Z.eqb_eq in Hn0 as ->. }
+  apply neg_wp, App_wp, Id_wp.
+  eapply wp_mono; [apply (IH (n-1))|]; [lia..| |].
+  2:{ intros e' He'. eapply wp_mono; [apply He'|].
+      intros ? ->. eexists; split; [done|].
+      by rewrite Z.negb_even Z.sub_1_r Z.odd_pred. }
+  eapply BinOp_wp, Id_wp. eapply wp_mono; [apply Hwp|]. intros ? ->.
+  eexists; split; [by constructor|]. apply Lit_wp; [done|].
+  eexists; split; [eexists _, _; split_and!; [done| |done]|].
+  - rewrite /= option_guard_True //. apply bool_decide_pack.
+    rewrite /int_min Z.shiftl_mul_pow2 //. lia.
+  - apply Lit_wp; [|done]. apply bool_decide_pack.
+    rewrite /int_min Z.shiftl_mul_pow2 //. lia.
+Qed.
+
+Lemma even_rec_functor_wp' n :
+  0 ≤ n ≤ int_max →
+  wp SHALLOW (even_rec_functor n) (.= Z.even n).
+Proof.
+  intros ?. apply even_rec_functor_wp; [done|]. apply Lit_wp; [|done].
+  rewrite /= /int_ok. apply bool_decide_pack.
+  rewrite /int_min Z.shiftl_mul_pow2 //. lia.
+Qed.
+
+(* ({ f ? (x: if x == 0 then true else !(f (x - 1))) }: f) {} n *)
+Definition even_rec_default :=
+  (λattr:
+    {[ "f" := Some (λ: "x", if: "x" =: 0 then true else neg ("f" ("x" -: 1))) ]}, "f")
+  (EAttr ∅).
+
+Lemma even_rec_default_wp e n :
+  0 ≤ n ≤ int_max →
+  wp SHALLOW e (.= n) →
+  wp SHALLOW (even_rec_default e) (.= Z.even n).
+Proof.
+  intros Hn Hwp. apply App_wp.
+  eapply βMatch_wp; [done|repeat econstructor|]. simplify_map_eq.
+  rewrite -/even_rec_attr. by apply Id_wp, App_wp, even_rec_attr_wp.
+Qed.
+
+Lemma even_rec_default_wp' n :
+  0 ≤ n ≤ int_max →
+  wp SHALLOW (even_rec_default n) (.= Z.even n).
+Proof.
+  intros ?. apply even_rec_default_wp; [done|]. apply Lit_wp; [|done].
+  rewrite /= /int_ok. apply bool_decide_pack.
+  rewrite /int_min Z.shiftl_mul_pow2 //. lia.
+Qed.
diff --git a/theories/res.v b/theories/res.v
new file mode 100644
index 0000000..d13bfee
--- /dev/null
+++ b/theories/res.v
@@ -0,0 +1,75 @@
+From mininix Require Export utils.
+From stdpp Require Import options.
+
+Variant res A :=
+  | Res (x : option A)
+  | NoFuel.
+Arguments Res {_} _.
+Arguments NoFuel {_}.
+
+Instance res_fail : MFail res := λ {A} _, Res None.
+
+Instance res_mret : MRet res := λ {A} x, Res (Some x).
+
+Instance res_mbind : MBind res := λ {A B} f rx,
+  match rx with
+  | Res mx => default mfail (f <$> mx)
+  | NoFuel => NoFuel
+  end.
+
+Instance res_fmap : FMap res := λ {A B} f rx,
+  match rx with
+  | Res mx => Res (f <$> mx)
+  | NoFuel => NoFuel
+  end.
+
+Instance Res_inj A : Inj (=) (=) (@Res A).
+Proof. by injection 1. Qed.
+
+Ltac simplify_res :=
+  repeat match goal with
+  | H : Res _ = mfail |- _ => apply (inj Res) in H
+  | H : mfail = Res _ |- _ => apply (inj Res) in H
+  | H : Res _ = mret _ |- _ => apply (inj Res) in H
+  | H : mret _ = Res _ |- _ => apply (inj Res) in H
+  | _ => progress simplify_eq/=
+  end.
+
+Lemma mapM_Res_impl {A B} (f g : A → res B) (xs : list A) ys :
+  mapM f xs = Res ys →
+  (∀ x y, f x = Res y → g x = Res y) →
+  mapM g xs = Res ys.
+Proof.
+  intros Hxs Hf. revert ys Hxs.
+  induction xs as [|x xs IH]; intros ys ?; simplify_res; [done|].
+  destruct (f x) as [my|] eqn:?; simplify_res. rewrite (Hf x my) //=.
+  destruct my as [y|]; simplify_res; [|done].
+  destruct (mapM f _) as [mys|]; simplify_res; [|done..].
+  by rewrite (IH _ eq_refl).
+Qed.
+
+Lemma map_mapM_sorted_Res_impl `{FinMap K M}
+    (R : relation K) `{!RelDecision R, !PartialOrder R, !Total R}
+    {A B} (f g : A → res B) (m1 : M A) m2 :
+  map_mapM_sorted R f m1 = Res m2 →
+  (∀ x y, f x = Res y → g x = Res y) →
+  map_mapM_sorted R g m1 = Res m2.
+Proof.
+  intros Hm Hf. revert m2 Hm.
+  induction m1 as [|i x m1 ?? IH] using (map_sorted_ind R); intros m2.
+  { by rewrite !map_mapM_sorted_empty. }
+  rewrite !map_mapM_sorted_insert //. intros.
+  destruct (f x) as [my|] eqn:?; simplify_res. rewrite (Hf x my) //=.
+  destruct my as [y|]; simplify_res; [|done].
+  destruct (map_mapM_sorted _ f _) as [mm2'|]; simplify_res; [|done..].
+  by rewrite (IH _ eq_refl).
+Qed.
+
+Lemma mapM_res_app {A B} (f : A → res B) xs1 xs2 :
+  mapM f (xs1 ++ xs2) = ys1 ← mapM f xs1; ys2 ← mapM f xs2; mret (ys1 ++ ys2).
+Proof.
+  induction xs1 as [|x1 xs1 IH]; simpl.
+  { by destruct (mapM f xs2) as [[]|]. }
+  destruct (f x1) as [[y1|]|]; simpl; [|done..].
+  rewrite IH. by destruct (mapM f xs1) as [[]|],  (mapM f xs2) as [[]|].
+Qed.
diff --git a/theories/utils.v b/theories/utils.v
new file mode 100644
index 0000000..0cb1b33
--- /dev/null
+++ b/theories/utils.v
@@ -0,0 +1,275 @@
+(* Stuff that should be upstreamed to std++ *)
+From stdpp Require Export gmap stringmap ssreflect.
+From stdpp Require Import sorting.
+From stdpp Require Import options.
+Set Default Proof Using "Type*".
+
+(* Succeeds if [t] is syntactically a constructor applied to some arguments.
+Note that Coq's [is_constructor] succeeds on [S], but fails on [S n]. *)
+Ltac is_app_constructor t :=
+  lazymatch t with
+  | ?t _ => is_app_constructor t
+  | _ => is_constructor t
+  end.
+
+Lemma xorb_True b1 b2 : xorb b1 b2 ↔ ¬(b1 ↔ b2).
+Proof. destruct b1, b2; naive_solver. Qed.
+
+Definition option_to_eq_Some {A} (mx : option A) : option { x | mx = Some x } :=
+  match mx with
+  | Some x => Some (x ↾ eq_refl)
+  | None => None
+  end.
+
+(* Premise can probably be weakened to something with [ProofIrrel]. *)
+Lemma option_to_eq_Some_Some `{!EqDecision A} (mx : option A) x (H : mx = Some x) :
+  option_to_eq_Some mx = Some (x ↾ H).
+Proof.
+  destruct mx as [x'|]; simplify_eq/=; f_equal/=.
+  assert (x' = x) as Hx by congruence. destruct Hx.
+  f_equal. apply (proof_irrel _).
+Qed.
+
+Definition from_sum {A B C} (f : A → C) (g : B → C) (xy : A + B) : C :=
+  match xy with inl x => f x | inr y => g y end.
+
+Global Instance maybe_String : Maybe2 String := λ s,
+  if s is String a s then Some (a,s) else None.
+
+Global Instance String_inj a : Inj (=) (=) (String a).
+Proof. by injection 1. Qed.
+
+Global Instance full_relation_dec {A} : RelDecision (λ _ _ : A, True).
+Proof. unfold RelDecision. apply _. Defined.
+
+Global Instance prod_relation_dec `{RA : relation A, RB : relation B} :
+  RelDecision RA → RelDecision RB → RelDecision (prod_relation RA RB).
+Proof. unfold RelDecision. apply _. Defined.
+
+Global Hint Extern 0 (from_option _ _ _) => progress simpl : core.
+
+Definition map_sum_with `{MapFold K A M} (f : A → nat) : M → nat :=
+  map_fold (λ _, plus ∘ f) 0.
+Lemma map_sum_with_lookup_le `{FinMap K M} {A} (f : A → nat) (m : M A) i x :
+  m !! i = Some x → f x ≤ map_sum_with f m.
+Proof.
+  intros. rewrite /map_sum_with (map_fold_delete_L _ _ i x m) /=; auto with lia.
+Qed.
+
+Lemma map_Forall2_dom `{FinMapDom K M C} {A B} (P : K → A → B → Prop)
+    (m1 : M A) (m2 : M B) :
+  map_Forall2 P m1 m2 → dom m1 ≡ dom m2.
+Proof.
+  revert m2. induction m1 as [|i x1 m1 ? IH] using map_ind; intros m2.
+  { intros ->%map_Forall2_empty_inv_l. by rewrite !dom_empty. }
+  intros (x2 & m2' & -> & ? & ? & ?)%map_Forall2_insert_inv_l; last done.
+  rewrite !dom_insert IH //.
+Qed.
+Lemma map_Forall2_dom_L `{FinMapDom K M C, !LeibnizEquiv C} {A B}
+    (P : K → A → B → Prop) (m1 : M A) (m2 : M B) :
+  map_Forall2 P m1 m2 → dom m1 = dom m2.
+Proof. unfold_leibniz. apply map_Forall2_dom. Qed.
+
+Definition map_mapM
+    `{!∀ A, MapFold K A (M A), !∀ A, Empty (M A), !∀ A, Insert K A (M A)}
+    `{MBind F, MRet F} {A B} (f : A → F B) (m : M A) : F (M B) :=
+  map_fold (λ i x mm, y ← f x; m ← mm; mret $ <[i:=y]> m) (mret ∅) m.
+
+Section fin_map.
+  Context `{FinMap K M}.
+
+  Lemma map_insert_inv_eq {A} {m1 m2 : M A} x v u :
+    m1 !! x = None →
+    m2 !! x = None →
+    <[x:=v]> m1 = <[x:=u]> m2 →
+    v = u ∧ m1 = m2.
+  Proof.
+    intros Hm1 Hm2 Heq. split.
+    - assert (Huv : <[x:=v]> m1 !! x = Some v). { apply lookup_insert. }
+      rewrite Heq lookup_insert in Huv. by injection Huv as ->.
+    - apply map_eq. intros i.
+      replace m1 with (delete x (<[x:=v]> m1)) by (apply delete_insert; done).
+      replace m2 with (delete x (<[x:=u]> m2)) by (apply delete_insert; done).
+      by rewrite Heq.
+  Qed.
+  
+  Lemma map_insert_inv_ne {A} {m1 m2 : M A} x1 x2 v1 v2 :
+    x1 ≠ x2 →
+    m1 !! x1 = None →
+    m2 !! x2 = None →
+    <[x1:=v1]> m1 = <[x2:=v2]> m2 →
+    m1 !! x2 = Some v2 ∧ m2 !! x1 = Some v1 ∧ delete x2 m1 = delete x1 m2.
+  Proof.
+    intros Hx1x2 Hm1 Hm2 Hm1m2. rewrite map_eq_iff in Hm1m2. split_and!.
+    - rewrite -(lookup_insert_ne _ x1 _ v1) //  Hm1m2 lookup_insert //.
+    - rewrite -(lookup_insert_ne _ x2 _ v2) // -Hm1m2 lookup_insert //.
+    - apply map_eq. intros y. destruct (decide (y = x1)) as [->|];
+        first rewrite lookup_delete_ne // lookup_delete //.
+      destruct (decide (y = x2)) as [->|];
+        first rewrite lookup_delete lookup_delete_ne //.
+      rewrite !lookup_delete_ne //
+        -(lookup_insert_ne m2 x2 _ v2) //
+        -(lookup_insert_ne m1 x1 _ v1) //.
+  Qed.
+
+  Lemma map_mapM_empty `{MBind F, MRet F} {A B} (f : A → F B) :
+    map_mapM f (∅ : M A) =@{F (M B)} mret ∅.
+  Proof. unfold map_mapM. by rewrite map_fold_empty. Qed.
+
+  Lemma map_mapM_insert `{MBind F, MRet F} {A B} (f : A → F B) (m : M A) i x :
+    m !! i = None → map_first_key (<[i:=x]> m) i →
+    map_mapM f (<[i:=x]> m) = y ← f x; m ← map_mapM f m; mret $ <[i:=y]> m.
+  Proof. intros. rewrite /map_mapM map_fold_insert_first_key //. Qed.
+
+  Lemma map_mapM_insert_option {A B} (f : A → option B) (m : M A) i x :
+    m !! i = None →
+    map_mapM f (<[i:=x]> m) = y ← f x; m ← map_mapM f m; mret $ <[i:=y]> m.
+  Proof.
+    intros. apply: map_fold_insert; [|done].
+    intros ?? z1 z2 my ???. destruct (f z1), (f z2), my; f_equal/=.
+    by apply insert_commute.
+  Qed.
+End fin_map.
+
+Definition map_minimal_key `{MapFold K A M} (R : relation K) `{!RelDecision R}
+    (m : M) : option K :=
+  map_fold (λ i _ mj,
+    match mj with
+    | Some j => if decide (R i j) then Some i else Some j
+    | None => Some i
+    end) None m.
+
+Section map_sorted.
+  Context `{FinMap K M} (R : relation K) .
+
+  Lemma map_minimal_key_None {A} `{!RelDecision R} (m : M A) :
+    map_minimal_key R m = None ↔ m = ∅.
+  Proof.
+    split; [|intros ->; apply map_fold_empty].
+    induction m as [|j x m ?? _] using map_first_key_ind; intros Hm; [done|].
+    rewrite /map_minimal_key map_fold_insert_first_key // in Hm.
+    repeat case_match; simplify_option_eq.
+  Qed.
+
+  Lemma map_minimal_key_Some_1 {A} `{!RelDecision R, !PreOrder R, !Total R}
+      (m : M A) i :
+    map_minimal_key R m = Some i →
+      is_Some (m !! i) ∧ ∀ j, is_Some (m !! j) → R i j.
+  Proof.
+    revert i. induction m as [|j x m ?? IH] using map_first_key_ind; intros i Hm.
+    { by rewrite /map_minimal_key map_fold_empty in Hm. }
+    rewrite /map_minimal_key map_fold_insert_first_key // in Hm.
+    destruct (map_fold _ _ m) as [i'|] eqn:Hfold; simplify_eq.
+    - apply IH in Hfold as [??]. rewrite lookup_insert_is_Some.
+      case_decide as HR; simplify_eq/=.
+      + split; [by auto|]. intros j [->|[??]]%lookup_insert_is_Some; [done|].
+        trans i'; eauto.
+      + split.
+        { right; split; [|done]. intros ->. by destruct HR. }
+        intros j' [->|[??]]%lookup_insert_is_Some; [|by eauto].
+        by destruct (total R i j').
+    - apply map_minimal_key_None in Hfold as ->.
+      split; [rewrite lookup_insert; by eauto|].
+      intros j' [->|[? Hj']]%lookup_insert_is_Some; [done|].
+      rewrite lookup_empty in Hj'. by destruct Hj'.
+  Qed.
+
+  Lemma map_minimal_key_Some {A} `{!RelDecision R, !PartialOrder R, !Total R}
+      (m : M A) i :
+    map_minimal_key R m = Some i ↔
+      is_Some (m !! i) ∧ ∀ j, is_Some (m !! j) → R i j.
+  Proof.
+    split; [apply map_minimal_key_Some_1|].
+    intros [Hi ?]. destruct (map_minimal_key R m) as [i'|] eqn:Hmin.
+    - f_equal. apply map_minimal_key_Some_1 in Hmin as [??].
+      apply (anti_symm R); eauto.
+    - apply map_minimal_key_None in Hmin as ->.
+      rewrite lookup_empty in Hi. by destruct Hi.
+  Qed.
+
+  Lemma map_sorted_ind {A} `{!PreOrder R, !Total R} (P : M A → Prop) :
+    P ∅ →
+    (∀ i x m,
+      m !! i = None →
+      (∀ j, is_Some (m !! j) → R i j) →
+      P m →
+      P (<[i:=x]> m)) →
+    (∀ m, P m).
+  Proof.
+    intros Hemp Hins m. induction (Nat.lt_wf_0_projected size m) as [m _ IH].
+    cut (m = ∅ ∨ map_Exists (λ i _, ∀ j, is_Some (m !! j) → R i j) m).
+    { intros [->|(i & x & Hi & ?)]; [done|]. rewrite -(insert_delete m i x) //.
+      apply Hins; [by rewrite lookup_delete|..].
+      - intros j ?%lookup_delete_is_Some. naive_solver.
+      - apply IH.
+        rewrite -{2}(insert_delete m i x) // map_size_insert lookup_delete. lia. }
+    clear P Hemp Hins IH. induction m as [|i x m ? IH] using map_ind; [by auto|].
+    right. destruct IH as [->|(i' & x' & ? & ?)].
+    { rewrite insert_empty map_Exists_singleton.
+      by intros j [y [-> ->]%lookup_singleton_Some]. }
+    apply map_Exists_insert; first done. destruct (total R i i').
+    - left. intros j [->|[??]]%lookup_insert_is_Some; [done|]. trans i'; eauto.
+    - right. exists i', x'. split; [done|].
+      intros j [->|[??]]%lookup_insert_is_Some; eauto.
+  Qed.
+End map_sorted.
+
+Definition map_fold_sorted `{!MapFold K A M} {B}
+    (R : relation K) `{!RelDecision R}
+    (f : K → A → B → B) (b : B)
+    (m : M) : B := foldr (λ '(i,x), f i x) b $
+  merge_sort (prod_relation R (λ _ _, True)) (map_to_list m).
+
+Definition map_mapM_sorted
+    `{!∀ A, MapFold K A (M A), !∀ A, Empty (M A), !∀ A, Insert K A (M A)}
+    `{MBind F, MRet F} {A B}
+    (R : relation K) `{!RelDecision R}
+    (f : A → F B) (m : M A) : F (M B) :=
+  map_fold_sorted R (λ i x mm, y ← f x; m ← mm; mret $ <[i:=y]> m) (mret ∅) m.
+
+Section fin_map.
+  Context `{FinMap K M}.
+  Context (R : relation K) `{!RelDecision R, !PartialOrder R, !Total R}.
+
+  Lemma map_fold_sorted_empty {A B} (f : K → A → B → B) b :
+    map_fold_sorted R f b (∅ : M A) = b.
+  Proof. by rewrite /map_fold_sorted map_to_list_empty. Qed.
+
+  Lemma map_fold_sorted_insert {A B} (f : K → A → B → B) (m : M A) b i x :
+    m !! i = None → (∀ j, is_Some (m !! j) → R i j) →
+    map_fold_sorted R f b (<[i:=x]> m) = f i x (map_fold_sorted R f b m).
+  Proof.
+    intros Hi Hleast. unfold map_fold_sorted.
+    set (R' := prod_relation R _).
+    assert (PreOrder R').
+    { split; [done|].
+      intros [??] [??] [??] [??] [??]; split; [by etrans|done]. }
+    assert (Total R').
+    { intros [i1 ?] [i2 ?]. destruct (total R i1 i2); [by left|by right]. }
+    assert (merge_sort R' (map_to_list (<[i:=x]> m))
+      = (i,x) :: merge_sort R' (map_to_list m)) as ->; [|done].
+    eapply (Sorted_unique_strong R').
+    - intros [i1 y1] [i2 y2].
+      rewrite !merge_sort_Permutation elem_of_cons !elem_of_map_to_list.
+      rewrite lookup_insert_Some. intros ?? [? _] [? _].
+      assert (i1 = i2) as -> by (by apply (anti_symm R)); naive_solver.
+    - apply (Sorted_merge_sort _).
+    - apply Sorted_cons; [apply (Sorted_merge_sort _)|].
+      destruct (merge_sort R' (map_to_list m))
+        as [|[i' x'] ixs] eqn:Hixs; repeat constructor; simpl.
+      apply Hleast. exists x'. apply elem_of_map_to_list.
+      rewrite -(merge_sort_Permutation R' (map_to_list m)) Hixs. left.
+    - by rewrite !merge_sort_Permutation map_to_list_insert.
+  Qed.
+
+  Lemma map_mapM_sorted_empty `{MBind F, MRet F} {A B} (f : A → F B) :
+    map_mapM_sorted R f (∅ : M A) =@{F (M B)} mret ∅.
+  Proof. by rewrite /map_mapM_sorted map_fold_sorted_empty. Qed.
+
+  Lemma map_mapM_sorted_insert `{MBind F, MRet F}
+      {A B} (f : A → F B) (m : M A) i x :
+    m !! i = None → (∀ j, is_Some (m !! j) → R i j) →
+    map_mapM_sorted R f (<[i:=x]> m)
+    = y ← f x; m ← map_mapM_sorted R f m; mret $ <[i:=y]> m.
+  Proof. intros. by rewrite /map_mapM_sorted map_fold_sorted_insert. Qed.
+End fin_map.