ExprCorrect.lean

import Verified.ExprSpec
import Verified.ArgsCorrect
import Verified.VarCorrect
import Verified.Float32Correct
import Verified.TreeNodeCorrect
import Verified.TreeCaseCorrect
import Verified.ListFoldCorrect
import Verified.Bytes.Get
import Verified.BytesBuildCorrect
import Verified.BytesLiteralCorrect
import Verified.LiteralCoverage
import Verified.LiteralCoverageFacts

/-! Correctness of expression code and ordinary function templates. -/

namespace Verified

variable {pool : Bytes.LiteralPool}

open Wasm LeanExe.Pipeline LeanExe.Runtime LeanExe.ProofKit

section Cases

variable {S : List Sig} {m : Module} {funs : Funs S} {flags : Flags S} {bounds : Bounds S}
  {fits : Fits S} {host : HostEnv Unit}
  {pv : List Value}

/-- A constant word. -/
theorem spec_word {Γ : List Ty} (value : UInt64) :
    ∀ env slots paid live,
      CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.word (S := S) (Γ := Γ) value) env slots
          paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt _ _ _ _ _ rest Q _ hNext
  have hNext0 := fun store' s' ws a =>
    hNext heap store' s' ws a (fun _ => Nat.le_add_right _ _)
  simpa [Expr.code, Expr.usesFast_eq, Expr.denote] using
    hNext0 store s [.i64 value] (After.refl hAt hVars (by intro i h; simp [h]) rfl
      (Mode.fresh_scalar rfl _ _) fun _ _ _ _ _ _ _ b hb => by
        rw [Ty.regions_scalar .word rfl] at hb; exact nomatch hb)


theorem spec_treeNil {Γ : List Ty} (shape : TreeShape) (hn : shape.hasNull = true) :
    ∀ env slots paid live,
      CodeSpec (pool := pool) m funs flags bounds fits host pv
        (Expr.treeNil (S := S) (Γ := Γ) shape hn) env slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt _ _ _ _ _ rest Q _ hNext
  have hRep : (Ty.tree shape).Rep .owned heap store [.i64 0] (Tree.nil hn) :=
    ⟨0, rfl, rfl, List.Pairwise.nil⟩
  have hAfter : After env slots (fun i => live i || (Expr.treeNil shape hn).uses i) live base
      heap store s (.tree shape) .owned (.nil hn) heap store s [.i64 0] :=
    After.refl hAt hVars (by intro i hi; simp [hi]) hRep rfl
      (fun _ _ _ _ _ _ _ _ hb => nomatch hb)
  have hRun := hNext heap store s [.i64 0] hAfter (fun _ => Nat.le_add_right _ _)
  simpa [Expr.code, Expr.denote] using hRun

theorem spec_bytesEmpty {Γ : List Ty} :
    ∀ env slots paid live,
      CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.bytesEmpty (S := S) (Γ := Γ))
        env slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt _ _ _ _ _ rest Q _ hNext
  have hRep : Ty.bytes.Rep .owned heap store [.i64 0, .i64 0] LeanExe.Bytes.empty :=
    ⟨0, 0, rfl, Bytes.Rep.empty heap store⟩
  have hAfter : After env slots (fun i => live i || Expr.bytesEmpty.uses i) live base
      heap store s .bytes .owned LeanExe.Bytes.empty heap store s [.i64 0, .i64 0] :=
    After.refl hAt hVars (by intro i hi; simp [hi]) hRep rfl
      (fun _ _ _ _ _ _ _ _ hb => nomatch hb)
  have hRun := hNext heap store s [.i64 0, .i64 0] hAfter (fun _ => Nat.le_add_right _ _)
  simpa [Expr.code, Expr.denote] using hRun

/-- A constant `Bool`. -/
theorem spec_bool {Γ : List Ty} (value : Bool) :
    ∀ env slots paid live,
      CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.bool (S := S) (Γ := Γ) value) env slots
          paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt _ _ _ _ _ rest Q _ hNext
  have hNext0 := fun store' s' ws a =>
    hNext heap store' s' ws a (fun _ => Nat.le_add_right _ _)
  simpa [Expr.code, Expr.usesFast_eq, Expr.denote] using
    hNext0 store s [.i64 (boolWord value)] (After.refl hAt hVars (by intro i h; simp [h]) rfl
      (Mode.fresh_scalar rfl _ _) fun _ _ _ _ _ _ _ b hb => by
        rw [Ty.regions_scalar .bool rfl] at hb; exact nomatch hb)


/-- A float constant, from its bit pattern. -/
theorem spec_float {Γ : List Ty} (bits : UInt64) :
    ∀ env slots paid live,
      CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.float (S := S) (Γ := Γ) bits) env slots
          paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt _ _ _ _ _ rest Q _ hNext
  have hNext0 := fun store' s' ws a =>
    hNext heap store' s' ws a (fun _ => Nat.le_add_right _ _)
  simpa [Expr.code, Expr.usesFast_eq, Expr.denote, F64Bits.toBits_ofBits] using
    hNext0 store s [.f64 (Float.ofBits bits).toBits] (After.refl hAt hVars
      (by intro i h; simp [h]) rfl (Mode.fresh_scalar rfl _ _) fun _ _ _ _ _ _ _ b hb => by
        rw [Ty.regions_scalar .float rfl] at hb; exact nomatch hb)


/-- An operation on words; division and remainder save their operands to test the divisor. -/
theorem spec_bin {Γ : List Ty} (op : BinOp) {left right : Expr S Γ .word}
    (leftSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv left env slots paid live)
    (rightSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv right env
        slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.bin op left right) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hL : left.width ≤ max op.scratch (max left.width right.width) :=
    (Nat.le_max_left ..).trans (Nat.le_max_right ..)
  have hR : right.width ≤ max op.scratch (max left.width right.width) :=
    (Nat.le_max_right ..).trans (Nat.le_max_right ..)
  have hS : op.scratch ≤ max op.scratch (max left.width right.width) := Nat.le_max_left ..
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  refine seq_spec leftSpec rightSpec env slots paid live h base heap store s hh hpv
      hVars hAt hSafe hCap hBase
    (by omega) (by omega) hPlace.1 hPlace.2 _ _
    hTrap (by flag_tac) (by flag_tac) (by flag_tac) (by flag_tac)
    fun heap2 store2 s2 ws1 ws2 hStep hF hH hR1 hR2 _ _ _ hTop => ?_
  have hNext2 := fun store' s' ws a => hNext heap2 store' s' ws a (fitsOf hTop)
  simp only [Ty.rep_word] at hR1 hR2
  subst hR1 hR2
  have hStep' := hStep
  rw [fresh_scalar_append rfl rfl] at hStep'
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append]
  cases op
  case div | rem =>
    have hW2 : base + 2 ≤ h := by
      have := hRoom
      simp only [Expr.width, BinOp.scratch] at this
      omega
    have hp2 : s2.params = s.params := hF.params
    have hh2 : s2.positions = h := hF.positions.trans hh
    simp only [BinOp.code, List.cons_append, List.nil_append]
    refine wp_localSet_local (by rw [hp2]; omega)
      (Locals.lt_total (show base + 1 < ({ s2 with values := _ } : Locals).positions by
        rw [Locals.positions_values, hh2]; omega)) ?_
    refine wp_localSet_local (vs := s.values)
      (s := setLocal { s2 with values := .i64 (left.denote funs env) :: s.values } (base + 1)
        (.i64 (right.denote funs env)))
      (by show s2.params.length ≤ base; rw [hp2]; omega)
      (Locals.lt_total (by simp only [Locals.positions_setLocal, Locals.positions_values]; omega)) ?_
    let s2a := setLocal { s2 with values := .i64 (left.denote funs env) :: s.values } (base + 1)
      (.i64 (right.denote funs env))
    let s2b := setLocal { s2a with values := s.values } base (.i64 (left.denote funs env))
    show wp m _ Q store2 s2b host
    have hLowA : ({ s2 with values := .i64 (left.denote funs env) :: s.values } :
        Locals).params.length ≤ base + 1 := by
      show s2.params.length ≤ base + 1; rw [hp2]; omega
    have hLowB : ({ s2a with values := s.values } : Locals).params.length ≤ base := by
      show s2.params.length ≤ base; rw [hp2]; omega
    have hRightSlot : s2b.get (base + 1) = some (.i64 (right.denote funs env)) := by
      rw [Locals.get_setLocal_ne hLowB (by omega), Locals.get_values]
      exact Locals.get_setLocal_same hLowA
        (Locals.lt_total (by simp only [Locals.positions_values]; omega))
    have hLeftSlot : s2b.get base = some (.i64 (left.denote funs env)) :=
      Locals.get_setLocal_same hLowB
        (Locals.lt_total (by simp only [s2a, Locals.positions_setLocal, Locals.positions_values]; omega))
    have hF2 : Frame base s2 s2b :=
      (Frame.setValues (s := s2) (vs := .i64 (left.denote funs env) :: s.values)
        (v := .i64 (right.denote funs env)) (by rw [hp2]; omega) (by omega) (by omega)).trans
        (Frame.setValues (s := s2a) (vs := s.values) (v := .i64 (left.denote funs env))
          (by show s2.params.length ≤ base; rw [hp2]; omega) le_rfl
          (by simp only [s2a, Locals.positions_setLocal, Locals.positions_values]; omega))
    have hFrame : Frame base s s2b := hF.trans hF2
    have hHolds : Holds env slots live base heap2 store2 s2b := hH.agree hF2
    have hs2b : s2b.values = s.values := rfl
    simp only [wp_localGet_cons, hRightSlot, wp_eqzI64_cons]
    rw [wp_iff_control_types]
    refine wp_iff_cons rfl ?_
    by_cases hZero : right.denote funs env = 0
    · simp only [hZero, ite_true, ne_eq]
      simpa [-Locals.get, hLeftSlot, hZero, Expr.denote, BinOp.apply, hs2b] using
        hNext2 store2 s2b _ (After.ofScalar rfl hStep' rfl hFrame hHolds rfl)
    · simp only [hZero, ite_false, ne_eq, not_true_eq_false]
      simpa [-Locals.get, hLeftSlot, hRightSlot, hZero, Expr.denote, BinOp.apply, hs2b] using
        hNext2 store2 s2b _ (After.ofScalar rfl hStep' rfl hFrame hHolds rfl)
  all_goals
    simpa [BinOp.code, Expr.denote, BinOp.apply, ← UInt64.shiftLeft_eq_shiftLeft_mod,
      ← UInt64.shiftRight_eq_shiftRight_mod] using
      hNext2 store2 s2 _ (After.ofScalar rfl hStep' rfl hF hH rfl)


/-- A comparison of words. -/
theorem spec_cmp {Γ : List Ty} (op : CmpOp) {left right : Expr S Γ .word}
    (leftSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv left env slots paid live)
    (rightSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv right env
        slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.cmp op left right) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hL : left.width ≤ max left.width right.width := Nat.le_max_left ..
  have hR : right.width ≤ max left.width right.width := Nat.le_max_right ..
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  refine seq_spec leftSpec rightSpec env slots paid live h base heap store s hh hpv
      hVars hAt hSafe hCap hBase
    (by omega) (by omega) hPlace.1 hPlace.2 _ _
    hTrap (by flag_tac) (by flag_tac) (by flag_tac) (by flag_tac)
    fun heap2 store2 s2 ws1 ws2 hStep hF hH hR1 hR2 _ _ _ hTop => ?_
  have hNext2 := fun store' s' ws a => hNext heap2 store' s' ws a (fitsOf hTop)
  simp only [Ty.rep_word] at hR1 hR2
  subst hR1 hR2
  have hStep' := hStep
  rw [fresh_scalar_append rfl rfl] at hStep'
  have hv := hNext2 store2 s2 _ (After.ofScalar rfl hStep' rfl hF hH rfl)
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append]
  cases op <;>
    simp only [CmpOp.instr, wp_eqI64_cons, wp_neI64_cons, wp_ltUI64_cons, wp_leUI64_cons,
      wp_extendUI32_cons]
  · by_cases hab : left.denote funs env = right.denote funs env <;>
      simpa [hab, Expr.denote, CmpOp.apply, boolWord] using hv
  · by_cases hab : left.denote funs env = right.denote funs env <;>
      simpa [hab, Expr.denote, CmpOp.apply, boolWord] using hv
  · by_cases hab : left.denote funs env < right.denote funs env <;>
      simpa [hab, Expr.denote, CmpOp.apply, boolWord] using hv
  · by_cases hab : left.denote funs env ≤ right.denote funs env <;>
      simpa [hab, Expr.denote, CmpOp.apply, boolWord] using hv


/-- An operation on floats. -/
theorem spec_fbin {Γ : List Ty} (op : FBinOp) {left right : Expr S Γ .float}
    (leftSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv left env slots paid live)
    (rightSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv right env
        slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.fbin op left right) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hL : left.width ≤ max left.width right.width := Nat.le_max_left ..
  have hR : right.width ≤ max left.width right.width := Nat.le_max_right ..
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  refine seq_spec leftSpec rightSpec env slots paid live h base heap store s hh hpv
      hVars hAt hSafe hCap hBase
    (by omega) (by omega) hPlace.1 hPlace.2 _ _
    hTrap (by flag_tac) (by flag_tac) (by flag_tac) (by flag_tac)
    fun heap2 store2 s2 ws1 ws2 hStep hF hH hR1 hR2 _ _ _ hTop => ?_
  have hNext2 := fun store' s' ws a => hNext heap2 store' s' ws a (fitsOf hTop)
  have hR1' : ws1 = [.f64 (left.denote funs env).toBits] := hR1
  have hR2' : ws2 = [.f64 (right.denote funs env).toBits] := hR2
  subst hR1' hR2'
  have hStep' := hStep
  rw [fresh_scalar_append rfl rfl] at hStep'
  have hv := hNext2 store2 s2 [.f64 ((Expr.fbin op left right).denote funs env).toBits]
    (After.ofScalar rfl hStep' rfl hF hH rfl)
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append] at hv ⊢
  cases op <;>
    simpa [FBinOp.instr, Expr.denote, FBinOp.apply, f64Add, f64Sub, f64Mul, f64Div,
      F64Bits.toBits_add, F64Bits.toBits_sub, F64Bits.toBits_mul, F64Bits.toBits_div] using hv


/-- A comparison of floats. -/
theorem spec_fcmp {Γ : List Ty} (op : FCmpOp) {left right : Expr S Γ .float}
    (leftSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv left env slots paid live)
    (rightSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv right env
        slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.fcmp op left right) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hL : left.width ≤ max left.width right.width := Nat.le_max_left ..
  have hR : right.width ≤ max left.width right.width := Nat.le_max_right ..
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  refine seq_spec leftSpec rightSpec env slots paid live h base heap store s hh hpv
      hVars hAt hSafe hCap hBase
    (by omega) (by omega) hPlace.1 hPlace.2 _ _
    hTrap (by flag_tac) (by flag_tac) (by flag_tac) (by flag_tac)
    fun heap2 store2 s2 ws1 ws2 hStep hF hH hR1 hR2 _ _ _ hTop => ?_
  have hNext2 := fun store' s' ws a => hNext heap2 store' s' ws a (fitsOf hTop)
  have hR1' : ws1 = [.f64 (left.denote funs env).toBits] := hR1
  have hR2' : ws2 = [.f64 (right.denote funs env).toBits] := hR2
  subst hR1' hR2'
  have hStep' := hStep
  rw [fresh_scalar_append rfl rfl] at hStep'
  have hv := hNext2 store2 s2 _ (After.ofScalar rfl hStep' rfl hF hH rfl)
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append] at hv ⊢
  cases op <;>
    simp only [FCmpOp.instr, wp_f64Lt_cons, wp_f64Le_cons, wp_f64Eq_cons, wp_extendUI32_cons]
  · cases hc : IEEE64.lt (left.denote funs env).toBits (right.denote funs env).toBits <;>
      simpa [hc, Expr.denote, FCmpOp.apply, F64Bits.decide_lt, f64Lt, boolWord] using hv
  · cases hc : IEEE64.le (left.denote funs env).toBits (right.denote funs env).toBits <;>
      simpa [hc, Expr.denote, FCmpOp.apply, F64Bits.decide_le, f64Le, boolWord] using hv
  · cases hc : IEEE64.eq (left.denote funs env).toBits (right.denote funs env).toBits <;>
      simpa [hc, Expr.denote, FCmpOp.apply, F64Bits.beq_eq, f64Eq, boolWord] using hv


/-- An operation on one float.  The negation subtracts from negative zero, pushed first. -/
theorem spec_funary {Γ : List Ty} (op : FUnOp) {e : Expr S Γ .float}
    (eSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv e env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.funary op e) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  simp only [Expr.code, Expr.usesFast_eq]
  cases op with
  | neg =>
    simp only [FUnOp.code, List.cons_append, List.append_assoc, wp_f64Const_cons]
    refine eSpec env slots paid live h base heap store { s with values := .f64 0x8000000000000000 ::
      s.values } hh hpv (hVars.agree Frame.ofValues) hAt (hSafe.values _) hCap hBase hRoom hPlace _ _
      (by rw [dyingPot_values]; exact hTrap)
      fun heap1 store1 s1 ws a1 hTop => ?_
    have hNext1 := fun store' s' ws a =>
      hNext heap1 store' s' ws a fun hf => top_part rfl (dyingPot_values _ _ _).le (hTop hf)
    have hR : ws = [.f64 (e.denote funs env).toBits] := a1.rep
    subst hR
    have hStep := a1.step
    rw [Mode.fresh_scalar rfl] at hStep
    have hv := hNext1 store1 s1 [.f64 (-(e.denote funs env)).toBits]
      (After.ofValues (After.ofScalar rfl hStep rfl a1.frame a1.holds rfl))
    simpa [Expr.denote, FUnOp.apply, f64Sub, F64Bits.toBits_neg] using hv
  | sqrt | abs =>
    simp only [FUnOp.code, List.append_assoc, List.cons_append, List.nil_append]
    refine eSpec env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase
        hRoom hPlace _ _
        hTrap
      fun heap1 store1 s1 ws a1 hTop => ?_
    have hNext1 := fun store' s' ws a => hNext heap1 store' s' ws a fun hf => top_part rfl
        le_rfl (hTop hf)
    have hR : ws = [.f64 (e.denote funs env).toBits] := a1.rep
    subst hR
    have hStep := a1.step
    rw [Mode.fresh_scalar rfl] at hStep
    have hv := hNext1 store1 s1 [.f64 ((Expr.funary _ e).denote funs env).toBits]
      (After.ofScalar rfl hStep rfl a1.frame a1.holds rfl)
    simpa [Expr.denote, FUnOp.apply, f64Sqrt, f64Abs, F64Bits.toBits_sqrt, F64Bits.toBits_abs]
      using hv


/-- A conversion of a word to a float. -/
theorem spec_toFloat {Γ : List Ty} (op : ToFloat) {e : Expr S Γ .word}
    (eSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv e env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.toFloat op e) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  refine eSpec env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom hPlace _ _
      hTrap
    fun heap1 store1 s1 ws a1 hTop => ?_
  have hNext1 := fun store' s' ws a => hNext heap1 store' s' ws a fun hf => top_part
      rfl le_rfl (hTop hf)
  have hR : ws = [.i64 (e.denote funs env)] := a1.rep
  subst hR
  have hStep := a1.step
  rw [Mode.fresh_scalar rfl] at hStep
  have hv := hNext1 store1 s1 [.f64 ((Expr.toFloat op e).denote funs env).toBits]
    (After.ofScalar rfl hStep rfl a1.frame a1.holds rfl)
  cases op <;>
    simpa [ToFloat.code, Expr.denote, ToFloat.apply, f64ConvertI64U, f64Add,
      F64Convert.toBits_toFloat, F64Bits.toBits_ofBits, add_negZero] using hv


/-- A conversion of a float to a word. -/
theorem spec_toWord {Γ : List Ty} (op : ToWord) {e : Expr S Γ .float}
    (eSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv e env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.toWord op e) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  refine eSpec env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom hPlace _ _
      hTrap
    fun heap1 store1 s1 ws a1 hTop => ?_
  have hNext1 := fun store' s' ws a => hNext heap1 store' s' ws a fun hf => top_part
      rfl le_rfl (hTop hf)
  have hR : ws = [.f64 (e.denote funs env).toBits] := a1.rep
  subst hR
  have hStep := a1.step
  rw [Mode.fresh_scalar rfl] at hStep
  have hv := hNext1 store1 s1 [.i64 ((Expr.toWord op e).denote funs env)]
    (After.ofScalar rfl hStep rfl a1.frame a1.holds rfl)
  cases op <;>
    simpa [ToWord.instr, Expr.denote, ToWord.apply, i64TruncSatF64U, F64Convert.toUInt64_eq]
      using hv


/-- The negation of a `Bool`. -/
theorem spec_not {Γ : List Ty} {e : Expr S Γ .bool}
    (eSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv e env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.not e) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc, List.cons_append, List.nil_append]
  refine eSpec env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom hPlace _ _
      hTrap
    fun heap1 store1 s1 ws a1 hTop => ?_
  have hNext1 := fun store' s' ws a => hNext heap1 store' s' ws a fun hf => top_part
      rfl le_rfl (hTop hf)
  have hR := a1.rep
  simp only [Ty.rep_bool] at hR
  subst hR
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append,
    wp_eqzI64_cons, wp_extendUI32_cons, boolWord_not]
  have hStep := a1.step
  rw [Mode.fresh_scalar rfl] at hStep
  simpa [Expr.denote] using
    hNext1 store1 s1 _ (After.ofScalar rfl hStep rfl a1.frame a1.holds rfl)


/-- The conjunction of `Bool`s. -/
theorem spec_and {Γ : List Ty} {left right : Expr S Γ .bool}
    (leftSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv left env slots paid live)
    (rightSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv right env
        slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.and left right) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hL : left.width ≤ max left.width right.width := Nat.le_max_left ..
  have hR : right.width ≤ max left.width right.width := Nat.le_max_right ..
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  refine seq_spec leftSpec rightSpec env slots paid live h base heap store s hh hpv
      hVars hAt hSafe hCap hBase
    (by omega) (by omega) hPlace.1 hPlace.2 _ _
    hTrap (by flag_tac) (by flag_tac) (by flag_tac) (by flag_tac)
    fun heap2 store2 s2 ws1 ws2 hStep hF hH hR1 hR2 _ _ _ hTop => ?_
  have hNext2 := fun store' s' ws a => hNext heap2 store' s' ws a (fitsOf hTop)
  simp only [Ty.rep_bool] at hR1 hR2
  subst hR1 hR2
  have hStep' := hStep
  rw [fresh_scalar_append rfl rfl] at hStep'
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append,
    wp_andI64_cons, boolWord_and]
  simpa [Expr.denote] using hNext2 store2 s2 _ (After.ofScalar rfl hStep' rfl hF hH rfl)


/-- The disjunction of `Bool`s. -/
theorem spec_or {Γ : List Ty} {left right : Expr S Γ .bool}
    (leftSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv left env slots paid live)
    (rightSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv right env
        slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.or left right) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hL : left.width ≤ max left.width right.width := Nat.le_max_left ..
  have hR : right.width ≤ max left.width right.width := Nat.le_max_right ..
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  refine seq_spec leftSpec rightSpec env slots paid live h base heap store s hh hpv
      hVars hAt hSafe hCap hBase
    (by omega) (by omega) hPlace.1 hPlace.2 _ _
    hTrap (by flag_tac) (by flag_tac) (by flag_tac) (by flag_tac)
    fun heap2 store2 s2 ws1 ws2 hStep hF hH hR1 hR2 _ _ _ hTop => ?_
  have hNext2 := fun store' s' ws a => hNext heap2 store' s' ws a (fitsOf hTop)
  simp only [Ty.rep_bool] at hR1 hR2
  subst hR1 hR2
  have hStep' := hStep
  rw [fresh_scalar_append rfl rfl] at hStep'
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append,
    wp_orI64_cons, boolWord_or]
  simpa [Expr.denote] using hNext2 store2 s2 _ (After.ofScalar rfl hStep' rfl hF hH rfl)


/-- A tuple of two elements: the code of each, in order. -/
theorem spec_mk {Γ : List Ty} {a b : Elem} {first : Expr S Γ (.elem a)}
    {second : Expr S Γ (.elem b)}
    (firstSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv first env
        slots paid live)
    (secondSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv second env
        slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.mk first second) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hL : first.width ≤ max first.width second.width := Nat.le_max_left ..
  have hR : second.width ≤ max first.width second.width := Nat.le_max_right ..
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  refine seq_spec firstSpec secondSpec env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap
      hBase
    (by omega) (by omega) hPlace.1 hPlace.2 _ _
    hTrap (by flag_tac) (by flag_tac) (by flag_tac) (by flag_tac)
    fun heap2 store2 s2 ws1 ws2 hStep hF hH hR1 hR2 _ _ _ hTop => ?_
  have hNext2 := fun store' s' ws a => hNext heap2 store' s' ws a (fitsOf hTop)
  have hR1' : ws1 = a.values (first.denote funs env) := hR1
  have hR2' : ws2 = b.values (second.denote funs env) := hR2
  subst hR1' hR2'
  have hStep' := hStep
  rw [fresh_scalar_append rfl rfl] at hStep'
  have hv := hNext2 store2 s2
    (a.values (first.denote funs env) ++ b.values (second.denote funs env))
    (After.ofScalar rfl hStep' rfl hF hH rfl)
  simpa [List.reverse_append, List.append_assoc] using hv


/-- The release of a variable that a reader reads, when it is owned and dies there,
which leaves `top`. -/
theorem read_release (hm : Runtime m) {Γ : List Ty} {env : Env Γ} {slots : List Slot}
    {live : Nat → Bool} {base : Nat} {heap : Heap} {store : Store Unit} {s : Locals}
    {vals : List Value} {rest : Program} {Q : Assertion Unit} {t : Ty} (x : Var Γ t)
    (hVars : Holds env slots (fun k => live k || k == x.index) base heap store s)
    (hAt : heap.At store)
    (hNext : ∀ heap' store', Evolves env slots (fun k => live k || k == x.index) live base heap
      store s heap' store' s → heap'.top = heap.top →
      wp m rest Q store' { s with values := vals } host) :
    wp m ((if (slots.getD x.index default).mode = .owned ∧ live x.index = false then
        releaseCode t (slots.getD x.index default).loc else []) ++ rest) Q store
      { s with values := vals } host := by
  have hCode : (if (slots.getD x.index default).mode = .owned ∧ live x.index = false then
      releaseCode t (slots.getD x.index default).loc else []) =
      (if live x.index = false then [x.index] else []).flatMap (releaseVar Γ slots) := by
    cases live x.index <;> simp [releaseVar, x.getElem?_index]
  rw [hCode]
  refine wp_releaseVars hm _ (by split <;> simp) (hVars.agree Frame.ofValues) hAt
    (by split <;> simp) fun heap' store' e hTop => hNext heap' store' ?_ hTop
  have e' := e.mono (live' := live) fun k h => by
    split
    · next hx =>
      have hne : k ≠ x.index := fun he => by rw [he, hx] at h; exact nomatch h
      simp [h, hne]
    · simp [h]
  exact ⟨e'.step, e'.frame.values.trans Frame.ofValues,
    e'.holds.agree Frame.ofValues⟩

theorem spec_bytesSize (hm : Runtime m) {Γ' : List Ty} (x : Var Γ' .bytes) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.bytesSize (S := S) x)
      env slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt _ _ _ _ _ rest Q _ hNext
  obtain ⟨_, _, hold, root, length, rfl, hBytes⟩ := hVars.1 _ x (by simp [Expr.uses])
  have hLength : s.get ((slots.getD x.index default).loc + 1) = some (.i64 length) := by
    simpa [Ty.types, slotIndex] using hold 1 (by simp)
  simp only [Expr.code, List.append_assoc, List.cons_append, List.nil_append,
    wp_localGet_cons, hLength]
  refine read_release hm x hVars hAt fun heap' store' ev hTop => ?_
  exact hNext heap' store' s [.i64 length]
    (After.ofScalar rfl ev.step rfl ev.frame ev.holds (by
      simp only [Ty.rep_word, Expr.denote, hBytes.size_eq]))
    fun _ => top_unpaid_le rfl (by rw [hTop]; omega)

theorem spec_bytesGet (hm : Runtime m) {Γ' : List Ty} (x : Var Γ' .bytes)
    {index : Expr S Γ' .word}
    (indexSpec : ∀ env slots paid live,
      CodeSpec (pool := pool) m funs flags bounds fits host pv index env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.bytesGet x index)
      env slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
    hPlace rest Q hTrap hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hIndexWidth : index.width ≤ max index.width 1 := Nat.le_max_left ..
  have hScratch : 1 ≤ max index.width 1 := Nat.le_max_right ..
  simp only [Expr.placeArgs] at hPlace
  simp only [Expr.code, List.append_assoc, List.cons_append, List.nil_append]
  have hIn : ∀ k, ((live k || k == x.index) || index.uses k) = true →
      (live k || (Expr.bytesGet x index).uses k) = true := fun k hk => by
    simp only [Expr.uses]; exact live_assoc _ _ _ hk
  have hD : dyingPot store s env slots paid (fun k => (live k || k == x.index) || index.uses k)
      (fun k => live k || k == x.index) ≤
        dyingPot store s env slots paid (fun k => live k || (Expr.bytesGet x index).uses k) live :=
    dyingPot_mono hIn fun k hk => by simp [hk]
  refine indexSpec env slots paid (fun k => live k || k == x.index) h base heap store s hh hpv
    (hVars.live_mono hIn) hAt (hSafe.mono hIn) hCap hBase (by omega) hPlace _ _
    (hTrap.part id id fun _ hw => hw.mono (by dsimp only; simp only [Expr.allocs]; omega))
    fun heap1 store1 s1 ws1 a1 hTop1 => ?_
  have hValue := a1.rep
  simp only [Ty.rep_word] at hValue
  subst hValue
  have e1 := a1.toEvolves rfl
  obtain ⟨hBelow, _, hold, root, length, rfl, hBytes⟩ := e1.holds.1 _ x (by simp)
  have hRoot : s1.get (slots.getD x.index default).loc = some (.i64 root) := by
    simpa [Ty.types, slotIndex] using hold 0 (by simp)
  have hLength : s1.get ((slots.getD x.index default).loc + 1) = some (.i64 length) := by
    simpa [Ty.types, slotIndex] using hold 1 (by simp)
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append]
  have hLow : ({ s1 with values := s.values } : Locals).params.length ≤ base := by
    rw [e1.frame.params]; exact hBase
  have hHigh : base < s1.positions := by rw [e1.frame.positions, hh]; omega
  refine wp_localSet_local hLow (Locals.lt_total hHigh) ?_
  let s1a := setLocal { s1 with values := s.values } base (.i64 (index.denote funs env))
  have hIndex : s1a.get base = some (.i64 (index.denote funs env)) :=
    Locals.get_setLocal_same hLow (Locals.lt_total hHigh)
  have hRoot' : s1a.get (slots.getD x.index default).loc = some (.i64 root) := by
    rw [Locals.get_setLocal_ne hLow (by change _ + 2 ≤ base at hBelow; omega), Locals.get_values]
    exact hRoot
  have hLength' : s1a.get ((slots.getD x.index default).loc + 1) = some (.i64 length) := by
    rw [Locals.get_setLocal_ne hLow (by change _ + 2 ≤ base at hBelow; omega), Locals.get_values]
    exact hLength
  have f1 : Frame base s1 s1a := Frame.setValues hLow le_rfl hHigh
  have hFrame : Frame base s s1a := e1.frame.trans f1
  have hVars1 := e1.holds.agree f1
  show wp m _ Q store1 s1a host
  refine Bytes.wp_get e1.step.at_ hBytes hRoot' hLength' hIndex ?_
  refine read_release hm x hVars1 e1.step.at_ fun heap2 store2 e2 hTop2 => ?_
  have e12 := Evolves.trans (hVars.live_mono hIn) ⟨e1.step, hFrame, hVars1⟩ e2
    (fun k hk => by simp [hk]) fun k hk => by simp [hk]
  exact hNext heap2 store2 s1a [.i64 ((env.get x).get (index.denote funs env))]
    ((After.ofScalar (t := .word) (mode := .borrowed) rfl e12.step rfl e12.frame e12.holds
      rfl).liveIn hIn)
    fun hd => by rw [hTop2]; exact top_part rfl hD (hTop1 hd)

/-- The size of an array variable: the load of its length word, then the release of the variable
when it is owned and dies there. -/
theorem spec_size (hm : Runtime m) {Γ' : List Ty} {e : Elem} (x : Var Γ' (.array e)) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.size (S := S) x) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt _ _ _ _ _ rest Q _ hNext
  obtain ⟨-, ws, hold, hRep⟩ := hVars.1 _ x (by simp [Expr.uses])
  obtain ⟨ptr, rfl, hB⟩ := hRep
  have hA := hB.borrow.values
  have hLength := hA.lengthBound
  have hPtr : s.get (slots.getD x.index default).loc = some (.i64 ptr) := by
    exact LocalsHold.word hold
  have hnk : (env.get x).size * e.width < 536870912 := by
    have := hA.1; rw [Elem.words_size] at this; omega
  simp only [Expr.code, Var.sizeCode, Expr.usesFast_eq, List.append_assoc, List.cons_append,
    List.nil_append]
  simp only [wp_localGet_cons, hPtr, wp_wrapI64_cons, wp_load64_cons, wrap_toUInt32,
    UInt32.toNat_zero, Nat.add_zero, UInt32.add_zero]
  rw [ite_eq_right (by omega), hA.lengthRead, Elem.words_size, wp_divCode e.width_pos,
    words_div e.width_pos hnk]
  refine read_release hm x hVars hAt fun heap' store' ev hTop => ?_
  exact hNext heap' store' s [.i64 (env.get x).size.toUInt64]
    (After.ofScalar rfl ev.step rfl ev.frame ev.holds rfl)
    fun _ => top_unpaid_le rfl (by rw [hTop]; omega)

theorem spec_leSize (hm : Runtime m) {Γ' : List Ty} {e : Elem}
    (x : Var Γ' (.array e)) (i : Var Γ' .word) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv
      (Expr.leSize (S := S) x i) env slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
    hPlace rest Q hTrap hNext
  obtain ⟨_, _, _, hRep⟩ := hVars.1 _ x (by simp [Expr.uses])
  have hValue := Expr.leSizeExpand_denote x i funs env hRep.array_size_lt
  have hCmp : CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.leSizeExpand x i)
      env slots paid live := spec_cmp .le (spec_var hm i) (spec_size hm x) env slots paid live
  simp only [CodeSpec, trapFlag, Expr.leSizeExpand_uses, Expr.leSizeExpand_width,
    Expr.leSizeExpand_placeArgs, Expr.leSizeExpand_aborts, Expr.leSizeExpand_allocs,
    Expr.leSizeExpand_fits, Expr.leSizeExpand_mode, Expr.leSizeExpand_paid,
    Expr.leSizeExpand_code, hValue] at hCmp
  exact hCmp h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom hPlace rest Q hTrap hNext

/-- A read of an array variable: the position in local `base`, a comparison of it with the
array's size as a flag in local `base + 1`, the position of the element's first word in local
`base`, the loads of its words under the flag, and the release of the variable when it is owned and
dies there. -/
theorem spec_get (hm : Runtime m) {Γ' : List Ty} {e : Elem} (x : Var Γ' (.array e))
    {i : Expr S Γ' .word}
    (iSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv i env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.get x i) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hi : i.width ≤ max i.width 2 := Nat.le_max_left ..
  have h2 : 2 ≤ max i.width 2 := Nat.le_max_right ..
  simp only [Expr.placeArgs] at hPlace
  simp only [Expr.code, getCode, Expr.usesFast_eq, List.append_assoc, List.cons_append,
    List.nil_append]
  have hIn : ∀ k, ((live k || k == x.index) || i.uses k) = true →
      (live k || (Expr.get x i).uses k) = true := fun k h => by
    simp only [Expr.uses]; exact live_assoc _ _ _ h
  have hD : dyingPot store s env slots paid (fun k => (live k || k == x.index) || i.uses k)
      (fun k => live k || k == x.index) ≤
        dyingPot store s env slots paid (fun k => live k || (Expr.get x i).uses k) live :=
    dyingPot_mono hIn fun k h => by simp [h]
  refine iSpec env slots paid (fun k => live k || k == x.index) h base heap store s hh hpv
    (hVars.live_mono hIn) hAt (hSafe.mono hIn) hCap hBase (by omega) hPlace _ _
    (hTrap.part id id fun _ hw => hw.mono (by dsimp only; simp only [Expr.allocs]; omega))
    fun heap1 store1 s1 ws1 a1 hTop1 => ?_
  have hR1 := a1.rep
  simp only [Ty.rep_word] at hR1
  subst hR1
  have e1 := a1.toEvolves rfl
  have hp1 : s1.params = s.params := e1.frame.params
  have hh1 : s1.positions = h := e1.frame.positions.trans hh
  obtain ⟨hBelowX, wx, holdx, hRepx⟩ := e1.holds.1 _ x (by simp)
  obtain ⟨ptr, rfl, hBx⟩ := hRepx
  have hA := hBx.borrow.values
  have hLength := hA.lengthBound
  have hnk : (env.get x).size * e.width < 536870912 := by
    have := hA.1; rw [Elem.words_size] at this; omega
  have hk := e.width_pos
  have hn64 : (env.get x).size < UInt64.size := by
    have := Nat.le_mul_of_pos_right (env.get x).size hk
    rw [show UInt64.size = 18446744073709551616 from rfl]; omega
  simp only [Ty.width] at hBelowX
  have hPtr1 : s1.get (slots.getD x.index default).loc = some (.i64 ptr) := by
    exact LocalsHold.word holdx
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append]
  -- The position, in local `base`.
  have hLow1 : ({ s1 with values := s.values } : Locals).params.length ≤ base := by
    show s1.params.length ≤ base; rw [hp1]; omega
  have hHigh1 : base < s1.positions := by rw [hh1]; omega
  refine wp_localSet_local hLow1 (Locals.lt_total hHigh1) ?_
  let s1a := setLocal { s1 with values := s.values } base (.i64 (i.denote funs env))
  have hK : s1a.get base = some (.i64 (i.denote funs env)) :=
    Locals.get_setLocal_same hLow1 (Locals.lt_total hHigh1)
  have hP : s1a.get (slots.getD x.index default).loc = some (.i64 ptr) := by
    rw [Locals.get_setLocal_ne hLow1 (by omega)]
    exact hPtr1
  show wp m _ Q store1 s1a host
  simp only [wp_localGet_cons, Locals.get_values, hK, hP, wp_wrapI64_cons, wp_load64_cons,
    wrap_toUInt32, UInt32.toNat_zero, Nat.add_zero, UInt32.add_zero]
  rw [ite_eq_right (by omega), hA.lengthRead, Elem.words_size, wp_divCode hk,
    words_div hk hnk]
  simp only [wp_ltUI64_cons, wp_extendUI32_cons]
  -- The flag, in local `base + 1`.
  have hLess : i.denote funs env < UInt64.ofNat (env.get x).size ↔
      (i.denote funs env).toNat < (env.get x).size := by
    rw [UInt64.lt_iff_toNat_lt, UInt64.toNat_ofNat_of_lt' hn64]
  set b := decide ((i.denote funs env).toNat < (env.get x).size) with hb
  have hFlag : UInt64.ofNat (if i.denote funs env < UInt64.ofNat (env.get x).size then (1 : UInt32)
      else 0).toNat = boolWord b := by
    by_cases hc : (i.denote funs env).toNat < (env.get x).size
    · simp [hb, hc, hLess.mpr hc, boolWord]
    · simp [hb, hc, (not_congr hLess).mpr hc, boolWord]
  rw [hFlag]
  have hLowB : ({ s1a with values := s.values } : Locals).params.length ≤ base + 1 := by
    show s1.params.length ≤ base + 1; rw [hp1]; omega
  have hHighB : base + 1 < ({ s1a with values := s.values } : Locals).positions := by
    simp only [s1a, Locals.positions_setLocal, Locals.positions_values, hh1]; omega
  refine wp_localSet_local hLowB (Locals.lt_total hHighB) ?_
  let s1b := setLocal { s1a with values := s.values } (base + 1) (.i64 (boolWord b))
  have hFb : s1b.get (base + 1) = some (.i64 (boolWord b)) :=
    Locals.get_setLocal_same hLowB (Locals.lt_total hHighB)
  have hKb : s1b.get base = some (.i64 (i.denote funs env)) := by
    rw [Locals.get_setLocal_ne hLowB (by omega), Locals.get_values]; exact hK
  have hPb : s1b.get (slots.getD x.index default).loc = some (.i64 ptr) := by
    rw [Locals.get_setLocal_ne hLowB (by omega), Locals.get_values]; exact hP
  -- The position of the element's first word, in local `base`.
  show wp m _ Q store1 s1b host
  simp only [wp_localGet_cons, hKb]
  rw [wp_scaleCode]
  have hLowC : ({ s1b with values := s.values } : Locals).params.length ≤ base := by
    show s1.params.length ≤ base; rw [hp1]; omega
  have hHighC : base < ({ s1b with values := s.values } : Locals).positions := by
    simp only [s1b, s1a, Locals.positions_setLocal, Locals.positions_values, hh1]; omega
  refine wp_localSet_local hLowC (Locals.lt_total hHighC) ?_
  let s1c := setLocal { s1b with values := s.values } base
    (.i64 (i.denote funs env * wordCount e.width))
  have hWc : s1c.get base = some (.i64 (i.denote funs env * wordCount e.width)) :=
    Locals.get_setLocal_same hLowC (Locals.lt_total hHighC)
  have hFc : s1c.get (base + 1) = some (.i64 (boolWord b)) := by
    rw [Locals.get_setLocal_ne hLowC (by omega), Locals.get_values]; exact hFb
  have hPc : s1c.get (slots.getD x.index default).loc = some (.i64 ptr) := by
    rw [Locals.get_setLocal_ne hLowC (by omega), Locals.get_values]; exact hPb
  have f1 : Frame base s1 s1c :=
    ((Frame.setValues (s := s1) (vs := s.values) hLow1 le_rfl hHigh1).trans
      (Frame.setValues (s := s1a) (vs := s.values) hLowB (by omega)
        (by simpa [s1a, Locals.positions_setLocal, Locals.positions_values] using hHighB))).trans
      (Frame.setValues (s := s1b) (vs := s.values) hLowC le_rfl
        (by simpa [s1b, s1a, Locals.positions_setLocal, Locals.positions_values] using hHighC))
  have hFrame : Frame base s s1c := e1.frame.trans f1
  have hVars1 : Holds env slots (fun k => live k || k == x.index) base heap1 store1 s1c :=
    e1.holds.agree f1
  have hsc : s1c.values = s.values := rfl
  -- The words of the element, or zeros past the end.
  show wp m _ Q store1 s1c host
  refine wp_loadWordsCode (ws := e.words (env.get x)) b (fun _ => hA) 0 e.types s1c
    (e.toWords (env.get x)[(i.denote funs env).toNat]!) hPc hWc hFc
    (by rw [e.toWords_length, e.types_length]) (fun hbt => ?_) (fun hbf => ?_) ?_
  · have hc : (i.denote funs env).toNat < (env.get x).size := by simpa [hb] using hbt
    have hw : (i.denote funs env * wordCount e.width).toNat =
        (i.denote funs env).toNat * e.width := by
      have hs := words_scale (i := (i.denote funs env).toNat) hk
        (lt_of_le_of_lt (Nat.mul_le_mul_right e.width (Nat.le_of_lt hc)) hnk)
      rw [UInt64.ofNat_toNat] at hs
      rw [hs, UInt64.toNat_ofNat_of_lt' (by
          rw [show UInt64.size = 18446744073709551616 from rfl]
          have := Nat.mul_le_mul_right e.width (Nat.le_of_lt hc); omega)]
    rw [hw, e.types_length, Elem.words_size]
    refine ⟨by
        have := Nat.mul_le_mul_right e.width (Nat.succ_le_of_lt hc)
        rw [Nat.succ_mul] at this; omega,
      fun j hj => ?_⟩
    rw [e.toWords_length] at hj
    rw [Nat.add_zero, Elem.words_getElem! e _ hc hj, getElem!_pos (env.get x) _ hc]
  · have hc : ¬(i.denote funs env).toNat < (env.get x).size := by simpa [hb] using hbf
    rw [getElem!_neg (env.get x) _ hc, e.toWords_default, e.types_length]
  · rw [e.values_typed, hsc]
    refine read_release hm x hVars1 e1.step.at_ fun heap2 store2 e2 hTop2 => ?_
    have e12 := Evolves.trans (hVars.live_mono hIn) ⟨e1.step, hFrame, hVars1⟩ e2
      (fun k h => by simp [h]) fun k h => by simp [h]
    exact hNext heap2 store2 s1c (e.values (env.get x)[(i.denote funs env).toNat]!)
      ((After.ofScalar (t := .elem e) (mode := .borrowed) rfl e12.step rfl e12.frame e12.holds
        rfl).liveIn hIn) fun hd => by rw [hTop2]; exact top_part rfl hD (hTop1 hd)

/-- A component of a tuple variable: the loads of the words that hold it. -/
theorem spec_proj {Γ' : List Ty} {e e' : Elem} (x : Var Γ' (.elem e)) (p : Path e e') :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.proj (S := S) x p) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt _ _ _ _ _ rest Q _ hNext
  obtain ⟨-, ws, hold, hRep⟩ := hVars.1 _ x (by simp [Expr.uses])
  have hRep' : ws = e.values (env.get x) := hRep
  subst hRep'
  simp only [Expr.code, Expr.usesFast_eq]
  exact wp_loadCode _ (by rw [e'.values_length, e'.types_length]) hh (p.holds hold)
    (hNext heap store s _ (After.refl hAt hVars (by intro i h; simp [Expr.uses, h]) rfl rfl
      (Holds.Apart.ofScalar rfl)) fun _ => Nat.le_add_right _ _)

/-- One branch of an `if`, after the condition: the releases of the owned variables that die at
its entry, its code, the coercion of its value to the `if`'s mode, and the store of its words,
which the code loads after the `if`. -/
theorem ite_branch (hm : Runtime m) {Γ' : List Ty} {tTy : Ty} {c : Expr S Γ' .bool}
    {thenE elseE b : Expr S Γ' tTy} {buy : Bool}
    (bSpec : ∀ env slots paid live,
      CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv b env slots paid live)
    {env : Env Γ'} {slots : List Slot} {paid : List Bool} {live : Nat → Bool} {h base : Nat}
    {heap : Heap} {store : Store Unit} {s : Locals} {rest : Program} {Q : Assertion Unit}
    (hh : s.positions = h) (hpv : s.params = pv)
    (hVars : Holds env slots (fun i => live i || (Expr.ite c thenE elseE).uses i) base heap
      store s)
    (hSafe : pool.Safe env slots (fun i => live i || (Expr.ite c thenE elseE).uses i)
      heap store s)
    (hCap : store.memoryCap m 0 ≤ 65535) (hBase : s.params.length ≤ base)
    (hRoomB : base + tTy.width + max b.width (copyWidth tTy) ≤ h)
    {B cA Db K : Nat} {wf P : Bool}
    (hTrap : TrapOK (trapFlag m (Expr.ite c thenE elseE) slots heap store B wf) Q)
    (hNext : ∀ heap' store' s' ws,
      After env slots (fun i => live i || (Expr.ite c thenE elseE).uses i) live base heap store s
        tTy ((Expr.ite c thenE elseE).mode (slots.map Slot.mode))
        ((Expr.ite c thenE elseE).denote funs env) heap' store' s' ws →
      (wf = true → heap'.top.toNat +
          (if P = true then tTy.pot store' ws ((Expr.ite c thenE elseE).denote funs env) else 0) ≤
        heap.top.toNat + B) →
      wp m rest Q store' { s' with values := ws.reverse ++ s.values } host)
    {heap1 : Heap} {store1 : Store Unit} {s1 : Locals}
    (e1 : Evolves env slots (fun i => live i || (Expr.ite c thenE elseE).uses i)
      (fun i => live i || thenE.uses i || elseE.uses i) base heap store s heap1 store1
      { s1 with values := s.values })
    (hTop1 : wf = true → heap1.top.toNat ≤ heap.top.toNat + cA)
    (hB : B = cA + (Db + (b.allocs funs flags bounds (slots.map Slot.mode) paid live env +
      coerceCost tTy (b.mode (slots.map Slot.mode))
        ((Expr.ite c thenE elseE).mode (slots.map Slot.mode)) (b.denote funs env) +
      (b.buysIn buy funs flags (slots.map Slot.mode) paid live env + K))))
    (hDb : dyingPot store s env slots paid (fun i => live i || b.uses i) live ≤ Db)
    (hbd : wf = true → b.fits funs fits env = true)
    (hbPlace : b.placeArgs = true)
    (hbu : ∀ i, b.uses i = true → (thenE.uses i || elseE.uses i) = true)
    (hba : b.aborts = true → (Expr.ite c thenE elseE).aborts = true)
    (hval : b.denote funs env = (Expr.ite c thenE elseE).denote funs env)
    (hbm : b.mode (slots.map Slot.mode) = .owned →
      (Expr.ite c thenE elseE).mode (slots.map Slot.mode) = .owned)
    (hPm : P = true → (Expr.ite c thenE elseE).mode (slots.map Slot.mode) = .owned)
    (hK : P = true → b.paidIn buy flags (slots.map Slot.mode) paid live = false →
      tTy.credit (b.denote funs env) ≤ K)
    (Qb : Assertion Unit) (hQbTrap : ∀ st, Q (.Trap st "unreachable") → Qb (.Trap st "unreachable"))
    (hQb : ∀ st' s', wp m (loadCode h base tTy.types ++ rest) Q st'
      { s' with values := s.values } host → Qb (.Fallthrough st' s')) :
    wp m (releaseWhere Γ' slots (fun i => (live i || thenE.uses i || elseE.uses i) &&
        !(live i || b.uses i)) ++
      (b.code (pool := pool) h slots (base + tTy.width) live ++
        (coerceCode h tTy (b.mode (slots.map Slot.mode))
          ((Expr.ite c thenE elseE).mode (slots.map Slot.mode)) (base + tTy.width) ++
          storeCode h base tTy.types))) Qb store1 { s1 with values := s.values } host := by
  have hp1 : s1.params = s.params := e1.frame.params
  have hh1 : s1.positions = h := e1.frame.positions.trans hh
  have hTrapB : TrapOK (trapFlag m (Expr.ite c thenE elseE) slots heap store B wf) Qb :=
    hTrap.imp hQbTrap
  have hwf : (!wf) = false → wf = true := fun hd => by simpa using hd
  have hbd' : (!wf) = false → b.fits funs fits env = true := fun hd => hbd (hwf hd)
  have hSubMid : ∀ i, (live i || b.uses i) = true →
      (live i || thenE.uses i || elseE.uses i) = true := fun i =>
    ite_live_branch _ _ _ _ (hbu i)
  refine wp_releaseWhere hm e1.holds e1.step.at_
    (fun i h => by simp only [Bool.and_eq_true] at h; exact h.1) fun heap2 store2 e2 hTop2 => ?_
  have hEq : (fun i => (live i || thenE.uses i || elseE.uses i) &&
      !((live i || thenE.uses i || elseE.uses i) && !(live i || b.uses i))) =
      (fun i => live i || b.uses i) := by
    funext i
    exact live_released _ _ (hSubMid i)
  rw [hEq] at e2
  have hEntry : ∀ i, (live i || thenE.uses i || elseE.uses i) = true →
      (live i || (Expr.ite c thenE elseE).uses i) = true := fun i h => by
    simp only [Expr.uses]; exact ite_live_entry _ _ _ _ h
  -- The variables that die in the branch keep their potential across the condition and the
  -- releases.
  have hDb2 : dyingPot store2 { s1 with values := s.values } env slots paid
      (fun i => live i || b.uses i) live =
        dyingPot store s env slots paid (fun i => live i || b.uses i) live := by
    rw [dyingPot_evolves e1.holds e2 hSubMid _ _ fun _ h => h,
      dyingPot_evolves hVars e1 hEntry _ _ hSubMid]
  rw [← List.append_nil (storeCode h base tTy.types)]
  have hbw := Nat.le_max_left b.width (copyWidth tTy)
  have hcw := Nat.le_max_right b.width (copyWidth tTy)
  refine bSpec env slots paid live h (base + tTy.width) heap2 store2 { s1 with values := s.values }
    hh1 (hp1.trans hpv) (e2.holds.mono (by omega)) e2.step.at_
    ((hSafe.evolves hVars e1 hEntry).evolves e1.holds e2 hSubMid)
    (by rw [e2.step.cap m, e1.step.cap m]; exact hCap)
    (by show s1.params.length ≤ base + tTy.width; rw [hp1]; omega)
    (by omega) hbPlace _ _ (hTrapB.part (fun h => by
          cases hw : wf
          · rfl
          · simp [hbd hw] at h) (fun h => by
          simp only [Bool.or_eq_true] at h ⊢; exact h.imp_left hba) fun hd hw => by
        rw [hB] at hw
        exact (hw.after (heap1 := heap2) (store1 := store2)
          (by have := hTop1 (hwf hd); have := congrArg UInt64.toNat hTop2; omega)
          (by rw [e2.step.cap m, e1.step.cap m])).mono (by rw [hDb2]; omega))
    fun heap3 store3 s3 ws3 a3 hTop3 => ?_
  have hp3 : s3.params = s.params := a3.frame.params.trans hp1
  have hh3 : s3.positions = h := a3.frame.positions.trans hh1
  refine After.coerce hm a3 hbm le_rfl (by rw [hp3]; omega) hh3 (by omega)
    (by rw [a3.step.cap m, e2.step.cap m, e1.step.cap m]; exact hCap)
    (fun hs ht _ => hTrapB.alloc (by
      have := (Expr.ite c thenE elseE).mode_owned (slots.map Slot.mode) ht
      rw [Slot.any_map] at this; exact this) fun hd hw => by
        have h3 := hw.shift (heap1 := heap3) (store1 := store3)
          (c1 := cA + Db + b.allocs funs flags bounds (slots.map Slot.mode) paid live env +
            b.buysIn buy funs flags (slots.map Slot.mode) paid live env)
          (c2 := coerceCost tTy (b.mode (slots.map Slot.mode))
            ((Expr.ite c thenE elseE).mode (slots.map Slot.mode)) (b.denote funs env))
          (by have := hTop3 (hbd' hd); have := hTop1 (hwf hd); have := congrArg UInt64.toNat hTop2
              omega)
          (by rw [hB]; omega)
          (by rw [a3.step.cap m, e2.step.cap m, e1.step.cap m])
        simpa [coerceCost, hs, ht] using h3)
    fun heap4 store4 s4 ws4 a4 hTop4 hSame4 => ?_
  have hp4 : s4.params = s.params := a4.frame.params.trans hp1
  have hh4 : s4.positions = h := a4.frame.positions.trans hh1
  refine wp_storeCode ws4 h base tTy.types s4 s.values a4.rep.typed hh4 (by rw [hp4]; omega)
    (by rw [Ty.types_length, hh4]; omega) fun s5 hF5 hold _ => ?_
  rw [wp_nil]
  refine hQb _ _ (wp_loadCode ws4 a4.rep.typed (hF5.positions.trans hh4) hold ?_)
  -- The `if`'s facts: the evolutions of the condition and the releases, then the branch.
  have hLower := a4.lower e2.holds (Nat.le_add_right _ _) (fun i h => by simp [h])
  have e12 := Evolves.trans hVars e1 e2 hSubMid hEntry
  have aAll := After.prepend hVars e12 hLower (fun i h => hEntry i (hSubMid i h))
    (fun i h => by simp [h])
  have hF45 : Frame base s4 { s5 with values := s.values } := hF5.trans Frame.ofValues
  have hFrame : Frame base s { s5 with values := s.values } := aAll.frame.trans hF45
  rw [hval] at aAll
  refine hNext heap4 store4 _ ws4 ⟨aAll.step, hFrame, aAll.holds.agree hF45, aAll.rep, ?_⟩
    fun hd => by
      have := hTop1 hd; have := hTop3 (hbd hd); have := congrArg UInt64.toNat hTop2
      -- A paid branch keeps its owned value through the coercion.  The charge `K` of an unpaid
      -- branch of a paid `if` bounds the potential of the owned result.
      have hPot : (if P = true then
            tTy.pot store4 ws4 ((Expr.ite c thenE elseE).denote funs env) else 0) ≤
          (if b.paidIn buy flags (slots.map Slot.mode) paid live = true then
            tTy.pot store3 ws3 (b.denote funs env) else 0) + K := by
        by_cases hP : P = true
        · by_cases hbP : b.paidIn buy flags (slots.map Slot.mode) paid live = true
          · obtain ⟨rfl, rfl⟩ := hSame4 (Expr.mode_of_paidIn b hbP)
            rw [ite_eq_left hP, ite_eq_left hbP, ← hval]
            omega
          · have hRep4 := a4.rep
            rw [hPm hP] at hRep4
            have hle := Ty.pot_le_credit tTy ws4 _ hRep4
            have hk := hK hP (by simpa using hbP)
            rw [ite_eq_left hP, ite_eq_right hbP, ← hval]
            omega
        · rw [ite_eq_right hP]
          omega
      rw [hB]; omega
  exact aAll.apart.agree aAll.holds hF45

/-- An `if`: the condition, then each branch as `ite_branch` describes. -/
theorem spec_ite (hm : Runtime m) {Γ' : List Ty} {tTy : Ty} {c : Expr S Γ' .bool}
    {thenE elseE : Expr S Γ' tTy} {buy : Bool}
    (cSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv c env slots paid live)
    (thenSpec : ∀ env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv
        thenE env slots paid live)
    (elseSpec : ∀ env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv
        elseE env slots paid live) :
    ∀ env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv
        (Expr.ite c thenE elseE) env slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hc : c.width ≤ max c.width (tTy.width + max (max thenE.width elseE.width)
      (copyWidth tTy)) := Nat.le_max_left ..
  have hb : tTy.width + max (max thenE.width elseE.width) (copyWidth tTy) ≤
      max c.width (tTy.width + max (max thenE.width elseE.width) (copyWidth tTy)) :=
    Nat.le_max_right ..
  have ht : thenE.width ≤ max thenE.width elseE.width := Nat.le_max_left ..
  have he : elseE.width ≤ max thenE.width elseE.width := Nat.le_max_right ..
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  obtain ⟨⟨hPlaceC, hPlaceT⟩, hPlaceE⟩ := hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc, List.cons_append, List.nil_append]
  have hMid : ∀ i, ((live i || thenE.uses i || elseE.uses i) || c.uses i) = true →
      (live i || (Expr.ite c thenE elseE).uses i) = true := by
    intro i h; simp only [Expr.uses]; exact ite_live_cond _ _ _ _ h
  -- The variables that die in the `if` die in the condition or after it.
  have hSplitI : dyingPot store s env slots paid
      (fun i => live i || (Expr.ite c thenE elseE).uses i)
      live =
        dyingPot store s env slots paid (fun i => (live i || thenE.uses i || elseE.uses i) ||
          c.uses i) (fun i => live i || thenE.uses i || elseE.uses i) +
        dyingPot store s env slots paid (fun i => live i || thenE.uses i || elseE.uses i) live := by
    rw [dyingPot_split _ (fun i => live i || thenE.uses i || elseE.uses i) _
      (fun i h => hMid i (by simp [h])) (fun i h => by simp [h])]
    congr 1
    exact dyingPot_congr (fun i => by
      simp only [Expr.uses]
      cases live i <;> cases c.uses i <;> cases thenE.uses i <;> cases elseE.uses i <;> rfl)
      fun _ => rfl
  refine cSpec env slots paid _ h base heap store s hh hpv (hVars.live_mono hMid) hAt (hSafe.mono hMid) hCap hBase
    (by omega) hPlaceC _ _
    (hTrap.part (by flag_tac) (fun h => by simp only [Expr.aborts]; exact ite_trap_cond _ _ _ _ h)
      fun _ hw => hw.mono (by rw [hSplitI]; simp only [Expr.allocs]; omega))
    fun heap1 store1 s1 ws1 a1 hTop1 => ?_
  have hR1 := a1.rep
  simp only [Ty.rep_bool] at hR1
  subst hR1
  have e1 : Evolves env slots (fun i => live i || (Expr.ite c thenE elseE).uses i)
      (fun i => live i || thenE.uses i || elseE.uses i) base heap store s heap1 store1
      { s1 with values := s.values } := by
    have e := (a1.toEvolves rfl).values s.values
    exact ⟨e.step.mono (fun r hr => hr.mono fun i h1 h2 => ⟨hMid i h1, h2⟩) fun _ h => h,
      e.frame, e.holds⟩
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append,
    wp_eqzI64_cons]
  rw [wp_iff_control_types]
  refine wp_iff_cons rfl ?_
  have hModeT : thenE.mode (slots.map Slot.mode) = .owned →
      (Expr.ite c thenE elseE).mode (slots.map Slot.mode) = .owned :=
    fun h => by simp [Expr.mode, h, Mode.join]
  have hModeE : elseE.mode (slots.map Slot.mode) = .owned →
      (Expr.ite c thenE elseE).mode (slots.map Slot.mode) = .owned := fun h => by
    simp only [Expr.mode, h]
    cases thenE.mode (slots.map Slot.mode) <;> rfl
  have hRoomT : base + tTy.width + max thenE.width (copyWidth tTy) ≤ h := by
    have := Nat.max_le.mpr ⟨ht.trans (Nat.le_max_left _ (copyWidth tTy)), Nat.le_max_right _ _⟩
    omega
  have hRoomE : base + tTy.width + max elseE.width (copyWidth tTy) ≤ h := by
    have := Nat.max_le.mpr ⟨he.trans (Nat.le_max_left _ (copyWidth tTy)), Nat.le_max_right _ _⟩
    omega
  have hNextB : ∀ heap' store' s' ws,
      After env slots (fun i => live i || (Expr.ite c thenE elseE).uses i) live base heap store s
        tTy ((Expr.ite c thenE elseE).mode (slots.map Slot.mode))
        ((Expr.ite c thenE elseE).denote funs env) heap' store' s' ws →
      ((Expr.ite c thenE elseE).fits funs fits env = true →
        heap'.top.toNat +
            (if (Expr.ite c thenE elseE).paidIn buy flags (slots.map Slot.mode) paid live = true then
              tTy.pot store' ws ((Expr.ite c thenE elseE).denote funs env) else 0) ≤
          heap.top.toNat +
          (dyingPot store s env slots paid (fun i => live i || (Expr.ite c thenE elseE).uses i)
            live + (Expr.ite c thenE elseE).allocs funs flags bounds (slots.map Slot.mode) paid live
              env +
            (Expr.ite c thenE elseE).buysIn buy funs flags (slots.map Slot.mode) paid live env)) →
      wp m rest Q store' { s' with values := ws.reverse ++ s.values } host :=
    fun heap' store' s' ws a hT => hNext heap' store' s' ws a fun hf => by
      have := hT hf; omega
  have hPm : (Expr.ite c thenE elseE).paidIn buy flags (slots.map Slot.mode) paid live = true →
      (Expr.ite c thenE elseE).mode (slots.map Slot.mode) = .owned :=
    Expr.mode_of_paidIn _
  have hTopC : (Expr.ite c thenE elseE).fits funs fits env = true →
      heap1.top.toNat ≤ heap.top.toNat +
        (dyingPot store s env slots paid (fun i => (live i || thenE.uses i || elseE.uses i) ||
          c.uses i) (fun i => live i || thenE.uses i || elseE.uses i) +
          c.allocs funs flags bounds (slots.map Slot.mode) paid
            (fun i => live i || thenE.uses i || elseE.uses i) env) := fun hd => by
    have := hTop1 (by simp only [Expr.fits, Bool.and_eq_true] at hd; exact hd.1)
    omega
  cases hcv : c.denote funs env
  · simp (config := { decide := true }) only [↓reduceIte]
    have hBuys : (Expr.ite c thenE elseE).buysIn buy funs flags (slots.map Slot.mode) paid live env =
        elseE.buysIn buy funs flags (slots.map Slot.mode) paid live env +
          (if buy then tTy.buyCost (thenE.bodyPaid flags (slots.map Slot.mode) paid live)
            (elseE.bodyPaid flags (slots.map Slot.mode) paid live) (elseE.denote funs env)
          else 0) := by
      cases buy <;> simp [Expr.buysIn, Expr.buys, hcv]
    exact ite_branch hm elseSpec hh hpv hVars hSafe hCap hBase hRoomE hTrap hNextB e1 hTopC
      (P := (Expr.ite c thenE elseE).paidIn buy flags (slots.map Slot.mode) paid live)
      (K := if buy then tTy.buyCost (thenE.bodyPaid flags (slots.map Slot.mode) paid live)
        (elseE.bodyPaid flags (slots.map Slot.mode) paid live) (elseE.denote funs env) else 0)
      (Db := dyingPot store s env slots paid (fun i => live i || thenE.uses i || elseE.uses i) live)
      (by rw [hSplitI, hBuys]; simp only [Expr.allocs, Expr.mode, hcv, Bool.false_eq_true, ↓reduceIte]
          omega)
      (show dyingPot store s env slots paid (fun i => live i || elseE.uses i) live ≤
          dyingPot store s env slots paid (fun i => live i || thenE.uses i || elseE.uses i) live
        from dyingPot_mono (fun i h => by
          simp only [Bool.or_eq_true] at h ⊢; rcases h with h | h <;> simp [h]) fun _ h => h)
      (show (Expr.ite c thenE elseE).fits funs fits env = true → elseE.fits funs fits env = true
        from fun h => by
          simp only [Expr.fits, hcv, Bool.and_eq_true, Bool.false_eq_true, ↓reduceIte] at h
          exact h.2) hPlaceE
      (fun i h => by simp [h]) (fun h => by simp [Expr.aborts, h])
      (by simp [Expr.denote, hcv]) hModeE hPm
      (fun hP hb => by
        cases buy
        · simp only [Expr.paidIn, Bool.false_eq_true, ↓reduceIte, Expr.paid,
            Bool.and_eq_true] at hP hb
          simp [hP.2] at hb
        · simp only [Expr.paidIn, ↓reduceIte, Expr.bodyPaid, Bool.or_eq_true] at hP hb
          have hT : thenE.bodyPaid flags (slots.map Slot.mode) paid live = true :=
            hP.resolve_right (by simp [hb])
          simp [Ty.buyCost, hT, hb]) _ (fun _ h => h)
      fun _ _ h => by simpa using h
  · simp (config := { decide := true }) only [↓reduceIte]
    have hBuys : (Expr.ite c thenE elseE).buysIn buy funs flags (slots.map Slot.mode) paid live env =
        thenE.buysIn buy funs flags (slots.map Slot.mode) paid live env +
          (if buy then tTy.buyCost (elseE.bodyPaid flags (slots.map Slot.mode) paid live)
            (thenE.bodyPaid flags (slots.map Slot.mode) paid live) (thenE.denote funs env)
          else 0) := by
      cases buy <;> simp [Expr.buysIn, Expr.buys, hcv]
    exact ite_branch hm thenSpec hh hpv hVars hSafe hCap hBase hRoomT hTrap hNextB e1 hTopC
      (P := (Expr.ite c thenE elseE).paidIn buy flags (slots.map Slot.mode) paid live)
      (K := if buy then tTy.buyCost (elseE.bodyPaid flags (slots.map Slot.mode) paid live)
        (thenE.bodyPaid flags (slots.map Slot.mode) paid live) (thenE.denote funs env) else 0)
      (Db := dyingPot store s env slots paid (fun i => live i || thenE.uses i || elseE.uses i) live)
      (by rw [hSplitI, hBuys]; simp only [Expr.allocs, Expr.mode, hcv, ↓reduceIte]; omega)
      (show dyingPot store s env slots paid (fun i => live i || thenE.uses i) live ≤
          dyingPot store s env slots paid (fun i => live i || thenE.uses i || elseE.uses i) live
        from dyingPot_mono (fun i h => by
          simp only [Bool.or_eq_true] at h ⊢; rcases h with h | h <;> simp [h]) fun _ h => h)
      (fun h => by simp only [Expr.fits, hcv, Bool.and_eq_true] at h; simpa using h.2) hPlaceT
      (fun i h => by simp [h]) (fun h => by simp [Expr.aborts, h])
      (by simp [Expr.denote, hcv]) hModeT hPm
      (fun hP hb => by
        cases buy
        · simp only [Expr.paidIn, Bool.false_eq_true, ↓reduceIte, Expr.paid,
            Bool.and_eq_true] at hP hb
          simp [hP.1] at hb
        · simp only [Expr.paidIn, ↓reduceIte, Expr.bodyPaid, Bool.or_eq_true] at hP hb
          have hE : elseE.bodyPaid flags (slots.map Slot.mode) paid live = true :=
            hP.resolve_left (by simp [hb])
          simp [Ty.buyCost, hE, hb]) _ (fun _ h => h)
      fun _ _ h => by simpa using h

/-- A `let` binding: the value's code, the store of its words from local `base` on, the release
of the value when it is owned and the body does not use it, and the body's code. -/
theorem spec_letE (hm : Runtime m) {Γ' : List Ty} {sTy tTy : Ty} {value : Expr S Γ' sTy}
    {body : Expr S (sTy :: Γ') tTy} {buy : Bool}
    (valueSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv value env
        slots paid live)
    (bodySpec : ∀ env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv
        body env slots paid live) :
    ∀ env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv
        (Expr.letE value body) env slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hValueRoom : value.width ≤ max value.width body.width := Nat.le_max_left ..
  have hBodyRoom : body.width ≤ max value.width body.width := Nat.le_max_right ..
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  have hV : ∀ i, ((live i || body.uses (i + 1)) || value.uses i) = true →
      (live i || (Expr.letE value body).uses i) = true := fun i h => by
    simp only [Expr.uses]; exact live_seq _ _ _ h
  -- The variables that die in the `let` die in the value or in the body.
  have hSplitL : dyingPot store s env slots paid
      (fun i => live i || (Expr.letE value body).uses i) live =
        dyingPot store s env slots paid (fun i => live i || body.uses (i + 1) || value.uses i)
          (fun i => live i || body.uses (i + 1)) +
        dyingPot store s env slots paid (fun i => live i || body.uses (i + 1)) live := by
    rw [dyingPot_split _ (fun i => live i || body.uses (i + 1)) _
      (fun i h => hV i (by simp [h])) (fun i h => by simp [h])]
    congr 1
    exact dyingPot_congr (fun i => by
      simp only [Expr.uses]
      cases live i <;> cases value.uses i <;> cases body.uses (i + 1) <;> rfl) fun _ => rfl
  refine valueSpec env slots paid (fun i => live i || body.uses (i + 1)) h (base + sTy.width) heap
    store s hh hpv ((hVars.mono (by omega)).live_mono hV) hAt (hSafe.mono hV) hCap (by omega) (by omega) hPlace.1 _
        _
    (hTrap.part (by flag_tac) (fun h => by simp only [Expr.aborts]; exact trap_left _ _ _ h)
      fun _ hw => hw.mono (by rw [hSplitL]; simp only [Expr.allocs]; omega))
    fun heap1 store1 s1 ws1 a1 hTop1 => ?_
  have hp1 : s1.params = s.params := a1.frame.params
  have hh1 : s1.positions = h := a1.frame.positions.trans hh
  have a1' := a1.lower (hVars.live_mono hV) (Nat.le_add_right _ _) fun i h => by simp [h]
  refine wp_storeCode ws1 h base sTy.types s1 s.values a1.rep.typed hh1 (by rw [hp1]; omega)
    (by rw [Ty.types_length, hh1]; omega) fun s2 hF2 hold _ => ?_
  have f2 : Frame base s1 { s2 with values := s.values } := hF2.trans Frame.ofValues
  have hp2 : s2.params = s.params := hF2.params.trans hp1
  have hh2 : ({ s2 with values := s.values } : Locals).positions = h := f2.positions.trans hh1
  have hold' : LocalsHold { s2 with values := s.values } base sTy.types ws1 := hold
  -- The body's context: the value as variable 0, in the locals from `base` on.
  have hVarsB : Holds (Env.cons (value.denote funs env) env)
      (⟨base, value.mode (slots.map Slot.mode)⟩ :: slots)
      (fun i => i == 0 || shift 1 live i || body.uses i) (base + sTy.width) heap1 store1
      { s2 with values := s.values } :=
    Holds.push ((a1'.holds.agree f2).live_mono fun i h => by
        simpa using h)
      hold' a1.rep ((a1'.apart.agree a1'.holds f2).live_mono
        fun i h => by simpa using h)
  have hSafeB : pool.Safe (Env.cons (value.denote funs env) env)
      (⟨base, value.mode (slots.map Slot.mode)⟩ :: slots)
      (fun i => i == 0 || shift 1 live i || body.uses i) heap1 store1
      { s2 with values := s.values } :=
    (hSafe.mono hV).bind (hVars.live_mono hV) a1'
      (fun i hi => by simp [hi]) (fun i hi => by simpa using hi) f2 hold'
  have hRelease : (if value.mode (slots.map Slot.mode) = .owned ∧ body.uses 0 = false then
      releaseCode sTy base else []) =
      (if body.uses 0 = false then [0] else []).flatMap
        (releaseVar (sTy :: Γ') (⟨base, value.mode (slots.map Slot.mode)⟩ :: slots)) := by
    cases body.uses 0 <;> cases value.mode (slots.map Slot.mode) <;> simp [releaseVar]
  rw [hRelease]
  have hd1 : (Expr.letE value body).fits funs fits env = true → value.fits funs fits env = true :=
    fun hd => by simp only [Expr.fits, Bool.and_eq_true] at hd; exact hd.1
  have hd3 : (Expr.letE value body).fits funs fits env = true →
      body.fits funs fits (.cons (value.denote funs env) env) = true := fun hd => by
    simp only [Expr.fits, Bool.and_eq_true] at hd; exact hd.2
  refine wp_releaseVars hm _ (by split <;> simp) hVarsB a1.step.at_ (by split <;> simp)
    fun heap2 store2 e2 hTop2 => ?_
  have e2' := e2.mono (live' := fun i => shift 1 live i || body.uses i) fun i h => by
    cases i with
    | zero =>
      have h0 : body.uses 0 = true := by simpa [shift] using h
      simp [h0]
    | succ k => split <;> simpa using h
  -- The body's dying variables: the value's variable, whose potential is the value's when paid,
  -- and the others, whose potential the value's code and the release keep.
  have hDb : dyingPot store2 { s2 with values := s.values } (Env.cons (value.denote funs env) env)
      (⟨base, value.mode (slots.map Slot.mode)⟩ :: slots)
      (value.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 1)) :: paid)
      (fun i => shift 1 live i || body.uses i) (shift 1 live) ≤
        (if value.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 1)) = true then
          sTy.pot store1 ws1 (value.denote funs env) else 0) +
        dyingPot store s env slots paid (fun i => live i || body.uses (i + 1)) live := by
    rw [dyingPot_evolves hVarsB e2' (fun i h => by
      simp only [Bool.or_eq_true] at h ⊢; rcases h with h | h <;> simp [h]) _ _ fun _ h => h,
      dyingPot_cons]
    have hTail : dyingPot store1 { s2 with values := s.values } env slots paid
        (fun i => shift 1 live (i + 1) || body.uses (i + 1)) (fun i => shift 1 live (i + 1)) =
          dyingPot store s env slots paid (fun i => live i || body.uses (i + 1)) live := by
      rw [dyingPot_congr (L0' := fun i => live i || body.uses (i + 1)) (L1' := live)
        (fun i => by simp [shift]) (fun i => by simp [shift])]
      exact dyingPot_step (hVars.live_mono hV) a1'.step (a1'.frame.trans f2)
        (fun i h => by simp [h]) _ _ fun _ h => h
    rw [hTail, hold'.read_eq (by rw [a1.rep.length, Ty.types_length])]
    refine Nat.add_le_add_right ?_ _
    split
    · next hc =>
      simp only [Bool.and_eq_true] at hc
      simp only [hc.1.2, ↓reduceIte, le_refl]
    · exact Nat.zero_le _
  have hbuys : (Expr.letE value body).buysIn buy funs flags (slots.map Slot.mode) paid live env =
      body.buysIn buy funs flags ((⟨base, value.mode (slots.map Slot.mode)⟩ :: slots).map Slot.mode)
        (value.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 1)) ::
          paid) (shift 1 live) (.cons (value.denote funs env) env) :=
    rfl
  refine bodySpec _ _
    (value.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 1)) :: paid)
    (shift 1 live) h (base + sTy.width) heap2 store2
    { s2 with values := s.values } hh2 (hp2.trans hpv) e2'.holds e2'.step.at_
    (hSafeB.evolves hVarsB e2' (fun i hi => live_right _ _ _ hi))
    (by rw [e2'.step.cap m, a1.step.cap m]; exact hCap)
    (by show s2.params.length ≤ base + sTy.width; rw [hp2]; omega)
    (by omega) hPlace.2 _ _
    (hTrap.part (by flag_tac) (fun h => by
      have hmo := value.mode_owned (slots.map Slot.mode)
      rw [Slot.any_map] at hmo
      simp only [List.any_cons, Expr.aborts] at h ⊢
      exact let_trap_body _ _ _ _ (fun hv => hmo (by simpa using hv)) h) fun hd hw => by
        have h1 := hTop1 (hd1 (fits_of_not hd)); have := congrArg UInt64.toNat hTop2
        dsimp only at h1
        refine hw.of_le ?_ (by rw [e2'.step.cap m, a1.step.cap m])
        rw [hSplitL, hbuys]
        simp only [Expr.allocs, List.map_cons]
        omega)
    fun heap3 store3 s3 ws3 aB hTop3 => ?_
  have aB' := After.prepend hVarsB e2' aB (fun i h => live_right _ _ _ h) fun i h => by simp [h]
  exact hNext heap3 store3 s3 ws3
    ((After.bind (hVars.live_mono hV) a1' f2 hold' aB' (fun i h => by simpa using h)
      (fun i h => by simp [h]) fun i h => by simp [h]).liveIn hV) fun hd => by
      have h1 := hTop1 (hd1 hd); have h3 := hTop3 (hd3 hd); have := congrArg UInt64.toNat hTop2
      dsimp only at h1
      have hpot : (if (Expr.letE value body).paidIn buy flags (slots.map Slot.mode) paid live = true
            then tTy.pot store3 ws3 ((Expr.letE value body).denote funs env) else 0) =
          (if body.paidIn buy flags ((⟨base, value.mode (slots.map Slot.mode)⟩ :: slots).map Slot.mode)
              (value.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 1)) ::
                paid) (shift 1 live) = true then
            tTy.pot store3 ws3 (body.denote funs (.cons (value.denote funs env) env)) else 0) :=
        rfl
      rw [hpot, hbuys, hSplitL]
      simp only [Expr.allocs, List.map_cons] at h3 ⊢
      omega

/-- The regions of the first of two values in a row, which the second's code keeps. -/
theorem After.seq_regions {Γ : List Ty} {env : Env Γ} {slots : List Slot}
    {L0 L1 live : Nat → Bool} {base : Nat} {heap heap1 heap2 : Heap}
    {store store1 store2 : Store Unit} {s s1 s2 : Locals} {t u : Ty} {m1 m2 : Mode}
    {v1 : t.denote} {v2 : u.denote} {ws1 ws2 vs : List Value}
    (a1 : After env slots L0 L1 base heap store s t m1 v1 heap1 store1 s1 ws1)
    (a2 : After env slots L1 live base heap1 store1 { s1 with values := vs } u m2 v2 heap2
      store2 s2 ws2) :
    t.regions m1 store2 ws1 v1 = t.regions m1 store1 ws1 v1 := by
  have hKeep1 : ∀ c ∈ t.regions m1 store1 ws1 v1,
      Holds.KeepDying env slots L1 live store1 { s1 with values := vs } c := by
    intro c hc w x hx _ hm wx hwx hlx b hb
    have hb' : b ∈ w.regions (slots.getD x.index default).mode store1 wx (env.get x) := by
      rw [hm]; exact hb
    exact a1.apart w x hx (Or.inr hm) wx hwx hlx c hc b hb'
  exact (a1.rep.step a2.step hKeep1).2.1

/-- The bound of a pair from those of its components and their coercions: a paid pair's
potential is the sum of its components', each paid or 0. -/
theorem pair_top {T0 T1' T1 T2' T2 D1 D2 A1 C1 A2 C2 P1 P2 P1' P2' : Nat} {p1 p2 pp : Bool}
    (hF : T1' + (if p1 = true then P1' else 0) ≤ T0 + D1 + A1) (hC1 : T1 ≤ T1' + C1)
    (hS : T2' + (if p2 = true then P2' else 0) ≤ T1 + D2 + A2) (hC2 : T2 ≤ T2' + C2)
    (h1 : pp = true → (p1 = true ∧ P1 = P1') ∨ P1 = 0)
    (h2 : pp = true → (p2 = true ∧ P2 = P2') ∨ P2 = 0) :
    T2 + (if pp = true then P1 + P2 else 0) ≤ T0 + (D1 + D2) + (A1 + C1 + A2 + C2) := by
  cases pp with
  | false =>
    simp only [Bool.false_eq_true, ↓reduceIte, Nat.add_zero]
    omega
  | true =>
    simp only [↓reduceIte]
    have e1 : P1 ≤ (if p1 = true then P1' else 0) := by
      rcases h1 rfl with ⟨hp1, rfl⟩ | h1
      · simp [hp1]
      · omega
    have e2 : P2 ≤ (if p2 = true then P2' else 0) := by
      rcases h2 rfl with ⟨hp2, rfl⟩ | h2
      · simp [hp2]
      · omega
    omega

/-- A pair: the code of each component, each followed by its coercion to the pair's mode. -/
theorem spec_pair (hm : Runtime m) {Γ' : List Ty} {sTy tTy : Ty} {first : Expr S Γ' sTy}
    {second : Expr S Γ' tTy}
    (firstSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv first env
        slots paid live)
    (secondSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv second env
        slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.pair first second) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have h1 : first.width ≤ max first.width second.width := Nat.le_max_left ..
  have h2 : second.width ≤ max first.width second.width := Nat.le_max_right ..
  have hc1 : copyWidth sTy ≤ max (copyWidth sTy) (copyWidth tTy) := Nat.le_max_left ..
  have hc2 : copyWidth tTy ≤ max (copyWidth sTy) (copyWidth tTy) := Nat.le_max_right ..
  have hw := Nat.le_max_left (max first.width second.width) (max (copyWidth sTy) (copyWidth tTy))
  have hc := Nat.le_max_right (max first.width second.width) (max (copyWidth sTy) (copyWidth tTy))
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  have hIn : ∀ i, ((live i || second.uses i) || first.uses i) = true →
      (live i || (Expr.pair first second).uses i) = true := fun i h => by
    simp only [Expr.uses]; exact live_seq _ _ _ h
  have hVarsL := hVars.live_mono hIn
  have hOwnedA : (Expr.pair first second).mode (slots.map Slot.mode) = .owned →
      ((Expr.pair first second).aborts || slots.any (·.mode == .owned)) = true := fun ht => by
    have := (Expr.pair first second).mode_owned (slots.map Slot.mode) ht
    rw [Slot.any_map] at this
    exact this
  have hdF : (Expr.pair first second).fits funs fits env = true → first.fits funs fits env = true :=
    fun hd => by simp only [Expr.fits, Bool.and_eq_true] at hd; exact hd.1
  have hdS : (Expr.pair first second).fits funs fits env = true →
      second.fits funs fits env = true := fun hd => by
    simp only [Expr.fits, Bool.and_eq_true] at hd; exact hd.2
  have hB : (Expr.pair first second).allocs funs flags bounds (slots.map Slot.mode) paid live env =
      first.allocs funs flags bounds (slots.map Slot.mode) paid (fun i => live i || second.uses i) env +
        coerceCost sTy (first.mode (slots.map Slot.mode))
          ((first.mode (slots.map Slot.mode)).join (second.mode (slots.map Slot.mode)))
          (first.denote funs env) +
        second.allocs funs flags bounds (slots.map Slot.mode) paid live env +
        coerceCost tTy (second.mode (slots.map Slot.mode))
          ((first.mode (slots.map Slot.mode)).join (second.mode (slots.map Slot.mode)))
          (second.denote funs env) := by
    simp only [Expr.allocs, Expr.mode]
  -- The variables that die in the pair die in the first component or in the second.
  have hSplitP : dyingPot store s env slots paid
      (fun i => live i || (Expr.pair first second).uses i)
      live =
        dyingPot store s env slots paid (fun i => live i || second.uses i || first.uses i)
          (fun i => live i || second.uses i) +
        dyingPot store s env slots paid (fun i => live i || second.uses i) live := by
    rw [dyingPot_split _ (fun i => live i || second.uses i) _
      (fun i h => hIn i (by simp [h])) (fun i h => by simp [h])]
    congr 1
    exact dyingPot_congr (fun i => by
      simp only [Expr.uses]
      cases live i <;> cases first.uses i <;> cases second.uses i <;> rfl) fun _ => rfl
  refine firstSpec env slots paid _ h base heap store s hh hpv hVarsL hAt
    (hSafe.mono hIn) hCap hBase (by omega) hPlace.1 _ _
    (hTrap.part (by flag_tac) (fun h => by simp only [Expr.aborts]; exact trap_left _ _ _ h)
      fun _ hw => hw.mono (by rw [hB, hSplitP]; omega))
    fun heap0 store0 s0 ws0 a0 hTopF => ?_
  refine After.coerce hm a0 (fun h => by simp [Mode.join, h]) le_rfl
    (by rw [a0.frame.params]; exact hBase) (a0.frame.positions.trans hh) (by omega)
    (by rw [a0.step.cap m]; exact hCap) (fun hs ht _ => hTrap.alloc (hOwnedA ht) fun hd hw => by
      have hcc : coerceCost sTy (first.mode (slots.map Slot.mode))
          ((first.mode (slots.map Slot.mode)).join (second.mode (slots.map Slot.mode)))
          (first.denote funs env) =
          sTy.copyCost (first.denote funs env) := by rw [coerceCost, if_pos ⟨hs, ht⟩]
      have := hTopF (hdF (fits_of_not hd))
      exact hw.shift (c1 := dyingPot store s env slots paid
          (fun i => live i || second.uses i || first.uses i) (fun i => live i || second.uses i) +
        first.allocs funs flags bounds (slots.map Slot.mode) paid (fun i => live i || second.uses i) env)
        (by omega) (by rw [hB, hSplitP]; omega) (a0.step.cap m))
    fun heap1 store1 s1 ws1 a1 hTopC1 hSame1 => ?_
  have hDs : dyingPot store1 { s1 with values := ws1.reverse ++ s.values } env slots paid
      (fun i => live i || second.uses i) live =
        dyingPot store s env slots paid (fun i => live i || second.uses i) live := by
    rw [dyingPot_values]
    exact dyingPot_after hVarsL a1 (fun i h => by simp [h]) _ _ fun _ h => h
  refine secondSpec env slots paid live h base heap1 store1
    { s1 with values := ws1.reverse ++ s.values } (a1.frame.positions.trans hh)
    (a1.frame.params.trans hpv) (a1.holds.agree Frame.ofValues) a1.step.at_
    (((hSafe.mono hIn).after hVarsL a1 (fun i hi => by simp [hi])).1.values _)
    (by rw [a1.step.cap m]; exact hCap)
    (by show s1.params.length ≤ base; rw [a1.frame.params]; exact hBase) (by omega) hPlace.2 _ _
    (hTrap.part (by flag_tac) (fun h => by simp only [Expr.aborts]; exact trap_right _ _ _ h)
      fun hd hw => by
        rw [hDs]
        exact hw.shift (heap1 := heap1) (store1 := store1)
          (c1 := dyingPot store s env slots paid (fun i => live i || second.uses i || first.uses i)
            (fun i => live i || second.uses i) +
            first.allocs funs flags bounds (slots.map Slot.mode) paid (fun i => live i || second.uses i)
            env + coerceCost sTy (first.mode (slots.map Slot.mode))
            ((first.mode (slots.map Slot.mode)).join (second.mode (slots.map Slot.mode)))
              (first.denote funs env))
          (by have := hTopF (hdF (fits_of_not hd)); have := hTopC1; omega)
          (by rw [hB, hSplitP]; omega) (a1.step.cap m))
    fun heap3 store3 s3 ws3 a3 hTopS => ?_
  refine After.coerce hm a3 (fun h => by
      simp only [Mode.join, h]; cases first.mode (slots.map Slot.mode) <;> rfl) le_rfl
    (by rw [a3.frame.params, a1.frame.params]; exact hBase)
    (a3.frame.positions.trans (a1.frame.positions.trans hh)) (by omega)
    (by rw [a3.step.cap m, a1.step.cap m]; exact hCap)
    (fun hs ht _ => hTrap.alloc (hOwnedA ht) fun hd hw => by
      have hcc : coerceCost tTy (second.mode (slots.map Slot.mode))
          ((first.mode (slots.map Slot.mode)).join (second.mode (slots.map Slot.mode)))
          (second.denote funs env) =
          tTy.copyCost (second.denote funs env) := by rw [coerceCost, if_pos ⟨hs, ht⟩]
      exact hw.shift (heap1 := heap3) (store1 := store3)
        (c1 := dyingPot store s env slots paid (fun i => live i || second.uses i || first.uses i)
          (fun i => live i || second.uses i) +
          first.allocs funs flags bounds (slots.map Slot.mode) paid (fun i => live i || second.uses i)
          env + coerceCost sTy (first.mode (slots.map Slot.mode))
          ((first.mode (slots.map Slot.mode)).join (second.mode (slots.map Slot.mode)))
            (first.denote funs env) +
          dyingPot store s env slots paid (fun i => live i || second.uses i) live +
          second.allocs funs flags bounds (slots.map Slot.mode) paid live env)
        (by have := hTopF (hdF (fits_of_not hd)); have := hTopC1
            have := hTopS (hdS (fits_of_not hd)); rw [hDs] at this; omega)
        (by rw [hB, hSplitP]; omega)
        (by rw [a3.step.cap m, a1.step.cap m]))
    fun heap2 store2 s2 ws2 a2 hTopC2 hSame2 => ?_
  obtain ⟨hStep, hFrame, hRep1, hApart1, hDisjoint⟩ :=
    After.seq hVarsL a1 a2 (fun i h => by simp [h]) fun i h => by simp [h]
  have hl1 := hRep1.length
  have hv := hNext heap2 store2 s2 (ws1 ++ ws2) ⟨by
      rw [Mode.fresh_pair hl1]
      exact hStep.mono (fun _ hr => hr.mono fun i h1 h2 => ⟨hIn i h1, h2⟩) fun _ hb => hb,
    hFrame, a2.holds, ⟨ws1, ws2, rfl, hRep1, a2.rep, fun hmo x hx y hy => by
      have hmo' : (first.mode (slots.map Slot.mode)).join (second.mode (slots.map Slot.mode)) =
          .owned := hmo
      rw [hmo'] at hDisjoint
      exact hDisjoint x hx y hy⟩, fun w y hy hmo wy hwy hly b hb c hc => by
      rw [Ty.regions_append hl1] at hb
      rcases List.mem_append.mp hb with hb | hb
      · exact hApart1 w y hy hmo wy hwy hly b hb c hc
      · exact a2.apart w y hy hmo wy hwy hly b hb c hc⟩
      (fun hd => by
        have hF := hTopF (hdF hd)
        have hS := hTopS (hdS hd)
        rw [hDs] at hS
        have hRegions1 := After.seq_regions a1 a2
        have hValue : (Expr.pair first second).denote funs env =
            (first.denote funs env, second.denote funs env) := rfl
        rw [hB, hSplitP, hValue]
        simp only [Ty.pot, List.take_left' hl1, List.drop_left' hl1]
        refine pair_top hF hTopC1 hS hTopC2 (fun hp => ?_) (fun hp => ?_)
        · simp only [Expr.paid, Bool.and_eq_true, beq_iff_eq, Bool.or_eq_true] at hp
          rcases hp.1.2 with hp1 | hc1
          · obtain ⟨rfl, rfl⟩ := hSame1 (Expr.mode_of_paid first hp1)
            exact Or.inl ⟨hp1, Ty.pot_of_regions hp.1.1 hRegions1⟩
          · exact Or.inr (Ty.pot_creditFree sTy hc1 _ _)
        · simp only [Expr.paid, Bool.and_eq_true, beq_iff_eq, Bool.or_eq_true] at hp
          rcases hp.2 with hp2 | hc2
          · obtain ⟨rfl, rfl⟩ := hSame2 (Expr.mode_of_paid second hp2)
            exact Or.inl ⟨hp2, rfl⟩
          · exact Or.inr (Ty.pot_creditFree tTy hc2 _ _))
  simpa [List.reverse_append, List.append_assoc] using hv

/-- A binding of a pair's components: the pair's code, the stores of its components' words, the
release of each component that is owned and that the body does not use, and the body's code. -/
theorem spec_letPair (hm : Runtime m) {Γ' : List Ty} {sTy tTy uTy : Ty}
    {e : Expr S Γ' (.pair sTy tTy)} {body : Expr S (tTy :: sTy :: Γ') uTy} {buy : Bool}
    (eSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv e env slots paid live)
    (bodySpec : ∀ env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv
        body env slots paid live) :
    ∀ env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv
        (Expr.letPair e body) env slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hER : e.width ≤ max e.width body.width := Nat.le_max_left ..
  have hBR : body.width ≤ max e.width body.width := Nat.le_max_right ..
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  have hV : ∀ i, ((live i || body.uses (i + 2)) || e.uses i) = true →
      (live i || (Expr.letPair e body).uses i) = true := fun i h => by
    simp only [Expr.uses]; exact live_seq _ _ _ h
  -- The variables that die in the binding die in the pair or in the body.
  have hSplitL : dyingPot store s env slots paid
      (fun i => live i || (Expr.letPair e body).uses i) live =
        dyingPot store s env slots paid (fun i => live i || body.uses (i + 2) || e.uses i)
          (fun i => live i || body.uses (i + 2)) +
        dyingPot store s env slots paid (fun i => live i || body.uses (i + 2)) live := by
    rw [dyingPot_split _ (fun i => live i || body.uses (i + 2)) _
      (fun i h => hV i (by simp [h])) (fun i h => by simp [h])]
    congr 1
    exact dyingPot_congr (fun i => by
      simp only [Expr.uses]
      cases live i <;> cases e.uses i <;> cases body.uses (i + 2) <;> rfl) fun _ => rfl
  refine eSpec env slots paid _ h
    (base + sTy.width + tTy.width) heap store s hh hpv ((hVars.mono (by omega)).live_mono hV) hAt (hSafe.mono hV)
        hCap
    (by omega) (by omega) hPlace.1
    _ _ (hTrap.part (by flag_tac) (fun h => by simp only [Expr.aborts]; exact trap_left _ _ _ h)
      fun _ hw => hw.mono (by rw [hSplitL]; simp only [Expr.allocs]; omega))
    fun heap1 store1 s1 ws a1 hTop1 => ?_
  have hp1 : s1.params = s.params := a1.frame.params
  have hh1 : s1.positions = h := a1.frame.positions.trans hh
  have a1' := a1.lower (hVars.live_mono hV) (by omega) fun i h => by simp [h]
  obtain ⟨wf, wsec, rfl, hRf, hRs, hDisj⟩ := a1.rep
  have hlf := hRf.length
  have hls := hRs.length
  rw [List.reverse_append, List.append_assoc]
  refine wp_storeCode wsec h (base + sTy.width) tTy.types s1 (wf.reverse ++ s.values) hRs.typed
    hh1 (by rw [hp1]; omega) (by rw [Ty.types_length, hh1]; omega) fun s2 hF2 hold2 _ => ?_
  have hh2 : s2.positions = h := hF2.positions.trans hh1
  refine wp_storeCode wf h base sTy.types s2 s.values hRf.typed hh2 (by rw [hF2.params, hp1]; omega)
    (by rw [Ty.types_length, hh2]; omega) fun s3 hF3 hold1 habove3 => ?_
  have hold1' : LocalsHold { s3 with values := s.values } base sTy.types wf := hold1
  have hold2' : LocalsHold { s3 with values := s.values } (base + sTy.width) tTy.types wsec :=
    hold2.keep hF3.positions habove3 (by rw [Ty.types_length]) (by rw [hls, hh2]; omega)
  have f3 : Frame base s1 { s3 with values := s.values } :=
    (hF2.mono (by omega)).trans (hF3.trans Frame.ofValues)
  have hp3 : s3.params = s.params := hF3.params.trans (hF2.params.trans hp1)
  -- The body's context: the second component as variable 0 and the first as variable 1.
  have hVars1 := (a1'.holds.agree f3)
  have hApart := a1'.apart.agree a1'.holds f3
  have hVarsB : Holds (Env.cons (e.denote funs env).2 (Env.cons (e.denote funs env).1 env))
      (⟨base + sTy.width, e.mode (slots.map Slot.mode)⟩ ::
        ⟨base, e.mode (slots.map Slot.mode)⟩ :: slots)
      (fun i => decide (i < 2) || shift 2 live i || body.uses i)
      (base + sTy.width + tTy.width) heap1 store1 { s3 with values := s.values } := by
    refine Holds.push (Holds.push (hVars1.live_mono fun i h => by simpa using h) hold1' hRf
      ((hApart.fst hlf).live_mono fun i h => by simpa using h)) hold2' hRs ?_
    refine Holds.Apart.push ((hApart.snd hlf).live_mono fun i h => by simpa using h) hold1' hlf
      fun hmo b hb c hc => ?_
    have hmo' : e.mode (slots.map Slot.mode) = .owned := by simpa using hmo
    rw [hmo'] at hb hc hDisj
    exact regionsDisjoint_symm (hDisj rfl c hc b hb)
  have hSafeB : pool.Safe
      (Env.cons (e.denote funs env).2 (Env.cons (e.denote funs env).1 env))
      (⟨base + sTy.width, e.mode (slots.map Slot.mode)⟩ ::
        ⟨base, e.mode (slots.map Slot.mode)⟩ :: slots)
      (fun i => decide (i < 2) || shift 2 live i || body.uses i)
      heap1 store1 { s3 with values := s.values } :=
    (hSafe.mono hV).bind2 (hVars.live_mono hV) a1'
      (fun i hi => by simp [hi]) (fun i hi => by simpa [shift] using hi)
      f3 hRf hRs hold1' hold2'
  have hRelease : ∀ rest' : Program,
      (if e.mode (slots.map Slot.mode) = .owned ∧ body.uses 1 = false then
        releaseCode sTy base else []) ++
      ((if e.mode (slots.map Slot.mode) = .owned ∧ body.uses 0 = false then
        releaseCode tTy (base + sTy.width) else []) ++ rest') =
      ((if body.uses 1 = false then [1] else []) ++
        (if body.uses 0 = false then [0] else [])).flatMap
        (releaseVar (tTy :: sTy :: Γ') (⟨base + sTy.width, e.mode (slots.map Slot.mode)⟩ ::
          ⟨base, e.mode (slots.map Slot.mode)⟩ :: slots)) ++ rest' := by
    intro rest'
    cases body.uses 1 <;> cases body.uses 0 <;> cases e.mode (slots.map Slot.mode) <;>
      simp [releaseVar]
  rw [hRelease]
  have hd1 : (Expr.letPair e body).fits funs fits env = true → e.fits funs fits env = true :=
    fun hd => by simp only [Expr.fits, Bool.and_eq_true] at hd; exact hd.1
  have hd3 : (Expr.letPair e body).fits funs fits env = true →
      body.fits funs fits (.cons (e.denote funs env).2 (.cons (e.denote funs env).1 env)) = true :=
    fun hd => by simp only [Expr.fits, Bool.and_eq_true] at hd; exact hd.2
  refine wp_releaseVars hm _ (by split <;> split <;> simp) hVarsB a1.step.at_
    (by split <;> split <;> simp) fun heap2 store2 e2 hTop2 => ?_
  have e2' := e2.mono (live' := fun i => shift 2 live i || body.uses i) fun i h => by
    match i with
    | 0 =>
      have h0 : body.uses 0 = true := by simpa [shift] using h
      simp [h0]
    | 1 =>
      have h1 : body.uses 1 = true := by simpa [shift] using h
      simp [h1]
    | k + 2 => split <;> split <;> simpa using h
  -- The body's dying variables: the components, paid when the pair is, whose potential is the
  -- pair's, and the others, whose potential the pair's code and the releases keep.
  have hPotE : (Ty.pair sTy tTy).pot store1 (wf ++ wsec) (e.denote funs env) =
      sTy.pot store1 wf (e.denote funs env).1 + tTy.pot store1 wsec (e.denote funs env).2 := by
    simp only [Ty.pot, List.take_left' hlf, List.drop_left' hlf]
  have hDb : dyingPot store2 { s3 with values := s.values }
      (Env.cons (e.denote funs env).2 (Env.cons (e.denote funs env).1 env))
      (⟨base + sTy.width, e.mode (slots.map Slot.mode)⟩ ::
        ⟨base, e.mode (slots.map Slot.mode)⟩ :: slots)
      (e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) ::
        e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) :: paid)
      (fun i => shift 2 live i || body.uses i) (shift 2 live) ≤
        (if e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) = true
          then (Ty.pair sTy tTy).pot store1 (wf ++ wsec) (e.denote funs env) else 0) +
        dyingPot store s env slots paid (fun i => live i || body.uses (i + 2)) live := by
    rw [dyingPot_evolves hVarsB e2' (fun i h => by
      simp only [Bool.or_eq_true] at h ⊢; rcases h with h | h <;> simp [h]) _ _ fun _ h => h,
      dyingPot_cons, dyingPot_cons]
    rw [dyingPot_congr (L0' := fun i => live i || body.uses (i + 2)) (L1' := live)
      (fun i => by simp [shift]) (fun i => by simp [shift])]
    rw [dyingPot_step (hVars.live_mono hV) a1'.step (a1'.frame.trans f3)
      (fun i h => by simp [h]) _ _ fun _ h => h]
    dsimp only
    rw [hold2'.read_eq (by rw [hls, Ty.types_length]), hold1'.read_eq (by rw [hlf, Ty.types_length]),
      hPotE]
    by_cases hpp : e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) = true
    · rw [ite_eq_left hpp]
      split <;> split <;> omega
    · simp only [hpp, Bool.and_false, Bool.false_and, Bool.false_eq_true, ↓reduceIte] <;> omega
  have hbuys : (Expr.letPair e body).buysIn buy funs flags (slots.map Slot.mode) paid live env =
      body.buysIn buy funs flags ((⟨base + sTy.width, e.mode (slots.map Slot.mode)⟩ ::
          ⟨base, e.mode (slots.map Slot.mode)⟩ :: slots).map Slot.mode)
        (e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) ::
          e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) ::
            paid) (shift 2 live)
        (.cons (e.denote funs env).2 (.cons (e.denote funs env).1 env)) :=
    rfl
  refine bodySpec _ _
    (e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) ::
      e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) :: paid)
    (shift 2 live) h (base + sTy.width + tTy.width)
    heap2 store2
    { s3 with values := s.values } (f3.positions.trans hh1) (hp3.trans hpv) e2'.holds e2'.step.at_
    (hSafeB.evolves hVarsB e2' (fun i hi => live_right _ _ _ hi))
    (by rw [e2'.step.cap m, a1.step.cap m]; exact hCap)
    (by show s3.params.length ≤ base + sTy.width + tTy.width; rw [hp3]; omega)
    (by omega) hPlace.2 _ _
    (hTrap.part (by flag_tac) (fun h => by
      have hmo := e.mode_owned (slots.map Slot.mode)
      rw [Slot.any_map] at hmo
      simp only [List.any_cons, Expr.aborts] at h ⊢
      exact let_trap_body2 _ _ _ _ (fun hv => hmo (by simpa using hv)) h) fun hd hw => by
        have h1 := hTop1 (hd1 (fits_of_not hd)); have := congrArg UInt64.toNat hTop2
        have hDb' := hDb
        refine hw.of_le ?_ (by rw [e2'.step.cap m, a1.step.cap m])
        rw [hSplitL, hbuys]
        simp only [Expr.allocs, List.map_cons]
        by_cases hpp :
            e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) = true
        · rw [ite_eq_left hpp] at h1 hDb'; omega
        · rw [ite_eq_right hpp] at h1 hDb'; omega)
    fun heap3 store3 s4 ws4 aB hTop3 => ?_
  have aB' := After.prepend hVarsB e2' aB (fun i h => live_right _ _ _ h) fun i h => by simp [h]
  have hNew : ∀ r, (∀ b ∈ (e.mode (slots.map Slot.mode)).fresh store1 (.pair sTy tTy) (wf ++ wsec)
      (e.denote funs env), regionsDisjoint r b) →
      ((e.mode (slots.map Slot.mode)) = .owned → ∀ w,
        LocalsHold { s3 with values := s.values } (base + sTy.width) tTy.types w →
        w.length = tTy.width →
        ∀ b ∈ tTy.blocks store1 w (e.denote funs env).2, regionsDisjoint r b) ∧
      ((e.mode (slots.map Slot.mode)) = .owned → ∀ w,
        LocalsHold { s3 with values := s.values } base sTy.types w → w.length = sTy.width →
        ∀ b ∈ sTy.blocks store1 w (e.denote funs env).1, regionsDisjoint r b) := by
    intro r hFresh
    rw [Mode.fresh_pair hlf] at hFresh
    refine ⟨fun hmo w hw hlw b hb => ?_, fun hmo w hw hlw b hb => ?_⟩
    · obtain rfl := LocalsHold.unique hw hold2' (hlw.trans hls.symm)
      rw [hmo] at hFresh
      exact hFresh b (List.mem_append_right _ hb)
    · obtain rfl := LocalsHold.unique hw hold1' (hlw.trans hlf.symm)
      rw [hmo] at hFresh
      exact hFresh b (List.mem_append_left _ hb)
  exact hNext heap3 store3 s4 ws4
    ((After.bind2 (hVars.live_mono hV) a1' f3 aB' (by omega) hNew
      (fun i h => by simpa using h) (fun i h => by simp [h]) fun i h => by simp [h]).liveIn hV)
    fun hd => by
      have h1 := hTop1 (hd1 hd); have h3 := hTop3 (hd3 hd); have := congrArg UInt64.toNat hTop2
      have hDb' := hDb
      have hpot : (if (Expr.letPair e body).paidIn buy flags (slots.map Slot.mode) paid live = true
            then uTy.pot store3 ws4 ((Expr.letPair e body).denote funs env) else 0) =
          (if body.paidIn buy flags ((⟨base + sTy.width, e.mode (slots.map Slot.mode)⟩ ::
              ⟨base, e.mode (slots.map Slot.mode)⟩ :: slots).map Slot.mode)
              (e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) ::
                e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) ::
                  paid) (shift 2 live) = true then
            uTy.pot store3 ws4 (body.denote funs
              (.cons (e.denote funs env).2 (.cons (e.denote funs env).1 env))) else 0) :=
        rfl
      rw [hpot, hbuys, hSplitL]
      simp only [List.map_cons] at h3 ⊢
      simp only [Expr.allocs]
      by_cases hpp :
          e.paid flags (slots.map Slot.mode) paid (fun i => live i || body.uses (i + 2)) = true
      · rw [ite_eq_left hpp] at h1 hDb'; omega
      · rw [ite_eq_right hpp] at h1 hDb'; omega

/-- A call: the arguments, the callee, whose theorem `Calls` gives, and the release of the owned
variables that the arguments use and that die at the call, other than those that the call
consumes. -/
theorem spec_call (hm : Runtime m) {d0 : UInt64}
    (hCalls : CallsAt m funs flags bounds fits d0 pool)
    {sig : Sig}
    {Γ' : List Ty} (g : FVar S sig)
    (args : (i : Fin sig.params.length) → Expr S Γ' (sig.params.get i))
    (argsSpec : ∀ i env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (args i) env
        slots paid live)
    (hDepth : (Expr.call g args).depthCalls = true → pv.head? = some (.i64 d0)) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.call g args) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hRoom' : ∀ i : Fin sig.params.length, base + (if sig.mode i = .owned then
      copyWidth (sig.params.get i)
      else (args i).width) ≤ h := fun i =>
    (Nat.add_le_add_left (le_argsMax (fun i => if sig.mode i = .owned then
      copyWidth (sig.params.get i) else (args i).width) i) base).trans hRoom
  simp only [Expr.placeArgs, Bool.and_eq_true, beq_iff_eq, Bool.not_eq_true'] at hPlace
  obtain ⟨⟨hA, hV⟩, hB⟩ := hPlace
  have hPlace1 : ∀ i, (sig.params.get i).scalar = false → sig.mode i = .borrowed →
      (args i).isPlace = true := fun i hs _ => by
    cases hi : (args i).isPlace with
    | true => rfl
    | false =>
      have := le_argsAny (fun i => !(sig.params.get i).scalar && !(args i).isPlace) i
        (by simp only [hs, hi, Bool.not_false, Bool.and_self])
      rw [hA] at this
      exact nomatch this
  have hVar : ∀ i : Fin sig.params.length, sig.mode i = .owned → ∃ x, args i = .var x :=
      fun i hmo => by
    refine Expr.exists_var (args i) ?_
    cases hi : (args i).varIndex?.isNone with
    | false => rfl
    | true =>
      have := le_argsAny (fun i => sig.mode i == .owned && (args i).varIndex?.isNone) i
        (by simp [hmo, hi])
      rw [hV] at this
      exact nomatch this
  have hPlace2 : ∀ i, (args i).placeArgs = true := fun i => by
    cases hi : (args i).placeArgs with
    | true => rfl
    | false =>
      have := le_argsAny (fun i => !(args i).placeArgs) i (by simp [hi])
      rw [hB] at this
      exact nomatch this
  have hMoved := callMoves_moved slots live args hVar
  have hAllocs : (Expr.call g args).allocs funs flags bounds (slots.map Slot.mode) paid live env =
      argsSum (argCost funs flags bounds (slots.map Slot.mode) paid
        (fun i => live i || argsAny fun j => (args j).uses i)
        (fun i => (live i || argsAny fun j => (args j).uses i) &&
          !(argsAny fun j => callMoves slots live args j && (args j).uses i)) sig.mode args env) +
        callCredits funs flags (slots.map Slot.mode) paid live g args env +
        bounds.get g (Env.ofFn fun i => (args i).denote funs env) := by
    simp only [Expr.allocs, callMovesAt_eq]; rfl
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc]
  refine wp_depthCode sig.depth (fun hd => by
    rw [hpv]; exact hDepth (by simp [Expr.depthCalls, hd])) ?_
  refine args_spec hm (paid := paid) (all := fun i => live i || argsAny fun j => (args j).uses i)
    (kept := fun i => (live i || argsAny fun j => (args j).uses i) &&
      !(argsAny fun j => callMoves slots live args j && (args j).uses i)) sig.mode args argsSpec
    (fun i k h => by
      simp only [Bool.or_eq_true]
      exact Or.inr (le_argsAny (fun j => (args j).uses k) i h))
    (fun k h => by simp only [Bool.and_eq_true] at h; exact h.1)
    (fun i hmo => ?_) hPlace1 (fun i hmo => ?_) hPlace2
    (fun i h => by
      simp only [Bool.not_eq_true'] at h
      simp only [Expr.fits, Bool.not_eq_true', Bool.and_eq_false_iff]
      exact Or.inl (argsAll_false _ i h))
    (fun i h => by
      simp only [Bool.or_eq_true] at h
      simp only [Expr.aborts, Bool.or_eq_true]
      rcases h with h | h
      · exact Or.inl (Or.inr (le_argsAny (fun j => (args j).aborts || sig.mode j == .owned) i
          (by simpa only [Bool.or_eq_true] using h)))
      · exact Or.inr h) heap store
    { s with values := (if sig.depth then [.i64 (d0 + 1)] else []) ++ s.values } hh hpv hVars hAt
    (hSafe.values _) hCap hBase hRoom' _ _
    (hTrap.part id id fun _ hw => hw.mono (by rw [hAllocs]; omega))
    fun heap1 store1 s1 ws1 F hStep1 hF1 hH1 hRep1 hSep1 hX1 hY1 hTop1 hPot1 => ?_
  · -- An owned parameter holds arrays.
    have := paramMode_owned hmo
    exact this
  · obtain ⟨x, hx⟩ := hVar i hmo
    refine ⟨x, hx, fun hkx => ?_⟩
    have hux : (args i).uses x.index = true := by rw [hx]; simp [Expr.uses]
    have hAll : (argsAny fun j => (args j).uses x.index) = true := le_argsAny _ i hux
    simp only [hAll, Bool.or_true, Bool.true_and, Bool.not_eq_false'] at hkx
    obtain ⟨j, y, hy, hyx, -, hmy, -, hOthers⟩ := hMoved _ hkx
    have hji : j = i := by
      by_contra hne
      have := hOthers i (Ne.symm hne) (paramMode_owned hmo)
      rw [hux] at this
      exact nomatch this
    subst hji
    exact ⟨hmy, hOthers⟩
  -- The callee, from the arguments' state, above the next call depth when its code takes it.
  replace hF1 : Frame base s s1 := hF1.values
  simp only [Holds.keepDying_values] at hX1
  obtain ⟨hStatic1, hStaticFresh⟩ := hSafe.static.step hStep1 (fun _ _ => trivial)
  have hInput : @Bytes.LiteralPool.Input (Env sig.params) (Env.represent sig.params sig.modes)
      pool heap1 store1 ws1 (Env.ofFn fun i => (args i).denote funs env) := by
    refine ⟨hStatic1, fun region hRegion => hX1 region (hStaticFresh region hRegion) ?_⟩
    exact (hSafe.apart region hRegion).mono fun k hk _ => by
      obtain ⟨i, hi⟩ := argsAny_true.mp hk
      simp only [Bool.and_eq_true] at hi
      exact ⟨by simp only [Expr.uses, Bool.or_eq_true]; exact Or.inr (le_argsAny _ i hi.1.2), rfl⟩
  have hRun := FunSpec.runs (hCalls g) hm host hStep1.at_ hInput hRep1 hSep1
    (by rw [hStep1.cap m]; exact hCap) (d := d0 + 1) (fun _ => rfl) s.values
  have hPArgs : Env.argPot store1 (sig.paidSel (flags.params g)) ws1
        (Env.ofFn fun i => (args i).denote funs env) ≤
      dyingPot store s env slots paid (fun i => live i || (Expr.call g args).uses i) live +
        callCredits funs flags (slots.map Slot.mode) paid live g args env := by
    simpa only [callCredits, Expr.uses] using
      args_pot_le_credits (pf := flags.params g) (slots := slots) (live := live)
        (paid := paid) (env := env) (s := s) (ws := ws1) (funs := funs) (base := base)
        args hVar hVars hStep1 (fun sel hsel => by
          simpa only [Expr.paramPot_values] using hPot1 sel hsel)
  have hsd : (Expr.call g args).fits funs fits env = true →
      (sig.depth && !fits.get g (Env.ofFn fun i => (args i).denote funs env)) = false :=
    fun hf => by
      simp only [Expr.fits, Bool.and_eq_true] at hf
      cases hdep : sig.depth
      · rfl
      · simp only [hdep, ↓reduceIte] at hf; simp [hf.2]
  refine wp_call_runs hRun (hTrap.of_imp fun h => by
    cases hfc : (Expr.call g args).fits funs fits env
    · simp [trapFlag, hfc]
    · simp only [hsd hfc, Bool.false_or, Bool.and_eq_true, Bool.not_eq_true',
        decide_eq_false_iff_not] at h
      obtain ⟨ha, hw⟩ := h
      have hab : ((Expr.call g args).aborts || slots.any (·.mode == .owned)) = true := by
        simp only [Bool.or_eq_true] at ha
        simp only [Expr.aborts, Bool.or_eq_true]; exact Or.inl (Or.inl (Or.inl ha))
      simp only [trapFlag, hfc, Bool.not_true, Bool.false_or, Bool.and_eq_true,
        Bool.not_eq_true', decide_eq_false_iff_not]
      refine ⟨hab, fun hW => hw ?_⟩
      rw [hAllocs] at hW
      have := hPArgs
      exact hW.shift (hTop1 (by simp [hfc])) (by omega) (hStep1.cap m)) fun st' vs hPost => ?_
  obtain ⟨out, rfl, heap', hAt', hOwned, hCaps, hRegions, hTopC⟩ := hPost
  have hRep : sig.result.Rep ((Expr.call g args).mode (slots.map Slot.mode)) heap' st'
      out.reverse (funs.get g (Env.ofFn fun i => (args i).denote funs env)) := by
    simp only [Expr.mode]
    split
    · exact Ty.Rep.borrow hOwned
    · exact hOwned
  have hStepC : Step heap1 store1
      (Apart store1 (Env.moves store1 sig.mode ws1 (Env.ofFn fun i => (args i).denote funs env))) heap'
      st' (((Expr.call g args).mode (slots.map Slot.mode)).fresh st' sig.result out.reverse
        (funs.get g (Env.ofFn fun i => (args i).denote funs env))) :=
    ⟨hAt', hCaps, fun r hr hpos hA => by
      obtain ⟨hb, hreg, hout⟩ := hRegions r hr hpos hA
      exact ⟨hb, hreg, fun b hb' => hout b (Mode.fresh_sub hb')⟩⟩
  -- The variables live after the call: those that its arguments use, other than the moved ones.
  have hKeptAll : ∀ i, ((live i || argsAny fun j => (args j).uses i) &&
      !(argsAny fun j => callMoves slots live args j && (args j).uses i)) = true →
      (live i || argsAny fun j => (args j).uses i) = true :=
    fun i h => by simp only [Bool.and_eq_true] at h; exact h.1
  have hMovedDie : ∀ i, (argsAny fun j => sig.mode j == .owned && (args j).uses i &&
      !((live i || argsAny fun j => (args j).uses i) &&
        !(argsAny fun j => callMoves slots live args j && (args j).uses i))) = true →
      (live i || argsAny fun j => (args j).uses i) = true ∧
        ((live i || argsAny fun j => (args j).uses i) &&
          !(argsAny fun j => callMoves slots live args j && (args j).uses i)) = false := by
    intro i h
    obtain ⟨j, hj⟩ := argsAny_true.mp h
    simp only [Bool.and_eq_true, Bool.not_eq_true'] at hj
    refine ⟨?_, hj.2⟩
    simp only [Bool.or_eq_true]
    exact Or.inr (le_argsAny (fun j => (args j).uses i) j hj.1.2)
  have hKeepC : ∀ (u : Ty) (y : Var Γ' u),
      ((live y.index || argsAny fun j => (args j).uses y.index) &&
        !(argsAny fun j => callMoves slots live args j && (args j).uses y.index)) = true →
      ∀ wy, LocalsHold s1 (slots.getD y.index default).loc u.types wy → wy.length = u.width →
      ∀ c ∈ u.regions (slots.getD y.index default).mode store1 wy (env.get y),
        Apart store1 (Env.moves store1 sig.mode ws1 (Env.ofFn fun i => (args i).denote funs env)) c := by
    exact args_moves_apart_kept sig.mode args
      (fun i k hi => by simp only [Bool.or_eq_true]; exact Or.inr (le_argsAny _ i hi))
      hKeptAll hVars hStep1 hF1 hX1
  have aCall : After env slots (fun i => live i || (Expr.call g args).uses i)
      (fun i => (live i || argsAny fun j => (args j).uses i) &&
        !(argsAny fun j => callMoves slots live args j && (args j).uses i)) base heap store s
      sig.result ((Expr.call g args).mode (slots.map Slot.mode))
      (funs.get g (Env.ofFn fun i => (args i).denote funs env)) heap' st' s1 out.reverse := by
    refine ⟨hStep1.trans hStepC fun r hr => ⟨trivial, fun hF => hX1 r hF
        (hr.mono fun i h _ => hMovedDie i h)⟩, hF1,
      (hH1.live_mono hKeptAll).step hStepC hKeepC, hRep, ?_⟩
    intro u y hy _ wy hwy hly b hb c hc
    obtain ⟨hSame, hFresh⟩ := (hH1.live_mono hKeptAll).regions_after hStepC hy hwy hly
      (hKeepC u y hy wy hwy hly)
    rw [hSame] at hc
    have hb' : b ∈ ((Expr.call g args).mode (slots.map Slot.mode)).fresh st' sig.result
        out.reverse (funs.get g (Env.ofFn fun i => (args i).denote funs env)) := by
      simp only [Expr.mode] at hb ⊢
      cases hsc : sig.result.scalar
      · simp only [hsc, Bool.false_eq_true, ↓reduceIte] at hb ⊢
        exact hb
      · simp only [hsc, ↓reduceIte] at hb
        rw [Ty.regions_scalar _ hsc] at hb
        exact nomatch hb
    exact regionsDisjoint_symm (hFresh c hc b hb')
  refine After.release hm (s1 := s1) (live := live)
    (sel := fun i => ((live i || argsAny fun j => (args j).uses i) &&
      !(argsAny fun j => callMoves slots live args j && (args j).uses i)) && !live i) hVars aCall
    hKeptAll (fun i h => by simp only [Bool.and_eq_true] at h ⊢; exact h.1) (fun i h => ?_)
    fun heap2 store2 a2 hTopR hReg => ?_
  · have hk : (argsAny fun j => callMoves slots live args j && (args j).uses i) = false := by
      cases hm' : argsAny fun j => callMoves slots live args j && (args j).uses i with
      | false => rfl
      | true =>
        obtain ⟨_, _, _, _, _, _, hl, _⟩ := hMoved i hm'
        rw [hl] at h
        exact nomatch h
    simp [h, hk]
  · refine (by simpa using hNext heap2 store2 s1 out.reverse a2 ·) fun hd => ?_
    have := hTop1 (by simp [hd]); have := hTopC (hsd hd); have := congrArg UInt64.toNat hTopR
    have := hPArgs
    -- A paid call returns a paid result, whose regions the release keeps.
    have := pot_keep (P := (Expr.call g args).paid flags (slots.map Slot.mode) paid live)
      (Q := flags.result g) (a := sig.result.pot store2 out.reverse
        (funs.get g (Env.ofFn fun i => (args i).denote funs env)))
      (b := sig.result.pot st' out.reverse
        (funs.get g (Env.ofFn fun i => (args i).denote funs env)))
      (fun h => by simp only [Expr.paid, Bool.and_eq_true] at h; exact h.2) fun h => by
        simp only [Expr.paid, Bool.and_eq_true, Bool.not_eq_true'] at h
        exact Ty.pot_of_regions (by simp [Expr.mode, h.1]) hReg
    rw [hAllocs]
    show _ + (if (Expr.call g args).paid flags (slots.map Slot.mode) paid live = true then
      sig.result.pot store2 out.reverse
        (funs.get g (Env.ofFn fun i => (args i).denote funs env)) else 0) ≤ _
    omega

/-- A paid loop state is held in owned mode. -/
theorem Expr.statePaid_mode {Γ : List Ty} {t : Ty} {modes : List Mode} {paid : List Bool}
    {live : Nat → Bool} {init : Expr S Γ t} {cond : Expr S (t :: Γ) .bool}
    {body : Expr S (t :: .word :: Γ) t} (h : Expr.statePaid flags modes paid live init cond body = true) :
    (init.mode modes).join (body.mode (.borrowed :: .borrowed :: modes)) = .owned := by
  simp only [Expr.statePaid, Bool.and_eq_true, beq_iff_eq] at h
  exact h.1.1

/-- The body of a loop whose state is paid gives a value paid as `Expr.bodyPaid` states. -/
theorem Expr.statePaid_body {Γ : List Ty} {t : Ty} {modes : List Mode} {paid : List Bool}
    {live : Nat → Bool} {init : Expr S Γ t} {cond : Expr S (t :: Γ) .bool}
    {body : Expr S (t :: .word :: Γ) t} (h : Expr.statePaid flags modes paid live init cond body = true) :
    body.paidIn (Expr.statePaid flags modes paid live init cond body) flags
      (((init.mode modes).join (body.mode (.borrowed :: .borrowed :: modes))) ::
        .borrowed :: modes) (Expr.statePaid flags modes paid live init cond body :: false :: paid)
      (shift 2 fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) = true := by
  rw [h]
  simp only [Expr.statePaid, Bool.and_eq_true] at h
  simpa only [Expr.paidIn, ↓reduceIte] using h.2

/-- In a loop's body, no paid variable dies other than the state: the index is unpaid, and the outer
variables that the body uses stay live. -/
theorem loop_body_dies {live c b : Nat → Bool} {paid : List Bool} :
    ∀ i, (fun j => shift 2 (fun i => live i || c (i + 1) || b (i + 2)) j || b j) (i + 1) = true →
      (shift 2 fun i => live i || c (i + 1) || b (i + 2)) (i + 1) = false →
      paidAt (false :: paid) i = false
  | 0, _, _ => rfl
  | k + 1, h0, h1 => by
    have hk : ¬ k + 1 + 1 < 2 := by omega
    have hs : k + 1 + 1 - 2 = k := by omega
    have hb : b (k + 1 + 1) = b (k + 2) := rfl
    simp only [shift, hk, hs, ↓reduceIte, hb] at h0 h1
    revert h0 h1
    cases live k <;> cases c (k + 1) <;> cases b (k + 2) <;> simp

/-- The potential of a loop's first state: that of a paid initial value, which the coercion keeps,
or the credit. -/
theorem loop_entry_pot {ps ip : Bool} {P0 P1 C : Nat} (h1 : ps = true → ip = true → P1 = P0)
    (h2 : ps = true → ip = false → P1 ≤ C) :
    (if ps = true then P1 else 0) ≤
      (if ip = true then P0 else 0) + (if (ps && !ip) = true then C else 0) := by
  cases ps <;> cases ip <;> simp_all

/-- A pass of a loop: the body's bound with the state's potential among its dying variables, and
the coercion of its value, which keeps a paid value's potential. -/
theorem loop_body_pot {ps bp : Bool} {top6 top6' top2 D B Y K P6 P6' Pi : Nat}
    (hbp : ps = true → bp = true) (hsame : ps = true → P6' = P6)
    (hB : top6 + (if bp = true then P6 else 0) ≤ top2 + D + B + Y)
    (hD : D ≤ (if ps = true then Pi else 0)) (hK : top6' ≤ top6 + K) :
    top6' + (if ps = true then P6' else 0) ≤ top2 + (if ps = true then Pi else 0) + B + K + Y := by
  cases ps
  · simp only [Bool.false_eq_true, ↓reduceIte] at hD ⊢
    split at hB <;> omega
  · obtain rfl := hbp rfl
    rw [hsame rfl]
    simp only [↓reduceIte] at hB hD ⊢
    omega

/-- The body of a loop at the state's flag `ps`, which holds only when the state is paid, gives a
value paid as `Expr.bodyPaid` states. -/
theorem Expr.statePaid_body_of {Γ : List Ty} {t : Ty} {modes : List Mode} {paid : List Bool}
    {live : Nat → Bool} {init : Expr S Γ t} {cond : Expr S (t :: Γ) .bool}
    {body : Expr S (t :: .word :: Γ) t} {ps : Bool}
    (hpsS : ps = true → Expr.statePaid flags modes paid live init cond body = true)
    (h : ps = true) :
    body.paidIn ps flags (((init.mode modes).join (body.mode (.borrowed :: .borrowed :: modes))) ::
        .borrowed :: modes) (ps :: false :: paid)
      (shift 2 fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) = true := by
  subst h
  have h2 := Expr.statePaid_body (hpsS rfl)
  rwa [hpsS rfl] at h2

/-- `LeanExe.loop` with a condition: the count in local `base`, the initial state, coerced to the
loop's mode, from local `base + 2` on, and the index in local `base + 1`.  The invariant at the top
of the WebAssembly `loop` holds the count, the index `i`, and the state after `i` passes, with the
facts of `After` for the outer variables live in the loop, those live after it or used by the
condition or the body.  Each pass leaves at the count, then runs the condition with the state as a
borrowed variable, in which no variable dies, so `After.test` keeps the invariant at its heap.  A
false condition leaves with the state, which `loopState_stop` shows is the loop's value.
Otherwise the pass releases a state that the body does not use, runs the body, coerces its value
to the loop's mode, and stores it as the next state.  After the loop the outer variables that only
the condition or the body uses are released. -/
theorem spec_loop_with (hm : Runtime m) {Γ' : List Ty} {tTy : Ty} {count : Expr S Γ' .word}
    {init : Expr S Γ' tTy} {cond : Expr S (tTy :: Γ') .bool}
    {body : Expr S (tTy :: .word :: Γ') tTy}
    (countSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv count env
        slots paid live)
    (initSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv init env slots paid live)
    (condSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv cond env slots paid live)
    (bodySpec : ∀ buy env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host
        pv body env slots paid live) :
    ∀ env slots paid live (ps : Bool),
      (ps = true → Expr.statePaid flags (slots.map Slot.mode) paid live init cond body = true) →
      ((Expr.loop count init cond body).paid flags (slots.map Slot.mode) paid live = true →
        ps = true) →
      CodeSpecWith (pool := pool)
        ((Expr.loop count init cond body).paid flags (slots.map Slot.mode) paid live)
        (Expr.loopBound ps funs flags bounds (slots.map Slot.mode) paid live count init cond body
          env)
        m funs flags bounds fits host pv (Expr.loop count init cond body) env slots paid live := by
  intro env slots paid live ps hpsS hlpS h base heap store s hh hpv hVars hAt hSafe hCap hBase
      hRoom hPlace rest Q hTrap hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hc := Nat.le_max_left count.width (max (1 + max init.width (copyWidth tTy))
    (2 + tTy.width + max (max cond.width body.width) (copyWidth tTy)))
  have hi := (Nat.le_max_left (1 + max init.width (copyWidth tTy))
    (2 + tTy.width + max (max cond.width body.width) (copyWidth tTy))).trans
    (Nat.le_max_right count.width _)
  have hb := (Nat.le_max_right (1 + max init.width (copyWidth tTy))
    (2 + tTy.width + max (max cond.width body.width) (copyWidth tTy))).trans
    (Nat.le_max_right count.width _)
  have hi1 := Nat.le_max_left init.width (copyWidth tTy)
  have hi2 := Nat.le_max_right init.width (copyWidth tTy)
  have hb1 := Nat.le_max_left (max cond.width body.width) (copyWidth tTy)
  have hb2 := Nat.le_max_right (max cond.width body.width) (copyWidth tTy)
  have hcd := Nat.le_max_left cond.width body.width
  have hbd := Nat.le_max_right cond.width body.width
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  obtain ⟨⟨⟨hPc, hPi⟩, hPcd⟩, hPb⟩ := hPlace
  have hOwnedA : (Expr.loop count init cond body).mode (slots.map Slot.mode) = .owned →
      ((Expr.loop count init cond body).aborts || slots.any (·.mode == .owned)) = true :=
    fun ht => by
      have := (Expr.loop count init cond body).mode_owned (slots.map Slot.mode) ht
      rw [Slot.any_map] at this
      exact this
  have hdl : (Expr.loop count init cond body).fits funs fits env = true →
      count.fits funs fits env = true ∧ init.fits funs fits env = true ∧
        Expr.loopFitsRest funs fits cond body env (count.denote funs env).toNat 0 (init.denote funs env) = true :=
    fun hd => by
      simp only [Expr.fits, Bool.and_eq_true] at hd
      exact ⟨hd.1.1, hd.1.2, hd.2⟩
  have hT := Expr.loopBound_def ps funs flags bounds (slots.map Slot.mode) paid live count init cond
    body env
  simp only [Expr.code, loopCode, Expr.usesFast_eq, List.append_assoc, List.cons_append,
    List.nil_append]
  -- The count, in local `base`.
  have hCountIn : ∀ i, ((live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i) ||
      count.uses i) = true → (live i || (Expr.loop count init cond body).uses i) = true :=
    fun i h => by simp only [Expr.uses]; exact loop_live_count _ _ _ _ _ h
  -- The variables that die in the count and in the initial state.  The others that die in the
  -- loop are released after it, and their potential is dropped.
  have hDw : dyingPot store s env slots paid
        (fun i => (live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i) ||
          count.uses i) (fun i => live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i) +
      dyingPot store s env slots paid
        (fun i => live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i)
        (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) ≤
      dyingPot store s env slots paid (fun i => live i || (Expr.loop count init cond body).uses i)
        live := by
    rw [dyingPot_split _ (fun i => live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i)
      _ (fun i h => hCountIn i (by simp [h])) (fun i h => by simp [h]),
      dyingPot_split (fun i => live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i)
      (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) live (fun i h => by simp [h])
      (fun i h => by simp [h])]
    rw [dyingPot_congr (L0 := fun i => live i || (Expr.loop count init cond body).uses i)
      (L0' := fun i => (live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i) ||
        count.uses i) (fun i => by
          simp only [Expr.uses]
          cases live i <;> cases count.uses i <;> cases init.uses i <;>
            cases cond.uses (i + 1) <;> cases body.uses (i + 2) <;> rfl) fun _ => rfl]
    omega
  refine countSpec env slots paid _ h base heap
    store s hh hpv (hVars.live_mono hCountIn) hAt (hSafe.mono hCountIn) hCap hBase (by omega) hPc _ _
    (hTrap.part (fun h => by simp only [Bool.not_eq_true'] at h; simp [Expr.fits, h])
      (fun h => by simp only [Expr.aborts]; exact loop_trap_count _ _ _ _ _ h)
      fun _ hw => hw.mono (by rw [hT]; omega))
    fun heap1 store1 s1 ws1 a1 hTopK => ?_
  have hR1 := a1.rep
  simp only [Ty.rep_word] at hR1
  subst hR1
  have e1 := a1.toEvolves rfl
  have hp1 : s1.params = s.params := e1.frame.params
  have hh1 : s1.positions = h := e1.frame.positions.trans hh
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append]
  have hLow1 : ({ s1 with values := s.values } : Locals).params.length ≤ base := by
    show s1.params.length ≤ base; rw [hp1]; exact hBase
  have hHigh1 : base < s1.positions := by rw [hh1]; omega
  refine wp_localSet_local hLow1 (Locals.lt_total hHigh1) ?_
  have f2 : Frame base s1
      (setLocal { s1 with values := s.values } base (.i64 (count.denote funs env))) :=
    Frame.setValues hLow1 le_rfl hHigh1
  have hF2 : Frame base s
      (setLocal { s1 with values := s.values } base (.i64 (count.denote funs env))) :=
    e1.frame.trans f2
  have hN2 : (setLocal { s1 with values := s.values } base
      (.i64 (count.denote funs env))).get base = some (.i64 (count.denote funs env)) :=
    Locals.get_setLocal_same hLow1 (Locals.lt_total hHigh1)
  have e1' : Evolves env slots
      (fun i => (live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i) || count.uses i)
      (fun i => live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i) base heap store s
      heap1 store1
      (setLocal { s1 with values := s.values } base (.i64 (count.denote funs env))) :=
    Evolves.mk e1.step hF2 (e1.holds.agree f2)
  -- The initial state, coerced to the loop's mode, in the locals from `base + 2` on.
  have hDi : dyingPot store1
      (setLocal { s1 with values := s.values } base (.i64 (count.denote funs env))) env slots paid
      (fun i => live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i)
      (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) =
    dyingPot store s env slots paid
      (fun i => live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i)
      (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) :=
    dyingPot_evolves (hVars.live_mono hCountIn) e1' (fun i h => by simp [h]) _ _ fun _ h => h
  refine initSpec env slots paid _ h
    (base + 1) heap1 store1 _ (hF2.positions.trans hh) (hF2.params.trans hpv)
    (e1'.holds.mono (Nat.le_succ base))
    e1'.step.at_
    ((hSafe.mono hCountIn).evolves (hVars.live_mono hCountIn) e1' (fun i hi => by simp [hi]))
    (by rw [e1'.step.cap m]; exact hCap) (by rw [hF2.params]; omega) (by omega) hPi
    _ _ (hTrap.part (fun h => by simp only [Bool.not_eq_true'] at h; simp [Expr.fits, h])
      (fun h => by simp only [Expr.aborts]; exact loop_trap_init _ _ _ _ _ h)
      fun hd hw => by
        have := hTopK (hdl (fits_of_not hd)).1
        rw [hDi]
        exact hw.shift (heap1 := heap1) (store1 := store1)
          (c1 := dyingPot store s env slots paid
            (fun i => (live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i) ||
              count.uses i)
            (fun i => live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i) +
            count.allocs funs flags bounds (slots.map Slot.mode) paid
              (fun i => live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i) env)
          (by omega) (by rw [hT]; omega) (e1'.step.cap m))
    fun heap2 storeV _ wsV aV hTopI => ?_
  have hTop2 : (Expr.loop count init cond body).fits funs fits env = true →
      heap2.top.toNat ≤ heap.top.toNat +
        (dyingPot store s env slots paid
            (fun i => live i || (Expr.loop count init cond body).uses i)
          live +
        (count.allocs funs flags bounds (slots.map Slot.mode) paid
        (fun i => live i || cond.uses (i + 1) || body.uses (i + 2) || init.uses i) env +
        init.allocs funs flags bounds (slots.map Slot.mode) paid
        (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) env)) := fun hd => by
    have := hTopK (hdl hd).1; have := hTopI (hdl hd).2.1; rw [hDi] at this; omega
  refine After.coerce hm aV (fun h => by simp [Mode.join, h]) le_rfl
    (by rw [aV.frame.params, hF2.params]; omega) (aV.frame.positions.trans (hF2.positions.trans hh))
    (by omega) (by rw [aV.step.cap m, e1'.step.cap m]; exact hCap)
    (fun hs ht _ => hTrap.alloc (hOwnedA ht) fun hd hw => by
      have hcc : coerceCost tTy (init.mode (slots.map Slot.mode))
          ((init.mode (slots.map Slot.mode)).join
            (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode)))
          (init.denote funs env) = tTy.copyCost (init.denote funs env) := by
        rw [coerceCost, if_pos ⟨hs, ht⟩]
      exact hw.shift (hTop2 (fits_of_not hd)) (by rw [hT]; omega)
        (by rw [aV.step.cap m, e1'.step.cap m]))
    fun heap2' store2 s3 ws0 a2 hTopCo hSame0 => ?_
  -- The first state's potential: a paid initial value's, which the coercion keeps, or the credit.
  have hTopEntry : (Expr.loop count init cond body).fits funs fits env = true →
      heap2'.top.toNat +
          (if ps = true then
            tTy.pot store2 ws0 (init.denote funs env) else 0) +
          Expr.loopRest funs flags bounds (slots.map Slot.mode) paid live ps init cond body env
            (count.denote funs env).toNat 0 (init.denote funs env) ≤
        heap.top.toNat +
          (dyingPot store s env slots paid
              (fun i => live i || (Expr.loop count init cond body).uses i)
            live +
          Expr.loopBound ps funs flags bounds (slots.map Slot.mode) paid live count init cond body env) := fun hd => by
    have hK := hTopK (hdl hd).1
    have hI := hTopI (hdl hd).2.1
    rw [hDi] at hI
    have hE := loop_entry_pot (ps := ps)
      (ip := init.paid flags (slots.map Slot.mode) paid
        (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)))
      (P0 := tTy.pot storeV wsV (init.denote funs env))
      (P1 := tTy.pot store2 ws0 (init.denote funs env)) (C := tTy.credit (init.denote funs env))
      (fun _ hip => by
        obtain ⟨rfl, rfl⟩ := hSame0 (Expr.mode_of_paid init hip)
        rfl)
      (fun hps _ => by
        have hr := a2.rep
        rw [Expr.statePaid_mode (hpsS hps)] at hr
        exact Ty.pot_le_credit tTy ws0 _ hr)
    rw [hT]
    omega
  have hF3 : Frame base s s3 := hF2.trans (a2.frame.mono (Nat.le_succ base))
  have hh3 : s3.positions = h := hF3.positions.trans hh
  have hN3 : s3.get base = some (.i64 (count.denote funs env)) :=
    (a2.frame.below base (by omega)).1.trans hN2
  have a0 := (After.prepend (hVars.live_mono hCountIn) e1'
    (a2.lower e1'.holds (Nat.le_succ base) fun i h => by simp [h]) (fun i h => by simp [h])
    fun i h => by simp [h]).liveIn hCountIn
  refine wp_storeCode ws0 h (base + 2) tTy.types s3 s.values a0.rep.typed hh3
    (by rw [hF3.params]; omega) (by rw [Ty.types_length, hh3]; omega)
    fun s4 hF4 hold4 _ => ?_
  -- The index, in local `base + 1`.
  simp only [wp_constI64_cons]
  have hh4 : s4.positions = h := hF4.positions.trans hh3
  have hLow4 : ({ s4 with values := s.values } : Locals).params.length ≤ base + 1 := by
    show s4.params.length ≤ base + 1; rw [hF4.params, hF3.params]; omega
  have hHigh4 : base + 1 < s4.positions := by rw [hh4]; omega
  refine wp_localSet_local (s := s4) (vs := s.values) hLow4 (Locals.lt_total hHigh4) ?_
  have f5 : Frame (base + 1) s4 (setLocal { s4 with values := s.values } (base + 1) (.i64 0)) :=
    Frame.setValues hLow4 le_rfl hHigh4
  have hF5 : Frame base s3 (setLocal { s4 with values := s.values } (base + 1) (.i64 0)) :=
    (hF4.mono (base := base) (by omega)).trans (f5.mono (base := base) (by omega))
  have hN5 : (setLocal { s4 with values := s.values } (base + 1) (.i64 0)).get base =
      some (.i64 (count.denote funs env)) := by
    rw [(((hF4.mono (base := base + 1) (by omega)).trans f5).below base (by omega)).1]
    exact hN3
  have hI5 : (setLocal { s4 with values := s.values } (base + 1) (.i64 0)).get (base + 1) =
      some (.i64 0) :=
    Locals.get_setLocal_same hLow4 (Locals.lt_total hHigh4)
  have hold5 : LocalsHold (setLocal { s4 with values := s.values } (base + 1) (.i64 0))
      (base + 2) tTy.types ws0 :=
    hold4.keep (lo := base + 2) (by simp)
      (fun j hj _ => ⟨by rw [Locals.get_setLocal_ne hLow4 (by omega)]; rfl,
        by rw [Locals.get_setLocal_ne hLow4 (by omega)]; rfl,
        by rw [Locals.get_setLocal_ne hLow4 (by omega)]; rfl⟩) le_rfl
      (by rw [a0.rep.length, hh4]; omega)
  -- The exit at either test: the release of the outer variables that only the loop uses, and the
  -- load of the state.
  have hExit : ∀ heapX stX sX wsX (vals : List Value), vals = s.values →
      LocalsHold sX (base + 2) tTy.types wsX →
      After env slots (fun i => live i || (Expr.loop count init cond body).uses i)
        (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) base heap store s tTy
        ((init.mode (slots.map Slot.mode)).join
          (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode)))
        ((Expr.loop count init cond body).denote funs env) heapX stX sX wsX →
      ((Expr.loop count init cond body).fits funs fits env = true →
        heapX.top.toNat +
            (if ps = true then
              tTy.pot stX wsX ((Expr.loop count init cond body).denote funs env) else 0) ≤
          heap.top.toNat +
          (dyingPot store s env slots paid
              (fun i => live i || (Expr.loop count init cond body).uses i)
            live +
          Expr.loopBound ps funs flags bounds (slots.map Slot.mode) paid live count init cond body env)) →
      wp m (releaseWhere Γ' slots (fun i => (cond.uses (i + 1) || body.uses (i + 2)) && !live i) ++
        (loadCode h (base + 2) tTy.types ++ rest)) Q stX { sX with values := vals } host := by
    intro heapX stX sX wsX vals hv holdX aX hTopX
    subst hv
    refine After.release hm (live := live)
      (sel := fun i => (cond.uses (i + 1) || body.uses (i + 2)) && !live i) hVars aX
      (fun i h => by simp only [Expr.uses]; exact loop_live_state _ _ _ _ _ h)
      (fun i h => by simp only [Bool.and_eq_true] at h; exact loop_sel _ _ _ h.1)
      (fun i h => by simp [h]) fun heap' store' a' hTopR hReg => ?_
    refine wp_loadCode wsX a'.rep.typed (aX.frame.positions.trans hh) holdX ?_
    refine hNext heap' store' sX wsX a' fun hd => ?_
    have h1 := hTopX hd
    have h2 := congrArg UInt64.toNat hTopR
    -- The loop's value has the last state's potential, which the release keeps.
    have hP : (if ps = true then
          tTy.pot store' wsX ((Expr.loop count init cond body).denote funs env) else 0) =
        (if ps = true then
          tTy.pot stX wsX ((Expr.loop count init cond body).denote funs env) else 0) := by
      split
      · next hps => rw [Ty.pot_of_regions (Expr.statePaid_mode (hpsS hps)) hReg]
      · rfl
    -- A paid loop has a paid state.
    have hLoopPaid : (if (Expr.loop count init cond body).paid flags (slots.map Slot.mode) paid live =
          true then tTy.pot store' wsX ((Expr.loop count init cond body).denote funs env) else 0) ≤
        (if ps = true then
          tTy.pot store' wsX ((Expr.loop count init cond body).denote funs env) else 0) := by
      split
      · next hlp =>
        rw [ite_eq_left (hlpS hlp)]
      · exact Nat.zero_le _
    rw [hP] at hLoopPaid
    omega
  -- The loop.  The invariant holds the count, the index `i`, and the state after `i` passes, and
  -- the count less the index decreases.
  refine wp_block_cons ?_
  refine wp_loop_cons
    (fun st si => ∃ heapI wsI, ∃ i : UInt64, i ≤ count.denote funs env ∧
      si.get base = some (.i64 (count.denote funs env)) ∧ si.get (base + 1) = some (.i64 i) ∧
      LocalsHold si (base + 2) tTy.types wsI ∧
      After env slots (fun i => live i || (Expr.loop count init cond body).uses i)
        (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) base heap store s tTy
        ((init.mode (slots.map Slot.mode)).join
          (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode)))
        (loopState (init.denote funs env)
          (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) heapI st si wsI ∧
      ((Expr.loop count init cond body).fits funs fits env = true →
        Expr.loopFitsRest funs fits cond body env ((count.denote funs env).toNat - i.toNat) i
          (loopState (init.denote funs env)
            (fun i acc => bif cond.denote funs (.cons acc env) then
              body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) = true ∧
        heapI.top.toNat +
            (if ps = true then
              tTy.pot st wsI (loopState (init.denote funs env)
                (fun i acc => bif cond.denote funs (.cons acc env) then
                  body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) else 0) +
          Expr.loopRest funs flags bounds (slots.map Slot.mode) paid live ps init cond body env
          ((count.denote funs env).toNat - i.toNat) i
          (loopState (init.denote funs env)
            (fun i acc => bif cond.denote funs (.cons acc env) then
              body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) ≤
          heap.top.toNat +
            (dyingPot store s env slots paid
              (fun i => live i || (Expr.loop count init cond body).uses i) live +
            Expr.loopBound ps funs flags bounds (slots.map Slot.mode) paid live count init cond body env)))
    (fun _ s' => match s'.get (base + 1) with
      | some (.i64 i) => (count.denote funs env).toNat - i.toNat
      | _ => 0)
    ⟨heap2', ws0, 0, UInt64.zero_le, hN5, hI5, hold5, a0.reframe hF5, fun hd =>
      ⟨by simpa only [UInt64.toNat_zero, Nat.sub_zero, loopState] using (hdl hd).2.2,
        by simpa only [UInt64.toNat_zero, Nat.sub_zero, loopState] using hTopEntry hd⟩⟩ ?_
  rintro st si ⟨heapI, wsI, i, hiN, hNi, hii, holdi, aI, hInv⟩
  simp only [wp_localGet_cons, Locals.get_values, hii, hNi, wp_geUI64_cons, wp_br_if_cons]
  by_cases hge : count.denote funs env ≤ i
  · -- The index reached the count.
    simp (config := { decide := true }) only [ge_iff_le, hge, ↓reduceIte, List.take_zero,
      List.drop_zero, List.nil_append]
    have hieq := UInt64.le_antisymm hiN hge
    have hden : (Expr.loop count init cond body).denote funs env =
        loopState (init.denote funs env)
          (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat := by
      rw [hieq, loopState_eq]; rfl
    rw [hieq, loopState_eq] at aI
    refine hExit _ _ _ _ _ rfl holdi aI fun hd => ?_
    have := (hInv hd).2
    rw [hieq, Nat.sub_self, Expr.loopRest_zero] at this
    rw [hden, hieq]
    omega
  -- One more pass, if the condition holds.
  have hlt : i < count.denote funs env := UInt64.not_le.mp hge
  have hk : (count.denote funs env).toNat - i.toNat =
      ((count.denote funs env).toNat - i.toNat - 1) + 1 := by
    have := UInt64.lt_iff_toNat_lt.mp hlt; omega
  have hsucc : (i + 1).toNat = i.toNat + 1 := by
    have := UInt64.lt_iff_toNat_lt.mp hlt
    have := (count.denote funs env).toNat_lt
    rw [UInt64.toNat_add]; simp; omega
  simp (config := { decide := true }) only [ge_iff_le, hge, ↓reduceIte]
  have hhi : si.positions = h := aI.frame.positions.trans hh
  -- The pass's frames, from the invariant.
  have hFitsI : (Expr.loop count init cond body).fits funs fits env = true →
      Expr.loopFitsRest funs fits cond body env ((count.denote funs env).toNat - i.toNat - 1 + 1) i
        (loopState (init.denote funs env)
          (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) = true :=
    fun hd => by rw [← hk]; exact (hInv hd).1
  have hFitsC : (Expr.loop count init cond body).fits funs fits env = true → cond.fits funs fits (.cons (loopState (init.denote funs env)
      (fun i acc => bif cond.denote funs (.cons acc env) then
        body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) env) = true :=
    fun hd => Expr.loopFitsRest_cond (hFitsI hd)
  -- The condition's context: the state, borrowed, as variable 0.
  have hdAll : ∀ j, cond.uses (j + 1) = true →
      (live j || cond.uses (j + 1) || body.uses (j + 2)) = true := fun j h => by simp [h]
  have hVarsC : Holds (Env.cons (loopState (init.denote funs env)
        (fun i acc => bif cond.denote funs (.cons acc env) then
          body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) env)
      (⟨base + 2, .borrowed⟩ :: slots)
      (fun j => (j == 0 ||
        shift 1 (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) j) || cond.uses j)
      (base + 2 + tTy.width) heapI st si :=
    Holds.push ((aI.holds.mono (by omega)).live_mono fun j hj => cond_live_outer _ _ hdAll j hj)
      holdi aI.rep.borrow
      ((aI.apart.borrow aI.rep).live_mono fun j hj => cond_live_outer _ _ hdAll j hj)
  have hSafeI := (hSafe.after hVars aI
    (fun j hj => by simp only [Expr.uses]; exact loop_live_state _ _ _ _ _ hj)).1
  have hSafeC : pool.Safe
      (Env.cons (loopState (init.denote funs env)
        (fun i acc => bif cond.denote funs (.cons acc env) then
          body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) env)
      (⟨base + 2, .borrowed⟩ :: slots)
      (fun j => (j == 0 ||
        shift 1 (fun k => live k || cond.uses (k + 1) || body.uses (k + 2)) j) || cond.uses j)
      heapI st si :=
    (hSafeI.mono fun j hj => cond_live_outer _ _ hdAll j hj).push
      holdi aI.rep.borrow (by simp only [Mode.fresh]; exact fun _ _ _ hMem => nomatch hMem)
  -- No variable dies in the condition: the outer ones it uses stay live, and the state is
  -- borrowed.
  have hDc : dyingPot st si (Env.cons (loopState (init.denote funs env)
        (fun i acc => bif cond.denote funs (.cons acc env) then
          body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) env)
      (⟨base + 2, .borrowed⟩ :: slots) (false :: paid)
      (fun j => (j == 0 || shift 1 (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) j) ||
        cond.uses j)
      (fun j => j == 0 || shift 1 (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) j) =
      0 :=
    dyingPot_eq_zero fun j h => cond_live _ _ hdAll j h
  refine condSpec _ (⟨base + 2, .borrowed⟩ :: slots) (false :: paid) _ h
    (base + 2 + tTy.width) heapI st si hhi (aI.frame.params.trans hpv) hVarsC aI.step.at_
    hSafeC
    (by rw [aI.step.cap m]; exact hCap)
    (by rw [aI.frame.params]; omega) (by omega) hPcd _ _
    ((hTrap.part (fun h => by
          cases hw : (Expr.loop count init cond body).fits funs fits env
          · rfl
          · exact absurd (hFitsC hw) (by simpa using h)) (fun h => by
      have h' : (cond.aborts || slots.any (·.mode == .owned)) = true := by
        simpa [List.any_cons] using h
      simp only [Expr.aborts]; exact loop_trap_cond _ _ _ _ _ h') fun hd hw => hw.of_le
        (by
          have := (hInv (fits_of_not hd)).2
          have := Expr.loopRest_cond_le (funs := funs) (flags := flags) (bounds := bounds)
            (modes := slots.map Slot.mode) (paid := paid) (live := live) (ps := ps) (init := init)
                (cond := cond)
            (body := body) (env := env) (n := (count.denote funs env).toNat - i.toNat - 1) (i := i)
            (x := loopState (init.denote funs env)
              (fun i acc => bif cond.denote funs (.cons acc env) then
                body.denote funs (.cons acc (.cons i env)) else acc) i.toNat)
          rw [← hk] at this
          rw [hDc]
          simp only [List.map_cons]; omega)
        (aI.step.cap m)).imp fun _ h => h)
    fun heapC stC sC wsC aC hTopC => ?_
  have hRC := aC.rep
  simp only [Ty.rep_bool] at hRC
  subst hRC
  have aI2 := After.test aI aC (by omega) (cond_live _ _ hdAll) rfl
  -- The condition keeps the state's blocks, and so its potential.
  have hPotC : (if ps = true then
        tTy.pot stC wsI (loopState (init.denote funs env)
          (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) else 0) =
      (if ps = true then
        tTy.pot st wsI (loopState (init.denote funs env)
          (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) else 0) := by
    split
    · next hps =>
      rw [Ty.pot_of_regions (Expr.statePaid_mode (hpsS hps))
        (After.test_regions aI aC (cond_live _ _ hdAll))]
    · rfl
  have hiiC : sC.get (base + 1) = some (.i64 i) :=
    (aC.frame.below (base + 1) (by omega)).1.trans hii
  have hNiC : sC.get base = some (.i64 (count.denote funs env)) :=
    (aC.frame.below base (by omega)).1.trans hNi
  have holdC : LocalsHold sC (base + 2) tTy.types wsI :=
    (LocalsHold.frame aC.frame (by rw [aI.rep.length, Ty.types_length])
      (by rw [Ty.types_length])).mpr holdi
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append,
    wp_eqzI64_cons, wp_br_if_cons]
  cases hcv : cond.denote funs (Env.cons (loopState (init.denote funs env)
      (fun i acc => bif cond.denote funs (.cons acc env) then
        body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) env)
  · -- The condition fails: the state stays for the remaining passes.
    simp (config := { decide := true }) only [↓reduceIte, List.take_zero, List.drop_zero,
      List.nil_append]
    have hStop := loopState_stop (init.denote funs env)
      (fun acc => cond.denote funs (.cons acc env))
      (fun i acc => body.denote funs (.cons acc (.cons i env))) hcv _
      (UInt64.le_iff_toNat_le.mp hiN)
    have hden : (Expr.loop count init cond body).denote funs env =
        loopState (init.denote funs env)
          (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat := by
      rw [← hStop, loopState_eq]; rfl
    rw [← hStop, loopState_eq] at aI2
    refine hExit _ _ _ _ _ rfl holdC aI2 fun hd => ?_
    have h1 := (hInv hd).2
    rw [hk, Expr.loopRest_false hcv] at h1
    have h2 := hTopC (hFitsC hd)
    rw [hDc] at h2
    simp only [List.map_cons] at h2
    rw [hden, hPotC]
    omega
  simp (config := { decide := true }) only [↓reduceIte]
  -- The condition holds: the pass runs the body.
  set sB : Locals := { sC with values := si.values }
  have aB0 := aI2.reframe (Frame.ofValues (s := sC) (values := si.values))
  have holdB : LocalsHold sB (base + 2) tTy.types wsI := holdC
  have hiiB : sB.get (base + 1) = some (.i64 i) := hiiC
  have hNiB : sB.get base = some (.i64 (count.denote funs env)) := hNiC
  have holdIdx : LocalsHold sB (base + 1) Ty.word.types [.i64 i] := fun k hk => by
    obtain rfl : k = 0 := by simpa using hk
    simpa [Ty.types, slotIndex] using hiiB
  have hhB : sB.positions = h := aB0.frame.positions.trans hh
  have hRoomi : base + 2 + tTy.width + max body.width (copyWidth tTy) ≤ h := by omega
  -- The body's context: the state as variable 0 and the index as variable 1.
  have hIdx := Holds.push (t := .word) (v := i) (mode := .borrowed)
    (live' := fun j => decide (j + 1 < 2) ||
      shift 2 (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) (j + 1) ||
        body.uses (j + 1))
    ((aB0.holds.mono (Nat.le_add_right base 1)).live_mono fun j h => by simpa using h) holdIdx
    rfl
    (Holds.Apart.ofScalar rfl)
  have hVarsB : Holds (Env.cons (loopState (init.denote funs env)
        (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat)
        (Env.cons (t := .word) i env))
      (⟨base + 2, (init.mode (slots.map Slot.mode)).join
        (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode))⟩ ::
        ⟨base + 1, .borrowed⟩ :: slots)
      (fun j => decide (j < 2) ||
        shift 2 (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) j || body.uses j)
      (base + 2 + tTy.width) heapC stC sB :=
    Holds.push (hIdx.mono (base' := base + 2) (by simp [Ty.width])) holdB aB0.rep
      (Holds.Apart.push (u := .word) (v := i) (mv := .borrowed)
        (live' := fun j => decide (j + 1 < 2) ||
          shift 2 (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) (j + 1) ||
            body.uses (j + 1))
        (aB0.apart.live_mono fun j h => by simpa using h) holdIdx rfl
        fun _ _ _ c hc => by simp [Ty.regions, Ty.reads] at hc)
  obtain ⟨hSafeB0, hFreshB0⟩ := hSafe.after hVars aB0
    (fun j hj => by simp only [Expr.uses]; exact loop_live_state _ _ _ _ _ hj)
  have hSafeIdx : pool.Safe (.cons (t := .word) i env) (⟨base + 1, .borrowed⟩ :: slots)
      (fun j => decide (j + 1 < 2) ||
        shift 2 (fun k => live k || cond.uses (k + 1) || body.uses (k + 2)) (j + 1) ||
          body.uses (j + 1)) heapC stC sB :=
    (hSafeB0.mono fun j hj => by simpa using hj).push
      holdIdx (show Ty.word.Rep .borrowed heapC stC [.i64 i] i from rfl)
      (by simp only [Mode.fresh]; exact fun _ _ _ hMem => nomatch hMem)
  have hSafeB : pool.Safe
      (Env.cons (loopState (init.denote funs env)
        (fun i acc => bif cond.denote funs (.cons acc env) then
          body.denote funs (.cons acc (.cons i env)) else acc) i.toNat)
        (Env.cons (t := .word) i env))
      (⟨base + 2, (init.mode (slots.map Slot.mode)).join
        (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode))⟩ ::
        ⟨base + 1, .borrowed⟩ :: slots)
      (fun j => decide (j < 2) ||
        shift 2 (fun k => live k || cond.uses (k + 1) || body.uses (k + 2)) j || body.uses j)
      heapC stC sB := hSafeIdx.push holdB aB0.rep hFreshB0
  have hRelease : (if (init.mode (slots.map Slot.mode)).join
        (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode)) = .owned ∧
        body.uses 0 = false then releaseCode tTy (base + 2) else []) =
      (if body.uses 0 = false then [0] else []).flatMap
        (releaseVar (tTy :: .word :: Γ') (⟨base + 2, (init.mode (slots.map Slot.mode)).join
          (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode))⟩ ::
          ⟨base + 1, .borrowed⟩ :: slots)) := by
    cases body.uses 0 <;>
      cases (init.mode (slots.map Slot.mode)).join
        (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode)) <;> simp [releaseVar]
  rw [hRelease]
  have hInv' := fun hd => by
    have h1 := (hInv hd).2
    rw [hk, Expr.loopRest_true hcv] at h1
    exact h1
  have hTopC' := fun hd => by
    have h2 := hTopC (hFitsC hd)
    rw [hDc] at h2
    simp only [List.map_cons] at h2
    exact h2
  have hFitsB : (Expr.loop count init cond body).fits funs fits env = true →
      body.fits funs fits (.cons (loopState (init.denote funs env)
        (fun i acc => bif cond.denote funs (.cons acc env) then
          body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) (.cons i env)) = true ∧
      Expr.loopFitsRest funs fits cond body env ((count.denote funs env).toNat - i.toNat - 1) (i + 1)
        (body.denote funs (.cons (loopState (init.denote funs env)
          (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) (.cons i env))) = true :=
    fun hd => Expr.loopFitsRest_body (hFitsI hd) hcv
  refine wp_releaseVars hm _ (by split <;> simp) hVarsB aB0.step.at_ (by split <;> simp)
    fun heap2 store2 e2 hTopRel => ?_
  have e2' := e2.mono
    (live' := fun j =>
      shift 2 (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) j || body.uses j)
    fun j h => by
      match j with
      | 0 =>
        have h0 : body.uses 0 = true := by simpa [shift] using h
        simp [h0]
      | 1 => simp
      | k + 2 => split <;> simpa using h
  -- The only paid variable that can die in the body is the state, when the body uses it.
  have hDbody : dyingPot store2 sB (Env.cons (loopState (init.denote funs env)
        (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat)
        (Env.cons (t := .word) i env))
      (⟨base + 2, (init.mode (slots.map Slot.mode)).join
        (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode))⟩ ::
        ⟨base + 1, .borrowed⟩ :: slots)
      (ps :: false :: paid)
      (fun j => shift 2 (fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) j ||
        body.uses j)
      (shift 2 fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) ≤
      (if ps = true then
        tTy.pot st wsI (loopState (init.denote funs env)
          (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) else 0) := by
    rw [dyingPot_evolves hVarsB e2' (fun j h => live_right _ _ _ h) _ _ fun _ h => h, ← hPotC,
      ← holdB.read_eq (by rw [aB0.rep.length, Ty.types_length])]
    exact dyingPot_le_head _ _ _ _ _ loop_body_dies
  refine bodySpec (ps) _ _
    (ps :: false :: paid)
    (shift 2 fun i => live i || cond.uses (i + 1) || body.uses (i + 2)) h
    (base + 2 + tTy.width) heap2 store2 sB hhB (aB0.frame.params.trans hpv) e2'.holds e2'.step.at_
    (hSafeB.evolves hVarsB e2' (fun j hj => live_right _ _ _ hj))
    (by rw [e2'.step.cap m, aB0.step.cap m]; exact hCap) (by rw [aB0.frame.params]; omega)
    (by omega) hPb _ _
    ((hTrap.part (fun h => by
          cases hw : (Expr.loop count init cond body).fits funs fits env
          · rfl
          · exact absurd (hFitsB hw).1 (by simpa using h)) (fun h => by
      have hmo := (Expr.loop count init cond body).mode_owned (slots.map Slot.mode)
      rw [Slot.any_map] at hmo
      simp only [List.any_cons, Expr.aborts] at h ⊢
      exact loop_trap_body _ _ _ _ _ _ _ (fun hv => hmo (beq_iff_eq.mp hv)) rfl h) fun hd hw =>
        hw.of_le (by
          have := hInv' (fits_of_not hd); have := hTopC' (fits_of_not hd)
          have := congrArg UInt64.toNat hTopRel
          have := hDbody
          simp only [List.map_cons, Expr.buysIn]; omega)
        (by rw [e2'.step.cap m, aB0.step.cap m])).imp
        fun _ h => h)
    fun heap6 _ s6b _ aBb hTopB => ?_
  have hp6 : s6b.params = s.params := aBb.frame.params.trans aB0.frame.params
  refine After.coerce hm aBb
    (fun h => loop_mode (f := fun md => body.mode (md :: .borrowed :: slots.map Slot.mode)) h)
    le_rfl (by rw [hp6]; omega) (aBb.frame.positions.trans hhB) (by omega)
    (by rw [aBb.step.cap m, e2'.step.cap m, aB0.step.cap m]; exact hCap)
    (fun hs ht _ => (hTrap.alloc (hOwnedA ht) fun hd hw => by
      have hcc : coerceCost tTy
          (body.mode (((init.mode (slots.map Slot.mode)).join
            (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode))) :: .borrowed ::
            slots.map Slot.mode))
          ((init.mode (slots.map Slot.mode)).join
            (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode)))
          (body.denote funs (.cons (loopState (init.denote funs env)
              (fun i acc => bif cond.denote funs (.cons acc env) then
                body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) (.cons i env))) =
          tTy.copyCost (body.denote funs (.cons (loopState (init.denote funs env)
              (fun i acc => bif cond.denote funs (.cons acc env) then
                body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) (.cons i env))) := by
        rw [coerceCost, if_pos ⟨by simpa only [List.map_cons] using hs, ht⟩]
      exact hw.of_le (by
          have := hInv' (fits_of_not hd); have := hTopC' (fits_of_not hd)
          have := congrArg UInt64.toNat hTopRel
          have h6 := hTopB (hFitsB (fits_of_not hd)).1
          have := hDbody
          simp only [List.map_cons, Expr.buysIn] at h6
          omega)
        (by rw [aBb.step.cap m, e2'.step.cap m, aB0.step.cap m])).imp fun _ h => h)
    fun heap6' store6 s6 ws6 aB hTopCo2 hSame6 => ?_
  have hp6 : s6.params = s.params := aB.frame.params.trans aB0.frame.params
  have hh6 : s6.positions = h := aB.frame.positions.trans hhB
  refine wp_storeCode ws6 h (base + 2) tTy.types s6 si.values aB.rep.typed hh6
    (by rw [hp6]; omega) (by rw [Ty.types_length, hh6]; omega) fun s7 hF7 hold7 _ => ?_
  have hp7' : s7.params = s.params := hF7.params.trans hp6
  have hh7 : s7.positions = h := hF7.positions.trans hh6
  have hget7 : ∀ j < base + 2, s7.get j = sB.get j := fun j hj => by
    rw [(hF7.below j hj).1]
    exact (aB.frame.below j (by omega)).1
  -- The next index, in local `base + 1`.
  simp only [wp_localGet_cons, Locals.get_values, hget7 (base + 1) (by omega), hiiB,
    wp_constI64_cons, wp_addI64_cons]
  have hLow7 : ({ s7 with values := si.values } : Locals).params.length ≤ base + 1 := by
    show s7.params.length ≤ base + 1; rw [hp7']; omega
  have hHigh7 : base + 1 < s7.positions := by rw [hh7]; omega
  refine wp_localSet_local (s := s7) (vs := si.values) hLow7 (Locals.lt_total hHigh7) ?_
  have hget8 : (setLocal { s7 with values := si.values } (base + 1) (.i64 (i + 1))).get
      (base + 1) = some (.i64 (i + 1)) :=
    Locals.get_setLocal_same hLow7 (Locals.lt_total hHigh7)
  have hold8 : LocalsHold (setLocal { s7 with values := si.values } (base + 1)
      (.i64 (i + 1))) (base + 2) tTy.types ws6 :=
    hold7.keep (lo := base + 2) (by simp)
      (fun j hj _ => ⟨by rw [Locals.get_setLocal_ne hLow7 (by omega)]; rfl,
        by rw [Locals.get_setLocal_ne hLow7 (by omega)]; rfl,
        by rw [Locals.get_setLocal_ne hLow7 (by omega)]; rfl⟩) le_rfl
      (by rw [aB.rep.length, hh7]; omega)
  -- The state after `i + 1` iterations: the facts of the body's code for the outer context.
  have aB' := After.prepend hVarsB e2' aB (fun j h => live_right _ _ _ h) fun j h => by
    simp [h]
  have hNew : ∀ r, (∀ b ∈ ((init.mode (slots.map Slot.mode)).join
        (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode))).fresh stC tTy wsI
        (loopState (init.denote funs env)
          (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat),
        regionsDisjoint r b) →
      ((init.mode (slots.map Slot.mode)).join
          (body.mode (.borrowed :: .borrowed :: slots.map Slot.mode)) = .owned → ∀ w,
        LocalsHold sB (base + 2) tTy.types w → w.length = tTy.width →
        ∀ b ∈ tTy.blocks stC w (loopState (init.denote funs env)
          (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat),
        regionsDisjoint r b) ∧
      (Mode.borrowed = .owned → ∀ w, LocalsHold sB (base + 1) Ty.word.types w →
        w.length = Ty.word.width →
        ∀ b ∈ Ty.word.blocks stC w i, regionsDisjoint r b) := by
    intro r hFresh
    refine ⟨fun hmo w hw hlw b hb => ?_, fun hmo => nomatch hmo⟩
    obtain rfl := LocalsHold.unique hw holdB (hlw.trans aB0.rep.length.symm)
    rw [hmo] at hFresh
    exact hFresh b hb
  have aNext := After.bind2 hVars aB0 (Frame.refl base sB) aB' (by omega) hNew
    (fun j h => by simpa using h)
    (fun j h => by simp only [Expr.uses]; exact loop_live_state _ _ _ _ _ h) fun _ h => h
  have hv : loopState (init.denote funs env)
      (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) (i + 1).toNat =
      body.denote funs (.cons (loopState (init.denote funs env)
        (fun i acc => bif cond.denote funs (.cons acc env) then
            body.denote funs (.cons acc (.cons i env)) else acc) i.toNat) (.cons i env)) := by
    rw [hsucc, loopState, UInt64.ofNat_toNat]
    simp only [hcv, Bool.cond_true]
  rw [wp_br_cons]
  dsimp only
  refine ⟨⟨heap6', ws6, i + 1, UInt64.le_iff_toNat_le.mpr ?_, ?_, hget8, hold8, ?_, ?_⟩, ?_⟩
  · have := UInt64.lt_iff_toNat_lt.mp hlt
    omega
  · rw [Locals.get_setLocal_ne hLow7 (by omega), Locals.get_values, hget7 base (by omega)]
    exact hNiB
  · rw [hv]
    exact aNext.reframe ((hF7.mono (base := base) (by omega)).trans
      ((Frame.setValues (s := s7) (vs := si.values) (base := base + 1) hLow7 le_rfl
        hHigh7).mono (base := base)
        (by omega)))
  · intro hd
    rw [hv, hsucc, show (count.denote funs env).toNat - (i.toNat + 1) =
      (count.denote funs env).toNat - i.toNat - 1 by omega]
    refine ⟨(hFitsB hd).2, ?_⟩
    have := hInv' hd; have := hTopC' hd; have := congrArg UInt64.toNat hTopRel
    have h6 := hTopB (hFitsB hd).1
    simp only [List.map_cons] at h6 hTopCo2
    -- The body's value, which is paid when the state is, keeps its potential through the
    -- coercion, the identity on an owned value.
    simp only [Expr.buysIn] at h6
    have := loop_body_pot (Expr.statePaid_body_of hpsS)
      (fun hps => by
        obtain ⟨rfl, rfl⟩ := hSame6 (Expr.mode_of_paidIn body (Expr.statePaid_body_of hpsS hps))
        rfl)
      h6 hDbody hTopCo2
    omega
  · have := UInt64.lt_iff_toNat_lt.mp hlt
    simp only [hget8]
    omega

/-- A loop: the bound of `spec_loop_with` at the state's flag, or, for a state of pair type that
is paid, at the flag whose bound is smaller. -/
theorem spec_loop (hm : Runtime m) {Γ' : List Ty} {tTy : Ty} {count : Expr S Γ' .word}
    {init : Expr S Γ' tTy} {cond : Expr S (tTy :: Γ') .bool}
    {body : Expr S (tTy :: .word :: Γ') tTy}
    (countSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv count env
        slots paid live)
    (initSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv init env slots paid live)
    (condSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv cond env slots paid live)
    (bodySpec : ∀ buy env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host
        pv body env slots paid live) :
    ∀ env slots paid live,
      CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.loop count init cond body) env slots paid live := by
  intro env slots paid live
  have hT := Expr.allocs_loop funs flags bounds (slots.map Slot.mode) paid live count init cond body
    env
  have core := spec_loop_with hm countSpec initSpec condSpec bodySpec env slots paid live
  by_cases hmin :
      (Expr.statePaid flags (slots.map Slot.mode) paid live init cond body && tTy.isPair) = true
  · rw [ite_eq_left hmin] at hT
    simp only [Bool.and_eq_true] at hmin
    have hnp : (Expr.loop count init cond body).paid flags (slots.map Slot.mode) paid live = false := by
      simp only [Expr.paid, hmin.2, Bool.not_true, Bool.and_false]
    by_cases hle : Expr.loopBound false funs flags bounds (slots.map Slot.mode) paid live count init
        cond body env ≤
      Expr.loopBound true funs flags bounds (slots.map Slot.mode) paid live count init cond body env
    · rw [Nat.min_eq_left hle] at hT
      exact CodeSpec.of_with hT (core false (fun h => nomatch h) fun h => by
        rw [hnp] at h; exact nomatch h)
    · rw [Nat.min_eq_right (by omega)] at hT
      exact CodeSpec.of_with hT (core true (fun _ => hmin.1) fun _ => rfl)
  · rw [ite_eq_right hmin] at hT
    exact CodeSpec.of_with hT (core _ id (Expr.paid_loop flags _ paid live count init cond body))

theorem spec_fold (hm : Runtime m) {Γ' : List Ty} {e : Elem} {t : Ty}
    (x : Var Γ' (.array e)) {init : Expr S Γ' t}
    {body : Expr S (.elem e :: t :: .word :: Γ') t}
    (initSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv init env
      slots paid live)
    (bodySpec : ∀ buy env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits
      host pv body env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.fold x init body)
      env slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
    hPlace rest Q hTrap hNext
  obtain ⟨_, _, _, hRep⟩ := hVars.1 _ x (by simp [Expr.uses])
  have hValue := Expr.foldExpand_denote x init body funs env hRep.array_size_lt
  have hLoop : CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.foldExpand x init body)
      env slots paid live :=
    spec_loop hm (spec_size hm x) initSpec (spec_bool true)
      (fun buy => spec_letE hm (spec_get hm (.there (.there x)) (spec_var hm (.there .here)))
        (bodySpec buy))
      env slots paid live
  simp only [CodeSpec, trapFlag, Expr.foldExpand_uses, Expr.foldExpand_width,
    Expr.foldExpand_placeArgs, Expr.foldExpand_aborts, Expr.foldExpand_allocs,
    Expr.foldExpand_fits, Expr.foldExpand_mode, Expr.foldExpand_paid, Expr.foldExpand_code,
    hValue] at hLoop
  exact hLoop h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom hPlace rest Q hTrap hNext

/-- `LeanExe.build`: the count in local `base`, a trap at `unreachable` when it is `2 ^ 29` or
more, a new owned array at the address in local `base + 1`, and the index in local `base + 2`.
The invariant at the top of the WebAssembly `loop` holds an owned array of the count's length
whose elements below the index are the built ones, with the facts of `After` for the outer
variables live in the loop.  Each iteration runs the element's code in the context with the
index, which keeps every region, and stores the element. -/
theorem spec_build (hm : Runtime m) {Γ' : List Ty} {e : Elem} {count : Expr S Γ' .word}
    {elem : Expr S (.word :: Γ') (.elem e)}
    (countSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv count env
        slots paid live)
    (elemSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv elem env
        slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.build count elem) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hc := Nat.le_max_left count.width (3 + max elem.width (e.width + 1))
  have he := Nat.le_max_right count.width (3 + max elem.width (e.width + 1))
  have he1 := Nat.le_max_left elem.width (e.width + 1)
  have he2 := Nat.le_max_right elem.width (e.width + 1)
  have hk := e.width_pos
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  have hT : (Expr.build count elem).allocs funs flags bounds (slots.map Slot.mode) paid live env =
      count.allocs funs flags bounds (slots.map Slot.mode) paid
          (fun i => live i || elem.uses (i + 1)) env +
        allocCost (((count.denote funs env).toNat * e.width + 1) * 8) +
        sumBelow
            (fun k => elem.allocs funs flags bounds (.borrowed :: slots.map Slot.mode) (false :: paid)
          (shift 1 (fun i => live i || elem.uses (i + 1))) (.cons (UInt64.ofNat k) env))
          (count.denote funs env).toNat := rfl
  have hdK : (Expr.build count elem).fits funs fits env = true → count.fits funs fits env = true ∧
      ∀ k, k < (count.denote funs env).toNat →
        elem.fits funs fits (.cons (UInt64.ofNat k) env) = true := fun hd => by
    simp only [Expr.fits, Bool.and_eq_true] at hd
    exact ⟨hd.1, allBelow_get hd.2⟩
  have hTrapW : ¬heap.Within store m
      (dyingPot store s env slots paid (fun i => live i || (Expr.build count elem).uses i) live +
        (Expr.build count elem).allocs funs flags bounds (slots.map Slot.mode) paid live env) →
      TrapOK true Q := fun hw =>
    hTrap.of_imp fun _ => by simp [trapFlag, Expr.aborts, hw]
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc, List.cons_append, List.nil_append]
  -- The count, in local `base`.
  have hCountIn : ∀ i, ((live i || elem.uses (i + 1)) || count.uses i) = true →
      (live i || (Expr.build count elem).uses i) = true := fun i h => by
    simp only [Expr.uses]; exact live_seq _ _ _ h
  -- The variables that die in the count.  The others that die in the build are released after
  -- it, and their potential is dropped.
  have hDk : dyingPot store s env slots paid
      (fun i => (live i || elem.uses (i + 1)) || count.uses i)
      (fun i => live i || elem.uses (i + 1)) ≤
        dyingPot store s env slots paid (fun i => live i || (Expr.build count elem).uses i) live :=
    dyingPot_mono hCountIn fun i h => by simp [h]
  -- No paid variable dies in an element: the index is unpaid, and the outer variables that the
  -- element uses stay live.
  have hDe : ∀ (v : UInt64) (st' : Store Unit) (s' : Locals) (sl : Slot),
      dyingPot st' s' (Env.cons (t := .word) v env) (sl :: slots) (false :: paid)
        (fun j => shift 1 (fun i => live i || elem.uses (i + 1)) j || elem.uses j)
        (shift 1 fun i => live i || elem.uses (i + 1)) = 0 := fun _ _ _ _ =>
    dyingPot_eq_zero_unpaid fun j h0 h1 => by
      match j with
      | 0 => rfl
      | k + 1 =>
        have hk : ¬ k + 1 < 1 := by omega
        simp only [shift, hk, ↓reduceIte, Nat.add_sub_cancel] at h0 h1
        revert h0 h1
        cases live k <;> cases elem.uses (k + 1) <;> simp
  refine countSpec env slots paid _ h base heap store s hh hpv
    (hVars.live_mono hCountIn) hAt (hSafe.mono hCountIn) hCap hBase (by omega) hPlace.1 _ _
    (hTrap.part (fun h => by simp only [Bool.not_eq_true'] at h; simp [Expr.fits, h])
      (fun _ => by simp [Expr.aborts]) fun _ hw => hw.mono (by rw [hT]; omega))
    fun heap1 store1 s1 ws1 a1 hTopK => ?_
  have hR1 := a1.rep
  simp only [Ty.rep_word] at hR1
  subst hR1
  have e1 := a1.toEvolves rfl
  have hp1 : s1.params = s.params := e1.frame.params
  have hh1 : s1.positions = h := e1.frame.positions.trans hh
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append]
  have hLow1 : ({ s1 with values := s.values } : Locals).params.length ≤ base := by
    show s1.params.length ≤ base; rw [hp1]; exact hBase
  have hHigh1 : base < s1.positions := by rw [hh1]; omega
  refine wp_localSet_local hLow1 (Locals.lt_total hHigh1) ?_
  set s2 := setLocal { s1 with values := s.values } base (.i64 (count.denote funs env)) with hs2
  have f2 : Frame base s1 s2 := Frame.setValues hLow1 le_rfl hHigh1
  have hN2 : s2.get base = some (.i64 (count.denote funs env)) :=
    Locals.get_setLocal_same hLow1 (Locals.lt_total hHigh1)
  have hh2 : s2.positions = h := by simp only [hs2, Locals.positions_setLocal, Locals.positions_values, hh1]
  -- The trap when the count's words would be `2 ^ 29` or more.
  simp only [wp_localGet_cons, hN2, wp_constI64_cons, wp_geUI64_cons]
  rw [wp_iff_control_types]
  refine wp_iff_cons rfl ?_
  by_cases hBig : UInt64.ofNat ((536870912 + e.width - 1) / e.width) ≤ count.denote funs env
  · simp (config := { decide := true }) only [ge_iff_le, hBig, ↓reduceIte]
    rw [wp_unreachable_cons]
    refine hTrapW (fun hw => ?_) _
    have hLim' : (536870912 + e.width - 1) / e.width < UInt64.size := by
      rw [show UInt64.size = 18446744073709551616 from rfl]
      have hd : (536870912 + e.width - 1) / e.width ≤ 536870912 :=
        Nat.div_le_of_le_mul (by omega)
      omega
    have hge := UInt64.le_iff_toNat_le.mp hBig
    rw [UInt64.toNat_ofNat_of_lt' hLim'] at hge
    have hlt := Nat.lt_mul_div_succ (536870912 + e.width - 1) hk
    have hmul := Nat.mul_le_mul_right e.width hge
    rw [Nat.mul_add, Nat.mul_one, Nat.mul_comm] at hlt
    unfold Heap.Within at hw
    rw [hT] at hw
    unfold allocCost at hw
    omega
  simp (config := { decide := true }) only [ge_iff_le, hBig, ↓reduceIte]
  rw [wp_nil]
  dsimp only
  simp only [List.take_zero, List.drop_zero, List.nil_append]
  have hLim : (536870912 + e.width - 1) / e.width < UInt64.size := by
    rw [show UInt64.size = 18446744073709551616 from rfl]
    have hd : (536870912 + e.width - 1) / e.width ≤ 536870912 :=
      Nat.div_le_of_le_mul (by omega)
    omega
  have hcLim : (count.denote funs env).toNat < (536870912 + e.width - 1) / e.width := by
    have := UInt64.not_le.mp hBig
    rw [UInt64.lt_iff_toNat_lt, UInt64.toNat_ofNat_of_lt' hLim] at this
    exact this
  have hck := build_limit hk hcLim
  have hcSmall : (count.denote funs env).toNat ≤ (count.denote funs env).toNat * e.width :=
    Nat.le_mul_of_pos_right _ hk
  -- The count of words, in local `base + 2`.
  show wp m _ Q store1 s2 host
  simp only [wp_localGet_cons, hN2]
  rw [wp_scaleCode, show count.denote funs env = UInt64.ofNat (count.denote funs env).toNat by simp,
    words_scale hk hck]
  have hLowT : ({ s2 with values := s.values } : Locals).params.length ≤ base + 2 := by
    show s1.params.length ≤ base + 2; rw [hp1]; omega
  have hHighT : base + 2 < ({ s2 with values := s.values } : Locals).positions := by
    simp only [Locals.positions_values, hh2]; omega
  refine wp_localSet_local hLowT (Locals.lt_total hHighT) ?_
  set s3 := setLocal { s2 with values := s.values } (base + 2)
    (.i64 (UInt64.ofNat ((count.denote funs env).toNat * e.width))) with hs3
  have hT3 : s3.get (base + 2) =
      some (.i64 (UInt64.ofNat ((count.denote funs env).toNat * e.width))) :=
    Locals.get_setLocal_same hLowT (Locals.lt_total hHighT)
  have hN3 : s3.get base = some (.i64 (count.denote funs env)) := by
    rw [Locals.get_setLocal_ne hLowT (by omega), Locals.get_values]; exact hN2
  have f3 : Frame base s2 s3 := Frame.setValues hLowT (by omega) (by simpa using hHighT)
  have hh3 : s3.positions = h := by simp only [hs3, Locals.positions_setLocal, Locals.positions_values, hh2]
  have hp3 : s3.params = s.params := by
    simp only [hs3, hs2, setLocal]; exact hp1
  -- The new array, at the address in local `base + 1`.
  have hTn : (UInt64.ofNat ((count.denote funs env).toNat * e.width)).toNat =
      (count.denote funs env).toNat * e.width :=
    UInt64.toNat_ofNat_of_lt' (by rw [show UInt64.size = 18446744073709551616 from rfl]; omega)
  have hLow4 : s3.params.length ≤ base + 1 := by rw [hp3]; omega
  have hHigh4' : base + 1 < s3.positions := by rw [hh3]; omega
  have hHigh4 := Locals.lt_total hHigh4'
  refine wp_allocArray (c := allocCost (((count.denote funs env).toNat * e.width + 1) * 8)) hm
    e1.step.at_ (by rw [e1.step.cap m]; exact hCap)
    (by rw [hTn]; unfold allocCost; omega)
    (hTrap.alloc (by simp [Expr.aborts]) fun hd hw => by
      have := hTopK (hdK (fits_of_not hd)).1
      exact hw.shift (c1 := dyingPot store s env slots paid
          (fun i => (live i || elem.uses (i + 1)) || count.uses i)
          (fun i => live i || elem.uses (i + 1)) +
          count.allocs funs flags bounds (slots.map Slot.mode) paid (fun i => live i || elem.uses (i + 1))
            env)
        (by omega) (by rw [hT]; omega) (e1.step.cap m))
    (by rw [hTn]; exact hck) hT3 hLow4 hHigh4 (by omega)
    fun heap2 store2 root words hSize hStepA hOwned hTopA => ?_
  rw [hTn] at hSize
  set s4 := setLocal { s3 with values := s3.values } (base + 1) (.i64 root) with hs4
  have f4 : Frame base s3 s4 := Frame.setValues hLow4 (by omega) hHigh4'
  have hF4 : Frame base s s4 := e1.frame.trans (f2.trans (f3.trans f4))
  have hN4 : s4.get base = some (.i64 (count.denote funs env)) := by
    rw [Locals.get_setLocal_ne hLow4 (by omega), Locals.get_values]; exact hN3
  have hRoot4 : s4.get (base + 1) = some (.i64 root) := Locals.get_setLocal_same hLow4 hHigh4
  have hh4 : s4.positions = h := by simp only [hs4, Locals.positions_setLocal, Locals.positions_values, hh3]
  have hp4 : s4.params = s.params := by simp only [hs4, setLocal]; exact hp3
  -- The facts of `After` for the new array.
  have hVars1 : Holds env slots (fun i => live i || elem.uses (i + 1)) base heap1 store1 s4 :=
    e1.holds.agree (f2.trans (f3.trans f4))
  have a0 : After env slots (fun i => live i || (Expr.build count elem).uses i)
      (fun i => live i || elem.uses (i + 1)) base heap store s (.array .word) .owned words heap2
      store2 s4 [.i64 root] := by
    refine ⟨(e1.step.trans hStepA fun _ hr => ⟨hr, fun _ => trivial⟩).mono
      (fun _ hr => hr.mono fun i h1 h2 => ⟨hCountIn i h1, h2⟩) (fun _ h => h), hF4,
      hVars1.step hStepA (fun _ _ _ _ _ _ _ _ => trivial), ⟨root, rfl, hOwned⟩, ?_⟩
    intro u y hy _ wy hwy hly b hb c hc
    obtain ⟨hSame, hFresh⟩ := hVars1.regions_after hStepA hy hwy hly fun _ _ => trivial
    rw [hSame] at hc
    exact regionsDisjoint_symm (hFresh c hc b hb)
  -- The index, in local `base + 2`.
  simp only [wp_constI64_cons]
  have hLow5 : ({ s4 with values := s4.values } : Locals).params.length ≤ base + 2 := by
    show s4.params.length ≤ base + 2; rw [hp4]; omega
  have hHigh5' : base + 2 < s4.positions := by rw [hh4]; omega
  have hHigh5 := Locals.lt_total (s := { s4 with values := s4.values }) hHigh5'
  refine wp_localSet_local hLow5 hHigh5 ?_
  set s5 := setLocal { s4 with values := s4.values } (base + 2) (.i64 0) with hs5
  have hF5 : Frame base s4 s5 := Frame.setValues hLow5 (by omega) hHigh5'
  have hN5 : s5.get base = some (.i64 (count.denote funs env)) := by
    rw [Locals.get_setLocal_ne hLow5 (by omega), Locals.get_values]; exact hN4
  have hRoot5 : s5.get (base + 1) = some (.i64 root) := by
    rw [Locals.get_setLocal_ne hLow5 (by omega), Locals.get_values]; exact hRoot4
  have hIdx5 : s5.get (base + 2) = some (.i64 0) := Locals.get_setLocal_same hLow5 hHigh5
  -- The loop.  The invariant holds an array of the count's elements' words whose elements below
  -- the index `i` hold the built ones, and the count less the index decreases.
  refine wp_block_cons ?_
  refine wp_loop_cons
    (fun st si => ∃ heapI words, ∃ i : Nat, i ≤ (count.denote funs env).toNat ∧
      words.size = (count.denote funs env).toNat * e.width ∧
      (∀ i', i' < i → ∀ j, j < e.width → words[i' * e.width + j]! =
        (e.toWords (elem.denote funs (.cons (UInt64.ofNat i') env)))[j]!) ∧
      si.get base = some (.i64 (count.denote funs env)) ∧
      si.get (base + 1) = some (.i64 root) ∧ si.get (base + 2) = some (.i64 (UInt64.ofNat i)) ∧
      After env slots (fun i => live i || (Expr.build count elem).uses i)
        (fun i => live i || elem.uses (i + 1)) base heap store s (.array .word) .owned words heapI
        st si [.i64 root] ∧
      ((Expr.build count elem).fits funs fits env = true →
        heapI.top.toNat ≤ heap.top.toNat +
          (dyingPot store s env slots paid (fun i => (live i || elem.uses (i + 1)) || count.uses i)
            (fun i => live i || elem.uses (i + 1)) +
          count.allocs funs flags bounds (slots.map Slot.mode) paid (fun i => live i || elem.uses (i + 1))
            env + allocCost (((count.denote funs env).toNat * e.width + 1) * 8) +
          sumBelow
              (fun k => elem.allocs funs flags bounds (.borrowed :: slots.map Slot.mode) (false :: paid)
          (shift 1 (fun i => live i || elem.uses (i + 1))) (.cons (UInt64.ofNat k) env)) i)))
    (fun _ si => match si.get (base + 2) with
      | some (.i64 i) => (count.denote funs env).toNat - i.toNat
      | _ => 0)
    ⟨heap2, words, 0, Nat.zero_le _, hSize, fun _ h => absurd h (Nat.not_lt_zero _), hN5,
      hRoot5, hIdx5, a0.reframe hF5, fun hd => by
        have := hTopK (hdK hd).1; simp only [sumBelow]; omega⟩ ?_
  rintro st si ⟨heapI, words, i, hi, hSize, hPrefix, hNi, hRooti, hIdxi, aI, hInv⟩
  have hi64 : (UInt64.ofNat i).toNat = i :=
    UInt64.toNat_ofNat_of_lt' (by rw [show UInt64.size = 18446744073709551616 from rfl]; omega)
  simp only [wp_localGet_cons, Locals.get_values, hIdxi, hNi, wp_geUI64_cons, wp_br_if_cons]
  by_cases hDone : count.denote funs env ≤ UInt64.ofNat i
  · -- The array is complete: the release of the outer variables that only the element reads,
    -- and the array's address.
    have hiEq : i = (count.denote funs env).toNat := by
      rw [UInt64.le_iff_toNat_le, hi64] at hDone; omega
    simp (config := { decide := true }) only [ge_iff_le, hDone, ↓reduceIte, List.take_zero,
      List.drop_zero, List.nil_append]
    have hWords : words = e.words (LeanExe.build (count.denote funs env)
        fun i => elem.denote funs (.cons i env)) := by
      refine Elem.words_ext e (by rw [hSize]; simp [LeanExe.build]) fun i' hi' j hj => ?_
      have hi'' : i' < (count.denote funs env).toNat := by simpa [LeanExe.build] using hi'
      rw [hPrefix i' (by omega) j hj, getElem!_pos (LeanExe.build (count.denote funs env)
        fun i => elem.denote funs (.cons i env)) i' hi']
      simp [LeanExe.build]
    rw [hWords] at aI
    refine After.release hm (s1 := si) (live := live)
      (sel := fun i => elem.uses (i + 1) && !live i) hVars (After.ofWords aI)
      (fun i h => by simp only [Expr.uses]; exact live_build _ _ _ h)
      (fun i h => by simp only [Bool.and_eq_true] at h; simp [h.1]) (fun i h => by simp [h])
      fun heap' store' a' hTopR _ => ?_
    simp only [wp_localGet_cons, Locals.get_values, hRooti]
    simpa [setLocal, hs2] using hNext heap' store' si [.i64 root] a' fun hd => top_unpaid rfl (by
      have h1 := hInv hd; have := congrArg UInt64.toNat hTopR
      rw [hiEq] at h1
      rw [hT]; omega)
  -- One more element.
  have hLess : i < (count.denote funs env).toNat := by
    rw [UInt64.le_iff_toNat_le, hi64] at hDone; omega
  simp (config := { decide := true }) only [ge_iff_le, hDone, ↓reduceIte]
  -- The element, in the context with the index as variable 0.
  have holdIdx : LocalsHold si (base + 2) Ty.word.types [.i64 (UInt64.ofNat i)] :=
    fun j hj => by
      obtain rfl : j = 0 := by simpa using hj
      simpa [Ty.types, slotIndex] using hIdxi
  have hhi : si.positions = h := aI.frame.positions.trans hh
  have hLE : ∀ j, (shift 1 (fun i => live i || elem.uses (i + 1)) (j + 1) ||
      elem.uses (j + 1)) = true → (live j || elem.uses (j + 1)) = true := fun j h => by
    simp only [shift_add] at h; exact live_dup _ _ h
  have hVarsI : Holds env slots (fun i => live i || elem.uses (i + 1)) (base + 2) heapI st si :=
    aI.holds.mono (by omega)
  have hVarsE := (Holds.push (t := .word) (v := UInt64.ofNat i) (mode := .borrowed)
    (live' := fun j => shift 1 (fun i => live i || elem.uses (i + 1)) j || elem.uses j)
    (hVarsI.live_mono hLE) holdIdx rfl (Holds.Apart.ofScalar rfl)).mono
    (base' := base + 3) (by simp [Ty.width])
  have hSafeI := (hSafe.after hVars aI
    (fun j hj => by simp only [Expr.uses]; exact live_build _ _ _ hj)).1
  have hSafeE : pool.Safe (.cons (t := .word) (UInt64.ofNat i) env)
      (⟨base + 2, .borrowed⟩ :: slots)
      (fun j => shift 1 (fun k => live k || elem.uses (k + 1)) j || elem.uses j) heapI st si :=
    (hSafeI.mono hLE).push holdIdx
      (show Ty.word.Rep .borrowed heapI st [.i64 (UInt64.ofNat i)] (UInt64.ofNat i) from rfl)
      (by simp only [Mode.fresh]; exact fun _ _ _ hMem => nomatch hMem)
  refine elemSpec _ _ (false :: paid) (shift 1 fun i => live i || elem.uses (i + 1)) h (base + 3)
    heapI st si hhi
    (aI.frame.params.trans hpv) hVarsE aI.step.at_ hSafeE (by rw [aI.step.cap m]; exact hCap)
    (by show si.params.length ≤ base + 3; rw [aI.frame.params]; omega) (by omega)
    hPlace.2 _ _ ((hTrap.part (fun h => by
          cases hw : (Expr.build count elem).fits funs fits env
          · rfl
          · exact absurd ((hdK hw).2 i hLess) (by simpa using h))
        (fun _ => by simp [Expr.aborts]) fun hd hw => hw.of_le (by
          have := hInv (fits_of_not hd)
          have := sumBelow_mono (fun k => elem.allocs funs flags bounds (.borrowed :: slots.map Slot.mode)
              (false :: paid)
            (shift 1 (fun i => live i || elem.uses (i + 1))) (.cons (UInt64.ofNat k) env))
            (show i + 1 ≤ (count.denote funs env).toNat by omega)
          simp only [sumBelow] at this
          rw [hDe]
          simp only [List.map_cons]; rw [hT]; omega) (aI.step.cap m)).imp fun _ h => h)
    fun heapE stE sE wsE aE hTopE => ?_
  have hRE := Ty.rep_elem.mp aE.rep
  subst hRE
  -- The element's facts for the outer context, after the array's.
  have aE1 := After.bind (base := base + 2) hVarsI
    (After.refl (t := .word) (mode := .borrowed) (v := UInt64.ofNat i)
      (ws := [.i64 (UInt64.ofNat i)]) aI.step.at_ hVarsI (fun _ h => h) rfl rfl
      (Holds.Apart.ofScalar rfl))
    (Frame.refl _ _) holdIdx aE hLE (fun _ h => h) fun _ h => h
  have aE2 := aE1.lower aI.holds (by omega) fun _ h => h
  obtain ⟨hStep, hFrame, hRep1, hApart1, -⟩ := After.seq hVars aI aE2
    (fun i h => by simp only [Expr.uses]; exact live_build _ _ _ h) fun _ h => h
  have aI2 : After env slots (fun i => live i || (Expr.build count elem).uses i)
      (fun i => live i || elem.uses (i + 1)) base heap store s (.array .word) .owned words heapE
      stE sE [.i64 root] :=
    ⟨hStep.mono (fun _ h => h) fun b hb => List.mem_append_left _ hb, hFrame, aE2.holds,
      hRep1, hApart1⟩
  have hpE : sE.params = s.params := aE.frame.params.trans aI.frame.params
  have hhE : sE.positions = h := aE.frame.positions.trans hhi
  have hgetE : ∀ j < base + 3, sE.get j = si.get j := fun j hj => (aE.frame.below j hj).1
  -- The element's words, from local `base + 3` on.
  refine wp_storeCode (e.values (elem.denote funs (.cons (UInt64.ofNat i) env))) h (base + 3)
    e.types sE si.values (by rw [e.values_length, e.types_length]) hhE
    (by rw [hpE]; omega) (by rw [e.types_length, hhE]; omega)
    fun s6 f6 hold6 _ => ?_
  have hp6 : s6.params = s.params := f6.params.trans hpE
  have hh6 : s6.positions = h := f6.positions.trans hhE
  have hget6 : ∀ j < base + 3, s6.get j = si.get j := fun j hj =>
    (f6.below j hj).1.trans (hgetE j hj)
  -- The position of the element's first word, in local `base + 3 + k`.
  simp only [wp_localGet_cons, Locals.get_values, hget6 (base + 2) (by omega), hIdxi]
  rw [wp_scaleCode, words_scale hk
    (lt_of_le_of_lt (Nat.mul_le_mul_right e.width (Nat.le_of_lt hLess)) hck)]
  have hLow7 : ({ s6 with values := si.values } : Locals).params.length ≤ base + 3 + e.width := by
    show s6.params.length ≤ _; rw [hp6]; omega
  have hHigh7' : base + 3 + e.width < s6.positions := by rw [hh6]; omega
  have hHigh7 := Locals.lt_total (s := { s6 with values := si.values }) hHigh7'
  refine wp_localSet_local hLow7 hHigh7 ?_
  set s7 := setLocal { s6 with values := si.values } (base + 3 + e.width)
    (.i64 (UInt64.ofNat (i * e.width))) with hs7
  have f7 : Frame (base + 3) s6 s7 := Frame.setValues hLow7 (by omega) hHigh7'
  have hW7 : s7.get (base + 3 + e.width) = some (.i64 (UInt64.ofNat (i * e.width))) :=
    Locals.get_setLocal_same hLow7 hHigh7
  have hget7 : ∀ j < base + 3, s7.get j = si.get j := fun j hj =>
    (f7.below j hj).1.trans (hget6 j hj)
  have hh7 : s7.positions = h := f7.positions.trans hh6
  have hold7 : LocalsHold s7 (base + 3) e.types
      (List.zipWith typedValue e.types
        (e.toWords (elem.denote funs (.cons (UInt64.ofNat i) env)))) := by
    rw [e.values_typed]
    intro j hj
    have := hold6 j hj
    rw [e.values_length] at hj
    rw [show s7.positions = s6.positions from f7.positions]
    rw [← this]
    simp only [hs7]
    rw [Locals.get_setLocal_ne hLow7, Locals.get_values]
    cases hty : e.types.getD j .i64 <;> simp only [slotIndex] <;> omega
  -- The writes of the element's words.
  have hik : i * e.width + e.width ≤ words.size := by
    rw [hSize]; have := Nat.mul_le_mul_right e.width (Nat.succ_le_of_lt hLess)
    rw [Nat.succ_mul] at this; exact this
  have hik64 : (UInt64.ofNat (i * e.width)).toNat = i * e.width :=
    UInt64.toNat_ofNat_of_lt' (by rw [show UInt64.size = 18446744073709551616 from rfl]; omega)
  refine wp_storeWordsCode 0 (base + 3) e.types
    (e.toWords (elem.denote funs (.cons (UInt64.ofNat i) env))) words stE s7
    (aI2.reframe ((f6.mono (by omega)).trans (f7.mono (by omega)))) hh7
    (by rw [hget7 (base + 1) (by omega)]; exact hRooti) hW7 hold7
    (by rw [e.toWords_length, e.types_length]) (e.typed_words _) (by rw [hik64, e.types_length]; omega)
    fun store8 a8 _ => ?_
  rw [hik64, Nat.add_zero] at a8
  -- The next index, in local `base + 2`.
  simp only [wp_localGet_cons, hget7 (base + 2) (by omega), hIdxi, wp_constI64_cons,
    wp_addI64_cons]
  have hLow9 : ({ s7 with values := s7.values } : Locals).params.length ≤ base + 2 := by
    show s7.params.length ≤ base + 2; rw [f7.params, hp6]; omega
  have hHigh9' : base + 2 < s7.positions := by rw [hh7]; omega
  have hHigh9 := Locals.lt_total (s := { s7 with values := s7.values }) hHigh9'
  refine wp_localSet_local (s := s7) (vs := s7.values) hLow9 hHigh9 ?_
  have hSucc : UInt64.ofNat i + 1 = UInt64.ofNat (i + 1) := by
    rw [UInt64.ofNat_add]; rfl
  have hSucc64 : (UInt64.ofNat (i + 1)).toNat = i + 1 :=
    UInt64.toNat_ofNat_of_lt' (by rw [show UInt64.size = 18446744073709551616 from rfl]; omega)
  have hIdx9 := Locals.get_setLocal_same (v := .i64 (UInt64.ofNat i + 1)) hLow9 hHigh9
  rw [wp_br_cons]
  dsimp only
  have hfit : i * e.width + (e.toWords (elem.denote funs (.cons (UInt64.ofNat i) env))).length ≤
      words.size := by rw [e.toWords_length]; exact hik
  refine ⟨⟨heapE, _, i + 1, by omega, by rw [writeWords_size, hSize], fun i' hi' j hj => ?_,
    ?_, ?_, by rw [hIdx9, hSucc],
    a8.reframe (Frame.setValues hLow9 (by omega) hHigh9'), ?_⟩, ?_⟩
  · rw [writeWords_getElem! _ _ _ hfit, e.toWords_length]
    by_cases hii : i' = i
    · subst hii
      rw [if_pos (by omega), show i' * e.width + j - i' * e.width = j by omega]
    · have hlt : i' < i := by omega
      have hout : ¬(i * e.width ≤ i' * e.width + j ∧ i' * e.width + j < i * e.width + e.width) := by
        intro ⟨h1, _⟩
        have := Nat.mul_le_mul_right e.width (Nat.succ_le_of_lt hlt)
        rw [Nat.succ_mul] at this; omega
      rw [if_neg hout]
      exact hPrefix i' hlt j hj
  · rw [Locals.get_setLocal_ne hLow9 (by omega), Locals.get_values, hget7 base (by omega)]
    exact hNi
  · rw [Locals.get_setLocal_ne hLow9 (by omega), Locals.get_values, hget7 (base + 1) (by omega)]
    exact hRooti
  · intro hd
    have := hInv hd; have h6 := hTopE ((hdK hd).2 i hLess)
    rw [hDe] at h6
    simp only [List.map_cons] at h6
    simp only [sumBelow]; omega
  · rw [hIdx9]
    simp only [hSucc, hSucc64]
    omega

/-- `x.set! i.toNat v`: the position in local `base`, the value's words from local `base + 1` on,
the array as owned in local `base + 1 + k`, which is `x`'s own block when `x` is owned and dies,
and, when the position is below the size, the position of the element's first word in local
`base + 2 + k` and the writes of the element's words. -/
theorem spec_set (hm : Runtime m) {Γ' : List Ty} {e : Elem} (x : Var Γ' (.array e))
    {i : Expr S Γ' .word} {v : Expr S Γ' (.elem e)}
    (iSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv i env slots paid live)
    (vSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv v env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.set x i v) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hi := Nat.le_max_left i.width (max (1 + v.width) (1 + e.width + copyWidth (.array e)))
  have hv := (Nat.le_max_left (1 + v.width) (1 + e.width + copyWidth (.array e))).trans
    (Nat.le_max_right i.width _)
  have hx := (Nat.le_max_right (1 + v.width) (1 + e.width + copyWidth (.array e))).trans
    (Nat.le_max_right i.width _)
  have hcw : copyWidth (Ty.array e) = 4 := rfl
  have hk := e.width_pos
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  have hT : (Expr.set x i v).allocs funs flags bounds (slots.map Slot.mode) paid live env =
      i.allocs funs flags bounds (slots.map Slot.mode) paid
          (fun j => live j || j == x.index || v.uses j) env +
        v.allocs funs flags bounds (slots.map Slot.mode) paid (fun j => live j || j == x.index) env +
        x.ownedCost (slots.map Slot.mode) live (env.get x) := rfl
  have hdS : (Expr.set x i v).fits funs fits env = true →
      i.fits funs fits env = true ∧ v.fits funs fits env = true :=
    fun hd => by simpa [Expr.fits] using hd
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc, List.cons_append, List.nil_append]
  -- The position, in local `base`.
  have hIn : ∀ k, ((live k || k == x.index || v.uses k) || i.uses k) = true →
      (live k || (Expr.set x i v).uses k) = true := fun k h => by
    simp only [Expr.uses]; exact set_live_index _ _ _ _ h
  -- The variables that die in the position and in the value.  The array, when it dies, is
  -- consumed, and its potential is dropped.
  have hDiv : dyingPot store s env slots paid
        (fun k => (live k || k == x.index || v.uses k) || i.uses k)
        (fun k => live k || k == x.index || v.uses k) +
      dyingPot store s env slots paid (fun k => (live k || k == x.index) || v.uses k)
        (fun k => live k || k == x.index) ≤
      dyingPot store s env slots paid (fun k => live k || (Expr.set x i v).uses k) live := by
    rw [dyingPot_split _ (fun k => live k || k == x.index || v.uses k) live
      (fun k h => hIn k (by simp [h])) (fun k h => by simp [h]),
      dyingPot_split (fun k => live k || k == x.index || v.uses k) (fun k => live k || k == x.index)
        live (fun k h => by simp [h]) (fun k h => by simp [h]),
      dyingPot_congr (L0 := fun k => live k || (Expr.set x i v).uses k)
        (L0' := fun k => (live k || k == x.index || v.uses k) || i.uses k)
        (fun k => by simp only [Expr.uses, Bool.or_comm, Bool.or_left_comm])
        fun _ => rfl]
    omega
  refine iSpec env slots paid _ h base heap store s hh hpv
    (hVars.live_mono hIn) hAt (hSafe.mono hIn) hCap hBase (by omega) hPlace.1 _ _
    (hTrap.part (fun h => by simp only [Bool.not_eq_true'] at h; simp [Expr.fits, h])
      (fun _ => by simp [Expr.aborts])
      fun _ hw => hw.mono (by rw [hT]; omega))
    fun heap1 store1 s1 ws1 a1 hTopI => ?_
  have hR1 := a1.rep
  simp only [Ty.rep_word] at hR1
  subst hR1
  refine After.storeWord a1 le_rfl hBase (by rw [hh]; omega) fun e1 hI1 => ?_
  have hp1 := e1.frame.params
  have hh1 := e1.frame.positions.trans hh
  -- The value's words, from local `base + 1` on.
  have hDv : ∀ s1' : Locals, Evolves env slots (fun k => (live k || k == x.index || v.uses k) ||
        i.uses k) (fun k => live k || k == x.index || v.uses k) base heap store s heap1 store1
        s1' →
      dyingPot store1 s1' env slots paid (fun k => (live k || k == x.index) || v.uses k)
        (fun k => live k || k == x.index) =
      dyingPot store s env slots paid (fun k => (live k || k == x.index) || v.uses k)
        (fun k => live k || k == x.index) := fun _ e =>
    dyingPot_evolves (hVars.live_mono hIn) e (fun k h => by simp [h]) _ _ fun _ h => h
  refine vSpec env slots paid _ h (base + 1) heap1 store1 _ hh1
    (hp1.trans hpv) (e1.holds.mono (Nat.le_succ base)) e1.step.at_
    ((hSafe.mono hIn).evolves (hVars.live_mono hIn) e1 (fun k hk => by simp [hk])) (by rw [e1.step.cap m]; exact
        hCap)
    (by rw [hp1]; omega) (by omega) hPlace.2 _ _
    (hTrap.part (fun h => by simp only [Bool.not_eq_true'] at h; simp [Expr.fits, h])
      (fun _ => by simp [Expr.aborts])
      fun hd hw => by
        have := hTopI (hdS (fits_of_not hd)).1
        rw [hDv _ e1]
        exact hw.shift (c1 := dyingPot store s env slots paid
            (fun k => (live k || k == x.index || v.uses k) || i.uses k)
            (fun k => live k || k == x.index || v.uses k) +
            i.allocs funs flags bounds (slots.map Slot.mode) paid
              (fun j => live j || j == x.index || v.uses j) env)
          (by omega) (by rw [hT]; omega) (e1.step.cap m))
    fun heap2 store2 s2 ws2 a2 hTopV => ?_
  have hR2 := Ty.rep_elem.mp a2.rep
  subst hR2
  have e2a := a2.toEvolves rfl
  have hp2a : s2.params = s.params := e2a.frame.params.trans hp1
  have hh2a : s2.positions = h := e2a.frame.positions.trans hh1
  refine wp_storeCode (e.values (v.denote funs env)) h (base + 1) e.types s2 s.values
    (by rw [e.values_length, e.types_length]) hh2a (by rw [hp2a]; omega)
    (by rw [e.types_length, hh2a]; omega) fun s2' f2 hold2 _ => ?_
  have f2' : Frame (base + 1) s2 { s2' with values := s.values } := f2.trans Frame.ofValues
  have e2 : Evolves env slots (fun k => (live k || k == x.index) || v.uses k)
      (fun k => live k || k == x.index) (base + 1) heap1 store1 _ heap2 store2
      { s2' with values := s.values } :=
    ⟨e2a.step, e2a.frame.trans f2', e2a.holds.agree f2'⟩
  have hp2 : s2'.params = s.params := f2.params.trans hp2a
  have hh2 : s2'.positions = h := f2.positions.trans hh2a
  have hI2 : s2'.get base = some (.i64 (i.denote funs env)) :=
    (e2.frame.below base (by omega)).1.trans hI1
  -- The array as owned, in local `base + 1 + k`.
  refine spec_ownedVar hm x (s := { s2' with values := s.values }) hh2 (hp2.trans hpv)
    ((e2.holds.mono (by omega)) : Holds env slots
      (fun k => live k || k == x.index) (base + 1 + e.width) heap2 store2 _) e2.step.at_
    (((hSafe.mono hIn).evolves (hVars.live_mono hIn) e1 (fun k hk => by simp [hk])).evolves
      (e1.holds.mono (Nat.le_succ base)) e2 (fun k hk => by simp [hk]))
    (by rw [e2.step.cap m, e1.step.cap m]; exact hCap)
    (by show s2'.params.length ≤ _; rw [hp2]; omega)
    (by omega) (hTrap.alloc (by simp [Expr.aborts]) fun hd hw => hw.of_le (by
      have := hTopI (hdS (fits_of_not hd)).1; have h2 := hTopV (hdS (fits_of_not hd)).2
      rw [hDv _ e1] at h2
      rw [hT]; omega)
      (by rw [e2.step.cap m, e1.step.cap m]))
    fun heap3 store3 s3 ws3 a3 hTopO => ?_
  obtain ⟨p, hws, hOwned⟩ := a3.rep
  subst hws
  have hp3 : s3.params = s.params := a3.frame.params.trans hp2
  have hh3 : s3.positions = h := a3.frame.positions.trans hh2
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append]
  have hLow3 : ({ s3 with values := s.values } : Locals).params.length ≤ base + 1 + e.width := by
    show s3.params.length ≤ _; rw [hp3]; omega
  have hHigh3' : base + 1 + e.width < s3.positions := by rw [hh3]; omega
  have hHigh3 := Locals.lt_total (s := { s3 with values := s.values }) hHigh3'
  refine wp_localSet_local hLow3 hHigh3 ?_
  set s4 : Locals := setLocal { s3 with values := s.values } (base + 1 + e.width) (.i64 p)
    with hs4
  have hP4 : s4.get (base + 1 + e.width) = some (.i64 p) := Locals.get_setLocal_same hLow3 hHigh3
  have hF4 : Frame (base + 1 + e.width) s3 s4 := Frame.setValues hLow3 le_rfl hHigh3'
  have hI4 : s4.get base = some (.i64 (i.denote funs env)) :=
    (hF4.below base (by omega)).1.trans ((a3.frame.below base (by omega)).1.trans hI2)
  have hold4 : LocalsHold s4 (base + 1) e.types (e.values (v.denote funs env)) :=
    (LocalsHold.frame (Frame.ofValues.trans (a3.frame.trans hF4))
      (by rw [e.values_length, e.types_length]) (by rw [e.types_length])).mpr hold2
  have hh4 : s4.positions = h := hF4.positions.trans hh3
  have hp4 : s4.params = s.params := hF4.params.trans hp3
  have hValues4 : s4.values = s.values := rfl
  have a4 := a3.reframe hF4
  -- The rest of the code, from the array after the writes or without them.
  have hFinish : ∀ (store4 : Store Unit) (s' : Locals) (ws : Array UInt64),
      Frame (base + 1 + e.width) s4 s' → s'.values = s.values →
      ws = e.words ((env.get x).set! (i.denote funs env).toNat (v.denote funs env)) →
      After env slots (fun k => live k || k == x.index) live (base + 1 + e.width) heap2 store2
        { s2' with values := s.values } (.array .word) .owned ws heap3 store4 s' [.i64 p] →
      wp m rest Q store4 { s' with values := .i64 p :: s'.values } host := by
    rintro store4 s' ws _ hv' rfl aX
    have aX1 := (After.ofWords aX).lower e2.holds (by omega) fun k h => by simp [h]
    have aX2 := After.prepend (e1.holds.mono (Nat.le_succ base)) e2 aX1
      (fun k h => by simp [h]) fun k h => by simp [h]
    have aX3 := After.prepend (hVars.live_mono hIn) e1 (aX2.lower e1.holds (Nat.le_succ base)
      fun k h => by simp [h]) (fun k h => by simp [h]) fun k h => by simp [h]
    simpa [hv'] using hNext heap3 store4 _ [.i64 p] (aX3.liveIn hIn) fun hd => top_unpaid rfl (by
      have := hTopI (hdS hd).1; have h2 := hTopV (hdS hd).2
      rw [hDv _ e1] at h2
      rw [hT]; omega)
  have hA := hOwned.values
  have hLength := hA.lengthBound
  have hnk : (env.get x).size * e.width < 536870912 := by
    have := hA.1; rw [Elem.words_size] at this; omega
  have hn64 : (env.get x).size < UInt64.size := by
    have := Nat.le_mul_of_pos_right (env.get x).size hk
    rw [show UInt64.size = 18446744073709551616 from rfl]; omega
  show wp m _ Q store3 s4 host
  simp only [wp_localGet_cons, Locals.get_values, hI4, hP4, wp_wrapI64_cons, wp_load64_cons,
    wrap_toUInt32, UInt32.toNat_zero, Nat.add_zero, UInt32.add_zero]
  rw [ite_eq_right (by omega), hA.lengthRead, Elem.words_size, wp_divCode hk, words_div hk hnk]
  simp only [wp_ltUI64_cons]
  rw [wp_iff_control_types]
  refine wp_iff_cons rfl ?_
  have hLess : i.denote funs env < UInt64.ofNat (env.get x).size ↔
      (i.denote funs env).toNat < (env.get x).size := by
    rw [UInt64.lt_iff_toNat_lt, UInt64.toNat_ofNat_of_lt' hn64]
  by_cases hc : (i.denote funs env).toNat < (env.get x).size
  · -- The writes of the element's words.
    rw [ite_eq_left (by simp [hLess.mpr hc])]
    have hik : (i.denote funs env).toNat * e.width < 536870912 :=
      lt_of_le_of_lt (Nat.mul_le_mul_right e.width (Nat.le_of_lt hc)) hnk
    simp only [List.cons_append, List.nil_append, wp_localGet_cons, Locals.get_values, hI4]
    have hs := words_scale hk hik
    rw [UInt64.ofNat_toNat] at hs
    rw [wp_scaleCode, hs]
    have hLow5 : ({ s4 with values := s4.values } : Locals).params.length ≤
        base + 2 + e.width := by
      show s4.params.length ≤ _; rw [hp4]; omega
    have hHigh5' : base + 2 + e.width < s4.positions := by rw [hh4]; omega
    have hHigh5 := Locals.lt_total (s := { s4 with values := s4.values }) hHigh5'
    refine wp_localSet_local hLow5 hHigh5 ?_
    set s5 : Locals := setLocal { s4 with values := s4.values } (base + 2 + e.width)
      (.i64 (UInt64.ofNat ((i.denote funs env).toNat * e.width))) with hs5
    have hF5 : Frame (base + 2 + e.width) s4 s5 := Frame.setValues hLow5 le_rfl hHigh5'
    have hW5 : s5.get (base + 2 + e.width) =
        some (.i64 (UInt64.ofNat ((i.denote funs env).toNat * e.width))) :=
      Locals.get_setLocal_same hLow5 hHigh5
    have hP5 : s5.get (base + 1 + e.width) = some (.i64 p) :=
      (hF5.below _ (by omega)).1.trans hP4
    have hold5 : LocalsHold s5 (base + 1) e.types
        (List.zipWith typedValue e.types (e.toWords (v.denote funs env))) := by
      rw [e.values_typed]
      exact (LocalsHold.frame hF5 (by rw [e.values_length, e.types_length])
        (by rw [e.types_length]; omega)).mpr hold4
    have hik64 : (UInt64.ofNat ((i.denote funs env).toNat * e.width)).toNat =
        (i.denote funs env).toNat * e.width :=
      UInt64.toNat_ofNat_of_lt' (by rw [show UInt64.size = 18446744073709551616 from rfl]; omega)
    rw [← List.append_nil (storeWordsCode h (base + 1 + e.width) (base + 2 + e.width) 0 (base + 1)
      e.types)]
    refine wp_storeWordsCode 0 (base + 1) e.types (e.toWords (v.denote funs env))
      (e.words (env.get x)) store3 s5 (a4.toWords.reframe (hF5.mono (by omega)))
      (hF5.positions.trans hh4) hP5 hW5 hold5 (by rw [e.toWords_length, e.types_length]) (e.typed_words _)
      (by rw [hik64, e.types_length, Elem.words_size]
          have := Nat.mul_le_mul_right e.width (Nat.succ_le_of_lt hc)
          rw [Nat.succ_mul] at this; omega)
      fun store6 a6 _ => ?_
    rw [hik64] at a6
    simp only [Nat.add_zero] at a6
    rw [Elem.words_set e hc] at a6
    rw [wp_nil]
    dsimp only
    simp only [List.take_zero, List.drop_zero, List.nil_append, wp_localGet_cons, hP5]
    exact hFinish store6 s5 _ (hF5.mono (by omega)) rfl rfl a6
  · rw [ite_eq_right (by simp [hLess, hc])]
    rw [wp_nil]
    dsimp only
    simp only [List.take_zero, List.drop_zero, List.nil_append, wp_localGet_cons, hP4]
    exact hFinish _ s4 (e.words (env.get x)) (Frame.refl _ _) rfl
      (by simp [Array.set!, Array.setIfInBounds, hc]) a4.toWords

/-- A request of at least 8 and at most `8 * k` bytes, within `2 ^ 32`, takes at most `8 * k`
bytes. -/
theorem allocSize_le_mul {bytes : UInt64} {k : Nat} (h8 : 8 ≤ bytes.toNat)
    (hb : bytes.toNat ≤ 4294967296) (h : bytes.toNat ≤ 8 * k) :
    (allocSize bytes).toNat ≤ 8 * k := by
  have hRound : ((bytes + 7) / 8 * 8).toNat = (bytes.toNat + 7) / 8 * 8 := by
    simp only [UInt64.toNat_mul, UInt64.toNat_div, UInt64.toNat_add, UInt64.reduceToNat]
    omega
  unfold allocSize
  split
  · simp only [UInt64.reduceToNat]; omega
  · rw [hRound]; omega

/-- `Var.roomCost` of an array that is copied: a copy at the new length. -/
theorem Var.roomCost_copy {Γ : List Ty} {e : Elem} (x : Var Γ (.array e)) {modes : List Mode}
    (paid : List Bool) {live : Nat → Bool} (xs : Array e.denote) (ext : Nat)
    (h : ¬(modeAt modes x.index = .owned ∧ live x.index = false)) :
    x.roomCost modes paid live xs ext = allocCost ((xs.size * e.width + ext + 1) * 8) := by
  simp only [Var.roomCost, ite_eq_right h]

/-- `Var.roomCost` of an owned array that dies: for a paid one, a header and four times the added
bytes, and for an unpaid one, a block of twice the new length's bytes and twice the added bytes. -/
theorem Var.roomCost_move {Γ : List Ty} {e : Elem} (x : Var Γ (.array e)) {modes : List Mode}
    (paid : List Bool) {live : Nat → Bool} (xs : Array e.denote) (ext : Nat)
    (h : modeAt modes x.index = .owned ∧ live x.index = false) :
    x.roomCost modes paid live xs ext =
      if paidAt paid x.index then allocCost (32 * ext)
      else allocCost (16 * (xs.size * e.width + ext + 1)) + 16 * ext := by
  simp only [Var.roomCost, ite_eq_left h]

/-! The arithmetic of a growth with the potential `4u ∸ 2c`, for an array of `n` words in a block
of capacity `c` that grows to `t` words.  A move requests `r`, twice the capacity or the new
length's bytes, which the allocator rounds to `A`, a multiple of 8. -/

theorem room_inplace_paid {n t c : Nat} (hnt : n ≤ t) :
    4 * (8 * (t + 1)) - 2 * c ≤ (4 * (8 * (n + 1)) - 2 * c) + (48 + 32 * (t - n)) := by omega

theorem room_inplace_unpaid {n t c : Nat} (hc : 8 * (n + 1) ≤ c) (hnt : n ≤ t) :
    4 * (8 * (t + 1)) - 2 * c ≤ 48 + 16 * (t + 1) + 16 * (t - n) := by omega

theorem room_alloc_paid {n t c r A : Nat} (hA : A % 8 = 0) (hAr : r ≤ A) (hAr7 : A ≤ r + 7)
    (hroom : c < 8 * (t + 1))
    (hr : (r = 2 * c ∧ 8 * (t + 1) ≤ 2 * c) ∨ (r = 8 * (t + 1) ∧ 2 * c < 8 * (t + 1))) :
    48 + A ≤ (4 * (8 * (n + 1)) - 2 * c) + (48 + 32 * (t - n)) := by
  rcases hr with ⟨rfl, h⟩ | ⟨rfl, h⟩ <;> omega

theorem room_alloc_unpaid {n t c r A : Nat} (hA : A % 8 = 0) (hAr : r ≤ A) (hAr7 : A ≤ r + 7)
    (hroom : c < 8 * (t + 1))
    (hr : (r = 2 * c ∧ 8 * (t + 1) ≤ 2 * c) ∨ (r = 8 * (t + 1) ∧ 2 * c < 8 * (t + 1))) :
    48 + A ≤ 48 + 16 * (t + 1) + 16 * (t - n) := by
  rcases hr with ⟨rfl, h⟩ | ⟨rfl, h⟩ <;> omega

theorem room_move_paid {top top' n t c c' r A : Nat} (hA : A % 8 = 0) (hAr : r ≤ A)
    (hAr7 : A ≤ r + 7) (hc : 8 * (n + 1) ≤ c) (hroom : c < 8 * (t + 1))
    (hr : (r = 2 * c ∧ 8 * (t + 1) ≤ 2 * c) ∨ (r = 8 * (t + 1) ∧ 2 * c < 8 * (t + 1)))
    (hshape : (top' = top ∧ r ≤ c') ∨ (top' = top + 48 + A ∧ c' = A)) :
    top' + (4 * (8 * (t + 1)) - 2 * c') ≤
      top + (4 * (8 * (n + 1)) - 2 * c) + (48 + 32 * (t - n)) := by
  rcases hr with ⟨rfl, h⟩ | ⟨rfl, h⟩ <;> rcases hshape with ⟨rfl, h'⟩ | ⟨rfl, rfl⟩ <;> omega

theorem room_move_unpaid {top top' n t c c' r A : Nat} (hA : A % 8 = 0) (hAr : r ≤ A)
    (hAr7 : A ≤ r + 7) (hc : 8 * (n + 1) ≤ c) (hroom : c < 8 * (t + 1))
    (hr : (r = 2 * c ∧ 8 * (t + 1) ≤ 2 * c) ∨ (r = 8 * (t + 1) ∧ 2 * c < 8 * (t + 1)))
    (hshape : (top' = top ∧ r ≤ c') ∨ (top' = top + 48 + A ∧ c' = A)) :
    top' + (4 * (8 * (t + 1)) - 2 * c') ≤ top + (48 + 16 * (t + 1) + 16 * (t - n)) := by
  rcases hr with ⟨rfl, h⟩ | ⟨rfl, h⟩ <;> rcases hshape with ⟨rfl, h'⟩ | ⟨rfl, rfl⟩ <;> omega

/-- A block of more than `2 ^ 31` bytes below `top` leaves no room for either charge. -/
theorem room_huge {top n t c : Nat} (hroom : c < 8 * (t + 1)) (hnt : 8 * (n + 1) ≤ c)
    (hc : 4294967296 < 2 * c) (htop : c ≤ top) :
    4294901760 < top + (4 * (8 * (n + 1)) - 2 * c) + (48 + 32 * (t - n)) ∧
      4294901760 < top + (48 + 16 * (t + 1) + 16 * (t - n)) := by
  omega

/-- A new length of `2 ^ 29` words or more leaves no room for any charge. -/
theorem room_long {n t c : Nat} (ht : 536870912 ≤ t) (hnt : n ≤ t) (hc : c < 4294967296) :
    4294901760 < (4 * (8 * (n + 1)) - 2 * c) + (48 + 32 * (t - n)) ∧
      4294901760 < 48 + 16 * (t + 1) + 16 * (t - n) ∧ 4294901760 < 48 + (t + 1) * 8 := by
  omega

/-- The rounded byte count of an allocation is a multiple of 8 within 7 of the request. -/
theorem allocSize_round {bytes : UInt64} (h : bytes.toNat ≤ 4294967296) (h8 : 8 ≤ bytes.toNat) :
    (allocSize bytes).toNat % 8 = 0 ∧ bytes.toNat ≤ (allocSize bytes).toNat ∧
      (allocSize bytes).toNat ≤ bytes.toNat + 7 := by
  have hRound : ((bytes + 7) / 8 * 8).toNat = (bytes.toNat + 7) / 8 * 8 := by
    simp only [UInt64.toNat_mul, UInt64.toNat_div, UInt64.toNat_add, UInt64.reduceToNat]
    omega
  unfold allocSize
  split
  · rename_i hs
    rw [UInt64.lt_iff_toNat_lt, hRound] at hs
    simp only [UInt64.reduceToNat] at hs
    omega
  · rw [hRound]; omega

/-- `Var.roomCode`: an owned array, at the address in local `b + 4`, whose first elements are
those of `x`, whose length is `x`'s length plus the word `e` in local `ext`, and whose block has
room for that length.  An owned `x` that dies is consumed, and any other `x` is read.  The code
traps only when `top` cannot rise by the potential of the paid owned variables that die plus
`Var.roomCost` within the cap.  `top` after the code, plus the potential of the array when `x` is
owned and dies, is at most `top` before it plus that sum. -/
theorem spec_room (hm : Runtime m) {Γ' : List Ty} {el : Elem} (x : Var Γ' (.array el))
    {env : Env Γ'}
    {slots : List Slot} {paid : List Bool} {live : Nat → Bool} {b ext : Nat} {e : UInt64}
    {heap : Heap}
    {store : Store Unit} {s : Locals} {rest : Program} {Q : Assertion Unit}
    (hVars : Holds env slots (fun i => live i || i == x.index) b heap store s)
    (hAt : heap.At store) (hCap : store.memoryCap m 0 ≤ 65535) (hBase : s.params.length ≤ b)
    (hRoom : b + 6 ≤ s.positions) (hExt : s.get ext = some (.i64 e))
    (hExtB : ext < b) (he : e.toNat ≤ 536870912)
    (hTrap : TrapOK (!decide (heap.Within store m
      (dyingPot store s env slots paid (fun i => live i || i == x.index) live +
        x.roomCost (slots.map Slot.mode) paid live (env.get x) e.toNat))) Q)
    (hNext : ∀ (heap' : Heap) (store' : Store Unit) (s' : Locals) (q : UInt64)
      (words : Array UInt64), words.size = (el.words (env.get x)).size + e.toNat →
      (∀ j (hj : j < (el.words (env.get x)).size), words[j]! = (el.words (env.get x))[j]) →
      After env slots (fun i => live i || i == x.index) live b heap store s (.array .word) .owned
        words heap' store' s' [.i64 q] →
      s'.get (b + 1) = some (.i64 (UInt64.ofNat (el.words (env.get x)).size)) →
      s'.get (b + 4) = some (.i64 q) → s'.values = s.values →
      heap'.top.toNat +
          (if (slots.getD x.index default).mode = .owned ∧ live x.index = false then
            arrayPot store' q words.size else 0) ≤
        heap.top.toNat + dyingPot store s env slots paid (fun i => live i || i == x.index) live +
          x.roomCost (slots.map Slot.mode) paid live (env.get x) e.toNat →
      wp m rest Q store' s' host) :
    wp m (x.roomCode slots b live ext ++ rest) Q store s host := by
  have hTot : 2 * s.positions ≤ s.params.length + s.locals.length := by
    simp only [Locals.positions]; omega
  obtain ⟨hBelowX, ws, hold, hRep⟩ := hVars.get x (by simp)
  obtain ⟨p, rfl, hArr⟩ := hRep
  -- The potential of `x` when it is paid and dies, which `dyingPot` counts.
  have hPotX : (slots.getD x.index default).mode = .owned → live x.index = false →
      paidAt paid x.index = true →
      arrayPot store p (el.words (env.get x)).size ≤
        dyingPot store s env slots paid (fun i => live i || i == x.index) live :=
    fun hOw hDd hp => by
      have := dyingPot_var (store := store) (s := s) (env := env) (paid := paid)
        (liveIn := fun i => live i || i == x.index) x (by simp) hDd hp hOw
      rw [Env.potOf, hold.read_eq rfl] at this
      exact this
  have hModes : ∀ P : Prop,
      ((slots.getD x.index default).mode = .owned ∧ live x.index = false ↔ P) →
      (modeAt (slots.map Slot.mode) x.index = .owned ∧ live x.index = false ↔ P) := fun P h => by
    rw [modeAt, Slot.modes_getD]; exact h
  have hB := hArr.borrow
  have hA := hB.values
  have hLenB := hA.lengthBound
  have hFitA := hA.1
  have hn : (el.words (env.get x)).size < 536870912 := by omega
  have hN : (UInt64.ofNat (el.words (env.get x)).size).toNat = (el.words (env.get x)).size :=
    UInt64.toNat_ofNat_of_lt' (by rw [show UInt64.size = 18446744073709551616 from rfl]; omega)
  have hP : s.get (slots.getD x.index default).loc = some (.i64 p) := by
    exact LocalsHold.word hold
  simp only [Var.roomCode, List.append_assoc, List.cons_append, List.nil_append]
  -- The address, in local `b`.
  simp only [wp_localGet_cons, hP]
  refine wp_localSet_local hBase (by omega) ?_
  have hLow0 : ({ s with values := s.values } : Locals).params.length ≤ b := hBase
  let s1 := setLocal { s with values := s.values } b (.i64 p)
  have hP1 : s1.get b = some (.i64 p) := Locals.get_setLocal_same hLow0 (by omega)
  have hExt1 : s1.get ext = some (.i64 e) := by
    rw [Locals.get_setLocal_ne hLow0 (by omega)]; exact hExt
  -- The length, in local `b + 1`.
  show wp m _ Q store s1 host
  simp only [wp_localGet_cons, hP1, wp_wrapI64_cons, wp_load64_cons, wrap_toUInt32,
    UInt32.toNat_zero, Nat.add_zero, UInt32.add_zero]
  rw [ite_eq_right (by omega), hA.lengthRead]
  have hLow1 : ({ s1 with values := s.values } : Locals).params.length ≤ b + 1 := by
    show s.params.length ≤ b + 1; omega
  have hHigh1 : b + 1 < ({ s1 with values := s.values } : Locals).params.length +
      ({ s1 with values := s.values } : Locals).locals.length := by
    show b + 1 < s.params.length + (setLocal _ _ _).locals.length; simp [setLocal]; omega
  refine wp_localSet_local hLow1 hHigh1 ?_
  let s2 := setLocal { s1 with values := s.values } (b + 1)
    (.i64 (UInt64.ofNat (el.words (env.get x)).size))
  have hN2 : s2.get (b + 1) = some (.i64 (UInt64.ofNat (el.words (env.get x)).size)) :=
    Locals.get_setLocal_same hLow1 hHigh1
  have hP2 : s2.get b = some (.i64 p) := by
    rw [Locals.get_setLocal_ne hLow1 (by omega)]; exact hP1
  have hExt2 : s2.get ext = some (.i64 e) := by
    rw [Locals.get_setLocal_ne hLow1 (by omega)]; exact hExt1
  -- The new length, in local `b + 2`.
  show wp m _ Q store s2 host
  simp only [wp_localGet_cons, Locals.get_values, hN2, hExt2, wp_addI64_cons]
  have hLow2 : ({ s2 with values := s.values } : Locals).params.length ≤ b + 2 := by
    show s.params.length ≤ b + 2; omega
  have hHigh2 : b + 2 < ({ s2 with values := s.values } : Locals).params.length +
      ({ s2 with values := s.values } : Locals).locals.length := by
    show b + 2 < s.params.length + (setLocal _ _ _).locals.length; simp [s1, setLocal]; omega
  refine wp_localSet_local hLow2 hHigh2 ?_
  let s3 := setLocal { s2 with values := s.values } (b + 2)
    (.i64 (UInt64.ofNat (el.words (env.get x)).size + e))
  have hT3 : s3.get (b + 2) = some (.i64 (UInt64.ofNat (el.words (env.get x)).size + e)) :=
    Locals.get_setLocal_same hLow2 hHigh2
  have hN3 : s3.get (b + 1) = some (.i64 (UInt64.ofNat (el.words (env.get x)).size)) := by
    rw [Locals.get_setLocal_ne hLow2 (by omega)]; exact hN2
  have hP3 : s3.get b = some (.i64 p) := by
    rw [Locals.get_setLocal_ne hLow2 (by omega)]; exact hP2
  have hTotal : (UInt64.ofNat (el.words (env.get x)).size + e).toNat =
      (el.words (env.get x)).size + e.toNat := by
    rw [UInt64.toNat_add, hN]; omega
  -- The trap when the new length is `2 ^ 29` or more.
  show wp m _ Q store s3 host
  simp only [wp_localGet_cons, hT3, wp_constI64_cons, wp_geUI64_cons]
  rw [wp_iff_control_types]
  refine wp_iff_cons rfl ?_
  by_cases hBig : (536870912 : UInt64) ≤ UInt64.ofNat (el.words (env.get x)).size + e
  · simp (config := { decide := true }) only [ge_iff_le, hBig, ↓reduceIte]
    rw [wp_unreachable_cons]
    have hW : ¬heap.Within store m
        (dyingPot store s env slots paid (fun i => live i || i == x.index) live +
          x.roomCost (slots.map Slot.mode) paid live (env.get x) e.toNat) := by
      rw [UInt64.le_iff_toNat_le, hTotal] at hBig
      simp only [UInt64.reduceToNat] at hBig
      intro hw
      unfold Heap.Within at hw
      have hws := Elem.words_size el (env.get x)
      by_cases hMv : (slots.getD x.index default).mode = .owned ∧ live x.index = false
      · have hO : heap.Owned store p (el.words (env.get x)) := by rw [hMv.1] at hArr; exact hArr
        have hAddr := hO.address
        have hL := room_long (n := (el.words (env.get x)).size)
          (t := (el.words (env.get x)).size + e.toNat) (c := capacityAt store p) hBig (by omega)
          (by omega)
        rw [Var.roomCost_move x paid (env.get x) e.toNat ((hModes _ Iff.rfl).mpr hMv)] at hw
        cases hp : paidAt paid x.index
        · simp only [hp, Bool.false_eq_true, ↓reduceIte, allocCost] at hw; omega
        · have := hPotX hMv.1 hMv.2 hp
          simp only [hp, ↓reduceIte, allocCost] at hw
          simp only [arrayPot] at this
          omega
      · rw [Var.roomCost_copy x paid (env.get x) e.toNat
          (fun h => hMv ((hModes _ Iff.rfl).mp h))] at hw
        have hL := room_long (n := 0) (t := (el.words (env.get x)).size + e.toNat) (c := 0) hBig
          (by omega) (by omega)
        simp only [allocCost] at hw; omega
    exact (hTrap.of_imp (a := true) fun _ => by simpa using hW) _
  simp (config := { decide := true }) only [ge_iff_le, hBig, ↓reduceIte]
  rw [wp_nil]
  dsimp only
  simp only [List.take_zero, List.drop_zero, List.nil_append]
  have hTotalLt : (el.words (env.get x)).size + e.toNat < 536870912 := by
    have := UInt64.not_le.mp hBig
    rw [UInt64.lt_iff_toNat_lt, hTotal] at this
    exact this
  have hT3' : ({ s3 with values := s3.values } : Locals).get (b + 2) =
      some (.i64 (UInt64.ofNat (el.words (env.get x)).size + e)) := hT3
  have frame3 : Frame b s s3 := by
    have f1 : Frame b s s1 := Frame.setValues hLow0 le_rfl (by omega)
    have f2 : Frame b s1 s2 := Frame.setValues hLow1 (by omega) (by
      simp only [s1, Locals.positions_setLocal, Locals.positions_values]
      omega)
    have f3 : Frame b s2 s3 := Frame.setValues hLow2 (by omega) (by
      simp only [s2, s1, Locals.positions_setLocal, Locals.positions_values]
      omega)
    exact f1.trans (f2.trans f3)
  have hFrame3 := frame3.below
  have hh3 : s3.positions = s.positions := by simp [s3, s2, s1]
  have hp3 : s3.params = s.params := rfl
  have hl3 : s3.locals.length = s.locals.length := by simp [s3, s2, s1, setLocal]
  have hv3 : s3.values = s.values := rfl
  by_cases hMove : (slots.getD x.index default).mode = .owned ∧ live x.index = false
  swap
  · -- A copy into a block with room.
    rw [ite_eq_right hMove]
    simp only [List.cons_append, List.append_assoc, wp_localGet_cons, hT3', wp_constI64_cons,
      wp_addI64_cons, wp_mulI64_cons]
    have hBytes : ((UInt64.ofNat (el.words (env.get x)).size + e + 1) * 8).toNat =
        8 * ((UInt64.ofNat (el.words (env.get x)).size + e).toNat + 1) := by
      simp only [UInt64.toNat_mul, UInt64.toNat_add, UInt64.reduceToNat] at hTotal ⊢
      omega
    have hc : allocCost (allocSize ((UInt64.ofNat (el.words (env.get x)).size + e + 1) * 8)).toNat ≤
        x.roomCost (slots.map Slot.mode) paid live (env.get x) e.toNat := by
      have h1 := allocSize_le_mul (k := (el.words (env.get x)).size + e.toNat + 1)
        (bytes := (UInt64.ofNat (el.words (env.get x)).size + e + 1) * 8)
        (by rw [hBytes]; omega) (by rw [hBytes, hTotal]; omega) (by rw [hBytes, hTotal])
      rw [Var.roomCost_copy x paid (env.get x) e.toNat (fun h => hMove ((hModes _ Iff.rfl).mp h)),
        ← Elem.words_size el (env.get x)]
      simp only [allocCost] at h1 ⊢
      omega
    refine wp_allocCopy hm hAt hCap (le_trans hc (Nat.le_add_left _ _)) hTrap hB
      (by rw [hTotal]; exact hTotalLt)
      (by omega)
      (by rw [hBytes]) (by rw [hBytes, hTotal]; omega) hP3 hT3 hN3
      (by show s.params.length ≤ b + 4; omega) (by rw [hp3, hl3]; omega)
      (by show s.params.length ≤ b + 5; omega) (by rw [hp3, hl3]; omega)
      (by omega) (by omega) (by omega) (by omega) (by omega) (by omega)
      fun heap1 store1 s4 q words hSize hPrefix hStep hOwnedQ _ hp4 hl4 hOther4 hQ4 hv4 hTop4 => ?_
    have hF4 : Frame b s s4 := ⟨hp4.trans hp3, hl4.trans hl3, fun j hj =>
      ⟨by rw [hOther4 j (by omega) (by omega), (hFrame3 j hj).1],
        by rw [hOther4 _ (by omega) (by omega), (hFrame3 j hj).2]⟩,
      fun j hj => by rw [hOther4 _ (by omega) (by omega), frame3.below32 j hj]⟩
    have hVarsL := hVars.live_mono (live' := live) fun i h => by simp [h]
    refine hNext heap1 store1 s4 q words (by rw [hSize, hTotal]) hPrefix ⟨?_, hF4, ?_,
      ⟨q, rfl, hOwnedQ⟩, ?_⟩ (by rw [hOther4 _ (by omega) (by omega)]; exact hN3) hQ4
      (by rw [hv4, hv3]) (by rw [ite_eq_right hMove]; omega)
    · exact hStep.mono (fun _ _ => trivial) fun _ h => h
    · exact (hVarsL.step hStep fun _ _ _ _ _ _ _ _ => trivial).frame hF4 le_rfl
    · intro u y hy _ wy hwy hly c hc d hd
      have hwy' := (hVarsL.hold_agree hF4 hy hly).mp hwy
      obtain ⟨hSame, hFresh⟩ := hVarsL.regions_after hStep hy hwy' hly fun _ _ => trivial
      rw [hSame] at hd
      exact regionsDisjoint_symm (hFresh d hd c hc)
  -- An owned `x` that dies: its block, extended in place or replaced by a larger one.
  obtain ⟨hOwnedX, hDead⟩ := hMove
  rw [ite_eq_left (show (slots.getD x.index default).mode = .owned ∧ live x.index = false from
    ⟨hOwnedX, hDead⟩)]
  have hOwned : heap.Owned store p (el.words (env.get x)) := by rw [hOwnedX] at hArr; exact hArr
  have hCost := Var.roomCost_move x paid (env.get x) e.toNat
    ((hModes _ Iff.rfl).mpr ⟨hOwnedX, hDead⟩)
  have hws := Elem.words_size el (env.get x)
  have hBaseP := hOwned.base
  have hAddrP := hOwned.address
  have hBelowP := hOwned.below
  have hTop := hAt.top
  have hCapacityP := hOwned.capacity
  have a0 := (After.move x hVars hAt hOwnedX hDead hold rfl).reframe frame3
  have hP3' : ({ s3 with values := s3.values } : Locals).get b = some (.i64 p) := hP3
  have hCapAddr : (p - 32).toUInt32.toNat = p.toNat - 32 :=
    headerAddress_toNat (by simp only [UInt64.reduceToNat]; omega) (by omega)
  -- The capacity, in local `b + 3`.
  simp only [List.cons_append, List.nil_append, wp_localGet_cons, hP3', wp_constI64_cons,
    wp_subI64_cons, wp_wrapI64_cons, wp_load64_cons, wrap_toUInt32,
    UInt32.toNat_zero, Nat.add_zero, UInt32.add_zero]
  rw [ite_eq_right (by rw [hCapAddr]; omega)]
  have hLow3 : ({ s3 with values := s3.values } : Locals).params.length ≤ b + 3 := by
    show s.params.length ≤ b + 3; omega
  have hHigh3 : b + 3 < ({ s3 with values := s3.values } : Locals).params.length +
      ({ s3 with values := s3.values } : Locals).locals.length := by
    show b + 3 < s3.params.length + s3.locals.length; rw [hp3, hl3]; omega
  refine wp_localSet_local hLow3 hHigh3 ?_
  let s4 := setLocal { s3 with values := s3.values } (b + 3)
    (.i64 (store.mem.read64 (p - 32).toUInt32))
  have hC4 : s4.get (b + 3) = some (.i64 (store.mem.read64 (p - 32).toUInt32)) :=
    Locals.get_setLocal_same hLow3 hHigh3
  have hT4 : s4.get (b + 2) = some (.i64 (UInt64.ofNat (el.words (env.get x)).size + e)) := by
    rw [Locals.get_setLocal_ne hLow3 (by omega), Locals.get_values]; exact hT3
  have hN4 : s4.get (b + 1) = some (.i64 (UInt64.ofNat (el.words (env.get x)).size)) := by
    rw [Locals.get_setLocal_ne hLow3 (by omega), Locals.get_values]; exact hN3
  have hP4 : s4.get b = some (.i64 p) := by
    rw [Locals.get_setLocal_ne hLow3 (by omega), Locals.get_values]; exact hP3
  have hp4 : s4.params = s.params := rfl
  have hl4 : s4.locals.length = s.locals.length := by simp [s4, setLocal, hl3]
  have hF4 : Frame b s3 s4 := ⟨rfl, by simp [s4, setLocal], fun j hj =>
    ⟨by rw [Locals.get_setLocal_ne hLow3 (by omega), Locals.get_values],
      by rw [Locals.get_setLocal_ne hLow3 (by omega), Locals.get_values]⟩,
    fun j hj => by rw [Locals.get_setLocal_ne hLow3 (by omega), Locals.get_values]⟩
  have hh4 : s4.positions = s.positions := by simp [s4, hh3]
  have hcN : (store.mem.read64 (p - 32).toUInt32).toNat = capacityAt store p := rfl
  -- The room test.
  show wp m _ Q store s4 host
  simp only [wp_localGet_cons, Locals.get_values, hT4, hC4, wp_constI64_cons, wp_addI64_cons,
    wp_mulI64_cons, wp_leUI64_cons]
  rw [wp_iff_control_types]
  refine wp_iff_cons rfl ?_
  have hNeed : ((UInt64.ofNat (el.words (env.get x)).size + e + 1) * 8).toNat =
      8 * ((el.words (env.get x)).size + e.toNat + 1) := by
    simp only [UInt64.toNat_mul, UInt64.toNat_add, UInt64.reduceToNat] at hTotal ⊢
    omega
  by_cases hFits : (UInt64.ofNat (el.words (env.get x)).size + e + 1) * 8 ≤
    store.mem.read64 (p - 32).toUInt32
  · -- Room in the block: the new length, in place.
    simp (config := { decide := true }) only [hFits, ↓reduceIte]
    rw [UInt64.le_iff_toNat_le, hNeed, hcN] at hFits
    have hP4' : ({ s4 with values := s4.values } : Locals).get b = some (.i64 p) := hP4
    simp only [wp_localGet_cons, hP4']
    have hLow4 : ({ s4 with values := s4.values } : Locals).params.length ≤ b + 4 := by
      show s.params.length ≤ b + 4; omega
    have hHigh4 : b + 4 < ({ s4 with values := s4.values } : Locals).params.length +
        ({ s4 with values := s4.values } : Locals).locals.length := by
      show b + 4 < s4.params.length + s4.locals.length; rw [hp4, hl4]; omega
    refine wp_localSet_local hLow4 hHigh4 ?_
    let s5 := setLocal { s4 with values := s4.values } (b + 4) (.i64 p)
    have hQ5 : s5.get (b + 4) = some (.i64 p) := Locals.get_setLocal_same hLow4 hHigh4
    have hT5 : s5.get (b + 2) = some (.i64 (UInt64.ofNat (el.words (env.get x)).size + e)) := by
      rw [Locals.get_setLocal_ne hLow4 (by omega), Locals.get_values]; exact hT4
    have hN5 : s5.get (b + 1) = some (.i64 (UInt64.ofNat (el.words (env.get x)).size)) := by
      rw [Locals.get_setLocal_ne hLow4 (by omega), Locals.get_values]; exact hN4
    have hF5 : Frame b s4 s5 := ⟨rfl, by simp [s5, setLocal], fun j hj =>
      ⟨by rw [Locals.get_setLocal_ne hLow4 (by omega), Locals.get_values],
        by rw [Locals.get_setLocal_ne hLow4 (by omega), Locals.get_values]⟩,
      fun j hj => by rw [Locals.get_setLocal_ne hLow4 (by omega), Locals.get_values]⟩
    show wp m _ _ store s5 host
    have hP32 : p.toUInt32.toNat = p.toNat := by rw [Memory.toUInt32_toNat]; omega
    simp only [wp_localGet_cons, Locals.get_values, hQ5, hT5, wp_wrapI64_cons, wrap_toUInt32,
      wp_store64_cons, UInt32.toNat_zero, Nat.add_zero, UInt32.add_zero]
    rw [ite_eq_right (by rw [hP32]; omega), wp_nil]
    dsimp only
    simp only [List.take_zero, List.drop_zero, List.nil_append]
    -- The block holds the new length, the elements of `x`, and what memory held after them.
    let store' : Store Unit :=
      { store with
        mem := store.mem.write64 p.toUInt32 (UInt64.ofNat (el.words (env.get x)).size + e) }
    let words : Array UInt64 :=
      Array.ofFn (n := (UInt64.ofNat (el.words (env.get x)).size + e).toNat) fun j =>
        if j.val < (el.words (env.get x)).size then (el.words (env.get x))[j.val]!
        else store'.mem.read64 (UInt64Array.wordAddress p (j.val + 1))
    have hSize : words.size = (UInt64.ofNat (el.words (env.get x)).size + e).toNat :=
      Array.size_ofFn
    have hValues : UInt64Array.At store' p words := by
      refine ⟨by rw [hSize, hTotal]; omega, ?_, ?_, fun j hj => ?_⟩
      · rw [hSize, hTotal]; simp only [store', Wasm.Mem.write64_pages]; omega
      · rw [hSize, UInt64.ofNat_toNat]; exact Memory.read64_write64 ..
      · simp only [words, Array.getElem_ofFn]
        rw [hSize, hTotal] at hj
        split
        · next hjn =>
          rw [getElem!_pos _ j hjn, ← hA.elementRead j hjn]
          refine Memory.read64_write64_disjoint _ _ _ _ (Or.inr ?_)
          rw [hP32, ← UInt64Array.wordAddress, UInt64Array.wordAddress_toNat hFitA (by omega)]
          omega
        · rfl
    have hWrites : Memory.WritesRange store store' p.toNat (p.toNat + 8) :=
      Memory.WritesRange.write64 _ p.toUInt32 _ _ _ (by omega) (by omega)
    have hWithin : WritesWithin store store' p.toNat (capacityAt store p) :=
      ⟨by rw [hWrites.1], hWrites.2.1, fun a ha => hWrites.2.2 a (by omega)⟩
    have aW := ((a0.toWords.reframe hF4).reframe hF5).rewrite hWithin (by rw [hWrites.1]) hValues
      (by rw [hSize, hTotal]; omega)
    have hCapSame : capacityAt store' p = capacityAt store p := by
      unfold capacityAt
      dsimp only [store']
      rw [Memory.read64_write64_disjoint _ _ _ _ (Or.inl (by rw [hCapAddr, hP32]; omega))]
    refine hNext heap store' _ p words (by rw [hSize, hTotal]) (fun j hj => ?_) aW hN5 hQ5 rfl
      (by
        rw [ite_eq_left ⟨hOwnedX, hDead⟩, hCost]
        simp only [arrayPot, hCapSame, hSize, hTotal]
        cases hp : paidAt paid x.index
        · have := room_inplace_unpaid (n := (el.words (env.get x)).size)
            (t := (el.words (env.get x)).size + e.toNat) hCapacityP (by omega)
          simp only [Bool.false_eq_true, ↓reduceIte, allocCost]; omega
        · have h1 := hPotX hOwnedX hDead hp
          have := room_inplace_paid (n := (el.words (env.get x)).size)
            (t := (el.words (env.get x)).size + e.toNat) (c := capacityAt store p) (by omega)
          simp only [↓reduceIte, allocCost]; simp only [arrayPot] at h1; omega)
    rw [getElem!_pos words j (by rw [hSize, hTotal]; omega)]
    simp only [words, Array.getElem_ofFn]
    rw [ite_eq_left hj, getElem!_pos _ j hj]
  · -- No room: a block of at least twice the capacity, then the release of the old one.
    simp (config := { decide := true }) only [hFits, ↓reduceIte]
    have hT4' : ({ s4 with values := s4.values } : Locals).get (b + 2) =
        some (.i64 (UInt64.ofNat (el.words (env.get x)).size + e)) := hT4
    have hC4' : ({ s4 with values := s4.values } : Locals).get (b + 3) =
        some (.i64 (store.mem.read64 (p - 32).toUInt32)) := hC4
    refine wp_requestCode hT4' hC4' (by rw [hTotal]; exact hTotalLt) (by rw [hcN]; omega)
      fun r hr => ?_
    rw [UInt64.le_iff_toNat_le, hNeed, hcN] at hFits
    replace hr : (r.toNat = 2 * capacityAt store p ∧
          8 * ((el.words (env.get x)).size + e.toNat + 1) ≤ 2 * capacityAt store p ∧
          2 * capacityAt store p ≤ 4294967296) ∨
        (r.toNat = 4294967296 ∧
          8 * ((el.words (env.get x)).size + e.toNat + 1) ≤ 2 * capacityAt store p ∧
          4294967296 < 2 * capacityAt store p) ∨
        (r.toNat = 8 * ((el.words (env.get x)).size + e.toNat + 1) ∧
          2 * capacityAt store p < 8 * ((el.words (env.get x)).size + e.toNat + 1)) := by
      rcases hr with h | h | h
      · left; omega
      · right; left; omega
      · right; right; omega
    have hRoomX : capacityAt store p < 8 * ((el.words (env.get x)).size + e.toNat + 1) := by
      omega
    have hr1 : 8 * ((UInt64.ofNat (el.words (env.get x)).size + e).toNat + 1) ≤ r.toNat := by
      rw [hTotal]; rcases hr with ⟨h, _⟩ | ⟨h, _⟩ | ⟨h, _⟩ <;> omega
    have hr2 : r.toNat ≤ 4294967296 := by rcases hr with ⟨h, _⟩ | ⟨h, _⟩ | ⟨h, _⟩ <;> omega
    have hRound := allocSize_round hr2 (by rw [hTotal] at hr1; omega)
    have hTopP := hOwned.below
    -- The allocation's charge fits whenever the growth's does; a request of `2 ^ 32` bytes
    -- follows a block too large for either.
    have hTrapA : TrapOK (!decide (heap.Within store m (allocCost (allocSize r).toNat))) Q :=
      hTrap.of_imp fun h => by
        simp only [Bool.not_eq_true', decide_eq_false_iff_not] at h ⊢
        refine fun hw => h (hw.mono ?_)
        unfold Heap.Within at hw
        rw [hCost]
        rcases hr with hr | hr | hr
        · cases hp : paidAt paid x.index
          · have := room_alloc_unpaid (n := (el.words (env.get x)).size)
              (t := (el.words (env.get x)).size + e.toNat) hRound.1 hRound.2.1 hRound.2.2
              hRoomX (Or.inl ⟨hr.1, hr.2.1⟩)
            simp only [Bool.false_eq_true, ↓reduceIte, allocCost]; omega
          · have h1 := hPotX hOwnedX hDead hp
            have := room_alloc_paid (n := (el.words (env.get x)).size)
              (t := (el.words (env.get x)).size + e.toNat) hRound.1 hRound.2.1 hRound.2.2
              hRoomX (Or.inl ⟨hr.1, hr.2.1⟩)
            simp only [↓reduceIte, allocCost]; simp only [arrayPot] at h1; omega
        · exfalso
          have hH := room_huge (top := heap.top.toNat) (n := (el.words (env.get x)).size)
            (t := (el.words (env.get x)).size + e.toNat) hRoomX hCapacityP hr.2.2 (by omega)
          rw [hCost] at hw
          cases hp : paidAt paid x.index
          · simp only [hp, Bool.false_eq_true, ↓reduceIte, allocCost] at hw; omega
          · have h1 := hPotX hOwnedX hDead hp
            simp only [hp, ↓reduceIte, allocCost] at hw; simp only [arrayPot] at h1; omega
        · cases hp : paidAt paid x.index
          · have := room_alloc_unpaid (n := (el.words (env.get x)).size)
              (t := (el.words (env.get x)).size + e.toNat) hRound.1 hRound.2.1 hRound.2.2
              hRoomX (Or.inr hr)
            simp only [Bool.false_eq_true, ↓reduceIte, allocCost]; omega
          · have h1 := hPotX hOwnedX hDead hp
            have := room_alloc_paid (n := (el.words (env.get x)).size)
              (t := (el.words (env.get x)).size + e.toNat) hRound.1 hRound.2.1 hRound.2.2
              hRoomX (Or.inr hr)
            simp only [↓reduceIte, allocCost]; simp only [arrayPot] at h1; omega
    refine wp_allocCopy (c := allocCost (allocSize r).toNat) hm hAt hCap le_rfl
      (hTrapA.imp fun _ h => h)
      hOwned.borrowed
      (by rw [hTotal]; exact hTotalLt) (by rw [hTotal]; omega) hr1 hr2 hP4 hT4 hN4
      (by show s.params.length ≤ b + 4; omega) (by rw [hp4, hl4]; omega)
      (by show s.params.length ≤ b + 5; omega) (by rw [hp4, hl4]; omega)
      (by omega) (by omega) (by omega) (by omega) (by omega) (by omega)
      fun heap1 store1 s5 q words hSize hPrefix hStep1 hOwnedQ hShape hp5 hl5 hOther5 hQ5 hv5
        _ => ?_
    have hP5 : s5.get b = some (.i64 p) := by rw [hOther5 b (by omega) (by omega)]; exact hP4
    simp only [wp_localGet_cons, hP5]
    obtain ⟨⟨hOwnedP1, hCapP1⟩, hApartPQ⟩ := hStep1.owned hOwned trivial
    refine wp_release hm hStep1.at_ hOwnedP1 ?_
    rw [wp_nil]
    dsimp only
    simp only [List.take_zero, List.drop_zero, List.nil_append]
    have hRel := releaseStep hStep1.at_ hOwnedP1
    have hPQ : regionsDisjoint (block store1 q) (block store1 p) := by
      rw [block_eq hCapP1]
      exact regionsDisjoint_symm (hApartPQ _ (List.mem_singleton_self _))
    obtain ⟨⟨hOwnedQ2, hCapQ2⟩, -⟩ := hRel.owned hOwnedQ hPQ
    have hStepG := hStep1.transBoth hRel (keep := fun r => regionsDisjoint r (block store p))
      fun _ hr => ⟨trivial, fun _ => by rw [block_eq hCapP1]; exact hr⟩
    have aG := (a0.toWords.reframe hF4).replace (hStepG.mono (fun _ h => h) fun c hc => by
      rw [List.mem_singleton.mp hc, block_eq hCapQ2]
      exact List.mem_append_left _ (List.mem_singleton_self _)) hOwnedQ2
    have hF5 : Frame b s4 { s5 with values := s4.values } := ⟨hp5, hl5, fun j hj =>
      ⟨by show s5.get j = s4.get j; exact hOther5 j (by omega) (by omega),
        by show s5.get _ = s4.get _; exact hOther5 _ (by omega) (by omega)⟩,
      fun j hj => by show s5.get _ = s4.get _; exact hOther5 _ (by omega) (by omega)⟩
    -- The bound: the move's cost and the new block's potential, against `x`'s potential when it
    -- is paid.
    have hQAddr := hOwnedQ.address
    have hQBase := hOwnedQ.base
    have hr' : (r.toNat = 2 * capacityAt store p ∧
          8 * ((el.words (env.get x)).size + e.toNat + 1) ≤ 2 * capacityAt store p) ∨
        (r.toNat = 8 * ((el.words (env.get x)).size + e.toNat + 1) ∧
          2 * capacityAt store p < 8 * ((el.words (env.get x)).size + e.toNat + 1)) := by
      rcases hr with hr | hr | hr
      · exact Or.inl ⟨hr.1, hr.2.1⟩
      · exfalso
        have := hShape.le hr2
        omega
      · exact Or.inr hr
    exact hNext _ _ _ q words (by rw [hSize, hTotal]) hPrefix (aG.reframe hF5)
      (by show s5.get (b + 1) = _; rw [hOther5 _ (by omega) (by omega)]; exact hN4) hQ5 rfl (by
        rw [ite_eq_left ⟨hOwnedX, hDead⟩, hCost]
        show heap1.top.toNat + arrayPot _ q words.size ≤ _
        simp only [arrayPot, hCapQ2, hSize, hTotal]
        cases hp : paidAt paid x.index
        · have := room_move_unpaid (top := heap.top.toNat) (top' := heap1.top.toNat)
            (n := (el.words (env.get x)).size) (t := (el.words (env.get x)).size + e.toNat)
            hRound.1 hRound.2.1 hRound.2.2 hCapacityP hRoomX hr' hShape
          simp only [Bool.false_eq_true, ↓reduceIte, allocCost]; omega
        · have h1 := hPotX hOwnedX hDead hp
          have := room_move_paid (top := heap.top.toNat) (top' := heap1.top.toNat)
            (n := (el.words (env.get x)).size) (t := (el.words (env.get x)).size + e.toNat)
            hRound.1 hRound.2.1 hRound.2.2 hCapacityP hRoomX hr' hShape
          simp only [↓reduceIte, allocCost]; simp only [arrayPot] at h1; omega)

/-- `x.push v`: the value's words from local `base` on, the array taken with room for one more
element by `Var.roomCode` from local `base + k + 1` on, and the writes of the element's words
after the array's words. -/
theorem spec_push (hm : Runtime m) {Γ' : List Ty} {e : Elem} (x : Var Γ' (.array e))
    {v : Expr S Γ' (.elem e)}
    (vSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv v env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.push x v) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hv := Nat.le_max_left v.width (e.width + 7)
  have h8 := Nat.le_max_right v.width (e.width + 7)
  have hk := e.width_pos
  simp only [Expr.placeArgs] at hPlace
  have hT : (Expr.push x v).allocs funs flags bounds (slots.map Slot.mode) paid live env =
      v.allocs funs flags bounds (slots.map Slot.mode) paid (fun j => live j || j == x.index) env +
        x.roomCost (slots.map Slot.mode) paid live (env.get x) (wordCount e.width).toNat := rfl
  have hdS : (Expr.push x v).fits funs fits env = true → v.fits funs fits env = true :=
    fun hd => by simpa [Expr.fits] using hd
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc, List.cons_append, List.nil_append]
  -- The value's words, from local `base` on.
  have hIn : ∀ k, ((live k || k == x.index) || v.uses k) = true →
      (live k || (Expr.push x v).uses k) = true := fun k h => by
    simp only [Expr.uses]; exact live_assoc _ _ _ h
  -- The variables that die in the value, and the array when it dies.
  have hDiv : dyingPot store s env slots paid (fun k => live k || (Expr.push x v).uses k) live =
      dyingPot store s env slots paid (fun k => (live k || k == x.index) || v.uses k)
        (fun k => live k || k == x.index) +
      dyingPot store s env slots paid (fun k => live k || k == x.index) live := by
    rw [dyingPot_congr (L0 := fun k => live k || (Expr.push x v).uses k)
        (L0' := fun k => (live k || k == x.index) || v.uses k)
        (fun k => by simp only [Expr.uses, Bool.or_assoc]) fun _ => rfl]
    exact dyingPot_split _ _ _ (fun k h => by simp [h]) (fun k h => by simp [h])
  refine vSpec env slots paid _ h base heap store s hh hpv
    (hVars.live_mono hIn) hAt (hSafe.mono hIn) hCap hBase (by omega) hPlace _ _
    (hTrap.part (fun h => by simp only [Bool.not_eq_true'] at h; simp [Expr.fits, h])
      (fun _ => by simp [Expr.aborts])
      fun _ hw => hw.mono (by rw [hT, hDiv]; omega))
    fun heap1 store1 s1 ws1 a1 hTopV => ?_
  replace hTopV : v.fits funs fits env = true →
      heap1.top.toNat ≤ heap.top.toNat + dyingPot store s env slots paid
        (fun k => (live k || k == x.index) || v.uses k) (fun k => live k || k == x.index) +
        v.allocs funs flags bounds (slots.map Slot.mode) paid (fun j => live j || j == x.index) env :=
    fun hd => Nat.le_trans (Nat.le_add_right _ _) (hTopV hd)
  have hR1 := Ty.rep_elem.mp a1.rep
  subst hR1
  have e1a := a1.toEvolves rfl
  have hp1a : s1.params = s.params := e1a.frame.params
  have hh1a : s1.positions = h := e1a.frame.positions.trans hh
  refine wp_storeCode (e.values (v.denote funs env)) h base e.types s1 s.values
    (by rw [e.values_length, e.types_length]) hh1a (by rw [hp1a]; omega)
    (by rw [e.types_length, hh1a]; omega) fun s1' f1 hold1 _ => ?_
  have f1' : Frame base s1 { s1' with values := s.values } := f1.trans Frame.ofValues
  have e1 : Evolves env slots (fun k => (live k || k == x.index) || v.uses k)
      (fun k => live k || k == x.index) base heap store s heap1 store1
      { s1' with values := s.values } :=
    ⟨e1a.step, e1a.frame.trans f1', e1a.holds.agree f1'⟩
  have hp1 : s1'.params = s.params := f1.params.trans hp1a
  have hh1 : s1'.positions = h := f1.positions.trans hh1a
  -- The count of new words, in local `base + k`.
  simp only [wp_constI64_cons]
  have hLowK : ({ s1' with values := s.values } : Locals).params.length ≤ base + e.width := by
    show s1'.params.length ≤ _; rw [hp1]; omega
  have hHighK' : base + e.width < ({ s1' with values := s.values } : Locals).positions := by
    simp only [Locals.positions_values, hh1]; omega
  have hHighK := Locals.lt_total hHighK'
  refine wp_localSet_local hLowK hHighK ?_
  set s2 := setLocal { s1' with values := s.values } (base + e.width) (.i64 (wordCount e.width))
    with hs2
  have hK2 : s2.get (base + e.width) = some (.i64 (wordCount e.width)) :=
    Locals.get_setLocal_same hLowK hHighK
  have hF2 : Frame (base + e.width) { s1' with values := s.values } s2 :=
    Frame.setValues (s := { s1' with values := s.values }) (vs := s.values) hLowK le_rfl hHighK'
  have hold2 : LocalsHold s2 base e.types (e.values (v.denote funs env)) :=
    (LocalsHold.frame (Frame.ofValues.trans hF2) (by rw [e.values_length, e.types_length])
      (by rw [e.types_length])).mpr hold1
  have e2 : Evolves env slots (fun k => (live k || k == x.index) || v.uses k)
      (fun k => live k || k == x.index) base heap store s heap1 store1 s2 :=
    ⟨e1.step, e1.frame.trans (hF2.mono (by omega)), e1.holds.agree (hF2.mono (by omega))⟩
  have hp2 : s2.params = s.params := e2.frame.params
  have hh2 : s2.positions = h := e2.frame.positions.trans hh
  have hDx : dyingPot store1 s2 env slots paid (fun k => live k || k == x.index) live =
      dyingPot store s env slots paid (fun k => live k || k == x.index) live :=
    dyingPot_evolves (hVars.live_mono hIn) e2 (fun k h => by simp [h]) _ _ fun _ h => h
  -- The array, with room for one more element, from local `base + k + 1` on.
  refine spec_room hm x (paid := paid) (b := base + e.width + 1) (ext := base + e.width)
      (e := wordCount e.width)
    (s := s2) (e2.holds.mono (by omega))
    e2.step.at_ (by rw [e2.step.cap m]; exact hCap) (by rw [hp2]; omega)
    (by rw [hh2]; omega) hK2 (by omega) (by rw [wordCount_toNat]; omega)
    (hTrap.alloc (by simp [Expr.aborts]) fun hd hw => hw.of_le
      (by have := hTopV (hdS (fits_of_not hd)); rw [hDx]; rw [hT, hDiv] at hw; omega)
      (e2.step.cap m))
    fun heap2 store2 s3 q words hSize hPrefix aR hN3 hQ3 hv3 hTopR => ?_
  obtain ⟨p, hp, hOwnedQ⟩ := aR.rep
  replace hOwnedQ : heap2.Owned store2 p words := hOwnedQ
  obtain rfl : p = q := by simp only [List.cons.injEq, Value.i64.injEq] at hp; exact hp.1.symm
  have hFitQ := hOwnedQ.values.1
  have hkw : (wordCount e.width).toNat = e.width := by
    rw [wordCount_toNat] at hSize ⊢; omega
  rw [hkw, Elem.words_size] at hSize
  have hL64 : (UInt64.ofNat (e.words (env.get x)).size).toNat = (env.get x).size * e.width := by
    rw [Elem.words_size]
    exact UInt64.toNat_ofNat_of_lt'
      (by rw [show UInt64.size = 18446744073709551616 from rfl]; omega)
  have hold3 : LocalsHold s3 base e.types
      (List.zipWith typedValue e.types (e.toWords (v.denote funs env))) := by
    rw [e.values_typed]
    exact (LocalsHold.frame (aR.frame.mono (base := base + e.width) (by omega))
      (by rw [e.values_length, e.types_length]) (by rw [e.types_length])).mpr hold2
  -- The writes of the element's words after the array's words.
  refine wp_storeWordsCode 0 base e.types (e.toWords (v.denote funs env)) words store2 s3 aR
    (aR.frame.positions.trans hh2) hQ3 hN3 hold3 (by rw [e.toWords_length, e.types_length]) (e.typed_words _)
    (by rw [hL64, e.types_length, hSize]; omega) fun store4 a4 hCap4 => ?_
  rw [hL64] at a4
  simp only [Nat.add_zero] at a4
  rw [Elem.words_push_into e (v.denote funs env) hSize (fun w hw => by
    rw [getElem!_pos (e.words (env.get x)) w (by rw [Elem.words_size]; exact hw)]
    exact hPrefix w (by rw [Elem.words_size]; exact hw))] at a4
  have aFin := After.prepend (hVars.live_mono hIn) e2 ((After.ofWords a4).lower e2.holds (by omega)
    fun k h => by simp [h]) (fun k h => by simp [h]) fun k h => by simp [h]
  simp only [wp_localGet_cons, hQ3]
  have hBound : (Expr.push x v).fits funs fits env = true →
      heap2.top.toNat + (if (Expr.push x v).paid flags (slots.map Slot.mode) paid live then
          (Ty.array e).pot store4 [.i64 p] ((Expr.push x v).denote funs env) else 0) ≤
        heap.top.toNat + dyingPot store s env slots paid (fun i => live i || (Expr.push x v).uses i)
          live + (Expr.push x v).allocs funs flags bounds (slots.map Slot.mode) paid live env := by
    intro hd
    have hV := hTopV (hdS hd)
    rw [hDx] at hTopR
    have hWords : (e.words ((env.get x).push (v.denote funs env))).size = words.size := by
      rw [Elem.words_size, Array.size_push, hSize, Nat.succ_mul]
    have hPot : (Ty.array e).pot store4 [.i64 p] ((Expr.push x v).denote funs env) =
        arrayPot store2 p words.size := by
      show arrayPot store4 p (e.words ((env.get x).push (v.denote funs env))).size = _
      rw [hWords]; unfold arrayPot; rw [hCap4]
    rw [hT, hDiv]
    show heap2.top.toNat + (if (modeAt (slots.map Slot.mode) x.index == .owned &&
        !live x.index) = true then _ else 0) ≤ _
    rw [hPot]
    by_cases hc : (slots.getD x.index default).mode = .owned ∧ live x.index = false
    · rw [ite_eq_left hc] at hTopR
      rw [ite_eq_left
          (by simp only [modeAt, Slot.modes_getD, hc.1, hc.2, beq_self_eq_true, Bool.not_false,
        Bool.and_self])]
      omega
    · rw [ite_eq_right hc] at hTopR
      rw [ite_eq_right (by
        simp only [modeAt, Slot.modes_getD, Bool.and_eq_true, beq_iff_eq, Bool.not_eq_true']
        exact hc)]
      omega
  simpa [hv3, hs2, setLocal] using hNext heap2 store4 s3 [.i64 p] (aFin.liveIn hIn) hBound

/-- `x ++ y`: the length of `y` in local `base`, the array `x` taken with room for `y`'s elements
by `Var.roomCode` from local `base + 1` on, with `y` live, the copy of `y`'s elements after `x`'s,
and the release of `y` when it is owned and dies there. -/
theorem spec_append (hm : Runtime m) {Γ' : List Ty} {e : Elem} (x y : Var Γ' (.array e)) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.append (S := S) x y) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom _
      rest Q hTrap hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hT : (Expr.append (S := S) x y).allocs funs flags bounds (slots.map Slot.mode) paid live env =
      x.roomCost (slots.map Slot.mode) paid (fun k => live k || k == y.index) (env.get x)
        ((env.get y).size * e.width) := rfl
  have hTot : 2 * s.positions ≤ s.params.length + s.locals.length := by
    simp only [Locals.positions]; omega
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc, List.cons_append, List.nil_append]
  -- The length of `y`, in local `base`.
  obtain ⟨hBelowY, wy, holdy, hRepY⟩ := hVars.get y (by simp [Expr.uses])
  obtain ⟨py, rfl, hArrY⟩ := hRepY
  have hYB : (slots.getD y.index default).loc < base := by
    have := hBelowY; simp only [Ty.width] at this; omega
  have hBY := hArrY.borrow
  have hAY := hBY.values
  have hLenY := hAY.lengthBound
  have hFitY := hAY.1
  have hmY : (e.words (env.get y)).size < 536870912 := by omega
  have hMY : (UInt64.ofNat (e.words (env.get y)).size).toNat = (e.words (env.get y)).size :=
    UInt64.toNat_ofNat_of_lt' (by rw [show UInt64.size = 18446744073709551616 from rfl]; omega)
  have hExt : (UInt64.ofNat (e.words (env.get y)).size).toNat = (env.get y).size * e.width := by
    rw [hMY, Elem.words_size]
  have hPY : s.get (slots.getD y.index default).loc = some (.i64 py) := by
    exact LocalsHold.word holdy
  simp only [wp_localGet_cons, hPY, wp_wrapI64_cons, wp_load64_cons, wrap_toUInt32,
    UInt32.toNat_zero, Nat.add_zero, UInt32.add_zero]
  rw [ite_eq_right (by omega), hAY.lengthRead]
  refine wp_localSet_local hBase (by omega) ?_
  have hLow0 : ({ s with values := s.values } : Locals).params.length ≤ base := hBase
  set s1 := setLocal { s with values := s.values } base
    (.i64 (UInt64.ofNat (e.words (env.get y)).size))
    with hs1
  have hM1 : s1.get base = some (.i64 (UInt64.ofNat (e.words (env.get y)).size)) :=
    Locals.get_setLocal_same hLow0 (by omega)
  have hF1 : Frame base s s1 := by
    rw [hs1]; exact Frame.setValues hLow0 le_rfl (by rw [hh]; omega)
  have hh1' : s1.positions = s.positions := hF1.positions
  -- The array `x` with room, from local `base + 1` on, with `y` live.
  have hIn : ∀ k, ((live k || k == y.index) || k == x.index) = true →
      (live k || (Expr.append (S := S) x y).uses k) = true := fun k h => by
    simp only [Expr.uses]; exact append_live _ _ _ h
  have hVars1 : Holds env slots (fun k => (live k || k == y.index) || k == x.index) (base + 1)
      heap store s1 :=
    ((hVars.live_mono hIn).agree hF1).mono (by omega)
  have e0 : Evolves env slots (fun i => live i || (Expr.append (S := S) x y).uses i)
      (fun k => (live k || k == y.index) || k == x.index) base heap store s heap store s1 :=
    ⟨Step.refl hAt _, hF1, (hVars.live_mono hIn).agree hF1⟩
  -- The potential of `x` when it is paid and dies, which `spec_room` counts.
  have hDx : dyingPot store s1 env slots paid (fun k => (live k || k == y.index) || k == x.index)
        (fun k => live k || k == y.index) ≤
      dyingPot store s env slots paid (fun i => live i || (Expr.append (S := S) x y).uses i)
        live := by
    rw [dyingPot_evolves hVars e0 hIn _ _ fun _ h => h]
    exact dyingPot_mono (fun k h => hIn k h) fun k h => by simp [h]
  refine spec_room hm x (paid := paid) (b := base + 1) (ext := base)
      (e := UInt64.ofNat (e.words (env.get y)).size)
    (s := s1) hVars1 hAt hCap (by show s.params.length ≤ base + 1; omega)
    (by rw [hh1', hh]; omega)
    hM1 (by omega) (by rw [hMY]; exact Nat.le_of_lt hmY)
    (hTrap.alloc (by simp [Expr.aborts]) fun _ hw => hw.mono (by have := hDx; rw [hT, hExt]; omega))
    fun heap1 store1 s2 q words hSize hPrefix aR hN2 hQ2 hv2 hTopR => ?_
  rw [hMY] at hSize
  have hp2 : s2.params = s.params := aR.frame.params
  have hl2 : s2.locals.length = s.locals.length := by rw [aR.frame.length]; simp [s1, setLocal]
  have hM2 : s2.get base = some (.i64 (UInt64.ofNat (e.words (env.get y)).size)) :=
    (aR.frame.below base (by omega)).1.trans hM1
  have hh2' : s2.positions = s.positions := aR.frame.positions.trans hh1'
  -- `y` stays readable, apart from the new array.
  obtain ⟨-, wy', holdy', hRepY'⟩ := aR.holds.get y (by simp)
  have hAgree2 : ∀ j < base, s2.get j = s.get j := fun j hj =>
    (aR.frame.below j (by omega)).1.trans (hF1.below j hj).1
  have holdy2 : LocalsHold s2 (slots.getD y.index default).loc (Ty.array e).types [.i64 py] :=
    (LocalsHold.frame (hF1.trans (aR.frame.mono (base := base) (by omega))) rfl
      (by simp only [Ty.types, List.length_singleton]; omega)).mpr holdy
  obtain rfl := LocalsHold.unique holdy' holdy2 (by rw [hRepY'.length]; rfl)
  obtain ⟨py', hpy, hArrY1⟩ := hRepY'
  obtain rfl : py = py' := by simp only [List.cons.injEq, Value.i64.injEq] at hpy; exact hpy.1
  have hBY1 := hArrY1.borrow
  obtain ⟨p, hp, hOwnedQ⟩ := aR.rep
  replace hOwnedQ : heap1.Owned store1 p words := hOwnedQ
  obtain rfl : p = q := by simp only [List.cons.injEq, Value.i64.injEq] at hp; exact hp.1.symm
  have hCapQ := hOwnedQ.capacity
  have hBaseQ := hOwnedQ.base
  have hApartQY : py.toNat + 8 * ((e.words (env.get y)).size + 1) ≤ p.toNat ∨
      p.toNat + 8 * (words.size + 1) ≤ py.toNat := by
    have hD := aR.apart _ y (by simp) (Or.inl rfl) [.i64 py] holdy2 rfl (block store1 p)
      (List.mem_singleton_self _)
    cases hmy : (slots.getD y.index default).mode
    · rw [hmy] at hD
      have := hD _ (List.mem_singleton_self _)
      simp only [block, regionsDisjoint] at this
      omega
    · rw [hmy] at hD hArrY1
      have hOwnedY : heap1.Owned store1 py (e.words (env.get y)) := hArrY1
      have := hD (block store1 py) (List.mem_singleton_self _)
      have := hOwnedY.capacity
      have := hOwnedY.base
      simp only [block, regionsDisjoint] at *
      omega
  -- The address of element `n` of the new array, in local `base + 4`.
  have h8n : UInt64.ofNat (e.words (env.get x)).size * 8 =
      UInt64.ofNat (8 * (e.words (env.get x)).size) := by
    apply UInt64.toNat_inj.mp
    simp only [UInt64.toNat_mul, UInt64.toNat_ofNat', UInt64.reduceToNat]
    omega
  simp only [wp_localGet_cons, Locals.get_values, hQ2, hN2, wp_constI64_cons, wp_mulI64_cons,
    wp_addI64_cons, h8n]
  have hLow2 : ({ s2 with values := s2.values } : Locals).params.length ≤ base + 4 := by
    show s2.params.length ≤ base + 4; rw [hp2]; omega
  have hHigh2 : base + 4 < ({ s2 with values := s2.values } : Locals).params.length +
      ({ s2 with values := s2.values } : Locals).locals.length := by
    show base + 4 < s2.params.length + s2.locals.length; rw [hp2, hl2]; omega
  refine wp_localSet_local hLow2 hHigh2 ?_
  set s3 := setLocal { s2 with values := s2.values } (base + 4)
    (.i64 (p + UInt64.ofNat (8 * (e.words (env.get x)).size))) with hs3
  have hD3 : s3.get (base + 4) = some (.i64 (p + UInt64.ofNat (8 * (e.words (env.get x)).size))) :=
    Locals.get_setLocal_same hLow2 hHigh2
  have hGet3 : ∀ j, j ≠ base + 4 → s3.get j = s2.get j := fun j hj => by
    rw [hs3, Locals.get_setLocal_ne hLow2 hj, Locals.get_values]
  have hp3 : s3.params = s.params := hp2
  have hl3 : s3.locals.length = s.locals.length := by simp [s3, setLocal, hl2]
  -- The copy of `y`'s elements after `x`'s.
  refine wp_copyInto (k := (e.words (env.get x)).size) hBY1.values hOwnedQ.values (by omega)
    hApartQY
    (by rw [hGet3 _ (by omega), hAgree2 _ hYB]; exact hPY) hD3
    (by rw [hGet3 _ (by omega)]; exact hM2) (by omega) (by omega)
    (by omega) (by rw [hp3]; omega) (by rw [hp3, hl3]; omega)
    fun store2 s4 hW hA2 hp4 hl4 hOther4 hv4 => ?_
  have hWords : overlay words (e.words (env.get y)) (e.words (env.get x)).size
      (e.words (env.get y)).size = e.words (env.get x ++ env.get y) := by
    rw [Elem.words_append]
    apply Array.ext (by simp [overlay_size, hSize]) fun j h1 h2 => ?_
    simp only [overlay, Array.getElem_ofFn]
    rw [overlay_size] at h1
    by_cases hj : j < (e.words (env.get x)).size
    · rw [ite_eq_right (by omega), Array.getElem_append_left hj, ← hPrefix j hj,
        getElem!_pos words j h1]
    · rw [ite_eq_left (by omega), Array.getElem_append_right (by omega),
        getElem!_pos _ _ (by omega)]
  rw [hWords] at hA2
  have hWithin : WritesWithin store1 store2 p.toNat (capacityAt store1 p) :=
    ⟨by rw [hW.1], hW.2.1, fun a ha => hW.2.2 a (by omega)⟩
  have aW := aR.rewrite hWithin (by rw [hW.1]) hA2
    (by rw [Elem.words_append, Array.size_append]; omega)
  have hCap2 : capacityAt store2 p = capacityAt store1 p :=
    (hOwnedQ.rewrite hWithin hA2 (by rw [Elem.words_append, Array.size_append]; omega)).2
  have hF4 : Frame (base + 1) s2 s4 := ⟨hp4.trans rfl, by rw [hl4]; simp [s3, setLocal],
    fun j hj => ⟨by rw [hOther4 j (by omega), hGet3 j (by omega)],
      by rw [hOther4 _ (by omega), hGet3 _ (by omega)]⟩,
    fun j hj => by rw [hOther4 _ (by omega), hGet3 _ (by omega)]⟩
  -- The release of `y` when it is owned and dies here.
  refine After.release hm (s1 := s4) (live := live)
    (sel := fun k => k == y.index && !live k) hVars1 (After.ofWords (aW.reframe hF4))
    (fun k h => by simp [h]) (fun k h => by
      simp only [Bool.and_eq_true, beq_iff_eq] at h; simp [h.1])
    (fun k h => by simp [h]) fun heap2 store3 a' hTop2 hRegions => ?_
  have hQ4 : s4.get (base + 5) = some (.i64 p) := by
    rw [hOther4 _ (by omega), hGet3 _ (by omega)]; exact hQ2
  simp only [wp_localGet_cons, hQ4]
  have aFin := After.prepend hVars e0 (a'.lower ((hVars.live_mono hIn).agree
    hF1) (by omega) fun k h => by simp [h]) hIn fun k h => by simp [h]
  have hv3 : s3.values = s.values := by rw [hs3]; exact hv2
  have hBound : (Expr.append (S := S) x y).fits funs fits env = true →
      heap2.top.toNat + (if (Expr.append (S := S) x y).paid flags (slots.map Slot.mode) paid live then
          (Ty.array e).pot store3 [.i64 p] ((Expr.append (S := S) x y).denote funs env) else 0) ≤
        heap.top.toNat + dyingPot store s env slots paid
          (fun i => live i || (Expr.append (S := S) x y).uses i) live +
          (Expr.append (S := S) x y).allocs funs flags bounds (slots.map Slot.mode) paid live env := by
    intro _
    have hPot : (Ty.array e).pot store3 [.i64 p] ((Expr.append (S := S) x y).denote funs env) =
        arrayPot store1 p words.size := by
      show (Ty.array e).pot store3 [.i64 p] (env.get x ++ env.get y) = _
      rw [Ty.pot_of_blocks _ _ _ hRegions]
      show arrayPot store2 p (e.words (env.get x ++ env.get y)).size = _
      rw [Elem.words_append, Array.size_append, ← hSize]; unfold arrayPot; rw [hCap2]
    rw [hTop2, hT, ← hExt, hPot]
    show heap1.top.toNat + (if (modeAt (slots.map Slot.mode) x.index == .owned &&
        !(live x.index || x.index == y.index)) = true then _ else 0) ≤ _
    by_cases hc : (slots.getD x.index default).mode = .owned ∧
        (live x.index || x.index == y.index) = false
    · rw [ite_eq_left hc] at hTopR
      rw [ite_eq_left
          (by simp only [modeAt, Slot.modes_getD, hc.1, hc.2, beq_self_eq_true, Bool.not_false,
        Bool.and_self])]
      omega
    · rw [ite_eq_right hc] at hTopR
      rw [ite_eq_right (by
        simp only [modeAt, Slot.modes_getD, Bool.and_eq_true, beq_iff_eq, Bool.not_eq_true']
        exact hc)]
      omega
  simpa [hv4, hv3] using hNext heap2 store3 s4 [.i64 p] aFin hBound

/-- `LeanExe.eraseAt x i`: the position in local `base`, the array as owned in local `base + 1`,
its length in local `base + 2`, and, when the position is below the size, the element's first
word in local `base + 3`, the move of the words after the element down by its word count, and the
write of the shorter length. -/
theorem spec_eraseAt (hm : Runtime m) {Γ' : List Ty} {e : Elem} (x : Var Γ' (.array e))
    {i : Expr S Γ' .word}
    (iSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv i env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.eraseAt x i) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hi := Nat.le_max_left i.width 8
  have hx := Nat.le_max_right i.width 8
  have hk := e.width_pos
  have hcw : copyWidth (Ty.array e) = 4 := rfl
  simp only [Expr.placeArgs] at hPlace
  have hT : (Expr.eraseAt x i).allocs funs flags bounds (slots.map Slot.mode) paid live env =
      i.allocs funs flags bounds (slots.map Slot.mode) paid (fun j => live j || j == x.index) env +
        x.ownedCost (slots.map Slot.mode) live (env.get x) := rfl
  have hdS : (Expr.eraseAt x i).fits funs fits env = true → i.fits funs fits env = true :=
    fun hd => by simpa [Expr.fits] using hd
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc, List.cons_append, List.nil_append]
  -- The position, in local `base`.
  have hIn : ∀ k, ((live k || k == x.index) || i.uses k) = true →
      (live k || (Expr.eraseAt x i).uses k) = true := fun k h => by
    simp only [Expr.uses]; exact live_assoc _ _ _ h
  have hDi : dyingPot store s env slots paid (fun k => (live k || k == x.index) || i.uses k)
        (fun k => live k || k == x.index) ≤
      dyingPot store s env slots paid (fun k => live k || (Expr.eraseAt x i).uses k) live :=
    dyingPot_mono hIn fun k h => by simp [h]
  refine iSpec env slots paid _ h base heap store s hh hpv
    (hVars.live_mono hIn) hAt (hSafe.mono hIn) hCap hBase (by omega) hPlace _ _
    (hTrap.part (fun h => by simp only [Bool.not_eq_true'] at h; simp [Expr.fits, h])
      (fun _ => by simp [Expr.aborts])
      fun _ hw => hw.mono (by rw [hT]; omega))
    fun heap1 store1 s1 ws1 a1 hTopI => ?_
  have hR1 := a1.rep
  simp only [Ty.rep_word] at hR1
  subst hR1
  refine After.storeWord a1 le_rfl hBase (by rw [hh]; omega) fun e1 hI1 => ?_
  have hp1 := e1.frame.params
  have hh1 := e1.frame.positions.trans hh
  -- The array as owned, in local `base + 1`.
  refine spec_ownedVar hm x hh1 (hp1.trans hpv) (e1.holds.mono (Nat.le_succ base)) e1.step.at_
    ((hSafe.mono hIn).evolves (hVars.live_mono hIn) e1 (fun k hk => by simp [hk]))
    (by rw [e1.step.cap m]; exact hCap) (by rw [hp1]; omega) (by omega)
    (hTrap.alloc (by simp [Expr.aborts]) fun hd hw => hw.of_le
      (by have := hTopI (hdS (fits_of_not hd)); rw [hT]; omega) (e1.step.cap m))
    fun heap3 store3 s3 ws3 a3 hTopO => ?_
  obtain ⟨p, hws, hOwned⟩ := a3.rep
  subst hws
  have hp3 : s3.params = s.params := a3.frame.params.trans hp1
  have hh3 : s3.positions = h := a3.frame.positions.trans hh1
  simp only [List.reverse_cons, List.reverse_nil, List.nil_append, List.cons_append]
  have hLow3 : ({ s3 with values := s.values } : Locals).params.length ≤ base + 1 := by
    show s3.params.length ≤ _; rw [hp3]; omega
  have hHigh3' : base + 1 < s3.positions := by rw [hh3]; omega
  have hHigh3 := Locals.lt_total (s := { s3 with values := s.values }) hHigh3'
  refine wp_localSet_local hLow3 hHigh3 ?_
  set s4 : Locals := setLocal { s3 with values := s.values } (base + 1) (.i64 p) with hs4
  have hP4 : s4.get (base + 1) = some (.i64 p) := Locals.get_setLocal_same hLow3 hHigh3
  have hF4 : Frame (base + 1) s3 s4 := Frame.setValues hLow3 le_rfl hHigh3'
  have hI4 : s4.get base = some (.i64 (i.denote funs env)) :=
    (hF4.below base (by omega)).1.trans ((a3.frame.below base (by omega)).1.trans hI1)
  have hh4 : s4.positions = h := hF4.positions.trans hh3
  have hp4 : s4.params = s.params := hF4.params.trans hp3
  have a4 := a3.toWords.reframe hF4
  -- The rest of the code, from the array after the move or without it.
  have hFinish : ∀ (store4 : Store Unit) (s' : Locals) (ws : Array UInt64),
      Frame (base + 1) s4 s' → s'.values = s.values →
      ws = e.words (LeanExe.eraseAt (env.get x) (i.denote funs env)) →
      After env slots (fun k => live k || k == x.index) live (base + 1) heap1 store1
        (setLocal { s1 with values := s.values } base (.i64 (i.denote funs env)))
        (.array .word) .owned ws heap3 store4 s' [.i64 p] →
      wp m rest Q store4 { s' with values := .i64 p :: s'.values } host := by
    rintro store4 s' ws _ hv' rfl aX
    have aX1 := (After.ofWords aX).lower e1.holds (Nat.le_succ base) fun k h => by simp [h]
    have aX2 := After.prepend (hVars.live_mono hIn) e1 aX1 (fun k h => by simp [h])
      fun k h => by simp [h]
    simpa [hv'] using hNext heap3 store4 _ [.i64 p] (aX2.liveIn hIn) fun hd => top_unpaid rfl (by
      have := hTopI (hdS hd); rw [hT]; omega)
  have hA := hOwned.values
  have hLength := hA.lengthBound
  have hnk : (env.get x).size * e.width < 536870912 := by
    have := hA.1; rw [Elem.words_size] at this; omega
  have hn64 : (env.get x).size < UInt64.size := by
    have := Nat.le_mul_of_pos_right (env.get x).size hk
    rw [show UInt64.size = 18446744073709551616 from rfl]; omega
  -- The length, in local `base + 2`.
  show wp m _ Q store3 s4 host
  simp only [wp_localGet_cons, hP4, wp_wrapI64_cons, wp_load64_cons, wrap_toUInt32,
    UInt32.toNat_zero, Nat.add_zero, UInt32.add_zero]
  rw [ite_eq_right (by omega), hA.lengthRead, Elem.words_size]
  have hLow5 : ({ s4 with values := s4.values } : Locals).params.length ≤ base + 2 := by
    show s4.params.length ≤ _; rw [hp4]; omega
  have hHigh5' : base + 2 < s4.positions := by rw [hh4]; omega
  have hHigh5 := Locals.lt_total (s := { s4 with values := s4.values }) hHigh5'
  refine wp_localSet_local hLow5 hHigh5 ?_
  set L := (env.get x).size * e.width with hLdef
  set s5 : Locals := setLocal { s4 with values := s4.values } (base + 2) (.i64 (UInt64.ofNat L))
    with hs5
  have hF5 : Frame (base + 2) s4 s5 := Frame.setValues hLow5 le_rfl hHigh5'
  have hL5 : s5.get (base + 2) = some (.i64 (UInt64.ofNat L)) :=
    Locals.get_setLocal_same hLow5 hHigh5
  have hI5 : s5.get base = some (.i64 (i.denote funs env)) :=
    (hF5.below base (by omega)).1.trans hI4
  have hP5 : s5.get (base + 1) = some (.i64 p) := (hF5.below _ (by omega)).1.trans hP4
  have hh5 : s5.positions = h := hF5.positions.trans hh4
  have hp5 : s5.params = s.params := hF5.params.trans hp4
  -- The test of the position.
  simp only [wp_localGet_cons, Locals.get_values, hI5, hL5]
  rw [wp_divCode hk, words_div hk hnk]
  simp only [wp_ltUI64_cons]
  rw [wp_iff_control_types]
  refine wp_iff_cons rfl ?_
  have hLess : i.denote funs env < UInt64.ofNat (env.get x).size ↔
      (i.denote funs env).toNat < (env.get x).size := by
    rw [UInt64.lt_iff_toNat_lt, UInt64.toNat_ofNat_of_lt' hn64]
  by_cases hc : (i.denote funs env).toNat < (env.get x).size
  · rw [ite_eq_left (by simp [hLess.mpr hc])]
    set I := (i.denote funs env).toNat with hIdef
    set W := I * e.width with hWdef
    have hk29 : e.width < 536870912 := by
      have := Nat.le_mul_of_pos_left e.width (show 0 < (env.get x).size by omega); omega
    have hIk : W + e.width ≤ L := by
      have := Nat.mul_le_mul_right e.width (Nat.succ_le_of_lt hc)
      rw [Nat.succ_mul] at this; omega
    have hwc := wordCount_eq hk29
    -- The element's first word, in local `base + 3`.
    simp only [wp_localGet_cons, Locals.get_values, hI5]
    have hs := words_scale hk (show I * e.width < 536870912 by omega)
    rw [UInt64.ofNat_toNat] at hs
    rw [wp_scaleCode, hs]
    have hLow6 : ({ s5 with values := s5.values } : Locals).params.length ≤ base + 3 := by
      show s5.params.length ≤ _; rw [hp5]; omega
    have hHigh6' : base + 3 < s5.positions := by rw [hh5]; omega
    have hHigh6 := Locals.lt_total (s := { s5 with values := s5.values }) hHigh6'
    refine wp_localSet_local hLow6 hHigh6 ?_
    set s6 : Locals := setLocal { s5 with values := s5.values } (base + 3) (.i64 (UInt64.ofNat W))
      with hs6
    have hF6 : Frame (base + 3) s5 s6 := Frame.setValues hLow6 le_rfl hHigh6'
    have hW6 : s6.get (base + 3) = some (.i64 (UInt64.ofNat W)) :=
      Locals.get_setLocal_same hLow6 hHigh6
    have hL6 : s6.get (base + 2) = some (.i64 (UInt64.ofNat L)) :=
      (hF6.below _ (by omega)).1.trans hL5
    have hP6 : s6.get (base + 1) = some (.i64 p) := (hF6.below _ (by omega)).1.trans hP5
    have hh6 : s6.positions = h := hF6.positions.trans hh5
    have hp6 : s6.params = s.params := hF6.params.trans hp5
    -- The count of words to move, in local `base + 4`.
    simp only [wp_localGet_cons, Locals.get_values, hL6, hW6, wp_subI64_cons, wp_constI64_cons]
    have hCount : UInt64.ofNat L - UInt64.ofNat W - wordCount e.width =
        UInt64.ofNat (L - W - e.width) := by
      rw [hwc]
      apply UInt64.toNat_inj.mp
      simp only [UInt64.toNat_sub, UInt64.toNat_ofNat']
      omega
    rw [hCount]
    have hLow7 : ({ s6 with values := s6.values } : Locals).params.length ≤ base + 4 := by
      show s6.params.length ≤ _; rw [hp6]; omega
    have hHigh7' : base + 4 < s6.positions := by rw [hh6]; omega
    have hHigh7 := Locals.lt_total (s := { s6 with values := s6.values }) hHigh7'
    refine wp_localSet_local hLow7 hHigh7 ?_
    set s7 : Locals := setLocal { s6 with values := s6.values } (base + 4)
      (.i64 (UInt64.ofNat (L - W - e.width))) with hs7
    have hF7 : Frame (base + 4) s6 s7 := Frame.setValues hLow7 le_rfl hHigh7'
    have hN7 : s7.get (base + 4) = some (.i64 (UInt64.ofNat (L - W - e.width))) :=
      Locals.get_setLocal_same hLow7 hHigh7
    have hW7 : s7.get (base + 3) = some (.i64 (UInt64.ofNat W)) :=
      (hF7.below _ (by omega)).1.trans hW6
    have hL7 : s7.get (base + 2) = some (.i64 (UInt64.ofNat L)) :=
      (hF7.below _ (by omega)).1.trans hL6
    have hP7 : s7.get (base + 1) = some (.i64 p) := (hF7.below _ (by omega)).1.trans hP6
    have hh7 : s7.positions = h := hF7.positions.trans hh6
    have hp7 : s7.params = s.params := hF7.params.trans hp6
    -- The source address, in local `base + 5`.
    simp only [wp_localGet_cons, Locals.get_values, hP7, hW7, wp_constI64_cons, wp_addI64_cons,
      wp_mulI64_cons]
    have hSrc : p + (UInt64.ofNat W + wordCount e.width) * 8 =
        p + UInt64.ofNat (8 * (W + e.width)) := by
      rw [hwc]; congr 1
      apply UInt64.toNat_inj.mp
      simp only [UInt64.toNat_mul, UInt64.toNat_add, UInt64.toNat_ofNat', UInt64.reduceToNat]
      omega
    rw [hSrc]
    have hLow8 : ({ s7 with values := s7.values } : Locals).params.length ≤ base + 5 := by
      show s7.params.length ≤ _; rw [hp7]; omega
    have hHigh8' : base + 5 < s7.positions := by rw [hh7]; omega
    have hHigh8 := Locals.lt_total (s := { s7 with values := s7.values }) hHigh8'
    refine wp_localSet_local hLow8 hHigh8 ?_
    set s8 : Locals := setLocal { s7 with values := s7.values } (base + 5)
      (.i64 (p + UInt64.ofNat (8 * (W + e.width)))) with hs8
    have hF8 : Frame (base + 5) s7 s8 := Frame.setValues hLow8 le_rfl hHigh8'
    have hS8 : s8.get (base + 5) = some (.i64 (p + UInt64.ofNat (8 * (W + e.width)))) :=
      Locals.get_setLocal_same hLow8 hHigh8
    have hN8 : s8.get (base + 4) = some (.i64 (UInt64.ofNat (L - W - e.width))) :=
      (hF8.below _ (by omega)).1.trans hN7
    have hW8 : s8.get (base + 3) = some (.i64 (UInt64.ofNat W)) :=
      (hF8.below _ (by omega)).1.trans hW7
    have hL8 : s8.get (base + 2) = some (.i64 (UInt64.ofNat L)) :=
      (hF8.below _ (by omega)).1.trans hL7
    have hP8 : s8.get (base + 1) = some (.i64 p) := (hF8.below _ (by omega)).1.trans hP7
    have hh8 : s8.positions = h := hF8.positions.trans hh7
    have hp8 : s8.params = s.params := hF8.params.trans hp7
    -- The destination address, in local `base + 6`.
    simp only [wp_localGet_cons, Locals.get_values, hP8, hW8, wp_constI64_cons, wp_addI64_cons,
      wp_mulI64_cons]
    have hDst : p + UInt64.ofNat W * 8 = p + UInt64.ofNat (8 * W) := by
      congr 1
      apply UInt64.toNat_inj.mp
      simp only [UInt64.toNat_mul, UInt64.toNat_ofNat', UInt64.reduceToNat]
      omega
    rw [hDst]
    have hLow9 : ({ s8 with values := s8.values } : Locals).params.length ≤ base + 6 := by
      show s8.params.length ≤ _; rw [hp8]; omega
    have hHigh9' : base + 6 < s8.positions := by rw [hh8]; omega
    have hHigh9 := Locals.lt_total (s := { s8 with values := s8.values }) hHigh9'
    refine wp_localSet_local hLow9 hHigh9 ?_
    set s9 : Locals := setLocal { s8 with values := s8.values } (base + 6)
      (.i64 (p + UInt64.ofNat (8 * W))) with hs9
    have hF9 : Frame (base + 6) s8 s9 := Frame.setValues hLow9 le_rfl hHigh9'
    have hD9 : s9.get (base + 6) = some (.i64 (p + UInt64.ofNat (8 * W))) :=
      Locals.get_setLocal_same hLow9 hHigh9
    have hS9 : s9.get (base + 5) = some (.i64 (p + UInt64.ofNat (8 * (W + e.width)))) :=
      (hF9.below _ (by omega)).1.trans hS8
    have hN9 : s9.get (base + 4) = some (.i64 (UInt64.ofNat (L - W - e.width))) :=
      (hF9.below _ (by omega)).1.trans hN8
    have hL9 : s9.get (base + 2) = some (.i64 (UInt64.ofNat L)) :=
      (hF9.below _ (by omega)).1.trans hL8
    have hP9 : s9.get (base + 1) = some (.i64 p) := (hF9.below _ (by omega)).1.trans hP8
    have hh9 : s9.positions = h := hF9.positions.trans hh8
    have hp9 : s9.params = s.params := hF9.params.trans hp8
    -- The move of the words after the element.
    have hWs : (e.words (env.get x)).size = L := Elem.words_size e _
    refine wp_copyDown (l := W) (n := L - W - e.width) (k := e.width) hA (by omega) hS9 hD9 hN9
      (by omega) (by omega) (by omega) (by rw [hp9]; omega)
      (Locals.lt_total (s := s9) (by rw [hh9]; omega))
      fun store10 s10 hW10 hA10 hp10 hl10 hOther10 hv10 => ?_
    have hP10 : s10.get (base + 1) = some (.i64 p) := by rw [hOther10 _ (by omega)]; exact hP9
    have hL10 : s10.get (base + 2) = some (.i64 (UInt64.ofNat L)) := by
      rw [hOther10 _ (by omega)]; exact hL9
    -- The shorter length.
    simp only [wp_localGet_cons, Locals.get_values, hP10, hL10, wp_wrapI64_cons, wrap_toUInt32,
      wp_constI64_cons, wp_subI64_cons]
    have hLen : UInt64.ofNat L - wordCount e.width = UInt64.ofNat (L - e.width) := by
      rw [hwc]
      apply UInt64.toNat_inj.mp
      simp only [UInt64.toNat_sub, UInt64.toNat_ofNat']
      omega
    rw [hLen]
    have hFit10 := hA10.1
    have hMem10 := hA10.2.1
    have hPtr := hA10.pointerAddress_toNat
    simp only [wp_store64_cons, UInt32.toNat_zero, Nat.add_zero, UInt32.add_zero]
    rw [ite_eq_right (by rw [hPtr]; rw [shiftDown_size] at hFit10 hMem10; omega)]
    rw [wp_nil]
    dsimp only
    simp only [List.take_zero, List.drop_zero, List.nil_append, hP10]
    have hFrame : Frame (base + 1) s4 s10 :=
      (hF5.mono (by omega)).trans ((hF6.mono (by omega)).trans ((hF7.mono (by omega)).trans
        ((hF8.mono (by omega)).trans ((hF9.mono (by omega)).trans
          (Frame.ofOthers hp10 hl10 hOther10 (by omega) (by rw [hh9]; omega))))))
    have hEq : LeanExe.eraseAt (env.get x) (i.denote funs env) = (env.get x).eraseIdx I hc :=
      dite_eq_left hc
    rw [show s5.values = s10.values from hv10.symm]
    refine hFinish _ s10 _ hFrame hv10 (by rw [hEq]; exact Elem.words_eraseIdx e hc)
      ((a4.reframe hFrame).rewriteRange
        (hW10.trans (writeLength_frame store10 p (e.words (env.get x)).size (L - e.width)
          (by rw [shiftDown_size] at hFit10; exact hFit10)))
        (hA10.writeLength (by rw [shiftDown_size]; omega))
        (by simp only [Array.size_extract, shiftDown_size]; omega))
  · rw [ite_eq_right (by simp [hLess, hc])]
    rw [wp_nil]
    dsimp only
    simp only [List.take_zero, List.drop_zero, List.nil_append, wp_localGet_cons, hP5]
    exact hFinish _ s5 (e.words (env.get x)) (hF5.mono (by omega)) rfl
      (by simp [LeanExe.eraseAt, Array.eraseIdxIfInBounds, hc]) (a4.reframe (hF5.mono (by omega)))

/-- `LeanExe.insertAt x i v`: the position in local `base`, the value's words from local `base + 1`
on, their count after them, the array taken with room for one more element by `Var.roomCode` from
local `base + k + 2` on, and then, when the position is at most the size, the element's first word
in local `base + k + 4`, the move of the words from there up by the element's word count, and the
writes of the value's words, or otherwise the old length written back. -/
theorem spec_insertAt (hm : Runtime m) {Γ' : List Ty} {e : Elem} (x : Var Γ' (.array e))
    {i : Expr S Γ' .word} {v : Expr S Γ' (.elem e)}
    (iSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv i env slots paid live)
    (vSpec : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv v env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv (Expr.insertAt x i v) env
        slots paid live := by
  intro env slots paid live h base heap store s hh hpv hVars hAt hSafe hCap hBase hRoom
      hPlace rest Q hTrap
    hNext
  have hWidth := hRoom
  simp only [Expr.width] at hWidth
  have hi := Nat.le_max_left i.width (max (1 + v.width) (e.width + 8))
  have hv := (Nat.le_max_left (1 + v.width) (e.width + 8)).trans (Nat.le_max_right i.width _)
  have hx := (Nat.le_max_right (1 + v.width) (e.width + 8)).trans (Nat.le_max_right i.width _)
  have hk := e.width_pos
  simp only [Expr.placeArgs, Bool.and_eq_true] at hPlace
  have hT : (Expr.insertAt x i v).allocs funs flags bounds (slots.map Slot.mode) paid live env =
      i.allocs funs flags bounds (slots.map Slot.mode) paid
          (fun j => live j || j == x.index || v.uses j) env +
        v.allocs funs flags bounds (slots.map Slot.mode) paid (fun j => live j || j == x.index) env +
        x.roomCost (slots.map Slot.mode) paid live (env.get x) (wordCount e.width).toNat := rfl
  have hdS : (Expr.insertAt x i v).fits funs fits env = true →
      i.fits funs fits env = true ∧ v.fits funs fits env = true :=
    fun hd => by simpa [Expr.fits] using hd
  simp only [Expr.code, Expr.usesFast_eq, List.append_assoc, List.cons_append, List.nil_append]
  -- The position, in local `base`.
  have hIn : ∀ k, ((live k || k == x.index || v.uses k) || i.uses k) = true →
      (live k || (Expr.insertAt x i v).uses k) = true := fun k h => by
    simp only [Expr.uses]; exact set_live_index _ _ _ _ h
  -- The variables that die in the position, in the value, and the array when it dies.
  have hDiv : dyingPot store s env slots paid
        (fun k => (live k || k == x.index || v.uses k) || i.uses k)
        (fun k => live k || k == x.index || v.uses k) +
      dyingPot store s env slots paid (fun k => (live k || k == x.index) || v.uses k)
        (fun k => live k || k == x.index) +
      dyingPot store s env slots paid (fun k => live k || k == x.index) live ≤
      dyingPot store s env slots paid (fun k => live k || (Expr.insertAt x i v).uses k) live := by
    rw [dyingPot_split _ (fun k => live k || k == x.index || v.uses k) live
      (fun k h => hIn k (by simp [h])) (fun k h => by simp [h]),
      dyingPot_split (fun k => live k || k == x.index || v.uses k) (fun k => live k || k == x.index)
        live (fun k h => by simp [h]) (fun k h => by simp [h]),
      dyingPot_congr (L0 := fun k => live k || (Expr.insertAt x i v).uses k)
        (L0' := fun k => (live k || k == x.index || v.uses k) || i.uses k)
        (fun k => by simp only [Expr.uses, Bool.or_comm, Bool.or_left_comm])
        fun _ => rfl]
    omega
  refine iSpec env slots paid _ h base heap store s hh hpv
    (hVars.live_mono hIn) hAt (hSafe.mono hIn) hCap hBase (by omega) hPlace.1 _ _
    (hTrap.part (fun h => by simp only [Bool.not_eq_true'] at h; simp [Expr.fits, h])
      (fun _ => by simp [Expr.aborts])
      fun _ hw => hw.mono (by rw [hT]; omega))
    fun heap1 store1 s1 ws1 a1 hTopI => ?_
  have hR1 := a1.rep
  simp only [Ty.rep_word] at hR1
  subst hR1
  refine After.storeWord a1 le_rfl hBase (by rw [hh]; omega) fun e1 hI1 => ?_
  have hp1 := e1.frame.params
  have hh1 := e1.frame.positions.trans hh
  -- The value's words, from local `base + 1` on.
  have hDv : ∀ s1' : Locals, Evolves env slots (fun k => (live k || k == x.index || v.uses k) ||
        i.uses k) (fun k => live k || k == x.index || v.uses k) base heap store s heap1 store1
        s1' →
      dyingPot store1 s1' env slots paid (fun k => (live k || k == x.index) || v.uses k)
        (fun k => live k || k == x.index) =
      dyingPot store s env slots paid (fun k => (live k || k == x.index) || v.uses k)
        (fun k => live k || k == x.index) := fun _ e =>
    dyingPot_evolves (hVars.live_mono hIn) e (fun k h => by simp [h]) _ _ fun _ h => h
  refine vSpec env slots paid _ h (base + 1) heap1 store1 _ hh1
    (hp1.trans hpv) (e1.holds.mono (Nat.le_succ base)) e1.step.at_
    ((hSafe.mono hIn).evolves (hVars.live_mono hIn) e1 (fun k hk => by simp [hk])) (by rw [e1.step.cap m]; exact
        hCap)
    (by rw [hp1]; omega) (by omega) hPlace.2 _ _
    (hTrap.part (fun h => by simp only [Bool.not_eq_true'] at h; simp [Expr.fits, h])
      (fun _ => by simp [Expr.aborts])
      fun hd hw => by
        have := hTopI (hdS (fits_of_not hd)).1
        rw [hDv _ e1]
        exact hw.shift (c1 := dyingPot store s env slots paid
            (fun k => (live k || k == x.index || v.uses k) || i.uses k)
            (fun k => live k || k == x.index || v.uses k) +
            i.allocs funs flags bounds (slots.map Slot.mode) paid
              (fun j => live j || j == x.index || v.uses j) env)
          (by omega) (by rw [hT]; omega) (e1.step.cap m))
    fun heap2 store2 s2 ws2 a2 hTopV => ?_
  have hR2 := Ty.rep_elem.mp a2.rep
  subst hR2
  have e2a := a2.toEvolves rfl
  have hp2a : s2.params = s.params := e2a.frame.params.trans hp1
  have hh2a : s2.positions = h := e2a.frame.positions.trans hh1
  refine wp_storeCode (e.values (v.denote funs env)) h (base + 1) e.types s2 s.values
    (by rw [e.values_length, e.types_length]) hh2a (by rw [hp2a]; omega)
    (by rw [e.types_length, hh2a]; omega) fun s2' f2 hold2 _ => ?_
  have f2' : Frame (base + 1) s2 { s2' with values := s.values } := f2.trans Frame.ofValues
  have e2 : Evolves env slots (fun k => (live k || k == x.index) || v.uses k)
      (fun k => live k || k == x.index) (base + 1) heap1 store1 _ heap2 store2
      { s2' with values := s.values } :=
    ⟨e2a.step, e2a.frame.trans f2', e2a.holds.agree f2'⟩
  have hp2 : s2'.params = s.params := f2.params.trans hp2a
  have hh2 : s2'.positions = h := f2.positions.trans hh2a
  have hI2 : s2'.get base = some (.i64 (i.denote funs env)) :=
    (e2.frame.below base (by omega)).1.trans hI1
  -- The count of new words, in local `base + k + 1`.
  simp only [wp_constI64_cons]
  have hLowK : ({ s2' with values := s.values } : Locals).params.length ≤ base + e.width + 1 := by
    show s2'.params.length ≤ _; rw [hp2]; omega
  have hHighK' : base + e.width + 1 < ({ s2' with values := s.values } : Locals).positions := by
    simp only [Locals.positions_values, hh2]; omega
  have hHighK := Locals.lt_total hHighK'
  refine wp_localSet_local hLowK hHighK ?_
  set s3 := setLocal { s2' with values := s.values } (base + e.width + 1)
    (.i64 (wordCount e.width)) with hs3
  have hK3 : s3.get (base + e.width + 1) = some (.i64 (wordCount e.width)) :=
    Locals.get_setLocal_same hLowK hHighK
  have hF3 : Frame (base + e.width + 1) { s2' with values := s.values } s3 :=
    Frame.setValues (s := { s2' with values := s.values }) (vs := s.values) hLowK le_rfl hHighK'
  have hold3 : LocalsHold s3 (base + 1) e.types (e.values (v.denote funs env)) :=
    (LocalsHold.frame (Frame.ofValues.trans hF3) (by rw [e.values_length, e.types_length])
      (by rw [e.types_length]; omega)).mpr hold2
  have e3 : Evolves env slots (fun k => (live k || k == x.index) || v.uses k)
      (fun k => live k || k == x.index) (base + 1) heap1 store1 _ heap2 store2 s3 :=
    ⟨e2.step, e2.frame.trans (hF3.mono (by omega)), e2.holds.agree (hF3.mono (by omega))⟩
  have hp3 : s3.params = s.params := e3.frame.params.trans hp1
  have hh3 : s3.positions = h := e3.frame.positions.trans hh1
  have hI3 : s3.get base = some (.i64 (i.denote funs env)) :=
    (hF3.below base (by omega)).1.trans hI2
  have hDx : dyingPot store2 s3 env slots paid (fun k => live k || k == x.index) live =
      dyingPot store s env slots paid (fun k => live k || k == x.index) live := by
    rw [dyingPot_evolves (e1.holds.mono (Nat.le_succ base)) e3 (fun k h => by simp [h]) _ _
      fun _ h => h]
    exact dyingPot_evolves (hVars.live_mono hIn) e1 (fun k h => by simp [h]) _ _
      fun k h => by simp [h]
  -- The array, with room for one more element, from local `base + k + 2` on.
  refine spec_room hm x (paid := paid) (b := base + e.width + 2) (ext := base + e.width + 1)
    (e := wordCount e.width) (s := s3) (e3.holds.mono (by omega))
    e3.step.at_ (by rw [e3.step.cap m, e1.step.cap m]; exact hCap) (by rw [hp3]; omega)
    (by rw [hh3]; omega) hK3 (by omega) (by rw [wordCount_toNat]; omega)
    (hTrap.alloc (by simp [Expr.aborts]) fun hd hw => hw.of_le
      (by
        have := hTopI (hdS (fits_of_not hd)).1; have h2 := hTopV (hdS (fits_of_not hd)).2
        rw [hDv _ e1] at h2
        rw [hDx]; rw [hT] at hw; omega)
      (by rw [e3.step.cap m, e1.step.cap m]))
    fun heap3 store3 s4 q words hSize hPrefix aR hN4 hQ4 hv4 hTopR => ?_
  obtain ⟨p0, hp0, hOwnedQ⟩ := aR.rep
  replace hOwnedQ : heap3.Owned store3 p0 words := hOwnedQ
  obtain rfl : p0 = q := by simp only [List.cons.injEq, Value.i64.injEq] at hp0; exact hp0.1.symm
  have hAQ := hOwnedQ.values
  have hFitQ := hAQ.1
  have hMemQ := hAQ.2.1
  have hPtrQ := hAQ.pointerAddress_toNat
  have hWs : (e.words (env.get x)).size = (env.get x).size * e.width := Elem.words_size e _
  have hk29 : e.width < 536870912 := by
    rw [wordCount_toNat] at hSize; omega
  have hkw : (wordCount e.width).toNat = e.width := by rw [wordCount_toNat]; omega
  rw [hkw, hWs] at hSize
  have hnk : (env.get x).size * e.width < 536870912 := by omega
  have hn64 : (env.get x).size < UInt64.size := by
    have := Nat.le_mul_of_pos_right (env.get x).size hk
    rw [show UInt64.size = 18446744073709551616 from rfl]; omega
  have hN4' : s4.get (base + e.width + 3) =
      some (.i64 (UInt64.ofNat ((env.get x).size * e.width))) := by
    rw [← hWs]; exact hN4
  have hQ4' : s4.get (base + e.width + 6) = some (.i64 p0) := hQ4
  have hPrefix' : ∀ w, w < (env.get x).size * e.width →
      words[w]! = (e.words (env.get x))[w]! := fun w hw => by
    rw [hPrefix w (by rw [hWs]; exact hw), getElem!_pos _ w (by rw [hWs]; exact hw)]
  have hp4 : s4.params = s.params := aR.frame.params.trans hp3
  have hh4 : s4.positions = h := aR.frame.positions.trans hh3
  have hI4 : s4.get base = some (.i64 (i.denote funs env)) :=
    (aR.frame.below base (by omega)).1.trans hI3
  have hold4 : LocalsHold s4 (base + 1) e.types (e.values (v.denote funs env)) :=
    (LocalsHold.frame aR.frame (by rw [e.values_length, e.types_length])
      (by rw [e.types_length]; omega)).mpr hold3
  -- The rest of the code, from the array after the writes or with the old length.
  have hCapW : ∀ (store' : Store Unit) (ws' : Array UInt64),
      Memory.WritesRange store3 store' p0.toNat (p0.toNat + 8 * (words.size + 1)) →
      UInt64Array.At store' p0 ws' → ws'.size ≤ words.size →
      capacityAt store' p0 = capacityAt store3 p0 := fun store' ws' hW hA hLe => by
    have := hOwnedQ.capacity
    exact (hOwnedQ.rewrite ⟨by rw [hW.1], hW.2.1, fun a ha => hW.2.2 a (by omega)⟩ hA
      (by omega)).2
  rw [hDx] at hTopR
  have hFinish : ∀ (store5 : Store Unit) (s' : Locals) (ws : Array UInt64),
      s'.values = s.values →
      ws = e.words (LeanExe.insertAt (env.get x) (i.denote funs env) (v.denote funs env)) →
      capacityAt store5 p0 = capacityAt store3 p0 → ws.size ≤ words.size →
      After env slots (fun k => live k || k == x.index) live (base + e.width + 2) heap2 store2 s3
        (.array .word) .owned ws heap3 store5 s' [.i64 p0] →
      wp m rest Q store5 { s' with values := .i64 p0 :: s'.values } host := by
    rintro store5 s' ws hv' rfl hCap5 hLe aX
    have aX1 := (After.ofWords aX).lower e3.holds (by omega) fun k h => by simp [h]
    have aX2 := After.prepend (e1.holds.mono (Nat.le_succ base)) e3 aX1
      (fun k h => by simp [h]) fun k h => by simp [h]
    have aX3 := After.prepend (hVars.live_mono hIn) e1 (aX2.lower e1.holds (Nat.le_succ base)
      fun k h => by simp [h]) (fun k h => by simp [h]) fun k h => by simp [h]
    have hBound : (Expr.insertAt x i v).fits funs fits env = true →
        heap3.top.toNat + (if (Expr.insertAt x i v).paid flags (slots.map Slot.mode) paid live then
            (Ty.array e).pot store5 [.i64 p0] ((Expr.insertAt x i v).denote funs env) else 0) ≤
          heap.top.toNat + dyingPot store s env slots paid
            (fun k => live k || (Expr.insertAt x i v).uses k) live +
            (Expr.insertAt x i v).allocs funs flags bounds (slots.map Slot.mode) paid live env := by
      intro hd
      have := hTopI (hdS hd).1; have h2 := hTopV (hdS hd).2
      rw [hDv _ e1] at h2
      have hPot : (Ty.array e).pot store5 [.i64 p0] ((Expr.insertAt x i v).denote funs env) ≤
          arrayPot store3 p0 words.size := by
        show arrayPot store5 p0 (e.words (LeanExe.insertAt (env.get x) (i.denote funs env)
          (v.denote funs env))).size ≤ _
        unfold arrayPot; rw [hCap5]; omega
      rw [hT]
      show heap3.top.toNat + (if (modeAt (slots.map Slot.mode) x.index == .owned &&
          !live x.index) = true then _ else 0) ≤ _
      by_cases hc : (slots.getD x.index default).mode = .owned ∧ live x.index = false
      · rw [ite_eq_left hc] at hTopR
        rw [ite_eq_left
            (by simp only [modeAt, Slot.modes_getD, hc.1, hc.2, beq_self_eq_true, Bool.not_false,
        Bool.and_self])]
        omega
      · rw [ite_eq_right hc] at hTopR
        rw [ite_eq_right (by
          simp only [modeAt, Slot.modes_getD, Bool.and_eq_true, beq_iff_eq, Bool.not_eq_true']
          exact hc)]
        omega
    simpa [hv'] using hNext heap3 store5 _ [.i64 p0] (aX3.liveIn hIn) hBound
  -- The test of the position.
  simp only [wp_localGet_cons, Locals.get_values, hI4, hN4']
  rw [wp_divCode hk, words_div hk hnk]
  simp only [wp_leUI64_cons]
  rw [wp_iff_control_types]
  refine wp_iff_cons rfl ?_
  have hLe : i.denote funs env ≤ UInt64.ofNat (env.get x).size ↔
      (i.denote funs env).toNat ≤ (env.get x).size := by
    rw [UInt64.le_iff_toNat_le, UInt64.toNat_ofNat_of_lt' hn64]
  by_cases hc : (i.denote funs env).toNat ≤ (env.get x).size
  · rw [ite_eq_left (by simp [hLe.mpr hc])]
    have hWL : (i.denote funs env).toNat * e.width ≤ (env.get x).size * e.width :=
      Nat.mul_le_mul_right _ hc
    -- The element's first word, in local `base + k + 4`.
    simp only [wp_localGet_cons, Locals.get_values, hI4]
    have hs := words_scale hk (show (i.denote funs env).toNat * e.width < 536870912 by omega)
    rw [UInt64.ofNat_toNat] at hs
    rw [wp_scaleCode, hs]
    have hLow5 : ({ s4 with values := s4.values } : Locals).params.length ≤ base + e.width + 4 := by
      show s4.params.length ≤ _; rw [hp4]; omega
    have hHigh5' : base + e.width + 4 < s4.positions := by rw [hh4]; omega
    have hHigh5 := Locals.lt_total (s := { s4 with values := s4.values }) hHigh5'
    refine wp_localSet_local hLow5 hHigh5 ?_
    set s5 : Locals := setLocal { s4 with values := s4.values } (base + e.width + 4)
      (.i64 (UInt64.ofNat ((i.denote funs env).toNat * e.width))) with hs5
    have hF5 : Frame (base + e.width + 4) s4 s5 := Frame.setValues hLow5 le_rfl hHigh5'
    have hW5 : s5.get (base + e.width + 4) =
        some (.i64 (UInt64.ofNat ((i.denote funs env).toNat * e.width))) :=
      Locals.get_setLocal_same hLow5 hHigh5
    have hN5 : s5.get (base + e.width + 3) =
        some (.i64 (UInt64.ofNat ((env.get x).size * e.width))) :=
      (hF5.below _ (by omega)).1.trans hN4'
    have hQ5 : s5.get (base + e.width + 6) = some (.i64 p0) := by
      rw [Locals.get_setLocal_ne hLow5 (by omega)]; exact hQ4'
    have hh5 : s5.positions = h := hF5.positions.trans hh4
    have hp5 : s5.params = s.params := hF5.params.trans hp4
    -- The old length, in local `base + k + 7`.
    simp only [wp_localGet_cons, hN5]
    have hLow6 : ({ s5 with values := s5.values } : Locals).params.length ≤ base + e.width + 7 := by
      show s5.params.length ≤ _; rw [hp5]; omega
    have hHigh6' : base + e.width + 7 < s5.positions := by rw [hh5]; omega
    have hHigh6 := Locals.lt_total (s := { s5 with values := s5.values }) hHigh6'
    refine wp_localSet_local hLow6 hHigh6 ?_
    set s6 : Locals := setLocal { s5 with values := s5.values } (base + e.width + 7)
      (.i64 (UInt64.ofNat ((env.get x).size * e.width))) with hs6
    have hF6 : Frame (base + e.width + 7) s5 s6 := Frame.setValues hLow6 le_rfl hHigh6'
    have hL6 : s6.get (base + e.width + 7) =
        some (.i64 (UInt64.ofNat ((env.get x).size * e.width))) :=
      Locals.get_setLocal_same hLow6 hHigh6
    have hW6 : s6.get (base + e.width + 4) =
        some (.i64 (UInt64.ofNat ((i.denote funs env).toNat * e.width))) :=
      (hF6.below _ (by omega)).1.trans hW5
    have hQ6 : s6.get (base + e.width + 6) = some (.i64 p0) :=
      (hF6.below _ (by omega)).1.trans hQ5
    have hh6 : s6.positions = h := hF6.positions.trans hh5
    have hp6 : s6.params = s.params := hF6.params.trans hp5
    -- The move of the words from the element's first word up.
    refine wp_shiftUp (ptr := base + e.width + 6) (lo := base + e.width + 4)
      (index := base + e.width + 7) (k := e.width) (l := (i.denote funs env).toNat * e.width)
      (h := (env.get x).size * e.width) hAQ hWL (by omega) hQ6 hW6 hL6 (by omega) (by omega)
      (by rw [hp6]; omega) (Locals.lt_total (s := s6) (by rw [hh6]; omega))
      fun store7 s7 hW7 hA7 hp7 hl7 hOther7 hv7 => ?_
    have hQ7 : s7.get (base + e.width + 6) = some (.i64 p0) := by
      rw [hOther7 _ (by omega)]; exact hQ6
    have hW7' : s7.get (base + e.width + 4) =
        some (.i64 (UInt64.ofNat ((i.denote funs env).toNat * e.width))) := by
      rw [hOther7 _ (by omega)]; exact hW6
    have hFrame7 : Frame (base + e.width + 2) s4 s7 :=
      (hF5.mono (by omega)).trans ((hF6.mono (by omega)).trans
        (Frame.ofOthers hp7 hl7 hOther7 (by omega) (by rw [hh6]; omega)))
    have aS := (aR.reframe hFrame7).rewriteRange hW7 hA7 (by rw [shiftUp_size])
    have hold7 : LocalsHold s7 (base + 1) e.types
        (List.zipWith typedValue e.types (e.toWords (v.denote funs env))) := by
      rw [e.values_typed]
      exact (LocalsHold.frame hFrame7 (by rw [e.values_length, e.types_length])
        (by rw [e.types_length]; omega)).mpr hold4
    have hW64 : (UInt64.ofNat ((i.denote funs env).toNat * e.width)).toNat =
        (i.denote funs env).toNat * e.width :=
      UInt64.toNat_ofNat_of_lt' (by rw [show UInt64.size = 18446744073709551616 from rfl]; omega)
    -- The writes of the value's words.
    rw [← List.append_nil (storeWordsCode h (base + e.width + 6) (base + e.width + 4) 0 (base + 1)
      e.types)]
    refine wp_storeWordsCode 0 (base + 1) e.types (e.toWords (v.denote funs env))
      (shiftUp words ((i.denote funs env).toNat * e.width) ((env.get x).size * e.width) e.width)
      store7 s7 aS (hFrame7.positions.trans hh4) hQ7 hW7' hold7
      (by rw [e.toWords_length, e.types_length]) (e.typed_words _)
      (by rw [hW64, e.types_length, shiftUp_size, hSize]; omega) fun store8 a8 hCap8 => ?_
    rw [hW64] at a8
    simp only [Nat.add_zero] at a8
    have hEq : LeanExe.insertAt (env.get x) (i.denote funs env) (v.denote funs env) =
        (env.get x).insertIdx (i.denote funs env).toNat (v.denote funs env) hc := dite_eq_left hc
    rw [wp_nil]
    dsimp only
    simp only [List.take_zero, List.drop_zero, List.nil_append, hQ7]
    rw [show s4.values = s7.values from (hv7.trans rfl).symm]
    exact hFinish store8 s7 _ (hv7.trans hv4)
      (by rw [hEq]; exact Elem.words_insertIdx e (v.denote funs env) hc hSize hPrefix')
      (hCap8.trans (hCapW store7 _ hW7 hA7 (le_of_eq (shiftUp_size ..))))
      (le_of_eq (by rw [writeWords_size, shiftUp_size])) a8
  · rw [ite_eq_right (by simp [hLe, hc])]
    simp only [wp_localGet_cons, Locals.get_values, hQ4', wp_wrapI64_cons, wrap_toUInt32, hN4']
    simp only [wp_store64_cons, UInt32.toNat_zero, Nat.add_zero, UInt32.add_zero]
    rw [ite_eq_right (by rw [hPtrQ]; omega)]
    rw [wp_nil]
    dsimp only
    simp only [List.take_zero, List.drop_zero, List.nil_append, hQ4']
    have hEq : LeanExe.insertAt (env.get x) (i.denote funs env) (v.denote funs env) = env.get x :=
      dite_eq_right hc
    have hWL := writeLength_frame store3 p0 words.size ((env.get x).size * e.width) hFitQ
    have hAL := hAQ.writeLength (by omega : (env.get x).size * e.width ≤ words.size)
    exact hFinish _ s4 _ hv4
      (by rw [hEq]; exact Elem.words_extract_prefix e (by omega) hPrefix')
      (hCapW _ _ hWL hAL (by simp only [Array.size_extract]; omega))
      (by simp only [Array.size_extract]; omega)
      (aR.rewriteRange hWL hAL (by simp only [Array.size_extract]; omega))

/-- `CodeSpec` from `CodeSpecIn` of every flag. -/
theorem specOf {Γ : List Ty} {t : Ty} {e : Expr S Γ t}
    (h : ∀ buy env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv
      e env slots paid live) :
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv e env slots
      paid live :=
  fun env slots paid live => (h false env slots paid live).spec

/-- `CodeSpecIn` of every flag for an expression that `Expr.bodyPaid` and `Expr.buys` treat as
`Expr.paid` does. -/
theorem specInOf {Γ : List Ty} {t : Ty} {e : Expr S Γ t}
    (hp : ∀ modes paid live, e.bodyPaid flags modes paid live = e.paid flags modes paid live)
    (hb : ∀ modes paid live env, e.buys funs flags modes paid live env = 0)
    (h : ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv e env slots
      paid live) :
    ∀ buy env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv e env
      slots paid live :=
  fun buy env slots paid live => CodeSpec.specIn buy (hp _ _ _) (hb _ _ _ _) (h env slots paid live)

end Cases

/-- The code of every expression meets its specification, also in the result of a loop's body. -/
theorem Expr.code_specIn {S : List Sig} (m : Module) (funs : Funs S) (flags : Flags S)
    (bounds : Bounds S) (fits : Fits S) (host : HostEnv Unit) (hm : Runtime m) {pv : List Value}
    {d0 : UInt64} (hCalls : CallsAt m funs flags bounds fits d0 pool) {Γ : List Ty} {t : Ty}
    (expr : Expr S Γ t) :
    expr.Covered pool →
    (expr.depthCalls = true → pv.head? = some (.i64 d0)) →
    ∀ buy env slots paid live, CodeSpecIn (pool := pool) buy m funs flags bounds fits host pv expr env
      slots paid live := by
  induction expr with
  | word value =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_word value
  | bool value =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_bool value
  | var x =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_var hm x
  | treeNil shape hn =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_treeNil shape hn
  | treeNode r reuse words children wordSpec childSpec =>
    have wordSpec := fun i c d => specOf (pool := pool) (wordSpec i c d)
    have childSpec := fun i c d => specOf (pool := pool) (childSpec i c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_treeNode hm reuse words children
      (fun i => wordSpec i ((Expr.covered_treeNode hCover).1 i) fun hd => hD (by
        simp only [Expr.depthCalls, Bool.or_eq_true]
        exact Or.inl (le_argsAny _ i hd)))
      (fun i => childSpec i ((Expr.covered_treeNode hCover).2 i) fun hd => hD (by
        simp only [Expr.depthCalls, Bool.or_eq_true]
        exact Or.inr (le_argsAny _ i hd)))
  | treeCase x empty nodes emptySpec nodeSpec =>
    have emptySpec := fun hn c d => specOf (pool := pool) (emptySpec hn c d)
    have nodeSpec := fun r c d => specOf (pool := pool) (nodeSpec r c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_treeCase hm x empty nodes
      (fun hn => emptySpec hn ((Expr.covered_treeCase hCover).1 hn) fun hd => hD (by
        simp only [Expr.depthCalls, dite_eq_left hn, hd, Bool.true_or]))
      (fun r => nodeSpec r ((Expr.covered_treeCase hCover).2 r) fun hd => hD (by
        simp only [Expr.depthCalls, Bool.or_eq_true]
        exact Or.inr (le_argsAny _ r hd)))
  | bin op left right leftSpec rightSpec =>
    have leftSpec := fun c d => specOf (pool := pool) (leftSpec c d)
    have rightSpec := fun c d => specOf (pool := pool) (rightSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_bin op (leftSpec ((Expr.covered_bin hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (rightSpec ((Expr.covered_bin hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | cmp op left right leftSpec rightSpec =>
    have leftSpec := fun c d => specOf (pool := pool) (leftSpec c d)
    have rightSpec := fun c d => specOf (pool := pool) (rightSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_cmp op (leftSpec ((Expr.covered_cmp hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (rightSpec ((Expr.covered_cmp hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | not e eSpec =>
    have eSpec := fun c d => specOf (pool := pool) (eSpec c d)
    intro hCover hD; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_not (eSpec ((Expr.covered_not hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | and left right leftSpec rightSpec =>
    have leftSpec := fun c d => specOf (pool := pool) (leftSpec c d)
    have rightSpec := fun c d => specOf (pool := pool) (rightSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_and (leftSpec ((Expr.covered_and hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (rightSpec ((Expr.covered_and hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | or left right leftSpec rightSpec =>
    have leftSpec := fun c d => specOf (pool := pool) (leftSpec c d)
    have rightSpec := fun c d => specOf (pool := pool) (rightSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_or (leftSpec ((Expr.covered_or hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (rightSpec ((Expr.covered_or hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | ite c thenE elseE cSpec thenSpec elseSpec =>
    have cSpec := fun c d => specOf (pool := pool) (cSpec c d)
    intro hCover hD
    exact fun buy => spec_ite hm (cSpec ((Expr.covered_ite hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (thenSpec ((Expr.covered_ite hCover).2.1) (fun h => hD (by simp [Expr.depthCalls, h])) buy)
      (elseSpec ((Expr.covered_ite hCover).2.2) (fun h => hD (by simp [Expr.depthCalls, h])) buy)
  | letE value body valueSpec bodySpec =>
    have valueSpec := fun c d => specOf (pool := pool) (valueSpec c d)
    intro hCover hD
    exact fun buy => spec_letE hm (valueSpec ((Expr.covered_letE hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (bodySpec ((Expr.covered_letE hCover).2) (fun h => hD (by simp [Expr.depthCalls, h])) buy)
  | call g args argsSpec =>
    have argsSpec := fun i c d => specOf (pool := pool) (argsSpec i c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_call hm hCalls g args (fun i => argsSpec i ((Expr.covered_call hCover) i) fun h => hD (by
      simp only [Expr.depthCalls, Bool.or_eq_true]
      exact Or.inr (le_argsAny _ i h))) hD
  | pair first second firstSpec secondSpec =>
    have firstSpec := fun c d => specOf (pool := pool) (firstSpec c d)
    have secondSpec := fun c d => specOf (pool := pool) (secondSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_pair hm (firstSpec ((Expr.covered_pair hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (secondSpec ((Expr.covered_pair hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | letPair e body eSpec bodySpec =>
    have eSpec := fun c d => specOf (pool := pool) (eSpec c d)
    intro hCover hD
    exact fun buy => spec_letPair hm (eSpec ((Expr.covered_letPair hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (bodySpec ((Expr.covered_letPair hCover).2) (fun h => hD (by simp [Expr.depthCalls, h])) buy)
  | loop count init cond body countSpec initSpec condSpec bodySpec =>
    have countSpec := fun c d => specOf (pool := pool) (countSpec c d)
    have initSpec := fun c d => specOf (pool := pool) (initSpec c d)
    have condSpec := fun c d => specOf (pool := pool) (condSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_loop hm (countSpec ((Expr.covered_loop hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (initSpec ((Expr.covered_loop hCover).2.1) fun h => hD (by simp [Expr.depthCalls, h]))
      (condSpec ((Expr.covered_loop hCover).2.2.1) fun h => hD (by simp [Expr.depthCalls, h]))
      (bodySpec ((Expr.covered_loop hCover).2.2.2) fun h => hD (by simp [Expr.depthCalls, h]))
  | fold x init body initSpec bodySpec =>
    have initSpec := fun c d => specOf (pool := pool) (initSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_fold hm x (initSpec ((Expr.covered_fold hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (bodySpec ((Expr.covered_fold hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | listFold args body argsSpec bodySpec =>
    have argsSpec := fun i c d => specOf (pool := pool) (argsSpec i c d)
    have bodySpec := fun c d => specOf (pool := pool) (bodySpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_listFold hm args body
      (fun i => argsSpec i ((Expr.covered_listFold hCover).1 i) fun hd => hD (by
        simp only [Expr.depthCalls, Bool.or_eq_true]
        exact Or.inl (le_argsAny _ i hd)))
      (bodySpec ((Expr.covered_listFold hCover).2) fun hd => hD (by simp [Expr.depthCalls, hd]))
  | size x =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_size hm x
  | bytesLiteral bytes =>
    intro hCover _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_bytesLiteral hm bytes hCover
  | bytesEmpty =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_bytesEmpty
  | bytesSize x =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_bytesSize hm x
  | bytesGet x index indexSpec =>
    have indexSpec := fun c d => specOf (pool := pool) (indexSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_bytesGet hm x (indexSpec ((Expr.covered_bytesGet hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | leSize x i =>
    intro _ _
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_leSize hm x i
  | get x i iSpec =>
    have iSpec := fun c d => specOf (pool := pool) (iSpec c d)
    intro hCover hD; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_get hm x (iSpec ((Expr.covered_get hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | build count elem countSpec elemSpec =>
    have countSpec := fun c d => specOf (pool := pool) (countSpec c d)
    have elemSpec := fun c d => specOf (pool := pool) (elemSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_build hm (countSpec ((Expr.covered_build hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (elemSpec ((Expr.covered_build hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | bytesBuild count elem countSpec elemSpec =>
    have countSpec := fun c d => specOf (pool := pool) (countSpec c d)
    have elemSpec := fun c d => specOf (pool := pool) (elemSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_bytesBuild hm (countSpec ((Expr.covered_bytesBuild hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (elemSpec ((Expr.covered_bytesBuild hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | set x i v iSpec vSpec =>
    have iSpec := fun c d => specOf (pool := pool) (iSpec c d)
    have vSpec := fun c d => specOf (pool := pool) (vSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_set hm x (iSpec ((Expr.covered_set hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (vSpec ((Expr.covered_set hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | push x v vSpec =>
    have vSpec := fun c d => specOf (pool := pool) (vSpec c d)
    intro hCover hD; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_push hm x (vSpec ((Expr.covered_push hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | append x y =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_append hm x y
  | insertAt x i v iSpec vSpec =>
    have iSpec := fun c d => specOf (pool := pool) (iSpec c d)
    have vSpec := fun c d => specOf (pool := pool) (vSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_insertAt hm x (iSpec ((Expr.covered_insertAt hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (vSpec ((Expr.covered_insertAt hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | eraseAt x i iSpec =>
    have iSpec := fun c d => specOf (pool := pool) (iSpec c d)
    intro hCover hD; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_eraseAt hm x (iSpec ((Expr.covered_eraseAt hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | float bits =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_float bits
  | float32 bits =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_float32 bits
  | fbin op left right leftSpec rightSpec =>
    have leftSpec := fun c d => specOf (pool := pool) (leftSpec c d)
    have rightSpec := fun c d => specOf (pool := pool) (rightSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_fbin op (leftSpec ((Expr.covered_fbin hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (rightSpec ((Expr.covered_fbin hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | fbin32 op left right leftSpec rightSpec =>
    have leftSpec := fun c d => specOf (pool := pool) (leftSpec c d)
    have rightSpec := fun c d => specOf (pool := pool) (rightSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_fbin32 op (leftSpec ((Expr.covered_fbin32 hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (rightSpec ((Expr.covered_fbin32 hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | funary op e eSpec =>
    have eSpec := fun c d => specOf (pool := pool) (eSpec c d)
    intro hCover hD; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_funary op (eSpec ((Expr.covered_funary hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | funary32 op e eSpec =>
    have eSpec := fun c d => specOf (pool := pool) (eSpec c d)
    intro hCover hD; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_funary32 op (eSpec ((Expr.covered_funary32 hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | fcmp op left right leftSpec rightSpec =>
    have leftSpec := fun c d => specOf (pool := pool) (leftSpec c d)
    have rightSpec := fun c d => specOf (pool := pool) (rightSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_fcmp op (leftSpec ((Expr.covered_fcmp hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (rightSpec ((Expr.covered_fcmp hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | fcmp32 op left right leftSpec rightSpec =>
    have leftSpec := fun c d => specOf (pool := pool) (leftSpec c d)
    have rightSpec := fun c d => specOf (pool := pool) (rightSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_fcmp32 op (leftSpec ((Expr.covered_fcmp32 hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (rightSpec ((Expr.covered_fcmp32 hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | toFloat op e eSpec =>
    have eSpec := fun c d => specOf (pool := pool) (eSpec c d)
    intro hCover hD; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_toFloat op (eSpec ((Expr.covered_toFloat hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | toFloat32 op e eSpec =>
    have eSpec := fun c d => specOf (pool := pool) (eSpec c d)
    intro hCover hD; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_toFloat32 op (eSpec ((Expr.covered_toFloat32 hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | toWord op e eSpec =>
    have eSpec := fun c d => specOf (pool := pool) (eSpec c d)
    intro hCover hD; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_toWord op (eSpec ((Expr.covered_toWord hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | toWord32 op e eSpec =>
    have eSpec := fun c d => specOf (pool := pool) (eSpec c d)
    intro hCover hD; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_toWord32 op (eSpec ((Expr.covered_toWord32 hCover)) fun h => hD (by simp [Expr.depthCalls, h]))
  | mk first second firstSpec secondSpec =>
    have firstSpec := fun c d => specOf (pool := pool) (firstSpec c d)
    have secondSpec := fun c d => specOf (pool := pool) (secondSpec c d)
    intro hCover hD
    exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_mk (firstSpec ((Expr.covered_mk hCover).1) fun h => hD (by simp [Expr.depthCalls, h]))
      (secondSpec ((Expr.covered_mk hCover).2) fun h => hD (by simp [Expr.depthCalls, h]))
  | proj x p =>
    intro _ _; exact specInOf (pool := pool) (fun _ _ _ => rfl) (fun _ _ _ _ => rfl) <| spec_proj x p

/-- The code of every expression meets its specification. -/
theorem Expr.code_spec {S : List Sig} (m : Module) (funs : Funs S) (flags : Flags S)
    (bounds : Bounds S) (fits : Fits S) (host : HostEnv Unit) (hm : Runtime m) {pv : List Value}
    {d0 : UInt64} (hCalls : CallsAt m funs flags bounds fits d0 pool) {Γ : List Ty} {t : Ty}
    (expr : Expr S Γ t) :
    expr.Covered pool →
    (expr.depthCalls = true → pv.head? = some (.i64 d0)) →
    ∀ env slots paid live, CodeSpec (pool := pool) m funs flags bounds fits host pv expr env slots paid live :=
  fun hCover hD env slots paid live =>
    (Expr.code_specIn m funs flags bounds fits host hm hCalls expr hCover hD false env slots paid
      live).spec

/-- A function's code after the copy of its parameters, whose words start at position `p0`: the
release of the owned parameters that the body does not use, the body's code, and the coercion of
the body's value to an owned one.  The parameters' flags are `pf`, and the result's flag `rf`
holds only when the body's value is paid.  The code traps only through a call whose code takes the
call depth, or, when it may allocate, when `top` cannot rise by the potential of the paid owned
parameters plus the function's bound within the cap.  When the body finds its frames, `top` after
the code, plus the result's potential when `rf` holds, is at most `top` before it plus that sum. -/
theorem body_code_spec {S : List Sig} {params : List Ty} {result : Ty} (modes : List Mode)
    (body : Expr S params result) (hCovered : body.Covered pool)
    (placeArgs : body.placeArgs = true) (p0 h : Nat)
    (funs : Funs S) (flags : Flags S) (bounds : Bounds S) (fits : Fits S) (pf : List Bool)
    (rf : Bool) (hrf : rf = true →
      body.paid flags (entryModes params modes) pf (fun _ => false) = true)
    (m : Module) (host : HostEnv Unit)
    (hm : Runtime m) {d0 : UInt64} (hCalls : CallsAt m funs flags bounds fits d0 pool)
    (args : Env params)
    (heap : Heap)
    (store : Store Unit) (s : Locals) (hh : s.positions = h)
    (hRoom : p0 + widthSum params + body.width + copyWidth result ≤ h)
    (hDepth : body.depthCalls = true → s.params.head? = some (.i64 d0))
    (hVars : Holds args (paramSlots params modes p0) (fun _ => true) (p0 + widthSum params)
      heap store s)
    (hAt : heap.At store)
    (hSafe : pool.Safe args (paramSlots params modes p0) (fun _ => true) heap store s)
    (hCap : store.memoryCap m 0 ≤ 65535)
    (hBase : s.params.length ≤ p0 + widthSum params) (Q : Assertion Unit)
    (hTrap : TrapOK (!body.fits funs fits args ||
      ((body.aborts || !result.scalar || (paramModes params modes).any (· == .owned)) &&
        !decide (heap.Within store m
          (args.pot store s (paramSlots params modes p0) (fun i =>
              paidAt pf i && paramMode params modes i == .owned) +
            bodyBound modes pf body funs flags bounds args)))) Q)
    (hNext : ∀ heap' store' s' ws,
      After args (paramSlots params modes p0) (fun _ => true) (fun _ => false)
        (p0 + widthSum params) heap store s result .owned (body.denote funs args) heap' store' s'
        ws →
      (body.fits funs fits args = true →
        heap'.top.toNat + (if rf then result.pot store' ws (body.denote funs args) else 0) ≤
          heap.top.toNat +
            args.pot store s (paramSlots params modes p0) (fun i =>
              paidAt pf i && paramMode params modes i == .owned) +
            bodyBound modes pf body funs flags bounds args) →
      Q (.Fallthrough store' { s' with values := ws.reverse ++ s.values })) :
    wp m (releaseWhere params (paramSlots params modes p0) (fun i => !body.uses i) ++
      (body.code (pool := pool) h (paramSlots params modes p0) (p0 + widthSum params) (fun _ => false) ++
      (coerceCode h result (body.mode ((paramSlots params modes p0).map Slot.mode)) .owned
        (p0 + widthSum params + body.width) ++ []))) Q store s host := by
  have hModes : (paramSlots params modes p0).map Slot.mode = entryModes params modes := by
    rw [entryModes, paramSlots_modes, paramSlots_modes]
  refine wp_releaseWhere hm hVars hAt (fun _ _ => rfl) fun heap1 store1 e hTop1 => ?_
  have e' := e.mono (live' := fun i => false || body.uses i) fun i h => by simpa using h
  -- The paid parameters that the body uses keep their potential across the release, and die in
  -- the body.
  have hDp : dyingPot store1 s args (paramSlots params modes p0) pf
        (fun i => false || body.uses i) (fun _ => false) ≤
      args.pot store s (paramSlots params modes p0) (fun i =>
        paidAt pf i && paramMode params modes i == .owned) := by
    rw [dyingPot_evolves hVars e' (fun _ _ => rfl) _ _ fun _ h => h]
    exact Env.pot_mono args _ _ _ fun i h => by
      simp only [Bool.and_eq_true, beq_iff_eq] at h ⊢
      exact ⟨h.1.2, by rw [← paramSlots_getD_mode params modes p0]; exact h.2⟩
  refine Expr.code_spec m funs flags bounds fits host hm hCalls body hCovered hDepth args
    (paramSlots params modes p0) pf (fun _ => false) h (p0 + widthSum params)
    heap1 store1 s hh rfl e'.holds e'.step.at_
    (hSafe.evolves hVars e' (fun _ _ => rfl))
    (by rw [e'.step.cap m]; exact hCap) hBase (by omega)
    placeArgs _ _
    (hTrap.part (fun h => h)
      (fun h => by
        rw [← Slot.any_map, paramSlots_modes] at h
        exact trap_left _ _ _ h)
      fun _ hw => hw.of_le (by rw [hTop1, hModes]; simp only [bodyBound]; omega)
        (e'.step.cap m))
    fun heap' store' s' ws a hTopB => ?_
  have hDp' : dyingPot store1 s args (paramSlots params modes p0) pf
      (fun i => (fun _ => false) i || body.uses i) (fun _ => false) ≤
      args.pot store s (paramSlots params modes p0) (fun i =>
        paidAt pf i && paramMode params modes i == .owned) := hDp
  have a' := After.prepend hVars e' a (fun _ _ => rfl) fun _ h => nomatch h
  refine After.coerce hm a' (fun _ => rfl) (Nat.le_add_right _ _)
    (by rw [a'.frame.params]; omega) (a'.frame.positions.trans hh) (by omega)
    (by rw [a'.step.cap m]; exact hCap)
    (fun hs _ hsc => hTrap.alloc (by simp [hsc]) fun hd hw => hw.of_le (by
      have := hTopB (fits_of_not hd)
      rw [hModes] at this hs
      rw [hTop1] at this
      simp only [bodyBound, coerceCost, hs, and_self, ↓reduceIte]
      omega) (a'.step.cap m))
    fun heap'' store'' s'' ws'' a'' hTopC hSameC => ?_
  rw [wp_nil]
  refine hNext heap'' store'' s'' ws'' a'' fun hd => ?_
  have hB := hTopB hd
  rw [hModes] at hB hTopC
  rw [hTop1] at hB
  -- A paid result is the body's paid value, which the coercion of an owned value keeps.
  have hK := pot_keep (P := rf) (Q := body.paid flags (entryModes params modes) pf (fun _ => false))
    (a := result.pot store'' ws'' (body.denote funs args))
    (b := result.pot store' ws (body.denote funs args)) hrf fun hp => by
      obtain ⟨rfl, rfl⟩ := hSameC (by rw [hModes]; exact Expr.mode_of_paid body (hrf hp))
      rfl
  simp only [bodyBound]
  omega

/-- The code of a function with modes `modes` and body `body`, at position `pos` of a module whose
functions at the call indices compute the functions that the body calls, computes the body's
meaning from the words `ws` of its arguments after, when the code takes the call depth, the depth
`d`, and traps at the depth limit.  When the code takes no call depth, it traps only when it may
allocate and `top` cannot rise by the function's bound within the cap, and it raises `top` by at
most that bound. -/
theorem bodyFunction_runs {S : List Sig} {params : List Ty} {result : Ty} (modes : List Mode)
    (body : Expr S params result) (placeArgs : body.placeArgs = true) (depth : Bool)
    (funs : Funs S) (flags : Flags S) (bounds : Bounds S) (fits : Fits S) (pf : List Bool)
    (rf : Bool) (hrf : rf = true →
      body.paid flags (entryModes params modes) pf (fun _ => false) = true)
    (m : Module) (pos : Nat) (hm : Runtime m)
    (hFunc : m.funcs[pos]? = some (bodyFunction modes body depth pos pool))
    (hCovered : body.Covered pool) (d : UInt64)
    (hCalls : (depth = true → d < depthLimit) → CallsAt m funs flags bounds fits d pool)
    (hDepth : depth = false → body.depthCalls = false) (aborts : Bool)
    (hAborts : (body.aborts || !result.scalar || (paramModes params modes).any (· == .owned) ||
      depth) = true → aborts = true)
    (host : HostEnv Unit) (store : Store Unit) (heap : Heap) (ws : List Value)
    (args : Env params) (hAt : heap.At store)
    (hInput : @pool.Input (Env params) (Env.represent params modes) heap store ws args)
    (hRep : Env.Rep (paramMode params modes) heap store ws args)
    (hSep : Separate store (Env.moves store (paramMode params modes) ws args)
      (Env.reads store (paramMode params modes) ws args))
    (hCap : store.memoryCap m 0 ≤ 65535) :
    Runs ((depth && !(decide (d < depthLimit) && body.fits funs fits args)) ||
        (aborts && !decide (heap.Within store m
          (Env.argPot store (fun i => paidAt pf i && paramMode params modes i == .owned) ws args +
            bodyBound modes pf body funs flags bounds args))))
      host m pos store ((if depth then [Value.i64 d] else []) ++ ws).reverse
      fun final values => ∃ heap' : Heap, heap'.At final ∧
        result.Rep .owned heap' final values.reverse (body.denote funs args) ∧
        final.memoryCaps = store.memoryCaps ∧
        (∀ r, heap.Region r → 0 < r.2 →
          Apart store (Env.moves store (paramMode params modes) ws args) r →
          (∀ a, r.1 ≤ a → a < r.1 + r.2 → final.mem.bytes a = store.mem.bytes a) ∧
          heap'.Region r ∧
          ∀ b ∈ result.blocks final values.reverse (body.denote funs args), regionsDisjoint r b) ∧
        ((depth && !(decide (d < depthLimit) && body.fits funs fits args)) = false →
          heap'.top.toNat + (if rf then result.pot final values.reverse (body.denote funs args)
              else 0) ≤
            heap.top.toNat +
              Env.argPot store (fun i => paidAt pf i && paramMode params modes i == .owned) ws
                args +
              bodyBound modes pf body funs flags bounds args) := by
  have hLength : ws.length = widthSum params := hRep.length
  have hdv : (if depth then [Value.i64 d] else []).length = (if depth then 1 else 0) := by
    cases depth <;> rfl
  have hNum := bodyFunction_numParams (pool := pool) modes body depth pos
  have hRes : (bodyFunction modes body depth pos pool).results.length = result.width := by
    simp [bodyFunction, Expr.usesFast_eq, Ty.types_length]
  apply Runs.of_wp_entry_for (f := bodyFunction modes body depth pos pool)
    (by rw [hm.imports, List.length_nil, Nat.sub_zero]; exact hFunc)
    (hImp := by simp [hm.imports])
  have hTake : (((if depth then [Value.i64 d] else []) ++ ws).reverse.take
      (bodyFunction modes body depth pos pool).numParams).reverse =
      (if depth then [Value.i64 d] else []) ++ ws := by
    rw [List.take_of_length_le (by
      rw [hNum, List.length_reverse, List.length_append, hdv, hLength])]
    simp
  rw [hTake, show (bodyFunction modes body depth pos pool).body =
    (if depth then guardCode else []) ++
    (paramCopyCode (positions body depth) (if depth then 1 else 0) (params.flatMap Ty.types) ++
    (releaseWhere params (paramSlots params modes (if depth then 1 else 0))
        (fun i => !body.uses i) ++
      (body.code (pool := pool) (positions body depth) (paramSlots params modes (if depth then 1 else 0))
        ((if depth then 1 else 0) + widthSum params) (fun _ => false) ++
      (coerceCode (positions body depth) result
        (body.mode ((paramSlots params modes (if depth then 1 else 0)).map Slot.mode)) .owned
        ((if depth then 1 else 0) + widthSum params + body.width) ++ [])))) by
    simp [bodyFunction, Expr.usesFast_eq]]
  have hl0 : ((bodyFunction modes body depth pos pool).toLocals
      ((if depth then [Value.i64 d] else []) ++ ws)).locals.length =
      body.width + copyWidth result + positions body depth + positions body depth := by
    simp [Function.toLocals, bodyFunction, Nat.add_assoc]
  have hHead : depth = true →
      ((if depth then [Value.i64 d] else []) ++ ws).head? = some (.i64 d) := by
    intro hd; subst hd; rfl
  refine wp_guardCode depth (d := d) (fun hd => by subst hd; simp [Function.toLocals])
    (fun hd hnd st => by
      show TrapMsg _ "unreachable"
      simp only [hd, hnd, decide_false, Bool.false_and, Bool.not_false, Bool.true_and,
        Bool.true_or]
      rfl) fun hlt => ?_
  have hCalls' : CallsAt m funs flags bounds fits d pool := hCalls hlt
  have hFitsB : (depth && !(decide (d < depthLimit) && body.fits funs fits args)) = false →
      body.fits funs fits args = true := fun h => by
    cases hdep : depth
    · exact Expr.fits_of_depthCalls funs fits body (hDepth hdep) args
    · simp only [hdep, Bool.true_and, Bool.not_eq_false', Bool.and_eq_true,
        decide_eq_true_eq] at h
      exact h.2
  have hPos : positions body depth =
      (if depth then 1 else 0) + widthSum params + body.width + copyWidth result := rfl
  have hp0 : ((bodyFunction modes body depth pos pool).toLocals
      ((if depth then [Value.i64 d] else []) ++ ws)).params =
      (if depth then [Value.i64 d] else []) ++ ws := rfl
  have hv0 : ((bodyFunction modes body depth pos pool).toLocals
      ((if depth then [Value.i64 d] else []) ++ ws)).values = [] := rfl
  generalize (bodyFunction modes body depth pos pool).toLocals
    ((if depth then [Value.i64 d] else []) ++ ws) = s0 at hl0 hp0 hv0 ⊢
  generalize (if depth then 1 else 0) = p0 at hdv hNum hPos ⊢
  generalize (if depth then [Value.i64 d] else []) = dv at hdv hHead hp0 ⊢
  generalize positions body depth = h at hPos hl0 ⊢
  have hLocals : s0.params.length + s0.locals.length = h + h + h := by
    rw [hp0, hl0, List.length_append, hdv, hLength, hPos]; omega
  refine wp_paramCopyCode (params.flatMap Ty.types) p0
    (by rw [flatMap_types_length, hp0, List.length_append, hdv, hLength])
    (by rw [hp0, List.length_append, hdv, hLength, hPos]; omega)
    (by simp only [Locals.positions, hLocals]; omega)
    fun s1 frame1 hv1 hcopy1 => ?_
  have hp1 := frame1.params
  have hh1 : s1.positions = h := by
    rw [frame1.positions, Locals.positions, hLocals]; omega
  have hParam : ∀ j (hj : j < ws.length), s0.get (p0 + j) = some ws[j] := by
    intro j hj
    have hlt : p0 + j < (dv ++ ws).length := by rw [List.length_append, hdv]; omega
    simp only [Locals.get, hp0, hlt, ↓reduceIte]
    rw [List.getElem?_append_right (by omega), hdv, Nat.add_sub_cancel_left,
      List.getElem?_eq_getElem hj]
  -- The locals after the copy hold each parameter's words.
  have hHold : ∀ {t : Ty} (x : Var params t),
      LocalsHold s1 (p0 + x.offset) t.types ((ws.drop x.offset).take t.width) := by
    intro t x k hk
    have hk' := hk
    simp only [List.length_take, List.length_drop] at hk'
    have hlt : x.offset + k < ws.length := by have := x.offset_width; omega
    have hkw : k < t.width := by have := x.offset_width; omega
    rw [List.getElem_take, List.getElem_drop, hh1]
    have copied := hcopy1 (p0 + x.offset + k) (by omega)
      (by rw [flatMap_types_length]; have := x.offset_width; omega)
    rw [show p0 + x.offset + k - p0 = x.offset + k by omega, x.types_getD hkw] at copied
    rw [copied, Nat.add_assoc]
    exact hParam _ hlt
  have hWords : ∀ {t : Ty} (x : Var params t),
      ((ws.drop x.offset).take t.width).length = t.width := by
    intro t x
    have := x.offset_width
    simp only [List.length_take, List.length_drop]
    omega
  have hPotEq : args.pot store s1 (paramSlots params modes p0)
      (fun i => paidAt pf i && paramMode params modes i == .owned) =
      Env.argPot store (fun i => paidAt pf i && paramMode params modes i == .owned) ws args :=
    Env.pot_paramSlots modes p0 _ ws args hLength fun x => hHold x
  refine body_code_spec modes body hCovered placeArgs p0 h funs flags bounds fits pf rf hrf m host hm hCalls'
    args heap store s1
    hh1 (by omega) (fun hb => ?_)
    ⟨fun t x _ => ?_, fun t u x y _ _ hxy hmo wx wy hwx hlx hwy hly => ?_⟩ hAt
    (hInput.params hRep hHold) hCap
    (by rw [hp1, hp0, List.length_append, hdv, hLength]) _
    ((TrapOK.of_msg fun _ => Iff.rfl).of_imp fun hb => by
      rw [hPotEq] at hb
      simp only [Bool.or_eq_true, Bool.and_eq_true] at hb ⊢
      rcases hb with hb | ⟨ha, hw⟩
      · have hd : depth = true := by
          cases hdep : depth
          · have := Expr.fits_of_depthCalls funs fits body (hDepth hdep) args
            simp [this] at hb
          · rfl
        refine Or.inl ⟨hd, ?_⟩
        simp only [Bool.not_eq_true'] at hb
        simp [hb]
      · exact Or.inr ⟨hAborts (by simp only [Bool.or_eq_true]; exact Or.inl ha), hw⟩)
    fun heap' store' s' ws' a hTopB => ?_
  · cases hdep : depth
    · rw [hDepth hdep] at hb; exact nomatch hb
    · rw [hp1, hp0]; exact hHead hdep
  · rw [paramSlots_getD x]
    exact ⟨show p0 + x.offset + t.width ≤ p0 + widthSum params by
      have := x.offset_width; omega, _, hHold x, hRep.var x⟩
  · rw [paramSlots_getD x] at hwx hmo
    rw [paramSlots_getD y] at hwy ⊢
    obtain rfl := LocalsHold.unique hwx (hHold x) (by rw [hlx, hWords])
    obtain rfl := LocalsHold.unique hwy (hHold y) (by rw [hly, hWords])
    exact hRep.apart x hSep y hxy hmo
  · have hLen := a.rep.length
    have hValues : (ws'.reverse ++ s1.values).take
        (bodyFunction modes body depth pos pool).results.length ++
        (dv ++ ws).reverse.drop (bodyFunction modes body depth pos pool).numParams = ws'.reverse := by
      rw [hv1, hv0, hNum, hRes, List.append_nil,
        List.take_of_length_le (by rw [List.length_reverse, hLen]),
        List.drop_of_length_le (by rw [List.length_reverse, List.length_append, hdv, hLength]),
        List.append_nil]
    simp only [hValues]
    refine ⟨heap', a.step.at_, ?_, a.step.caps, fun r hr hpos hA => ?_, fun hf => ?_⟩
    · rw [List.reverse_reverse]
      exact a.rep
    · obtain ⟨hb, hreg, hf⟩ := a.step.keeps r hr hpos fun t x _ _ hmo wx hwx hlx b hb => by
        rw [paramSlots_getD x] at hwx hmo
        obtain rfl := LocalsHold.unique hwx (hHold x) (by rw [hlx, hWords x])
        rw [Ty.blocks_pointers] at hb
        obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hb
        exact hA q (Env.moves_var x hRep hmo q hq)
      refine ⟨hb, hreg, fun b hb' => hf b ?_⟩
      rw [List.reverse_reverse] at hb'
      exact hb'
    · have := hTopB (hFitsB hf)
      rw [hPotEq] at this
      rw [List.reverse_reverse]
      exact this

/-- A run that may trap as `a` allows may trap as any `a'` that `a` implies. -/
theorem _root_.Wasm.Runs.of_imp {α : Type} {env : HostEnv α} {m : Module} {id : Nat}
    {initial : Store α} {args : List Value} {P : Store α → List Value → Prop} {a a' : Bool}
    (h : Runs a env m id initial args P) (himp : a = true → a' = true) :
    Runs a' env m id initial args P := by
  cases a
  · exact h.weaken
  · rw [himp rfl]; exact h

/-- The code of a function whose code does not take the call depth computes its body's meaning
from the words of its arguments, within the function's bound. -/
theorem bodyFunction_implements {S : List Sig} {params : List Ty} {result : Ty}
    (modes : List Mode) (body : Expr S params result) (placeArgs : body.placeArgs = true)
    (funs : Funs S) (flags : Flags S) (bounds : Bounds S) (fits : Fits S) (pf : List Bool)
    (rf : Bool) (hrf : rf = true →
      body.paid flags (entryModes params modes) pf (fun _ => false) = true)
    (m : Module) (pos : Nat) (hm : Runtime m)
    (hFunc : m.funcs[pos]? = some (bodyFunction modes body false pos pool))
    (hCovered : body.Covered pool) {d0 : UInt64}
    (hCalls : CallsAt m funs flags bounds fits d0 pool) (hDepth : body.depthCalls = false)
    (aborts : Bool)
    (hAborts : (body.aborts || !result.scalar || (paramModes params modes).any (· == .owned)) =
      true → aborts = true) :
    @ImplementsP _ _ (Env.represent params modes) (Ty.represent result) (fun _ => True)
      (fun _ => true)
      (fun store ws x => Env.argPot store (fun i => paidAt pf i && paramMode params modes i == .owned)
        ws x)
      (fun store ws v => if rf then result.pot store ws v else 0) aborts m pos
      (body.denote funs) (bodyBound modes pf body funs flags bounds) pool := by
  intro host store heap ws args _ hAt hInput hRep hSep hCap
  have hRun := bodyFunction_runs modes body placeArgs false funs flags bounds fits pf rf hrf m pos
    hm hFunc hCovered d0 (fun _ => hCalls) (fun _ => hDepth) aborts (fun h => hAborts (by simpa using h))
    host store heap ws args hAt hInput hRep hSep hCap
  simp only [Bool.false_eq_true, ↓reduceIte, List.nil_append, Bool.false_and,
    Bool.false_or] at hRun
  exact hRun.mono fun final values ⟨heap', hAt', hOwned, hCaps, hRegions, hTop⟩ =>
    ⟨heap', hAt', hOwned, hCaps, hRegions, fun _ => by simpa using hTop⟩

/-- The frames at the next depth: one fewer, below the limit. -/
theorem framesAt_succ {d : UInt64} (h : d < depthLimit) : framesAt d = framesAt (d + 1) + 1 := by
  have := UInt64.lt_iff_toNat_lt.mp h
  simp only [depthLimit, UInt64.reduceToNat] at this
  have hd1 : (d + 1).toNat = d.toNat + 1 := by
    rw [UInt64.toNat_add]; simp only [UInt64.reduceToNat]; omega
  simp only [framesAt, depthLimit, UInt64.reduceToNat, hd1]; omega

theorem framesAt_eq_zero {d : UInt64} (h : ¬d < depthLimit) : framesAt d = 0 := by
  have := UInt64.not_lt.mp h
  have := UInt64.le_iff_toNat_le.mp this
  simp only [depthLimit, UInt64.reduceToNat] at this
  simp only [framesAt, depthLimit, UInt64.reduceToNat]; omega

/-- The code of a function whose code takes the call depth computes its body's meaning from the
words of the depth `d` and its arguments, when the functions that the body calls compute theirs
at the next depth below the limit, within the bound `A` when its calls find their frames as `Fi`
states, which are its body's below the limit, and with any trap at the limit. -/
theorem bodyFunction_depth {S : List Sig} {params : List Ty} {result : Ty} (modes : List Mode)
    (body : Expr S params result) (placeArgs : body.placeArgs = true) (funs : Funs S)
    (flags : Flags S) (bounds : Bounds S) (fits : Fits S) (pf : List Bool) (rf : Bool)
    (hrf : rf = true → body.paid flags (entryModes params modes) pf (fun _ => false) = true)
    (m : Module) (pos : Nat) (hm : Runtime m)
    (hFunc : m.funcs[pos]? = some (bodyFunction modes body true pos pool))
    (hCovered : body.Covered pool) (d : UInt64)
    (hCalls : d < depthLimit → CallsAt m funs flags bounds fits d pool) (Fi : Env params → Bool)
    (A : Env params → Nat)
    (hFi : ∀ args, Fi args = (decide (d < depthLimit) && body.fits funs fits args))
    (hA : d < depthLimit → ∀ args, A args = bodyBound modes pf body funs flags bounds args) :
    @ImplementsP _ _ (Env.represent (.word :: params) (.borrowed :: modes)) (Ty.represent result)
      (fun env => env.depthOf = d) (fun env => Fi env.dropDepth)
      (fun store ws x => Env.argPot store
        (depthSelOf fun i => paidAt pf i && paramMode params modes i == .owned) ws x)
      (fun store ws v => if rf then result.pot store ws v else 0) true m pos
      (depthMeaning (body.denote funs)) (fun env => A env.dropDepth) pool := by
  intro host store heap vs env hd hAt hInput hRep hSep hCap
  cases env with
  | cons d' args =>
    change d' = d at hd
    subst hd
    obtain ⟨ws, rfl, hRep'⟩ := Env.rep_depth.mp hRep
    have hSep' : Separate store (Env.moves store (paramMode params modes) ws args)
        (Env.reads store (paramMode params modes) ws args) := by
      have := hSep
      change Separate store
        (Env.moves store (paramMode (.word :: params) (.borrowed :: modes)) (.i64 d' :: ws)
          (.cons (t := .word) d' args))
        (Env.reads store (paramMode (.word :: params) (.borrowed :: modes)) (.i64 d' :: ws)
          (.cons (t := .word) d' args)) at this
      rw [Env.moves_depth, Env.reads_depth] at this
      exact this
    have hInput' : @pool.Input (Env params) (Env.represent params modes) heap store ws args := by
      refine ⟨hInput.1, ?_⟩
      intro region hRegion
      change Apart store (Env.moves store (paramMode params modes) ws args) region
      have hApart := hInput.2 region hRegion
      change Apart store
        (Env.moves store (paramMode (.word :: params) (.borrowed :: modes))
          (.i64 d' :: ws) (.cons (t := .word) d' args)) region at hApart
      rw [Env.moves_depth] at hApart
      exact hApart
    have hRun := bodyFunction_runs modes body placeArgs true funs flags bounds fits pf rf hrf m pos
      hm hFunc hCovered d' (fun h => hCalls (h rfl)) nofun true (fun _ => rfl) host store heap ws args hAt
      hInput' hRep' hSep' hCap
    simp only [↓reduceIte, List.singleton_append, Bool.true_and] at hRun
    change Runs (!Fi args || (true && !decide (heap.Within store m
      (Env.argPot store (depthSelOf fun i => paidAt pf i && paramMode params modes i == .owned)
        (.i64 d' :: ws) (.cons (t := .word) d' args) + A args)))) host m pos store
      (Value.i64 d' :: ws).reverse _
    rw [Env.argPot_depthOf]
    refine (hRun.of_imp fun h => ?_).mono
      fun final values ⟨heap', hAt', hOwned, hCaps, hRegions, hTop⟩ =>
        ⟨heap', hAt', hOwned, hCaps, fun r hr hpos hA' => hRegions r hr hpos (by
          change Apart store (Env.moves store (paramMode (.word :: params) (.borrowed :: modes))
            (.i64 d' :: ws) (.cons (t := .word) d' args)) r at hA'
          rw [Env.moves_depth] at hA'
          exact hA'), fun hf => ?_⟩
    · change (!Fi args || (true && !decide (heap.Within store m
        (Env.argPot store (fun i => paidAt pf i && paramMode params modes i == .owned) ws args +
          A args)))) = true
      rw [hFi]
      simp only [Bool.or_eq_true, Bool.not_eq_true', Bool.and_eq_true, decide_eq_true_eq,
        Bool.true_and, decide_eq_false_iff_not, Bool.and_eq_false_iff] at h ⊢
      by_cases hlt : d' < depthLimit
      · rcases h with h | h
        · exact Or.inl (Or.inr (h.resolve_left (by simpa using hlt)))
        · refine Or.inr ?_
          rw [hA hlt]; exact h
      · exact Or.inl (Or.inl (by simpa using hlt))
    · change Fi args = true at hf
      rw [hFi] at hf
      simp only [Bool.and_eq_true, decide_eq_true_eq] at hf
      show _ ≤ heap.top.toNat + Env.argPot store (depthSelOf fun i =>
        paidAt pf i && paramMode params modes i == .owned) (.i64 d' :: ws)
          (.cons (t := .word) d' args) + A args
      rw [Env.argPot_depthOf, hA hf.1]
      exact hTop (by simp [hf.1, hf.2])


end Verified