import vc0.basic

namespace c0

open ast ast.gdecl

theorem start_ok (Γ : ast) (ok : Γ.ok) : ∀ s, start Γ s → state.ok Γ s
| _ (@start.mk _ s h) := begin
  rcases get_body_ok' ok.ind h with ⟨h₁, h₂|⟨⟨⟩⟩⟩,
  rcases ok.ok_init h with ⟨δ, h₃⟩,
  exact state.ok.stmt (some type.int) env.ok.empty vtype.of_ty.int h₁ h₃ (or.inl h₂)
end

namespace value

theorem default.ok {Γ : ast} {ts v} (Γok : Γ.ok)
  (h : default Γ ts v) (E) : ok_type_or_sdef Γ E v ts :=
begin
  induction h,
  { exact ⟨_, vtype.of_ty.int, ok.int⟩ },
  { exact ⟨_, vtype.of_ty.bool, ok.bool⟩ },
  { exact ⟨_, vtype.of_ty.ref (vtype.of_ty_fn _).2, ok.null⟩ },
  { exact ⟨_, vtype.of_ty.arr (vtype.of_ty_fn _).2, ok.null_arr⟩ },
  { rcases h_ih with ⟨vs, vm, al'⟩,
    refine ⟨_, vtype.of_ty.struct, ok.struct
      (λ sd' τs hd al, value.of_map_ok.2 ⟨_, rfl, _⟩) vm⟩,
    cases get_sdef_determ Γok.ind h_a hd,
    refine list.forall₂.mp_trans _ al'.flip al,
    rintro _ _ _ ⟨i, v, t, τ, tτ, vok⟩ ⟨_, _, τ', tτ'⟩,
    cases vtype.of_ty_determ tτ tτ',
    exact ⟨vok⟩ },
  { exact ⟨∅, rfl, list.forall₂.nil⟩ },
  case c0.value.default.cons : Δ x τ h v vs h₁ h₂ IH₁ IH₂ {
    rcases IH₁ with ⟨τ', tτ₁, vok⟩,
    rcases IH₂ with ⟨τs', rfl, al⟩,
    exact ⟨_, (of_map_cons (mt al.mem_iff.2 h)).symm,
      alist.forall₂_cons.2 ⟨⟨_, tτ₁, vok⟩, al⟩⟩ },
end

theorem default.ok' {Γ : ast} {t τ v} (ok : Γ.ok)
  (h : default Γ (sum.inl t) v) (E)
  (tτ : vtype.of_ty (exp.type.reg t) τ) : value.ok Γ E v τ :=
let ⟨τ', h₁, h₂⟩ := h.ok ok E in vtype.of_ty_determ h₁ tτ ▸ h₂

theorem ok.repeat {Γ E v τ} (h : value.ok Γ E v τ) :
  ∀ {n}, value.ok Γ E (value.repeat v n) (vtype.arr' τ n)
| 0     := value.ok.nil
| (n+1) := value.ok.cons h ok.repeat

end value

namespace addr

theorem update.ok {Γ E Δ H σ η} (ok : ast.okind Γ)
  (σok : vars_ty.ok Δ σ)
  (Hok : heap.ok Γ H E) (ηok : vars.ok Γ E η σ)
  {R a H' η' τ} (aok : addr.ok Γ E σ a τ)
  (h : update H η R a H' η')
  (Rok : ∀ x, value.ok Γ E x τ → ∀ y, R x y → value.ok Γ E y τ) :
  heap.ok Γ H' E ∧ vars.ok Γ E η' σ :=
begin
  induction h generalizing τ,
  case c0.addr.update.ref : R n H' {
    rcases aok with ⟨_, _, m⟩,
    suffices : ∀ E', list.forall₂ (value.ok Γ E) H E' → τ ∈ list.nth E' n →
      list.forall₂ (value.ok Γ E) H' E', from ⟨this _ Hok m, ηok⟩,
    clear Hok m,
    induction h_a with v v' vs r n v' H H' h IH;
      intros E' Hok m; cases Hok with _ τ' _ E' v'ok vsok,
    { cases m,
      exact list.forall₂.cons (Rok _ v'ok _ r) vsok },
    { exact list.forall₂.cons v'ok (IH _ vsok m) } },
  case c0.addr.update.var : R i v v' e mη r {
    refine ⟨Hok, λ j τ' τσ, _⟩, subst e,
    rcases ηok _ _ τσ with ⟨x, xη, xok⟩,
    rcases aok with _|⟨_, _, mσ⟩,
    revert η, refine λ η, finmap.induction_on η (λ η, _), intros,
    have := alist.replace_forall₂ i v' η,
    rcases this.rel_of_lookup_right xη with ⟨v', m', h⟩,
    refine ⟨v', m', _⟩,
    cases h,
    { cases option.mem_unique mη xη,
      cases option.mem_unique mσ τσ,
      exact Rok _ xok _ r },
    { exact xok } },
  case c0.addr.update.head : R a H' η' h IH {
    rcases aok with _|_|⟨_, _, τs, aok⟩,
    exact IH aok (at_head.ok Rok) },
  case c0.addr.update.tail : R a H' η' h IH {
    rcases aok with _|_|_|⟨_, τ₁, _, aok⟩,
    exact IH aok (at_tail.ok Rok) },
  case c0.addr.update.nth : R a i H' η' h IH {
    rcases aok with _|_|_|_|⟨_, τ₁, _, aok⟩,
    exact IH aok_a_2 (at_nth.ok Rok aok_a_1) },
  case c0.addr.update.field : R a f H' η' h IH {
    rcases aok with _|_|_|_|⟨_, τ₁, _, aok⟩,
    exact IH aok_a_4 (at_field.ok ok Rok aok_a_1 aok_a_2 aok_a_3) },
end

end addr

theorem assign.ok {Γ E Δ σ η x v t τ}
  (σok : vars_ty.ok Δ σ) (ηok : vars.ok Γ E η σ)
  (xok : t ∈ Δ.lookup x)
  (tτ : vtype.of_ty (exp.type.reg t) τ)
  (vok : value.ok Γ E v τ) :
∃ σ', vars_ty.ok Δ σ' ∧
  σ'.keys = insert x σ.keys ∧
  vars.ok Γ E (vars.assign η x v) σ' :=
begin
  by_cases xσ : x ∈ σ,
  { refine ⟨σ, σok, (finset.insert_eq_of_mem (finmap.mem_keys.2 xσ)).symm, _⟩,
    rw [vars.assign, if_pos (ηok.mem xσ)],
    intros y τ' hy,
    by_cases x = y,
    { subst y,
      rcases σok _ _ hy with ⟨t', h₁, h₂⟩,
      cases option.mem_unique xok h₁,
      cases vtype.of_ty_determ tτ h₂,
      exact ⟨v, finmap.lookup_replace_self (ηok.mem xσ), vok⟩ },
    { rcases ηok _ _ hy with ⟨v', h₁, h₂⟩,
      refine ⟨v', _, h₂⟩,
      convert h₁ using 1,
      exact finmap.lookup_replace_of_ne h } },
  { refine ⟨σ.insert x τ, λ y τ' hy, _, finmap.keys_insert _ _ _, λ y τ' hy, _⟩;
      rw finmap.lookup_insert_of_neg xσ at hy;
      rcases hy with ⟨⟨⟩⟩ | hy,
    { exact ⟨_, xok, tτ⟩ },
    { exact σok _ _ hy },
    { refine ⟨v, _, vok⟩,
      rw vars.assign, split_ifs,
      { exact finmap.lookup_replace_self h },
      { exact (finmap.lookup_insert_of_neg h).2 (or.inl rfl) } },
    { rcases ηok _ _ hy with ⟨v', h₁, h₂⟩,
      refine ⟨v', _, h₂⟩,
      rw vars.assign, split_ifs,
      { rwa finmap.lookup_replace_of_ne,
        rintro rfl,
        cases xσ (finmap.exists_mem_lookup_iff.1 ⟨_, hy⟩) },
      { exact (finmap.lookup_insert_of_neg h).2 (or.inr h₁) } } }
end

theorem value.step_binop.ok {Γ E op t₁ t₂ τ₁ τ₂ v₁ v₂ v}
  (sok : value.step_binop op v₁ v₂ (sum.inl v))
  (opok : binop.ok op t₁ t₂)
  (tτ₁ : vtype.of_ty (exp.type.reg t₁) τ₁)
  (tτ₂ : vtype.of_ty (exp.type.reg t₂) τ₂)
  (vok₁ : value.ok Γ E v₁ τ₁) (vok₂ : value.ok Γ E v₂ τ₁) :
  value.ok Γ E v τ₂ :=
begin
  generalize_hyp e : sum.inl v = o at sok,
  generalize_hyp e' : op = o' at opok,
  induction sok; cases opok; cases e'; try {injection e, subst v};
    cases tτ₁; cases tτ₂; try {constructor},
  all_goals {
    rcases (⟨_, e⟩ : ∃ x, sum.inl v = value.to_err x) with ⟨_|_, ⟨⟩⟩,
    constructor }
end

theorem value.step_unop.ok {Γ E op t₁ t₂ τ₁ τ₂ v v'}
  (sok : value.step_unop op v v')
  (opok : unop.ok op t₁ t₂)
  (tτ₁ : vtype.of_ty (exp.type.reg t₁) τ₁)
  (tτ₂ : vtype.of_ty (exp.type.reg t₂) τ₂)
  (vok₁ : value.ok Γ E v τ₁) : value.ok Γ E v' τ₂ :=
by cases sok; cases opok; cases tτ₁; cases tτ₂; constructor

theorem stmt_list.ok.mono {Γ Δ δ₁ δ₂ ret K}
  (ss : δ₁ ⊆ δ₂) (Kok : stmt_list.ok Γ ret Δ δ₁ K) :
  stmt_list.ok Γ ret Δ δ₂ K :=
begin
  induction Kok generalizing δ₂,
  { exact stmt_list.ok.nil Kok_a },
  { rcases Kok_a_2.mono ss with ⟨δ', ss', i⟩,
    exact stmt_list.ok.one Kok_a Kok_a_1 i },
  { rcases Kok_a_1.mono ss with ⟨δ', ss', i⟩,
    exact stmt_list.ok.cons Kok_a i (Kok_ih ss') },
  { exact stmt_list.ok.weak (Kok_ih (finset.erase_subset_erase _ ss)) }
end

theorem stmt_list.ok.cons_inv {Γ E Δ σ η ret s K}
  (σok : vars_ty.ok Δ σ)
  (ηok : vars.ok Γ E η σ) : stmt_list.ok Γ ret Δ σ.keys (s :: K) →
  ∃ Δ' σ' δ', vars_ty.ok Δ' σ' ∧ vars.ok Γ E η σ' ∧
    stmt.ok Γ ret Δ' s ∧
    stmt.init' Γ Δ'.keys.to_finset σ'.keys s δ' ∧
    (stmt.returns s ∨ stmt_list.ok Γ ret Δ' δ' K) :=
begin
  generalize e : (s :: K : list stmt) = K',
  generalize e' : σ.keys = δ,
  intro Kok, induction Kok generalizing σ; cases e; subst Kok_δ,
  { exact ⟨_, _, _, σok, ηok, Kok_a, Kok_a_2, or.inl Kok_a_1⟩ },
  { rcases Kok_a_1.subset Kok_a rfl σok.subset with ⟨ss₁', ss₂'⟩,
    exact ⟨_, _, _, σok, ηok, Kok_a, Kok_a_1, or.inr Kok_a_2⟩ },
  { exact Kok_ih rfl σok.erase ηok.erase (finmap.keys_erase _ _) }
end

theorem step_deref.ok {Γ E σs Δ σ H S η ret a τ K s'}
  (σok : vars_ty.ok Δ σ) (Eok : heap.ok Γ H E)
  (ηok : vars.ok Γ E η σ) (Sok : stack.ok Γ E σs S ret)
  (aok : addr_opt.ok Γ E σ a τ)
  (Kok : cont.ok' Γ E σ Δ ret K τ)
  (h : step_deref ⟨H, S, η⟩ a K s') : state.ok Γ s' :=
begin
  cases h,
  { apply state.ok.err },
  { exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩
      (h_a_1.ok σok Eok ηok aok) Kok }
end

theorem step_ret.ok {Γ E σs Δ σ H S η τ v s'}
  (σok : vars_ty.ok Δ σ) (Eok : heap.ok Γ H E)
  (ηok : vars.ok Γ E η σ) (Sok : stack.ok Γ E σs S τ)
  (vok : value.ok Γ E v τ)
  (h : step_ret ⟨H, S, η⟩ v s') : state.ok Γ s' :=
begin
  cases h,
  { cases Sok with Δ' η K' S' σ σs τ₁ τ' σok' ηok' Kok' Sok',
    exact state.ok.ret ⟨σok', Eok, ηok', Sok'⟩ vok Kok' },
  { apply state.ok.done }
end

theorem step_call.ok {Γ : ast} {Δ : ctx} {E vs τs η}
  (τok : vtype.of_ty (exp.type.ls Δ.values) τs)
  (sc : step_call Δ vs η) (vok : value.ok Γ E vs τs) :
  ∃ σ, vars_ty.ok Δ σ ∧ vars.ok Γ E η σ ∧ Δ.keys.to_finset ⊆ σ.keys ∧ ∀ x ∈ η, x ∈ σ :=
begin
  induction sc with Δ x τ v vs η h a IH generalizing τs; cases τok; cases vok,
  { exact ⟨∅, by rintro _ _ ⟨⟩, by rintro _ _ ⟨⟩, λ _, id, by rintro _ ⟨_, ⟨⟩⟩⟩ },
  { rcases IH τok_a_1 vok_a_1 with ⟨σ, σok, ηok, ss, ησ⟩,
    have ηok' := ηok.insert (mt (σok.mem ∘ ησ _) h) vok_a,
    refine ⟨_, (σok.weak _).insert (mt σok.mem h) alist.lookup_cons_self τok_a,
      ηok', _, λ y h, _⟩,
    { rw [alist.cons_keys, list.cons_to_finset, finmap.keys_insert],
      exact finset.insert_subset_insert _ ss },
    { rw [← finmap.mem_keys, finmap.keys_insert, finset.mem_insert, finmap.mem_keys] at h ⊢,
      exact h.imp_right (ησ _) } }
end

theorem step_alloc.ok {Γ E σs Δ σ H S ret η τ v K s}
  (σok : vars_ty.ok Δ σ) (Eok : heap.ok Γ H E)
  (ηok : vars.ok Γ E η σ) (Sok : stack.ok Γ E σs S ret)
  (vok : value.ok Γ E v τ) (Kok : cont.ok' Γ E σ Δ ret K (vtype.ref τ))
  (h : step_alloc ⟨H, S, η⟩ v K s) : state.ok Γ s :=
begin
  cases h,
  have EE : E ≤ E.add τ := E.le_add τ,
  refine state.ok.ret
    ⟨σok, Eok.add (vok.mono EE), ηok.mono EE, Sok.mono EE⟩
    (value.ok.ref _) (Kok.mono EE),
  rintro _ ⟨⟩,
  rw list.forall₂_length_eq Eok,
  apply list.nth_concat_length
end

theorem step_alloc_arr.ok {Γ E σs Δ σ H S ret η τ n v K s}
  (σok : vars_ty.ok Δ σ) (Eok : heap.ok Γ H E)
  (ηok : vars.ok Γ E η σ) (Sok : stack.ok Γ E σs S ret)
  (vok : value.ok Γ E v (vtype.arr τ n))
  (Kok : cont.ok' Γ E σ Δ ret K (vtype.refarr τ))
  (h : step_alloc ⟨H, S, η⟩ v K s) : state.ok Γ s :=
begin
  cases h,
  have EE : E ≤ E.add (vtype.arr τ n) := E.le_add (vtype.arr τ n),
  refine state.ok.ret
    ⟨σok, Eok.add (vok.mono EE), ηok.mono EE, Sok.mono EE⟩
    (value.ok.refarr _) (Kok.mono EE),
  rintro _ ⟨⟩, existsi n,
  rw list.forall₂_length_eq Eok,
  apply list.nth_concat_length
end

theorem preservation {Γ : ast} (ok : Γ.ok)
  {s} (sok : state.ok Γ s) {o} (iok : io.ok Γ o)
  {s'} (H : step Γ s o s') : state.ok Γ s' :=
begin
  cases H,
  case c0.step.decl : H S η v τ τ' s K H₁ {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, ⟨_, _, _, τ', _, hn, ττ', τsm, sok⟩, si, Kok⟩,
    cases si,
    refine state.ok.stmt t ⟨σok.weak _, Eok, ηok, Sok⟩ tτ sok
      (by simpa using si_a) _,
    rcases Kok with ⟨⟨_, _, _, r⟩⟩|Kok,
    { exact or.inl r },
    { exact or.inr Kok.weak } },
  case c0.step.decl_asgn : H S η v τ τ' e s K H₁ {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, Kok⟩, cases si, cases sok,
    refine state.ok.stmt t ⟨σok.weak sok_h, Eok, ηok, Sok⟩ tτ
      (stmt.ok.asgn (exp.ok.var alist.lookup_cons_self) sok_a_2.weak' sok_a_1)
      (ast.stmt.init.asgn ⟨⟩ si_a) (or.inr _),
    change stmt.init' Γ (insert v sok_Δ.keys.to_finset)
      (insert v sok_σ.keys) s si_δ' at si_a_1,
    rw [← list.cons_to_finset, ← alist.cons_keys] at si_a_1,
    rcases Kok with ⟨⟨⟩⟩|Kok,
    { exact stmt_list.ok.one sok_a_3 Kok_a si_a_1 },
    { exact Kok.weak.cons sok_a_3 si_a_1 } },
  case c0.step.If₁ : C c s₁ s₂ K {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, Kok⟩, cases si, cases sok,
    refine state.ok.exp ⟨σok, Eok, ηok, Sok⟩ si_a ⟨⟩
      ⟨_, sok_a_1, vtype.of_ty.bool⟩
      (cont.ok.If tτ sok_a_2 si_a_1 sok_a_3 si_a_2 _),
    rcases Kok with ⟨⟨⟩⟩|Kok,
    { exact or.inl ⟨Kok_a, Kok_a_1⟩ },
    { exact or.inr Kok } },
  case c0.step.If₂ : C b s₁ s₂ K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      _, _, _, _, δ₁, δ₂, _, t, tτ, s₁ok, i₁, s₂ok, i₂, Kok⟩,
    cases b,
    exact state.ok.stmt t ⟨σok, Eok, ηok, Sok⟩ tτ s₂ok i₂
      (Kok.imp and.right $ stmt_list.ok.mono (finset.inter_subset_right _ _)),
    exact state.ok.stmt t ⟨σok, Eok, ηok, Sok⟩ tτ s₁ok i₁
      (Kok.imp and.left $ stmt_list.ok.mono (finset.inter_subset_left _ _)) },
  case c0.step.while : C c s K {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, ⟨⟨⟩⟩|Kok⟩, cases si, cases id sok,
    have := si_a_1.subset a_1 rfl σok.subset,
    rcases si.mono this.1 with ⟨δ'', ss', i'⟩,
    exact (state.ok.exp ⟨σok, Eok, ηok, Sok⟩ si_a ⟨⟩ ⟨_, a, vtype.of_ty.bool⟩ $
      cont.ok.If tτ (a_1.seq sok) (si_a_1.seq i') stmt.ok.nop stmt.init.nop $
      or.inr $ Kok.mono $ finset.subset_inter ss' (finset.subset.refl _)) },
  case c0.step.asgn₁ : C lv e K eq {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, ⟨⟨⟩⟩|Kok⟩, cases si, cases sok,
    rcases vtype.of_ty_fn sok_τ with ⟨vτ, hv⟩,
    rw [lval.uses, eq] at si_a, rw eq at Kok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ si_a lv.ok ⟨_, sok_a_1, hv⟩
      (cont.ok.asgn₁ ⟨_, sok_a_2, hv⟩ si_a_1 ⟨t, tτ, Kok⟩) },
  case c0.step.asgn₂ : C a e K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      aok, _|⟨_, _, _, _, ⟨t, eok, tτ⟩, eu, t', tτ', Kok⟩⟩,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu ⟨⟩
      ⟨_, eok, tτ⟩ (cont.ok.asgn₂ aok ⟨_, tτ', Kok⟩) },
  case c0.step.asgn₃ : H H' S η η' a v K h {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, _|_|⟨_, _, _, _, aok, t, tτ, Kok⟩⟩,
    rcases h.ok ok.ind σok Eok ηok aok (addr.eq.ok vok) with ⟨Eok', ηok'⟩,
    exact state.ok.stmt t ⟨σok, Eok', ηok', Sok⟩ tτ
      stmt.ok.nop stmt.init.nop (or.inr Kok) },
  case c0.step.asgn_var₁ : C lv x e K eq {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, ⟨⟨⟩⟩|Kok⟩, cases si, cases sok,
    cases lv; cases eq,
    rcases vtype.of_ty_fn sok_τ with ⟨vτ, hv⟩,
    rcases sok_a_1 with _|_|_|⟨_, t', tΔ⟩,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ si_a_1 ⟨⟩
      ⟨_, sok_a_2, hv⟩ (cont.ok.asgn_var tΔ hv ⟨_, tτ, Kok⟩) },
  case c0.step.asgn_var₂ : H S η x v K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, Kok⟩, cases Kok, rcases Kok_a_2 with ⟨t, tτ, Kok⟩,
    rcases assign.ok σok ηok Kok_a Kok_a_1 vok with ⟨σ', σok', e, ηok'⟩,
    exact state.ok.stmt _ ⟨σok', Eok, ηok', Sok⟩ tτ
      stmt.ok.nop stmt.init.nop (or.inr (by rwa e)) },
  case c0.step.asgn_err : H S η v K { apply state.ok.err },
  case c0.step.asnop₁ : C lv op e K {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, ⟨⟨⟩⟩|Kok⟩, cases si, cases id sok,
    rcases vtype.of_ty_fn (exp.type.reg τ_1) with ⟨vτ, hv⟩,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ si_a lv.ok
      ⟨_, a, hv⟩ (cont.ok.asnop a_2 hv a_1 si_a_1 ⟨_, tτ, Kok⟩) },
  case c0.step.asnop₂ : _ C a op e K h {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      aok, Kok⟩, cases Kok, cases Kok_a with _ opok,
    exact step_deref.ok σok Eok ηok Sok aok
      (cont.ok.binop₁ opok Kok_a_1 Kok_a_1 Kok_a_2 Kok_a_3 $
       cont.ok.asgn₂ aok Kok_a_4) h },
  case c0.step.eval₁ : C e K {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, ⟨⟨⟩⟩|Kok⟩, cases si, cases id sok,
    rcases vtype.of_ty_fn τ_1 with ⟨vτ, hv⟩,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ si_a ⟨⟩
      ⟨_, a, hv⟩ (cont.ok.eval ⟨t, tτ, Kok⟩) },
  case c0.step.eval₂ : C e K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      aok, Kok⟩, cases Kok, rcases Kok_a with ⟨t, tτ, Kok⟩,
    exact state.ok.stmt t ⟨σok, Eok, ηok, Sok⟩ tτ
      stmt.ok.nop stmt.init.nop (or.inr Kok) },
  case c0.step.assert₁ : C e K {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, ⟨⟨⟩⟩|Kok⟩, cases si, cases id sok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ si_a ⟨⟩
      ⟨_, a, vtype.of_ty.bool⟩ (cont.ok.assert ⟨t, tτ, Kok⟩) },
  case c0.step.assert₂ : C b K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      aok, Kok⟩,
    cases b, {apply state.ok.err},
    cases Kok, rcases Kok_a with ⟨t, tτ, Kok⟩,
    exact state.ok.stmt t ⟨σok, Eok, ηok, Sok⟩ tτ
      stmt.ok.nop stmt.init.nop (or.inr Kok) },
  case c0.step.ret₁ : C e K {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, Kok⟩, cases si, cases id sok, cases a,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ (si_a _ rfl) ⟨⟩
      ⟨_, a_a_1, tτ⟩ cont.ok.ret },
  case c0.step.ret₂ : _ C v h {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, ⟨⟩⟩,
    exact h.ok σok Eok ηok Sok vok },
  case c0.step.ret_none : _ C v h {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, Kok⟩, cases id sok, cases a, cases tτ,
    exact h.ok σok Eok ηok Sok value.ok.nil },
  case c0.step.nop₁ : _ C h {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, _, si, ⟨⟨⟩⟩|Kok⟩, cases si, cases Kok.eq_none, cases tτ,
    exact h.ok σok Eok ηok Sok value.ok.nil },
  case c0.step.nop₂ : C s K {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, _, si, ⟨⟨⟩⟩|Kok⟩, cases si,
    rcases Kok.cons_inv σok ηok with ⟨Δ', σ', δ', σok', ηok', sok, si', Kok⟩,
    exact state.ok.stmt t ⟨σok', Eok, ηok', Sok⟩ tτ sok si' Kok },
  case c0.step.seq : C s₁ s₂ K {
    rcases sok with ⟨_, _, _, _, _, τ, _, _, _, t,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      tτ, sok, si, Kok⟩, cases si, cases id sok, rcases Kok with ⟨⟨⟩⟩|Kok,
    { exact state.ok.stmt t ⟨σok, Eok, ηok, Sok⟩ tτ a si_a (or.inl Kok_a) },
    { exact state.ok.stmt t ⟨σok, Eok, ηok, Sok⟩ tτ a si_a
        (or.inr $ stmt_list.ok.one a_1 Kok_a si_a_1) },
    { exact state.ok.stmt t ⟨σok, Eok, ηok, Sok⟩ tτ a si_a
        (or.inr $ Kok.cons a_1 si_a_1) } },
  case c0.step.int : C n K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, ⟨⟩, tτ⟩, Kok⟩, cases tτ,
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩ value.ok.int Kok },
  case c0.step.bool : C b K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, ⟨⟩, tτ⟩, Kok⟩, cases tτ,
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩ value.ok.bool Kok },
  case c0.step.null : C K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, ⟨⟩, tτ⟩, Kok⟩, cases tτ,
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩ value.ok.null Kok },
  case c0.step.var : C i v K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨_, _|_|_|⟨_, t, iΔ⟩, tτ⟩, Kok⟩,
    rcases finmap.exists_mem_lookup_iff.2 (finmap.mem_keys.1 eu) with ⟨τ', iτ'⟩,
    cases vtype.of_ty_determ tτ (σok.ok_of_mem iτ' iΔ),
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩ (ηok.ok_of_mem iτ' H_a) Kok },
  case c0.step.binop₁ : C op e₁ e₂ K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      ⟨eu₁, eu₂⟩, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    rcases vtype.of_ty_fn (exp.type.reg eok_τ₁) with ⟨vτ₁, hv₁⟩,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu₁ ⟨⟩
      ⟨_, eok_a, hv₁⟩ (cont.ok.binop₁ eok_a_2 hv₁ tτ eok_a_1 eu₂ Kok) },
  case c0.step.binop₂ : C op v₁ e₂ K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, Kok⟩, cases Kok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ Kok_a_4 ⟨⟩ ⟨_, Kok_a_3, Kok_a_1⟩
      (cont.ok.binop₂ Kok_a Kok_a_1 Kok_a_2 vok Kok_a_5) },
  case c0.step.binop₃ : C op v₁ v₂ v K sb {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok₂, Kok⟩, cases Kok,
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩
      (sb.ok Kok_a Kok_a_1 Kok_a_2 Kok_a_3 vok₂) Kok_a_4 },
  case c0.step.binop_err : C op v₁ v₂ err K sb { apply state.ok.err },
  case c0.step.unop₁ : C op e K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    rcases vtype.of_ty_fn (exp.type.reg eok_τ₁) with ⟨vτ₁, hv₁⟩,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu ⟨⟩
      ⟨_, eok_a, hv₁⟩ (cont.ok.unop eok_a_1 hv₁ tτ Kok) },
  case c0.step.unop₂ : C op v v' K su {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, Kok⟩, cases Kok,
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩
      (su.ok Kok_a Kok_a_1 Kok_a_2 vok) Kok_a_3 },
  case c0.step.cond₁ : C c e₁ e₂ K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      ⟨euc, eu₁, eu₂⟩, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ euc ⟨⟩ ⟨_, eok_a, vtype.of_ty.bool⟩
      (cont.ok.cond ⟨_, eok_a_1, tτ⟩ eu₁ ⟨_, eok_a_2, tτ⟩ eu₂ Kok) },
  case c0.step.cond₂ : C b e₁ e₂ K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, Kok⟩, cases Kok,
    cases b,
    { exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ Kok_a_3 ⟨⟩ Kok_a_2 Kok_a_4 },
    { exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ Kok_a_1 ⟨⟩ Kok_a Kok_a_4 } },
  case c0.step.nil : C K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, ⟨⟩, tτ⟩, Kok⟩, cases tτ,
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩ value.ok.nil Kok },
  case c0.step.cons₁ : C e es K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      ⟨eu₁, eu₂⟩, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok, cases tτ,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu₁ ⟨⟩ ⟨_, eok_a, tτ_a⟩
      (cont.ok.cons₁ ⟨_, eok_a_1, tτ_a_1⟩ eu₂ Kok) },
  case c0.step.cons₂ : C v es K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, Kok⟩, cases Kok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ Kok_a_1 ⟨⟩ Kok_a
      (cont.ok.cons₂ vok Kok_a_2) },
  case c0.step.cons₃ : C v₁ v₂ K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok₂, Kok⟩, cases Kok,
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩
      (value.ok.cons Kok_a vok₂) Kok_a_1 },
  case c0.step.call₁ : C op e K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      ⟨fok, eu⟩, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    rcases vtype.of_ty_fn (exp.type.ls eok_τs) with ⟨vτs, tτs⟩,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu ⟨⟩
      ⟨_, eok_a_1, tτs⟩ (cont.ok.call eok_a fok tτ tτs Kok) },
  case c0.step.call₂ : H S η η' f τ Δ' s vs K bok sc {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, Kok⟩, cases Kok,
    cases ok.fdef_uniq bok.get_fdef Kok_a,
    rcases sc.ok Kok_a_3 vok with ⟨σ', σok', ηok', ss, _⟩,
    rcases get_body_ok' ok.ind bok with ⟨sok, r⟩,
    rcases ok.ok_init bok with ⟨δ, si⟩,
    rcases si.mono ss with ⟨δ', ss', si'⟩,
    exact state.ok.stmt _ ⟨σok', Eok, ηok', Sok.cons σok ηok Kok_a_4⟩
      Kok_a_2 sok si' (r.imp_right stmt_list.ok.nil) },
  case c0.step.call_extern : H S η f vs H' v K ext {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, Kok⟩, cases Kok,
    rcases iok ext Kok_a Kok_a_2 Kok_a_3 Eok vok with ⟨E', EE, Eok', vok'⟩,
    exact state.ok.ret ⟨σok, Eok', ηok.mono EE, Sok.mono EE⟩
       vok' (Kok_a_4.mono EE) },
  case c0.step.deref : C e K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu ⟨⟩ ⟨_, eok_a, tτ.ref⟩
      (cont.ok.addr_deref $ cont.ok.deref Kok) },
  case c0.step.index : C e n K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      ⟨eu₁, eu₂⟩, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu₁ ⟨⟩ ⟨_, eok_a, tτ.arr⟩
      (cont.ok.addr_index₁ eok_a_1 eu₂ $ cont.ok.deref Kok) },
  case c0.step.field : C e n K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu
      (lv_ok_of_struct ok.ind eok_a) ⟨_, eok_a, vtype.of_ty.struct⟩
      (cont.ok.addr_field eok_a_1 eok_a_2 tτ $ cont.ok.deref Kok) },
  case c0.step.deref' : _ C a K sd {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      aok, Kok⟩, cases Kok,
    exact sd.ok σok Eok ηok Sok aok Kok_a },
  case c0.step.alloc_ref : _ C τ τ' v K ττ' v0 sa {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    cases ast.eval_ty.determ ok.ind ττ' eok_a, cases tτ,
    refine sa.ok σok Eok ηok Sok (v0.ok' ok _ tτ_a) Kok },
  case c0.step.alloc_arr₁ : C τ τ' e K ττ' {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    cases ast.eval_ty.determ ok.ind ττ' eok_a, cases tτ,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu ⟨⟩ ⟨_, eok_a_2, vtype.of_ty.int⟩
      (cont.ok.alloc_arr tτ eok_a_1 Kok) },
  case c0.step.alloc_arr₂ : _ C τ v K i n e v0 sa {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, Kok⟩, cases Kok, cases Kok_a,
    exact step_alloc_arr.ok σok Eok ηok Sok
      (v0.ok' ok _ Kok_a_a).repeat.arr Kok_a_2 sa },
  case c0.step.alloc_arr_err : C τ i K i0 { apply state.ok.err },
  case c0.step.addr_var : C v K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    rcases finmap.exists_mem_lookup_iff.2 (finmap.mem_keys.1 eu) with ⟨τ', vτ'⟩,
    cases vtype.of_ty_determ (σok.ok_of_mem vτ' eok_a) tτ,
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩ (addr.ok.var vτ') Kok },
  case c0.step.addr_deref₁ : C e K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu ⟨⟩ ⟨_, eok_a, tτ.ref⟩
      (cont.ok.addr_deref Kok) },
  case c0.step.addr_deref₂ : C v K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, Kok⟩, cases Kok,
    refine state.ok.ret ⟨σok, Eok, ηok, Sok⟩ (addr.ok.ref_opt vok) Kok_a },
  case c0.step.addr_index₁ : C e n K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      ⟨eu₁, eu₂⟩, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu₁ ⟨⟩ ⟨_, eok_a, tτ.arr⟩
      (cont.ok.addr_index₁ eok_a_1 eu₂ Kok) },
  case c0.step.addr_index₂ : C a n K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      vok, Kok⟩, cases Kok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ Kok_a_1 ⟨⟩
      ⟨_, Kok_a, vtype.of_ty.int⟩
      (cont.ok.addr_index₂ (addr.ok.refarr_opt vok) Kok_a_2) },
  case c0.step.addr_index₃ : C a n K i j len e lt {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      _, Kok⟩, cases Kok,
    cases len with _ _ v aok,
    cases Kok_a _ rfl with n h,
    cases addr.get.ok σok Eok ηok h aok,
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩ (h.nth lt) Kok_a_1 },
  case c0.step.addr_index_err₁ : C i K { apply state.ok.err },
  case c0.step.addr_index_err₂ : C a n K i { apply state.ok.err },
  case c0.step.addr_field₁ : C e f K {
    rcases sok with _|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      eu, _, ⟨t, eok, tτ⟩, Kok⟩, cases eok,
    exact state.ok.exp ⟨σok, Eok, ηok, Sok⟩ eu
      (lv_ok_of_struct ok.ind eok_a) ⟨_, eok_a, vtype.of_ty.struct⟩
      (cont.ok.addr_field eok_a_1 eok_a_2 tτ Kok) },
  case c0.step.addr_field₂ : C a f K {
    rcases sok with _|_|⟨E, σs, σ, H, η, S, Δ, ret, τ, α, v, K,
      ⟨E, σs, σ, H, η, S, Δ, _, σok, Eok, ηok, Sok⟩,
      aok, Kok⟩, cases Kok,
    exact state.ok.ret ⟨σok, Eok, ηok, Sok⟩
      (addr.ok.field Kok_a Kok_a_1 Kok_a_2 aok) Kok_a_3 },
  case c0.step.addr_field_err : C f K { apply state.ok.err }
end

end c0


import code
import frespects_pfun

/-! This code is adapted from Bolton Bailey's PR: https://github.com/leanprover-community/mathlib/pull/11046 -/

open boolcodeable (encode decode)

local attribute [reducible] bitstring

def time {ι : Type} (impl : ι → bitstring → bitstring) : code ι → bitstring →. ℕ
| (code.oracle i) := λ b, pure 1
| (code.pair c₁ c₂) := λ v, (+1) <$> (time c₁ v) + (time c₂ v)
| (code.comp c₁ c₂) := λ v, (+1) <$> (time c₂ v) + (c₂.eval impl v >>= time c₁)
| (code.case c₁ c₂) := λ v, (+1) <$> (if v.head = ff then time c₁ v.tail else time c₂ v.tail)
| (code.fix f) := λ v₀, (@pfun.fix (bitstring × ℕ) ℕ $
  λ vt, (time f vt.1) >>= λ t',
    (f.eval impl vt.1).map (λ v' : bitstring,
      if v'.head = ff then sum.inl (vt.2+t')
      else sum.inr (v'.tail, vt.2+t'))
  ) (v₀, 0)

variables {ι : Type} (impl : ι → bitstring → bitstring)

lemma time_dom_iff_eval_dom (c : code ι) (b : bitstring) : (time impl c b).dom ↔ (c.eval impl b).dom :=
begin
  induction c generalizing b,
  case code.oracle { simp [time], refl, },
  case code.pair : c₁ c₂ c₁ih c₂ih { simp only [time, code.eval, (+), (<*>)], simp [c₁ih, c₂ih], },
  case code.comp : c₁ c₂ c₁ih c₂ih { simp only [time, code.eval, (+), (<*>)], simp [c₁ih, c₂ih], tauto, },
  case code.case : c₁ c₂ c₁ih c₂ih { simp only [time, code.eval], split_ifs; simp [c₁ih, c₂ih], },
  case code.fix : f ih
  { simp only [time, code.eval], refine pfun.eq_dom_of_frespects_once prod.fst _ _,
    intro a, split,
    { simp [ih], }, split,
    { intro a',
      simp only [part.bind_eq_bind, part.mem_bind_iff, part.mem_map_iff, exists_prop, forall_exists_index, and_imp],
      intros n hn e he h, use e, refine ⟨he, _⟩,
      split_ifs at h, { contradiction, },
      rw ← h, split_ifs; refl,  },
    simp only [part.bind_eq_bind, part.mem_bind_iff, part.mem_map_iff, exists_prop, forall_exists_index, and_imp],
    intros n₁ n₂ hn₂ b hb h,
    refine ⟨b.tail, b, hb, _⟩,
    split_ifs at h ⊢, { refl, }, { contradiction, }, }
end

variables (c : code ι) (bound : ℕ → ℕ)
def time_bound : Prop :=
∀ (b : bitstring) (l : ℕ), b.sizeof ≤ l → ∃ t ∈ time impl c b, t ≤ bound l

variables {impl c bound}
lemma total_of_time_bound (H : time_bound impl c bound)
  (b : bitstring) : (c.eval impl b).dom :=
begin
  rw ← time_dom_iff_eval_dom,
  obtain ⟨n, t, _⟩ := H b b.sizeof (by refl),
  rw part.dom_iff_mem, use n, assumption,
end

lemma time_bound_oracle (i : ι) :
  time_bound impl (code.oracle i) 1 :=
by { intros _ _ _, refine ⟨1, _, (by refl)⟩, simp [time], }

lemma time_bound_pair (c₁ c₂ : code ι) {b₁ b₂ : ℕ → ℕ} (hb₁ : time_bound impl c₁ b₁) (hb₂ : time_bound impl c₂ b₂) :
  time_bound impl (code.pair c₁ c₂) (λ n, b₁ n + b₂ n + 1) :=
begin
  intros b l hb, simp only [time],
  obtain ⟨t₁, ht₁, t₁_le⟩ := hb₁ b l hb,
  obtain ⟨t₂, ht₂, t₂_le⟩ := hb₂ b l hb,
  use t₁ + t₂ + 1, split, swap, { linarith, },
  simp only [part.eq_some_iff.mpr ht₁, part.eq_some_iff.mpr ht₂, (+), (<*>)], simp, ring,
end


/-
File: signature_recover_public_key_ec_double_soundness.lean

Autogenerated file.
-/
import starkware.cairo.lean.semantics.soundness.hoare
import .signature_recover_public_key_code
import ..signature_recover_public_key_spec
import .signature_recover_public_key_compute_doubling_slope_soundness
open tactic

open starkware.cairo.common.cairo_secp.ec
open starkware.cairo.common.cairo_secp.bigint
open starkware.cairo.common.cairo_secp.field

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]
variable  mem : F → F
variable  σ : register_state F

/- starkware.cairo.common.cairo_secp.ec.ec_double autogenerated soundness theorem -/

theorem auto_sound_ec_double_block5
    -- An independent ap variable.
    (ap : F)
    -- arguments
    (range_check_ptr : F) (point : EcPoint F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_ec_double σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 244))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 232))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 212))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 196))
    (h_mem_12 : mem_at mem code_compute_doubling_slope (σ.pc  - 68))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 9))
    (hin_point : point = cast_EcPoint mem (σ.fp - 8))
    (νbound : ℕ)
    -- conclusion
  : ensuresb_ret νbound mem
    {pc := σ.pc + 14, ap := ap, fp := σ.fp}
    (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 9)) (mem $ τ.ap - 7)
        (auto_spec_ec_double_block5 mem κ range_check_ptr point (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  have h_mem_rec := h_mem,
  unpack_memory code_ec_double at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15, hpc16, hpc17, hpc18, hpc19, hpc20, hpc21, hpc22, hpc23, hpc24, hpc25, hpc26, hpc27, hpc28, hpc29, hpc30, hpc31, hpc32, hpc33, hpc34, hpc35, hpc36, hpc37, hpc38, hpc39, hpc40, hpc41, hpc42, hpc43, hpc44, hpc45, hpc46, hpc47, hpc48, hpc49, hpc50, hpc51, hpc52, hpc53, hpc54, hpc55, hpc56, hpc57, hpc58, hpc59, hpc60, hpc61, hpc62, hpc63, hpc64, hpc65, hpc66, hpc67, hpc68, hpc69, hpc70, hpc71, hpc72⟩,
  -- function call
  step_assert_eq hpc14 with arg0,
  step_assert_eq hpc15 with arg1,
  step_assert_eq hpc16 with arg2,
  step_assert_eq hpc17 with arg3,
  step_assert_eq hpc18 with arg4,
  step_assert_eq hpc19 with arg5,
  step_assert_eq hpc20 with arg6,
  step_sub hpc21 (auto_sound_compute_doubling_slope mem _ range_check_ptr point _ _ _ _ _ _ _),
  { rw hpc22, norm_num2, exact h_mem_12 },
  { rw hpc22, norm_num2, exact h_mem_4 },
  { rw hpc22, norm_num2, exact h_mem_5 },
  { rw hpc22, norm_num2, exact h_mem_6 },
  { rw hpc22, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call23 ap23 h_call23,
  rcases h_call23 with ⟨h_call23_ap_offset, h_call23⟩,
  rcases h_call23 with ⟨rc_m23, rc_mle23, hl_range_check_ptr₁, h_call23⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap23 - 4) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  generalize' hr_rev_slope: cast_BigInt3 mem (ap23 - 3) = slope,
  simp only [hr_rev_slope] at h_call23,
  have htv_slope := hr_rev_slope.symm, clear hr_rev_slope,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at hl_range_check_ptr₁ },
  rw [←htv_range_check_ptr₁, ←hin_range_check_ptr] at hl_range_check_ptr₁,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at h_call23 },
  rw [hin_range_check_ptr] at h_call23,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6,
  -- function call
  step_sub hpc23 (auto_sound_unreduced_sqr mem _ slope _ _),
  { rw hpc24, norm_num2, exact h_mem_6 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { simp only [h_call23_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call25 ap25 h_call25,
  rcases h_call25 with ⟨h_call25_ap_offset, h_call25⟩,
  generalize' hr_rev_slope_sqr: cast_UnreducedBigInt3 mem (ap25 - 3) = slope_sqr,
  simp only [hr_rev_slope_sqr] at h_call25,
  have htv_slope_sqr := hr_rev_slope_sqr.symm, clear hr_rev_slope_sqr,
  clear ,
  -- function call
  step_assert_eq hpc25 with arg0,
  step_sub hpc26 (auto_sound_nondet_bigint3 mem _ range_check_ptr₁ _ _),
  { rw hpc27, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr] },
    try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0] },
    try { simp only [h_call23_ap_offset, h_call25_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call28 ap28 h_call28,
  rcases h_call28 with ⟨h_call28_ap_offset, h_call28⟩,
  rcases h_call28 with ⟨rc_m28, rc_mle28, hl_range_check_ptr₂, h_call28⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap28 - 4) = range_check_ptr₂,
  have htv_range_check_ptr₂ := hr_rev_range_check_ptr₂.symm, clear hr_rev_range_check_ptr₂,
  generalize' hr_rev_new_x: cast_BigInt3 mem (ap28 - 3) = new_x,
  simp only [hr_rev_new_x] at h_call28,
  have htv_new_x := hr_rev_new_x.symm, clear hr_rev_new_x,
  try { simp only [arg0] at hl_range_check_ptr₂ },
  try { rw [h_call25_ap_offset] at hl_range_check_ptr₂ }, try { arith_simps at hl_range_check_ptr₂ },
  rw [←htv_range_check_ptr₂, ←htv_range_check_ptr₁] at hl_range_check_ptr₂,
  try { simp only [arg0] at h_call28 },
  try { rw [h_call25_ap_offset] at h_call28 }, try { arith_simps at h_call28 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call28,
  clear arg0,
  -- function call
  step_assert_eq hpc28 with arg0,
  step_sub hpc29 (auto_sound_nondet_bigint3 mem _ range_check_ptr₂ _ _),
  { rw hpc30, norm_num2, exact h_mem_4 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x] },
    try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0] },
    try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call31 ap31 h_call31,
  rcases h_call31 with ⟨h_call31_ap_offset, h_call31⟩,
  rcases h_call31 with ⟨rc_m31, rc_mle31, hl_range_check_ptr₃, h_call31⟩,
  generalize' hr_rev_range_check_ptr₃: mem (ap31 - 4) = range_check_ptr₃,
  have htv_range_check_ptr₃ := hr_rev_range_check_ptr₃.symm, clear hr_rev_range_check_ptr₃,
  generalize' hr_rev_new_y: cast_BigInt3 mem (ap31 - 3) = new_y,
  simp only [hr_rev_new_y] at h_call31,
  have htv_new_y := hr_rev_new_y.symm, clear hr_rev_new_y,
  try { simp only [arg0] at hl_range_check_ptr₃ },
  rw [←htv_range_check_ptr₃, ←htv_range_check_ptr₂] at hl_range_check_ptr₃,
  try { simp only [arg0] at h_call31 },
  rw [←htv_range_check_ptr₂, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call31,
  clear arg0,
  -- function call
  step_assert_eq hpc31 with arg0,
  step_assert_eq hpc32 hpc33 with arg1,
  step_assert_eq hpc34 with arg2,
  step_assert_eq hpc35 with arg3,
  step_assert_eq hpc36 hpc37 with arg4,
  step_assert_eq hpc38 with arg5,
  step_assert_eq hpc39 with arg6,
  step_assert_eq hpc40 hpc41 with arg7,
  step_assert_eq hpc42 with arg8,
  step_assert_eq hpc43 with arg9,
  step_assert_eq hpc44 with arg10,
  step_assert_eq hpc45 with arg11,
  step_assert_eq hpc46 with arg12,
  step_sub hpc47 (auto_sound_verify_zero mem _ range_check_ptr₃ {
    d0 := slope_sqr.d0 - new_x.d0 - 2 * point.x.d0,
    d1 := slope_sqr.d1 - new_x.d1 - 2 * point.x.d1,
    d2 := slope_sqr.d2 - new_x.d2 - 2 * point.x.d2
  } _ _ _),
  { rw hpc48, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y] },
    try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), arg1, arg2, (eq_sub_of_eq_add arg3), arg4, arg5, (eq_sub_of_eq_add arg6), arg7, arg8, arg9, (eq_sub_of_eq_add arg10), (eq_sub_of_eq_add arg11), (eq_sub_of_eq_add arg12)] },
    try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), arg1, arg2, (eq_sub_of_eq_add arg3), arg4, arg5, (eq_sub_of_eq_add arg6), arg7, arg8, arg9, (eq_sub_of_eq_add arg10), (eq_sub_of_eq_add arg11), (eq_sub_of_eq_add arg12)] },
      try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call49 ap49 h_call49,
  rcases h_call49 with ⟨h_call49_ap_offset, h_call49⟩,
  rcases h_call49 with ⟨rc_m49, rc_mle49, hl_range_check_ptr₄, h_call49⟩,
  generalize' hr_rev_range_check_ptr₄: mem (ap49 - 1) = range_check_ptr₄,
  have htv_range_check_ptr₄ := hr_rev_range_check_ptr₄.symm, clear hr_rev_range_check_ptr₄,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9 ,arg10 ,arg11 ,arg12] at hl_range_check_ptr₄ },
  rw [←htv_range_check_ptr₄, ←htv_range_check_ptr₃] at hl_range_check_ptr₄,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6 ,arg7 ,arg8 ,arg9 ,arg10 ,arg11 ,arg12] at h_call49 },
  rw [←htv_range_check_ptr₃, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call49,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12,
  -- function call
  step_assert_eq hpc49 with arg0,
  step_assert_eq hpc50 with arg1,
  step_assert_eq hpc51 with arg2,
  step_assert_eq hpc52 with arg3,
  step_assert_eq hpc53 with arg4,
  step_assert_eq hpc54 with arg5,
  step_sub hpc55 (auto_sound_unreduced_mul mem _ {
    d0 := point.x.d0 - new_x.d0,
    d1 := point.x.d1 - new_x.d1,
    d2 := point.x.d2 - new_x.d2
  } slope _ _ _),
  { rw hpc56, norm_num2, exact h_mem_5 },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y, htv_range_check_ptr₄] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), arg3, arg4, arg5] },
      try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset, h_call49_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y, htv_range_check_ptr₄] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), arg3, arg4, arg5] },
      try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset, h_call49_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call57 ap57 h_call57,
  rcases h_call57 with ⟨h_call57_ap_offset, h_call57⟩,
  generalize' hr_rev_x_diff_slope: cast_UnreducedBigInt3 mem (ap57 - 3) = x_diff_slope,
  simp only [hr_rev_x_diff_slope] at h_call57,
  have htv_x_diff_slope := hr_rev_x_diff_slope.symm, clear hr_rev_x_diff_slope,
  clear arg0 arg1 arg2 arg3 arg4 arg5,
  -- function call
  step_assert_eq hpc57 with arg0,
  step_assert_eq hpc58 with arg1,
  step_assert_eq hpc59 with arg2,
  step_assert_eq hpc60 with arg3,
  step_assert_eq hpc61 with arg4,
  step_assert_eq hpc62 with arg5,
  step_assert_eq hpc63 with arg6,
  step_sub hpc64 (auto_sound_verify_zero mem _ range_check_ptr₄ {
    d0 := x_diff_slope.d0 - point.y.d0 - new_y.d0,
    d1 := x_diff_slope.d1 - point.y.d1 - new_y.d1,
    d2 := x_diff_slope.d2 - point.y.d2 - new_y.d2
  } _ _ _),
  { rw hpc65, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y, htv_range_check_ptr₄, htv_x_diff_slope] },
    try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), arg3, (eq_sub_of_eq_add arg4), (eq_sub_of_eq_add arg5), (eq_sub_of_eq_add arg6)] },
    try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset, h_call49_ap_offset, h_call57_ap_offset] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { ext } ; {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y, htv_range_check_ptr₄, htv_x_diff_slope] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [(eq_sub_of_eq_add arg0), (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), arg3, (eq_sub_of_eq_add arg4), (eq_sub_of_eq_add arg5), (eq_sub_of_eq_add arg6)] },
      try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset, h_call49_ap_offset, h_call57_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call66 ap66 h_call66,
  rcases h_call66 with ⟨h_call66_ap_offset, h_call66⟩,
  rcases h_call66 with ⟨rc_m66, rc_mle66, hl_range_check_ptr₅, h_call66⟩,
  generalize' hr_rev_range_check_ptr₅: mem (ap66 - 1) = range_check_ptr₅,
  have htv_range_check_ptr₅ := hr_rev_range_check_ptr₅.symm, clear hr_rev_range_check_ptr₅,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at hl_range_check_ptr₅ },
  try { rw [h_call57_ap_offset] at hl_range_check_ptr₅ }, try { arith_simps at hl_range_check_ptr₅ },
  rw [←htv_range_check_ptr₅, ←htv_range_check_ptr₄] at hl_range_check_ptr₅,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3 ,arg4 ,arg5 ,arg6] at h_call66 },
  try { rw [h_call57_ap_offset] at h_call66 }, try { arith_simps at h_call66 },
  rw [←htv_range_check_ptr₄, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call66,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6,
  -- return
  step_assert_eq hpc66 with hret0,
  step_assert_eq hpc67 with hret1,
  step_assert_eq hpc68 with hret2,
  step_assert_eq hpc69 with hret3,
  step_assert_eq hpc70 with hret4,
  step_assert_eq hpc71 with hret5,
  step_ret hpc72,
  -- finish
  step_done, use_only [rfl, rfl],
  -- range check condition
  use_only (rc_m23+rc_m28+rc_m31+rc_m49+rc_m66+0+0), split,
  linarith [rc_mle23, rc_mle28, rc_mle31, rc_mle49, rc_mle66],
  split,
  { arith_simps, try { simp only [hret0 ,hret1 ,hret2 ,hret3 ,hret4 ,hret5] },
    rw [←htv_range_check_ptr₅, hl_range_check_ptr₅, hl_range_check_ptr₄, hl_range_check_ptr₃, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr],
    try { arith_simps, refl <|> norm_cast }, try { refl } },
  intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
  have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
  -- Final Proof
  dsimp [auto_spec_ec_double_block5],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call23],
  use_only [range_check_ptr₁],
  use_only [slope],
  have rc_h_range_check_ptr₁ := range_checked_offset' rc_h_range_check_ptr,
  have rc_h_range_check_ptr₁' := range_checked_add_right rc_h_range_check_ptr₁, try { norm_cast at rc_h_range_check_ptr₁' },
  have spec23 := h_call23 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec23,
  try { dsimp at spec23, arith_simps at spec23 },
  use_only [spec23],
  use_only [κ_call25],
  use_only [slope_sqr],
  try { dsimp at h_call25, arith_simps at h_call25 },
  try { use_only [h_call25] },
  use_only [κ_call28],
  use_only [range_check_ptr₂],
  use_only [new_x],
  have rc_h_range_check_ptr₂ := range_checked_offset' rc_h_range_check_ptr₁,
  have rc_h_range_check_ptr₂' := range_checked_add_right rc_h_range_check_ptr₂, try { norm_cast at rc_h_range_check_ptr₂' },
  have spec28 := h_call28 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec28,
  try { dsimp at spec28, arith_simps at spec28 },
  use_only [spec28],
  use_only [κ_call31],
  use_only [range_check_ptr₃],
  use_only [new_y],
  have rc_h_range_check_ptr₃ := range_checked_offset' rc_h_range_check_ptr₂,
  have rc_h_range_check_ptr₃' := range_checked_add_right rc_h_range_check_ptr₃, try { norm_cast at rc_h_range_check_ptr₃' },
  have spec31 := h_call31 rc_h_range_check_ptr₂',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←htv_range_check_ptr₃] at spec31,
  try { dsimp at spec31, arith_simps at spec31 },
  use_only [spec31],
  use_only [κ_call49],
  use_only [range_check_ptr₄],
  have rc_h_range_check_ptr₄ := range_checked_offset' rc_h_range_check_ptr₃,
  have rc_h_range_check_ptr₄' := range_checked_add_right rc_h_range_check_ptr₄, try { norm_cast at rc_h_range_check_ptr₄' },
  have spec49 := h_call49 rc_h_range_check_ptr₃',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←htv_range_check_ptr₄] at spec49,
  try { dsimp at spec49, arith_simps at spec49 },
  use_only [spec49],
  use_only [κ_call57],
  use_only [x_diff_slope],
  try { dsimp at h_call57, arith_simps at h_call57 },
  try { use_only [h_call57] },
  use_only [κ_call66],
  use_only [range_check_ptr₅],
  have rc_h_range_check_ptr₅ := range_checked_offset' rc_h_range_check_ptr₄,
  have rc_h_range_check_ptr₅' := range_checked_add_right rc_h_range_check_ptr₅, try { norm_cast at rc_h_range_check_ptr₅' },
  have spec66 := h_call66 rc_h_range_check_ptr₄',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂, ←hl_range_check_ptr₃, ←hl_range_check_ptr₄, ←htv_range_check_ptr₅] at spec66,
  try { dsimp at spec66, arith_simps at spec66 },
  use_only [spec66],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point, htv_range_check_ptr₁, htv_slope, htv_slope_sqr, htv_range_check_ptr₂, htv_new_x, htv_range_check_ptr₃, htv_new_y, htv_range_check_ptr₄, htv_x_diff_slope, htv_range_check_ptr₅] }, },
  try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
  try { arith_simps }, try { simp only [hret0, hret1, hret2, hret3, hret4, hret5] },
  try { simp only [h_call23_ap_offset, h_call25_ap_offset, h_call28_ap_offset, h_call31_ap_offset, h_call49_ap_offset, h_call57_ap_offset, h_call66_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end

theorem auto_sound_ec_double
    -- arguments
    (range_check_ptr : F) (point : EcPoint F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_ec_double σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 244))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 232))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 212))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 196))
    (h_mem_12 : mem_at mem code_compute_doubling_slope (σ.pc  - 68))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 9))
    (hin_point : point = cast_EcPoint mem (σ.fp - 8))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 9)) (mem $ τ.ap - 7)
        (spec_ec_double mem κ range_check_ptr point (mem (τ.ap - 7)) (cast_EcPoint mem (τ.ap - 6)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_ec_double at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15, hpc16, hpc17, hpc18, hpc19, hpc20, hpc21, hpc22, hpc23, hpc24, hpc25, hpc26, hpc27, hpc28, hpc29, hpc30, hpc31, hpc32, hpc33, hpc34, hpc35, hpc36, hpc37, hpc38, hpc39, hpc40, hpc41, hpc42, hpc43, hpc44, hpc45, hpc46, hpc47, hpc48, hpc49, hpc50, hpc51, hpc52, hpc53, hpc54, hpc55, hpc56, hpc57, hpc58, hpc59, hpc60, hpc61, hpc62, hpc63, hpc64, hpc65, hpc66, hpc67, hpc68, hpc69, hpc70, hpc71, hpc72⟩,
  -- if statement
  step_jnz hpc0 hpc1 with hcond hcond,
  {
    -- if: positive branch
    have a0 : point.x.d0 = 0, {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [hcond] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
    },
    try { dsimp at a0 }, try { arith_simps at a0 },
    clear hcond,
    -- if statement
    step_jnz hpc2 hpc3 with hcond hcond,
    {
      -- if: positive branch
      have a2 : point.x.d1 = 0, {
        try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
        try { dsimp [cast_EcPoint, cast_BigInt3] },
        try { arith_simps }, try { simp only [hcond] },
        try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
      },
      try { dsimp at a2 }, try { arith_simps at a2 },
      clear hcond,
      -- if statement
      step_jnz hpc4 hpc5 with hcond hcond,
      {
        -- if: positive branch
        have a4 : point.x.d2 = 0, {
          try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
          try { dsimp [cast_EcPoint, cast_BigInt3] },
          try { arith_simps }, try { simp only [hcond] },
          try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
        },
        try { dsimp at a4 }, try { arith_simps at a4 },
        clear hcond,
        -- return
        step_assert_eq hpc6 with hret0,
        step_assert_eq hpc7 with hret1,
        step_assert_eq hpc8 with hret2,
        step_assert_eq hpc9 with hret3,
        step_assert_eq hpc10 with hret4,
        step_assert_eq hpc11 with hret5,
        step_assert_eq hpc12 with hret6,
        step_ret hpc13,
        -- finish
        step_done, use_only [rfl, rfl],
        -- range check condition
        use_only (0+0), split,
        linarith [],
        split,
        { arith_simps, try { simp only [hret0 ,hret1 ,hret2 ,hret3 ,hret4 ,hret5 ,hret6] },
          try { arith_simps, refl <|> norm_cast }, try { refl } },
        intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
        have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
        -- Final Proof
        -- user-provided reduction
        suffices auto_spec: auto_spec_ec_double mem _ range_check_ptr point _ _,
        { apply sound_ec_double, apply auto_spec },
        -- prove the auto generated assertion
        dsimp [auto_spec_ec_double],
        try { norm_num1 }, try { arith_simps },
        left,
        use_only [a0],
        left,
        use_only [a2],
        left,
        use_only [a4],
        try { split, linarith },
        try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] }, },
        try { dsimp [cast_EcPoint, cast_BigInt3] },
        try { arith_simps }, try { simp only [hret0, hret1, hret2, hret3, hret4, hret5, hret6] },
        try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
      },
      {
        -- if: negative branch
        have a4 : point.x.d2 ≠ 0, {
          try { simp only [ne.def] },
          try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
          try { dsimp [cast_EcPoint, cast_BigInt3] },
          try { arith_simps }, try { simp only [hcond] },
          try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
        },
        try { dsimp at a4 }, try { arith_simps at a4 },
        clear hcond,
        -- Use the block soundness theorem.
        apply ensuresb_ret_trans (auto_sound_ec_double_block5 mem σ _ range_check_ptr point h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_12 hin_range_check_ptr hin_point νbound),
        intros κ_block5 τ, try { arith_simps },
        intro h_block5,
        rcases h_block5 with ⟨rc_m_block5, rc_m_le_block5, hblk_range_check_ptr₁, h_block5⟩,
        -- range check condition
        use_only (rc_m_block5+0+0), split,
        linarith [rc_m_le_block5],
        split,
        { arith_simps, try { simp only [hblk_range_check_ptr₁] },
          try { arith_simps, refl <|> norm_cast }, try { refl } },
        intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
        have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
        -- Final Proof
        -- user-provided reduction
        suffices auto_spec: auto_spec_ec_double mem _ range_check_ptr point _ _,
        { apply sound_ec_double, apply auto_spec },
        -- prove the auto generated assertion
        dsimp [auto_spec_ec_double],
        try { norm_num1 }, try { arith_simps },
        left,
        use_only [a0],
        left,
        use_only [a2],
        right,
        use_only [a4],
        have rc_h_range_check_ptr₁ := range_checked_offset' rc_h_range_check_ptr,
        have rc_h_range_check_ptr₁' := range_checked_add_right rc_h_range_check_ptr₁, try { norm_cast at rc_h_range_check_ptr₁' },
        have h_block5' := h_block5 rc_h_range_check_ptr',
        try { rw [←hin_range_check_ptr] at h_block5' },
        try { dsimp at h_block5, arith_simps at h_block5' },
        have h_block5 := h_block5',
        use_only[κ_block5],
        use [h_block5],
        try { linarith }
      }
    },
    {
      -- if: negative branch
      have a2 : point.x.d1 ≠ 0, {
        try { simp only [ne.def] },
        try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
        try { dsimp [cast_EcPoint, cast_BigInt3] },
        try { arith_simps }, try { simp only [hcond] },
        try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
      },
      try { dsimp at a2 }, try { arith_simps at a2 },
      clear hcond,
      -- Use the block soundness theorem.
      apply ensuresb_ret_trans (auto_sound_ec_double_block5 mem σ _ range_check_ptr point h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_12 hin_range_check_ptr hin_point νbound),
      intros κ_block5 τ, try { arith_simps },
      intro h_block5,
      rcases h_block5 with ⟨rc_m_block5, rc_m_le_block5, hblk_range_check_ptr₁, h_block5⟩,
      -- range check condition
      use_only (rc_m_block5+0+0), split,
      linarith [rc_m_le_block5],
      split,
      { arith_simps, try { simp only [hblk_range_check_ptr₁] },
        try { arith_simps, refl <|> norm_cast }, try { refl } },
      intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
      have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
      -- Final Proof
      -- user-provided reduction
      suffices auto_spec: auto_spec_ec_double mem _ range_check_ptr point _ _,
      { apply sound_ec_double, apply auto_spec },
      -- prove the auto generated assertion
      dsimp [auto_spec_ec_double],
      try { norm_num1 }, try { arith_simps },
      left,
      use_only [a0],
      right,
      use_only [a2],
      have rc_h_range_check_ptr₁ := range_checked_offset' rc_h_range_check_ptr,
      have rc_h_range_check_ptr₁' := range_checked_add_right rc_h_range_check_ptr₁, try { norm_cast at rc_h_range_check_ptr₁' },
      have h_block5' := h_block5 rc_h_range_check_ptr',
      try { rw [←hin_range_check_ptr] at h_block5' },
      try { dsimp at h_block5, arith_simps at h_block5' },
      have h_block5 := h_block5',
      use_only[κ_block5],
      use [h_block5],
      try { linarith }
    }
  },
  {
    -- if: negative branch
    have a0 : point.x.d0 ≠ 0, {
      try { simp only [ne.def] },
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [hcond] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
    },
    try { dsimp at a0 }, try { arith_simps at a0 },
    clear hcond,
    -- Use the block soundness theorem.
    apply ensuresb_ret_trans (auto_sound_ec_double_block5 mem σ _ range_check_ptr point h_mem_rec h_mem_4 h_mem_5 h_mem_6 h_mem_7 h_mem_12 hin_range_check_ptr hin_point νbound),
    intros κ_block5 τ, try { arith_simps },
    intro h_block5,
    rcases h_block5 with ⟨rc_m_block5, rc_m_le_block5, hblk_range_check_ptr₁, h_block5⟩,
    -- range check condition
    use_only (rc_m_block5+0+0), split,
    linarith [rc_m_le_block5],
    split,
    { arith_simps, try { simp only [hblk_range_check_ptr₁] },
      try { arith_simps, refl <|> norm_cast }, try { refl } },
    intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
    have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
    -- Final Proof
    -- user-provided reduction
    suffices auto_spec: auto_spec_ec_double mem _ range_check_ptr point _ _,
    { apply sound_ec_double, apply auto_spec },
    -- prove the auto generated assertion
    dsimp [auto_spec_ec_double],
    try { norm_num1 }, try { arith_simps },
    right,
    use_only [a0],
    have rc_h_range_check_ptr₁ := range_checked_offset' rc_h_range_check_ptr,
    have rc_h_range_check_ptr₁' := range_checked_add_right rc_h_range_check_ptr₁, try { norm_cast at rc_h_range_check_ptr₁' },
    have h_block5' := h_block5 rc_h_range_check_ptr',
    try { rw [←hin_range_check_ptr] at h_block5' },
    try { dsimp at h_block5, arith_simps at h_block5' },
    have h_block5 := h_block5',
    use_only[κ_block5],
    use [h_block5],
    try { linarith }
  }
end


import condensed.top_comparison
import condensed.exact
import for_mathlib.exact_functor

.

open category_theory
open category_theory.limits
open opposite

namespace Condensed

universes u

variables {X Y Z : Condensed.{u} Ab.{u+1}} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0)
  (S : Profinite.{u})

noncomputable theory

instance evaluation_additive (S : Profinite.{u}) :
  functor.additive (Condensed.evaluation _ S : Condensed.{u} Ab.{u+1} ⥤ _) :=
⟨λ X Y f g, rfl⟩

lemma evaluation_exact (S : ExtrDisc.{u}) :
  functor.exact (Condensed.evaluation _ S.val : Condensed.{u} Ab.{u+1} ⥤ _) :=
begin
  intros X Y Z f g h,
  rw Condensed.exact_iff_ExtrDisc at h,
  apply h
end

abbreviation homology_evaluation_iso (S : ExtrDisc.{u}) :
  (homology f g w).val.obj (op S.val) ≅
  homology (f.val.app (op S.val)) (g.val.app (op S.val))
    (by { rw [← f.val.comp_app, ← Sheaf.hom.comp_val, w], refl }) :=
(Condensed.evaluation Ab.{u+1} _).homology_iso _ _ _ _

.

abbreviation homology_functor_evaluation_iso {M : Type*} (c : complex_shape M)
  (i : M) (S : ExtrDisc.{u}) :
  homology_functor (Condensed.{u} Ab.{u+1}) c i ⋙ Condensed.evaluation _ S.val ≅
  (Condensed.evaluation _ S.val).map_homological_complex _ ⋙ homology_functor Ab.{u+1} c i :=
(Condensed.evaluation Ab.{u+1} _).homology_functor_iso _ _

end Condensed


/- Enumerable and the Decidable instance may already be in Mathlib -/

class Enumerable (α : Type u) where
  elems    : List α
  complete : ∀ a : α, a ∈ elems

def List.allTrue (p : α → Prop) [(a : α) → Decidable (p a)] : List α → Bool
  | [] => true
  | a :: as => p a && allTrue p as

theorem List.of_allTrue [(a : α) → Decidable (p a)] (hc : allTrue p as) (hin : a ∈ as) : p a := by
  induction as with
  | nil => contradiction
  | cons b bs ih =>
    cases hin with simp [allTrue] at hc
    | head => simp [*]
    | tail _ h => exact ih hc.2 h

theorem List.allTrue_of_forall [(a : α) → Decidable (p a)] (h : ∀ a, p a) : allTrue p as := by
  induction as <;> simp [allTrue, *]

instance [Enumerable α] (p : α → Prop) [(a : α) → Decidable (p a)] : Decidable (∀ a, p a) :=
  have : List.allTrue p Enumerable.elems → (a : α) → p a :=
    fun h a => List.of_allTrue h (Enumerable.complete a)
  decidable_of_decidable_of_iff (Iff.intro this List.allTrue_of_forall)

inductive States | s0 | s1 | s2 | s3 | s4 | s5 | s6 | s7 | s8 | s9 | s10 | s11
deriving DecidableEq

/- We can add a `deriving` for `Enumerable` in the future. -/
open States in
instance : Enumerable States where
  elems := [s0, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11]
  complete a := by cases a <;> decide

open States
def f : States → States → States
| s0, s0 => s0
| s0, s1 => s0
| s0, s2 => s0
| s0, s3 => s0
| s0, s4 => s0
| s0, s5 => s0
| s0, s6 => s0
| s0, s7 => s0
| s0, s8 => s0
| s0, s9 => s0
| s0, s10 => s0
| s0, s11 => s0
| s1, s0 => s0
| s1, s1 => s0
| s1, s2 => s0
| s1, s3 => s0
| s1, s4 => s0
| s1, s5 => s0
| s1, s6 => s0
| s1, s7 => s0
| s1, s8 => s0
| s1, s9 => s0
| s1, s10 => s0
| s1, s11 => s0
| s2, s0 => s0
| s2, s1 => s0
| s2, s2 => s0
| s2, s3 => s0
| s2, s4 => s0
| s2, s5 => s0
| s2, s6 => s0
| s2, s7 => s0
| s2, s8 => s0
| s2, s9 => s0
| s2, s10 => s0
| s2, s11 => s0
| s3, s0 => s0
| s3, s1 => s0
| s3, s2 => s0
| s3, s3 => s0
| s3, s4 => s0
| s3, s5 => s0
| s3, s6 => s0
| s3, s7 => s0
| s3, s8 => s0
| s3, s9 => s0
| s3, s10 => s0
| s3, s11 => s0
| s4, s0 => s0
| s4, s1 => s0
| s4, s2 => s0
| s4, s3 => s0
| s4, s4 => s0
| s4, s5 => s0
| s4, s6 => s0
| s4, s7 => s0
| s4, s8 => s0
| s4, s9 => s0
| s4, s10 => s0
| s4, s11 => s0
| s5, s0 => s0
| s5, s1 => s0
| s5, s2 => s0
| s5, s3 => s0
| s5, s4 => s0
| s5, s5 => s0
| s5, s6 => s0
| s5, s7 => s0
| s5, s8 => s0
| s5, s9 => s0
| s5, s10 => s0
| s5, s11 => s0
| s6, s0 => s0
| s6, s1 => s0
| s6, s2 => s0
| s6, s3 => s0
| s6, s4 => s0
| s6, s5 => s0
| s6, s6 => s0
| s6, s7 => s0
| s6, s8 => s0
| s6, s9 => s0
| s6, s10 => s0
| s6, s11 => s0
| s7, s0 => s0
| s7, s1 => s0
| s7, s2 => s0
| s7, s3 => s0
| s7, s4 => s0
| s7, s5 => s0
| s7, s6 => s0
| s7, s7 => s0
| s7, s8 => s0
| s7, s9 => s0
| s7, s10 => s0
| s7, s11 => s0
| s8, s0 => s0
| s8, s1 => s0
| s8, s2 => s0
| s8, s3 => s0
| s8, s4 => s0
| s8, s5 => s0
| s8, s6 => s0
| s8, s7 => s0
| s8, s8 => s0
| s8, s9 => s0
| s8, s10 => s0
| s8, s11 => s0
| s9, s0 => s0
| s9, s1 => s0
| s9, s2 => s0
| s9, s3 => s0
| s9, s4 => s0
| s9, s5 => s0
| s9, s6 => s0
| s9, s7 => s0
| s9, s8 => s0
| s9, s9 => s0
| s9, s10 => s0
| s9, s11 => s0
| s10, s0 => s0
| s10, s1 => s0
| s10, s2 => s0
| s10, s3 => s0
| s10, s4 => s0
| s10, s5 => s0
| s10, s6 => s0
| s10, s7 => s0
| s10, s8 => s0
| s10, s9 => s0
| s10, s10 => s0
| s10, s11 => s0
| s11, s0 => s0
| s11, s1 => s0
| s11, s2 => s0
| s11, s3 => s0
| s11, s4 => s0
| s11, s5 => s0
| s11, s6 => s0
| s11, s7 => s0
| s11, s8 => s0
| s11, s9 => s0
| s11, s10 => s0
| s11, s11 => s0

set_option maxHeartbeats 0
example : ∀ x y z, f (f (f s0 x) y) z = f (f x z) (f y z) := by
 native_decide -- This is fast, but the TCB is much bigger


/-
File: signature_recover_public_key_unreduced_sqr_soundness.lean

Autogenerated file.
-/
import starkware.cairo.lean.semantics.soundness.hoare
import .signature_recover_public_key_code
import ..signature_recover_public_key_spec
open tactic

open starkware.cairo.common.cairo_secp.field
open starkware.cairo.common.cairo_secp.bigint
open starkware.cairo.common.cairo_secp.constants

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]
variable  mem : F → F
variable  σ : register_state F

/- starkware.cairo.common.cairo_secp.field.unreduced_sqr autogenerated soundness theorem -/

theorem auto_sound_unreduced_sqr
    -- arguments
    (a : BigInt3 F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_unreduced_sqr σ.pc)
    -- input arguments on the stack
    (hin_a : a = cast_BigInt3 mem (σ.fp - 5))
    -- conclusion
  : ensures_ret mem σ (λ κ τ, τ.ap = σ.ap + 12 ∧ spec_unreduced_sqr mem κ a (cast_UnreducedBigInt3 mem (τ.ap - 3))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_unreduced_sqr at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4, hpc5, hpc6, hpc7, hpc8, hpc9, hpc10, hpc11, hpc12, hpc13, hpc14, hpc15⟩,
  -- tempvar
  step_assert_eq hpc0 hpc1 with tv_twice_d00,
  generalize' hl_rev_twice_d0: (a.d0 * 2 : F) = twice_d0,
  have hl_twice_d0 := hl_rev_twice_d0.symm, clear hl_rev_twice_d0,
  have htv_twice_d0: twice_d0 = _, {
    apply eq.symm, apply eq.trans tv_twice_d00,
      try { simp only [add_neg_eq_sub, hin_a, hl_twice_d0] },
      try { dsimp [cast_BigInt3] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  clear tv_twice_d00,
  try { dsimp at hl_twice_d0 }, try { arith_simps at hl_twice_d0 },
  -- return
  step_assert_eq hpc2 with hret0,
  step_assert_eq hpc3 hpc4 with hret1,
  step_assert_eq hpc5 with hret2,
  step_assert_eq hpc6 with hret3,
  step_assert_eq hpc7 hpc8 with hret4,
  step_assert_eq hpc9 with hret5,
  step_assert_eq hpc10 with hret6,
  step_assert_eq hpc11 with hret7,
  step_assert_eq hpc12 with hret8,
  step_assert_eq hpc13 with hret9,
  step_assert_eq hpc14 with hret10,
  step_ret hpc15,
  -- finish
  step_done, use_only [rfl, rfl],
  split, refl,
  -- Final Proof
  -- user-provided reduction
  suffices auto_spec: auto_spec_unreduced_sqr mem _ a _,
  { apply sound_unreduced_sqr, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_unreduced_sqr],
  try { norm_num1 }, try { arith_simps },
  use_only [twice_d0, hl_twice_d0],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_a, hl_twice_d0, htv_twice_d0] }, },
  try { dsimp [cast_BigInt3, cast_UnreducedBigInt3] },
  try { arith_simps }, try { simp only [hret0, hret1, hret2, hret3, hret4, hret5, hret6, hret7, hret8, hret9, hret10] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


import Radon.defs

open_locale nnreal big_operators classical

noncomputable theory

open category_theory
open category_theory.limits
open topological_space

local attribute [instance]
  locally_constant.seminormed_add_comm_group
  locally_constant.pseudo_metric_space

namespace Profinite

/-- Consider an element of `X.Radon_LC p c` as a function on the
type of locally constant functions. -/
def Radon_LC_to_fun (X : Profinite.{0}) (p c : ℝ≥0) :
  X.Radon_LC p c → locally_constant X ℝ → ℝ :=
λ μ, μ.1

/-- Consider an element of `X.Radon p c` as a function on the
type of continuous functions. -/
def Radon_to_fun (X : Profinite.{0}) (p c : ℝ≥0) :
  X.Radon p c → C(X,ℝ) → ℝ :=
λ μ, μ.1

lemma Radon_LC_to_fun_injective (X : Profinite.{0}) (p c : ℝ≥0) :
  function.injective (X.Radon_LC_to_fun p c) :=
begin
  intros a b h, ext x : 2,
  exact congr_fun h x
end

lemma Radon_to_fun_injective (X : Profinite.{0}) (p c : ℝ≥0) :
  function.injective (X.Radon_to_fun p c) :=
begin
  intros a b h, ext x : 2,
  exact congr_fun h x
end

lemma Radon_LC_to_fun_continuous (X : Profinite.{0}) (p c : ℝ≥0) :
  continuous (X.Radon_LC_to_fun p c) :=
begin
  apply continuous_pi,
  intros f,
  refine continuous.comp (weak_dual.eval_continuous f) (continuous_subtype_coe),
end

lemma Radon_to_fun_continuous (X : Profinite.{0}) (p c : ℝ≥0) :
  continuous (X.Radon_to_fun p c) :=
begin
  apply continuous_pi,
  intros f,
  refine continuous.comp (weak_dual.eval_continuous f) (continuous_subtype_coe),
end

--WHY!?!?!?
instance t2_space_fun_to_R (X : Type*) :
  t2_space (X → ℝ) :=
@Pi.t2_space X (λ _, ℝ) infer_instance
begin
  intros a, dsimp,
  apply_instance
end

instance t2_space_Radon_LC (X : Profinite.{0}) (p c : ℝ≥0) :
  t2_space (X.Radon_LC p c) :=
⟨λ f g h, separated_by_continuous (X.Radon_LC_to_fun_continuous p c)
  $ (X.Radon_LC_to_fun_injective p c).ne h⟩

instance t2_space_Radon (X : Profinite.{0}) (p c : ℝ≥0) :
  t2_space (X.Radon p c) :=
⟨λ f g h, separated_by_continuous (X.Radon_to_fun_continuous p c)
  $ (X.Radon_to_fun_injective p c).ne h⟩

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_comparison_component_equiv_aux (X : Profinite.{0}) (p : ℝ≥0)
  (T : discrete_quotient X) :
  weak_dual ℝ (locally_constant (X.diagram.obj T) ℝ) ≃
  real_measures p (X.fintype_diagram.obj T) :=
{ to_fun := λ μ t,
    μ (clopens.indicator_LC $
      discrete_quotient.fibre ⊥ (discrete_quotient.equiv_bot t)),
  inv_fun := λ μ,
  { to_fun := λ e, ∑ t : T, μ t * e t,
    map_add' := begin
      intros x y,
      dsimp,
      simp only [mul_add, finset.sum_add_distrib],
    end,
    map_smul' := begin
      intros r e, dsimp,
      rw finset.mul_sum,
      simp_rw [← mul_assoc, mul_comm r],
    end,
    cont := begin
      apply continuous_finset_sum, intros t ht,
      refine continuous.comp (continuous_mul_left (μ t)) _,
      apply locally_constant.continuous_eval,
    end },
  left_inv := begin
    intros μ, ext t, dsimp,
    haveI : fintype (X.diagram.obj T),
    { show fintype T, by apply_instance },
    conv_rhs { rw t.eq_sum_of_fintype },
    rw μ.map_sum,
    apply finset.sum_congr, convert rfl,
    intros t ht,
    rw [μ.map_smul, mul_comm], change _ = _ * _,
    congr' 3, ext w, change _ = _ ↔ _ = _,
    split,
    { intros h, apply_fun discrete_quotient.equiv_bot.symm at h,
      erw discrete_quotient.equiv_bot.symm_apply_apply at h,
      rw discrete_quotient.equiv_bot.symm_apply_apply at h,
      exact h },
    { intros h, rw h, refl, }
  end,
  right_inv := begin
    intros μ, ext (t : T), dsimp,
    rw finset.sum_eq_single t,
    { change _ * ite _ _ _ = _, rw if_pos, erw mul_one,
      change _ = _, refl },
    { intros s _ hs, change _ * ite _ _ _ = _, rw [if_neg, mul_zero],
      change _ ≠ _, contrapose! hs,
      apply_fun discrete_quotient.equiv_bot.symm at hs,
      erw discrete_quotient.equiv_bot.symm_apply_apply at hs,
      rw discrete_quotient.equiv_bot.symm_apply_apply at hs,
      exact hs },
    { intros h, exact false.elim (h (finset.mem_univ _)) },
  end }

lemma bdd_LC_iff_comparison
  (X : Profinite.{0}) (T : discrete_quotient X) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)]
  (f : weak_dual ℝ (locally_constant (X.diagram.obj T) ℝ)) :
  f.bdd_LC p c ↔
  X.Radon_LC_comparison_component_equiv_aux p T f ∈
    pseudo_normed_group.filtration (real_measures p (X.fintype_diagram.obj T)) c :=
begin
  split,
  { intros h, change ∑ (t : T), _ ≤ _, specialize h ⊥,
    convert h using 1,
    fapply finset.sum_bij',
    { intros t _, exact discrete_quotient.equiv_bot t, },
    { intros, exact finset.mem_univ _ },
    { intros t _, congr, },
    { intros t _, exact discrete_quotient.equiv_bot.symm t, },
    { intros, exact finset.mem_univ _ },
    { intros, apply equiv.apply_symm_apply },
    { intros, exact discrete_quotient.equiv_bot.apply_symm_apply _, } },
  { intros h E, change ∑ (e : E), _ ≤ _,
    change ∑ (t : T), _ ≤ _ at h,
    dsimp [Radon_LC_comparison_component_equiv_aux] at h,
    refine le_trans _ h,
    have : ∀ e : E,
      (E.fibre e).indicator_LC =
      ∑ t in finset.univ.filter (λ t : T, E.proj t = e),
        ((⊥ : discrete_quotient T).fibre
        (discrete_quotient.equiv_bot t)).indicator_LC,
    { intros e,
      ext (q : T), rw locally_constant.sum_apply,
      change ite (_ = _) (1 : ℝ) 0 = _, split_ifs with hh hh,
      { rw finset.sum_eq_single q,
        change _ = ite (_ = _) (1 : ℝ) _, erw if_pos rfl,
        { intros t ht hh,
          change ite (_ = _) _ (0 : ℝ) = 0, rw if_neg,
          contrapose! hh,
          rw finset.mem_filter at ht,
          apply_fun discrete_quotient.equiv_bot.symm at hh,
          erw discrete_quotient.equiv_bot.symm_apply_apply at hh,
          rw discrete_quotient.equiv_bot.symm_apply_apply at hh,
          exact hh.symm },
        { intros h, refine false.elim (h _), rw finset.mem_filter,
          refine ⟨finset.mem_univ _, hh⟩ } },
      { symmetry, apply finset.sum_eq_zero,
        intros t ht, rw finset.mem_filter at ht,
        change ite (_ = _) _ (0 : ℝ) = 0, rw if_neg,
        contrapose! hh,
        apply_fun discrete_quotient.equiv_bot.symm at hh,
        erw discrete_quotient.equiv_bot.symm_apply_apply at hh,
        rw discrete_quotient.equiv_bot.symm_apply_apply at hh,
        rw hh,
        exact ht.2 } },
    simp_rw [this, f.map_sum], clear this,
    have : ∑ (x : ↥E),
      ∥∑ (i : ↥T) in
        finset.filter (λ (t : ↥T), E.proj t = x) finset.univ,
        f ((⊥ : discrete_quotient T).fibre
          (discrete_quotient.equiv_bot i)).indicator_LC∥₊^(p : ℝ) ≤
      ∑ (x : E), ∑ (i : T) in finset.filter (λ (t : ↥T), E.proj t = x) finset.univ,
        ∥ f ((⊥ : discrete_quotient T).fibre
          (discrete_quotient.equiv_bot i)).indicator_LC∥₊^(p : ℝ),
    { apply finset.sum_le_sum,
      intros e _,
      apply real.pow_nnnorm_sum_le },
    refine le_trans this _, clear this,
    erw ← finset.sum_bUnion,
    have : finset.univ.bUnion (λ (x : ↥E), finset.filter (λ (t : ↥T), E.proj t = x) finset.univ) =
      finset.univ,
    { rw finset.eq_univ_iff_forall,
      intros t,
      rw finset.mem_bUnion,
      refine ⟨E.proj t, finset.mem_univ _, _⟩,
      rw finset.mem_filter,
      refine ⟨finset.mem_univ _, rfl⟩ },
    rw this,
    intros a ha b hb hh q, dsimp, rw finset.mem_inter, rintros ⟨h1,h2⟩,
    simp only [finset.not_mem_empty], apply hh,
    rw finset.mem_filter at h1 h2,
    rw [← h1.2, h2.2] },
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_comparison_component_equiv
  (X : Profinite.{0}) (T : discrete_quotient X) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  Radon_LC (X.diagram.obj T) p c ≃
  pseudo_normed_group.filtration (real_measures p (X.fintype_diagram.obj T)) c :=
{ to_fun := λ μ, ⟨X.Radon_LC_comparison_component_equiv_aux p T μ.1,
    begin
      rw ← bdd_LC_iff_comparison, exact μ.2,
    end⟩,
  inv_fun := λ μ, ⟨(X.Radon_LC_comparison_component_equiv_aux p T).symm μ.1,
    begin
      have := μ.2,
      rw ← (X.Radon_LC_comparison_component_equiv_aux p T).apply_symm_apply μ.val at this,
      rw ← bdd_LC_iff_comparison at this,
      exact this,
    end⟩,
  left_inv := begin
    intros μ, ext1,
    apply (X.Radon_LC_comparison_component_equiv_aux p T).symm_apply_apply,
  end,
  right_inv := begin
    intros μ, ext1,
    apply (X.Radon_LC_comparison_component_equiv_aux p T).apply_symm_apply,
  end }

lemma continuous_Radon_LC_comparison_component_equiv_symm
  (X : Profinite.{0}) (T : discrete_quotient X) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  continuous (X.Radon_LC_comparison_component_equiv T p c).symm :=
begin
  apply continuous.subtype_mk,
  apply weak_dual.continuous_of_continuous_eval,
  intros y,
  apply continuous_finset_sum,
  rintros t -,
  refine continuous.comp (continuous_mul_right (y t)) _,
  refine continuous.comp (continuous_apply t) continuous_subtype_coe,
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_comparison_component_homeo
  (X : Profinite.{0}) (T : discrete_quotient X) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  Radon_LC (X.diagram.obj T) p c ≃ₜ
  pseudo_normed_group.filtration (real_measures p (X.fintype_diagram.obj T)) c :=
{ continuous_to_fun := begin
    rw continuous_iff_is_closed, intros S hS,
    erw ← (Radon_LC_comparison_component_equiv _ _ _ _).symm.image_eq_preimage,
    apply is_compact.is_closed,
    apply hS.is_compact.image,
    apply continuous_Radon_LC_comparison_component_equiv_symm,
  end,
  continuous_inv_fun := continuous_Radon_LC_comparison_component_equiv_symm _ _ _ _,
  ..(X.Radon_LC_comparison_component_equiv T p c) }

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_comparison_component_iso
  (X : Profinite.{0}) (T : discrete_quotient X) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  Radon_LC (X.diagram.obj T) p c ≅
  Top.of (pseudo_normed_group.filtration (real_measures p (X.fintype_diagram.obj T)) c) :=
Top.iso_of_homeo $ Radon_LC_comparison_component_homeo _ _ _ _

lemma Radon_LC_comparison_naturality_aux (X : Profinite.{0})
  (S T : discrete_quotient X) (f : S ⟶ T) (t : T) (q : S) :
  ((⊥ : discrete_quotient T).fibre (discrete_quotient.equiv_bot t)).indicator_LC
    (X.fintype_diagram.map f q) =
  ∑ i : S in finset.univ.filter (λ j, X.fintype_diagram.map f j = t),
    ((⊥ : discrete_quotient S).fibre (discrete_quotient.equiv_bot i)).indicator_LC q :=
begin
  by_cases H : (X.fintype_diagram.map f q = t),
  { rw @finset.sum_eq_single ℝ S _
      (finset.filter (λ (j : (X.fintype_diagram.obj S).α),
        X.fintype_diagram.map f j = t) finset.univ)
      (λ i, ((⊥ : discrete_quotient S).fibre
        (discrete_quotient.equiv_bot i)).indicator_LC q) q _ _,
    { dsimp [clopens.indicator_LC, set.indicator, discrete_quotient.fibre],
      erw if_pos rfl,
      rw if_pos, congr' 1 },
    { intros s hs hsq, rw finset.mem_filter at hs,
      dsimp [clopens.indicator_LC, set.indicator, discrete_quotient.fibre],
      rw if_neg,
      contrapose! hsq,
      apply_fun discrete_quotient.equiv_bot.symm at hsq,
      rw equiv.symm_apply_apply at hsq,
      erw equiv.symm_apply_apply at hsq,
      exact hsq.symm },
    { intros hq,
      erw finset.mem_filter at hq,
      push_neg at hq, specialize hq (finset.mem_univ _),
      exact false.elim (hq H) } },
  { change ite _ _ _ = _, rw if_neg,
    { symmetry, apply finset.sum_eq_zero,
      intros s hs, rw finset.mem_filter at hs, replace hs := hs.2,
      change ite _ _ _ = _, rw if_neg,
      contrapose! H,
      dsimp [discrete_quotient.fibre] at H,
      apply_fun discrete_quotient.equiv_bot.symm at H,
      rw equiv.symm_apply_apply at H,
      erw equiv.symm_apply_apply at H,
      rw H, exact hs },
    { contrapose! H,
      dsimp [discrete_quotient.fibre] at H,
      apply_fun discrete_quotient.equiv_bot.symm at H,
      rw equiv.symm_apply_apply at H,
      erw equiv.symm_apply_apply at H,
      exact H } },
end

/-- The restriction of `Radon_LC_functor` to the discrete quotients of a profinite set `X`
is isomorphic to the `c`-th level of the restriction of `real_measures.functor p`.
This is one of the key isomorphisms used in the comparison between Radon measures and `ℳ_p`.
 -/
def Radon_LC_comparison (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  X.diagram ⋙ Radon_LC_functor p c ≅
  X.fintype_diagram ⋙ real_measures.functor p ⋙ CompHausFiltPseuNormGrp₁.level.obj c ⋙
  CompHaus_to_Top :=
nat_iso.of_components
(λ T, Radon_LC_comparison_component_iso _ _ _ _)
begin
  intros S T f,
  ext a t,
  dsimp [Radon_functor, Radon_LC_comparison_component_iso,
    Radon_LC_comparison_component_homeo,
    Radon_LC_comparison_component_equiv,
    Radon_LC_comparison_component_equiv_aux,
    Radon_LC_functor, real_measures.map_hom,
    CompHausFiltPseuNormGrp₁.level,
    map_Radon_LC, weak_dual.comap
    ],
  let aa : weak_dual ℝ (locally_constant S ℝ) := a.1,
  erw ← aa.map_sum,
  congr' 1,
  ext q,
  rw locally_constant.sum_apply,
  dsimp [continuous_map.comap_LC],
  convert Radon_LC_comparison_naturality_aux X S T f t q,
end

end Profinite