/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Sébastien Gouëzel, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.uniform_space.cauchy
import Mathlib.topology.uniform_space.separation
import Mathlib.topology.dense_embedding
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4

namespace Mathlib

/-!
# Uniform embeddings of uniform spaces.

Extension of uniform continuous functions.
-/

structure uniform_inducing {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] (f : α → β)
where
  comap_uniformity : filter.comap (fun (x : α × α) => (f (prod.fst x), f (prod.snd x))) (uniformity β) = uniformity α

theorem uniform_inducing.mk' {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {f : α → β} (h : ∀ (s : set (α × α)),
  s ∈ uniformity α ↔ ∃ (t : set (β × β)), ∃ (H : t ∈ uniformity β), ∀ (x y : α), (f x, f y) ∈ t → (x, y) ∈ s) : uniform_inducing f := sorry

theorem uniform_inducing.comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α] [uniform_space β] [uniform_space γ] {g : β → γ} (hg : uniform_inducing g) {f : α → β} (hf : uniform_inducing f) : uniform_inducing (g ∘ f) := sorry

structure uniform_embedding {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] (f : α → β)
extends uniform_inducing f
where
  inj : function.injective f

theorem uniform_embedding_subtype_val {α : Type u_1} [uniform_space α] {p : α → Prop} : uniform_embedding subtype.val :=
  uniform_embedding.mk (uniform_inducing.mk rfl) subtype.val_injective

theorem uniform_embedding_subtype_coe {α : Type u_1} [uniform_space α] {p : α → Prop} : uniform_embedding coe :=
  uniform_embedding_subtype_val

theorem uniform_embedding_set_inclusion {α : Type u_1} [uniform_space α] {s : set α} {t : set α} (hst : s ⊆ t) : uniform_embedding (set.inclusion hst) := sorry

theorem uniform_embedding.comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α] [uniform_space β] [uniform_space γ] {g : β → γ} (hg : uniform_embedding g) {f : α → β} (hf : uniform_embedding f) : uniform_embedding (g ∘ f) := sorry

theorem uniform_embedding_def {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {f : α → β} : uniform_embedding f ↔
  function.injective f ∧
    ∀ (s : set (α × α)),
      s ∈ uniformity α ↔ ∃ (t : set (β × β)), ∃ (H : t ∈ uniformity β), ∀ (x y : α), (f x, f y) ∈ t → (x, y) ∈ s := sorry

theorem uniform_embedding_def' {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {f : α → β} : uniform_embedding f ↔
  function.injective f ∧
    uniform_continuous f ∧
      ∀ (s : set (α × α)),
        s ∈ uniformity α → ∃ (t : set (β × β)), ∃ (H : t ∈ uniformity β), ∀ (x y : α), (f x, f y) ∈ t → (x, y) ∈ s := sorry

theorem uniform_inducing.uniform_continuous {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {f : α → β} (hf : uniform_inducing f) : uniform_continuous f := sorry

theorem uniform_inducing.uniform_continuous_iff {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α] [uniform_space β] [uniform_space γ] {f : α → β} {g : β → γ} (hg : uniform_inducing g) : uniform_continuous f ↔ uniform_continuous (g ∘ f) := sorry

theorem uniform_inducing.inducing {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {f : α → β} (h : uniform_inducing f) : inducing f := sorry

theorem uniform_inducing.prod {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {α' : Type u_3} {β' : Type u_4} [uniform_space α'] [uniform_space β'] {e₁ : α → α'} {e₂ : β → β'} (h₁ : uniform_inducing e₁) (h₂ : uniform_inducing e₂) : uniform_inducing fun (p : α × β) => (e₁ (prod.fst p), e₂ (prod.snd p)) := sorry

theorem uniform_inducing.dense_inducing {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {f : α → β} (h : uniform_inducing f) (hd : dense_range f) : dense_inducing f :=
  dense_inducing.mk (inducing.mk (inducing.induced (uniform_inducing.inducing h))) hd

theorem uniform_embedding.embedding {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {f : α → β} (h : uniform_embedding f) : embedding f :=
  embedding.mk (inducing.mk (inducing.induced (uniform_inducing.inducing (uniform_embedding.to_uniform_inducing h))))
    (uniform_embedding.inj h)

theorem uniform_embedding.dense_embedding {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {f : α → β} (h : uniform_embedding f) (hd : dense_range f) : dense_embedding f :=
  dense_embedding.mk
    (dense_inducing.mk (inducing.mk (inducing.induced (embedding.to_inducing (uniform_embedding.embedding h)))) hd)
    (uniform_embedding.inj h)

theorem closure_image_mem_nhds_of_uniform_inducing {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {s : set (α × α)} {e : α → β} (b : β) (he₁ : uniform_inducing e) (he₂ : dense_inducing e) (hs : s ∈ uniformity α) : ∃ (a : α), closure (e '' set_of fun (a' : α) => (a, a') ∈ s) ∈ nhds b := sorry

theorem uniform_embedding_subtype_emb {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] (p : α → Prop) {e : α → β} (ue : uniform_embedding e) (de : dense_embedding e) : uniform_embedding (dense_embedding.subtype_emb p e) := sorry

theorem uniform_embedding.prod {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {α' : Type u_3} {β' : Type u_4} [uniform_space α'] [uniform_space β'] {e₁ : α → α'} {e₂ : β → β'} (h₁ : uniform_embedding e₁) (h₂ : uniform_embedding e₂) : uniform_embedding fun (p : α × β) => (e₁ (prod.fst p), e₂ (prod.snd p)) := sorry

theorem is_complete_of_complete_image {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {m : α → β} {s : set α} (hm : uniform_inducing m) (hs : is_complete (m '' s)) : is_complete s := sorry

/-- A set is complete iff its image under a uniform embedding is complete. -/
theorem is_complete_image_iff {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {m : α → β} {s : set α} (hm : uniform_embedding m) : is_complete (m '' s) ↔ is_complete s := sorry

theorem complete_space_iff_is_complete_range {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {f : α → β} (hf : uniform_embedding f) : complete_space α ↔ is_complete (set.range f) := sorry

theorem complete_space_congr {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {e : α ≃ β} (he : uniform_embedding ⇑e) : complete_space α ↔ complete_space β := sorry

theorem complete_space_coe_iff_is_complete {α : Type u_1} [uniform_space α] {s : set α} : complete_space ↥s ↔ is_complete s :=
  iff.trans (complete_space_iff_is_complete_range uniform_embedding_subtype_coe)
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_complete (set.range coe) ↔ is_complete s)) subtype.range_coe))
      (iff.refl (is_complete s)))

theorem is_complete.complete_space_coe {α : Type u_1} [uniform_space α] {s : set α} (hs : is_complete s) : complete_space ↥s :=
  iff.mpr complete_space_coe_iff_is_complete hs

theorem is_closed.complete_space_coe {α : Type u_1} [uniform_space α] [complete_space α] {s : set α} (hs : is_closed s) : complete_space ↥s :=
  is_complete.complete_space_coe (is_closed.is_complete hs)

theorem complete_space_extension {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {m : β → α} (hm : uniform_inducing m) (dense : dense_range m) (h : ∀ (f : filter β), cauchy f → ∃ (x : α), filter.map m f ≤ nhds x) : complete_space α := sorry

theorem totally_bounded_preimage {α : Type u_1} {β : Type u_2} [uniform_space α] [uniform_space β] {f : α → β} {s : set β} (hf : uniform_embedding f) (hs : totally_bounded s) : totally_bounded (f ⁻¹' s) := sorry

theorem uniform_embedding_comap {α : Type u_1} {β : Type u_2} {f : α → β} [u : uniform_space β] (hf : function.injective f) : uniform_embedding f :=
  uniform_embedding.mk (uniform_inducing.mk rfl) hf

theorem uniformly_extend_exists {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α] [uniform_space β] [uniform_space γ] {e : β → α} (h_e : uniform_inducing e) (h_dense : dense_range e) {f : β → γ} (h_f : uniform_continuous f) [complete_space γ] (a : α) : ∃ (c : γ), filter.tendsto f (filter.comap e (nhds a)) (nhds c) := sorry

theorem uniform_extend_subtype {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α] [uniform_space β] [uniform_space γ] [complete_space γ] {p : α → Prop} {e : α → β} {f : α → γ} {b : β} {s : set α} (hf : uniform_continuous fun (x : Subtype p) => f (subtype.val x)) (he : uniform_embedding e) (hd : ∀ (x : β), x ∈ closure (set.range e)) (hb : closure (e '' s) ∈ nhds b) (hs : is_closed s) (hp : ∀ (x : α), x ∈ s → p x) : ∃ (c : γ), filter.tendsto f (filter.comap e (nhds b)) (nhds c) := sorry

theorem uniformly_extend_of_ind {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α] [uniform_space β] [uniform_space γ] {e : β → α} (h_e : uniform_inducing e) (h_dense : dense_range e) {f : β → γ} (h_f : uniform_continuous f) [separated_space γ] (b : β) : dense_inducing.extend (uniform_inducing.dense_inducing h_e h_dense) f (e b) = f b :=
  dense_inducing.extend_eq_at (uniform_inducing.dense_inducing h_e h_dense) b
    (continuous.continuous_at (uniform_continuous.continuous h_f))

theorem uniformly_extend_unique {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α] [uniform_space β] [uniform_space γ] {e : β → α} (h_e : uniform_inducing e) (h_dense : dense_range e) {f : β → γ} [separated_space γ] {g : α → γ} (hg : ∀ (b : β), g (e b) = f b) (hc : continuous g) : dense_inducing.extend (uniform_inducing.dense_inducing h_e h_dense) f = g :=
  dense_inducing.extend_unique (uniform_inducing.dense_inducing h_e h_dense) hg hc

theorem uniformly_extend_spec {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α] [uniform_space β] [uniform_space γ] {e : β → α} (h_e : uniform_inducing e) (h_dense : dense_range e) {f : β → γ} (h_f : uniform_continuous f) [separated_space γ] [complete_space γ] (a : α) : filter.tendsto f (filter.comap e (nhds a))
  (nhds (dense_inducing.extend (uniform_inducing.dense_inducing h_e h_dense) f a)) := sorry

theorem uniform_continuous_uniformly_extend {α : Type u_1} {β : Type u_2} {γ : Type u_3} [uniform_space α] [uniform_space β] [uniform_space γ] {e : β → α} (h_e : uniform_inducing e) (h_dense : dense_range e) {f : β → γ} (h_f : uniform_continuous f) [separated_space γ] [cγ : complete_space γ] : uniform_continuous (dense_inducing.extend (uniform_inducing.dense_inducing h_e h_dense) f) := sorry


import data.fintype.card
import tactic.zify
import tactic.ring
import tactic.linarith
import defs

open sum

variables {α β α' β' : Type} {γ : β → Type}

def propagate_aux (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool) × bool)
  (x : β → ℕ → bool) : ℕ → (α → bool) × bool
| 0 := next_bit init_carry (λ i, x i 0)
| (n+1) :=
next_bit (propagate_aux n).1 (λ i, x i (n+1))

def propagate (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool) × bool)
  (x : β → ℕ → bool) (i : ℕ) : bool :=
(propagate_aux init_carry next_bit x i).2

@[simp] def propagate_carry (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool))
  (x : β → ℕ → bool) : ℕ → (α → bool)
| 0 := next_bit init_carry (λ i, x i 0)
| (n+1) := next_bit (propagate_carry n) (λ i, x i (n+1))

@[simp] def propagate_carry2 (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool))
  (x : β → ℕ → bool) : ℕ → (α → bool)
| 0 := init_carry
| (n+1) := next_bit (propagate_carry2 n) (λ i, x i n)

lemma propagate_carry2_succ (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool))
  (x : β → ℕ → bool) (n : ℕ) :
  propagate_carry2 init_carry next_bit x (n+1) =
  propagate_carry init_carry next_bit x n :=
by induction n; simp *

@[simp] lemma propagate_aux_fst_eq_carry (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool) × bool)
  (x : β → ℕ → bool) : ∀ n : ℕ,
  (propagate_aux init_carry next_bit x n).1 =
  propagate_carry init_carry (λ c b, (next_bit c b).1) x n
| 0 := rfl
| (n+1) := by rw [propagate_aux, propagate_carry, propagate_aux_fst_eq_carry]

@[simp] lemma propagate_zero (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
  (α → bool) × bool)
  (x : β → ℕ → bool) :
  propagate init_carry next_bit x 0 = (next_bit init_carry (λ i, x i 0)).2 :=
rfl

lemma propagate_succ (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool) × bool)
  (x : β → ℕ → bool) (i : ℕ) :
  propagate init_carry next_bit x (i+1) = (next_bit
    (propagate_carry init_carry (λ c b, (next_bit c b).1) x i)
    (λ j, x j (i+1))).2 :=
by rw [← propagate_aux_fst_eq_carry]; refl

lemma propagate_succ2 (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool) × bool)
  (x : β → ℕ → bool) (i : ℕ) :
  propagate init_carry next_bit x (i+1) = (next_bit
    (propagate_carry2 init_carry (λ c b, (next_bit c b).1) x (i+1))
    (λ j, x j (i+1))).2 :=
by rw [propagate_carry2_succ, ← propagate_aux_fst_eq_carry]; refl

lemma propagate_carry_propagate {δ : β → Type*} {β' : Type}
    (f : Π a, δ a → β') : Π (n : ℕ) (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool))
  (init_carry_x : Π a, γ a → bool)
  (next_bit_x : Π a (carry : γ a → bool) (bits : δ a → bool),
    (γ a → bool) × bool)
  (x : β' → ℕ → bool),
  propagate_carry init_carry next_bit (λ a, propagate (init_carry_x a)
    (next_bit_x a) (λ d, x (f a d))) n =
  propagate_carry
    (λ a : α ⊕ (Σ a, γ a), sum.elim init_carry (λ b : Σ a, γ a,
      init_carry_x b.1 b.2) a)
    (λ (carry : (α ⊕ (Σ a, γ a)) → bool) (bits : β' → bool),
  -- first compute (propagate (init_carry_x a) (next_bit_x a) (x a) n)
      let f : Π (a : β), (γ a → bool) × bool := λ a, next_bit_x a (λ d,
        carry (inr ⟨a, d⟩)) (λ d, bits (f a d)) in
      let g : (α → bool) := (next_bit (carry ∘ inl) (λ a, (f a).2)) in
      sum.elim g (λ x, (f x.1).1 x.2)
    )
    x n ∘ inl
| 0 init_carry next_bit init_carry_x next_bit_x x := rfl
| (n+1) init_carry next_bit init_carry_x next_bit_x x := begin
  have := propagate_carry_propagate n,
  clear_aux_decl,
  simp only [propagate_carry, propagate_succ, elim_inl] at *,
  conv_lhs { simp only [this] },
  clear this,
  ext,
  congr,
  ext,
  congr,
  induction n with n ih,
  { simp },
  { simp [ih] }
end

lemma propagate_propagate {δ : β → Type*} {β' : Type}
    (f : Π a, δ a → β') : Π (n : ℕ) (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool) × bool)
  (init_carry_x : Π a, γ a → bool)
  (next_bit_x : Π a (carry : γ a → bool) (bits : δ a → bool),
    (γ a → bool) × bool)
  (x : β' → ℕ → bool),
  propagate init_carry next_bit (λ a, propagate (init_carry_x a)
    (next_bit_x a) (λ d, x (f a d))) n =
  propagate
    (λ a : α ⊕ (Σ a, γ a), sum.elim init_carry (λ b : Σ a, γ a,
      init_carry_x b.1 b.2) a)
    (λ (carry : (α ⊕ (Σ a, γ a)) → bool) (bits : β' → bool),
      -- first compute (propagate (init_carry_x a) (next_bit_x a) (x a) n)
      let f : Π (a : β), (γ a → bool) × bool := λ a, next_bit_x a (λ d,
        carry (inr ⟨a, d⟩)) (λ d, bits (f a d)) in
      let g : (α → bool) × bool := (next_bit (carry ∘ inl) (λ a, (f a).2)) in
      (sum.elim g.1 (λ x, (f x.1).1 x.2), g.2)
    )
  x n
| 0 init_carry next_bit init_carry_x next_bit_x x := rfl
| (n+1) init_carry next_bit init_carry_x next_bit_x x := begin
  simp only [propagate_succ],
  clear_aux_decl,
  rw [propagate_carry_propagate],
  congr,
  ext,
  congr,
  induction n with n ih,
  { simp },
  { simp [ih] }
end

lemma propagate_carry_change_vars {β' : Type}
  (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool))
  (x : β' → ℕ → bool) (i : ℕ)
  (change_vars : β → β') :
  propagate_carry init_carry next_bit (λ b, x (change_vars b)) i =
  propagate_carry init_carry (λ (carry : α → bool) (bits : β' → bool),
    next_bit carry (λ b, bits (change_vars b))) x i :=
begin
  induction i,
  { simp },
  { simp * }
end

lemma propagate_change_vars {β' : Type}
  (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool) × bool)
  (x : β' → ℕ → bool) (i : ℕ)
  (change_vars : β → β') :
  propagate init_carry next_bit (λ b, x (change_vars b)) i =
  propagate init_carry (λ (carry : α → bool) (bits : β' → bool),
    next_bit carry (λ b, bits (change_vars b))) x i :=
begin
  induction i with i ih,
  { refl },
  { simp only [propagate_succ, propagate_carry_change_vars, ih] }
end

open term

@[simp] def arity : term → ℕ
| (var n) := n+1
| zero := 0
| one := 0
| neg_one := 0
| (and t₁ t₂) := max (arity t₁) (arity t₂)
| (or t₁ t₂) := max (arity t₁) (arity t₂)
| (xor t₁ t₂) := max (arity t₁) (arity t₂)
| (not t) := arity t
| (ls t) := arity t
| (add t₁ t₂) := max (arity t₁) (arity t₂)
| (sub t₁ t₂) := max (arity t₁) (arity t₂)
| (neg t) := arity t
| (incr t) := arity t
| (decr t) := arity t

@[simp] def term.eval_fin : Π (t : term) (vars : fin (arity t) → ℕ → bool), ℕ → bool
| (var n) vars := vars (fin.last n)
| zero vars := zero_seq
| one vars := one_seq
| neg_one vars := neg_one_seq
| (and t₁ t₂) vars :=
  and_seq (term.eval_fin t₁
    (λ i, vars (fin.cast_le (by simp [arity]) i)))
  (term.eval_fin t₂
    (λ i, vars (fin.cast_le (by simp [arity]) i)))
| (or t₁ t₂) vars :=
  or_seq (term.eval_fin t₁
    (λ i, vars (fin.cast_le (by simp [arity]) i)))
  (term.eval_fin t₂
    (λ i, vars (fin.cast_le (by simp [arity]) i)))
| (xor t₁ t₂) vars :=
  xor_seq (term.eval_fin t₁
    (λ i, vars (fin.cast_le (by simp [arity]) i)))
  (term.eval_fin t₂
    (λ i, vars (fin.cast_le (by simp [arity]) i)))
| (not t) vars := not_seq (term.eval_fin t vars)
| (ls t) vars := ls_seq (term.eval_fin t vars)
| (add t₁ t₂) vars :=
  add_seq (term.eval_fin t₁
    (λ i, vars (fin.cast_le (by simp [arity]) i)))
  (term.eval_fin t₂
    (λ i, vars (fin.cast_le (by simp [arity]) i)))
| (sub t₁ t₂) vars :=
  sub_seq (term.eval_fin t₁
    (λ i, vars (fin.cast_le (by simp [arity]) i)))
  (term.eval_fin t₂
    (λ i, vars (fin.cast_le (by simp [arity]) i)))
| (neg t) vars := neg_seq (term.eval_fin t vars)
| (incr t) vars := incr_seq (term.eval_fin t vars)
| (decr t) vars := decr_seq (term.eval_fin t vars)

lemma eval_fin_eq_eval (t : term) (vars : ℕ → ℕ → bool) :
  term.eval_fin t (λ i, vars i) = term.eval t vars :=
begin
  induction t;
  dsimp [term.eval_fin, term.eval, arity] at *; simp *
end

lemma id_eq_propagate (x : ℕ → bool) :
  x = propagate empty.elim (λ _ (y : unit → bool), (empty.elim, y ())) (λ _, x) :=
by ext n; cases n; refl

lemma zero_eq_propagate :
  zero_seq = propagate empty.elim (λ (_ _ : empty → bool), (empty.elim, ff)) empty.elim :=
by ext n; cases n; refl

lemma one_eq_propagate :
  one_seq = propagate (λ _ : unit, tt) (λ f (_ : empty → bool), (λ _, ff, f ())) empty.elim :=
begin
  ext n,
  cases n with n,
  { refl },
  { cases n,
    { simp [one_seq, propagate_succ] },
    { simp [one_seq, propagate_succ] } }
end

lemma and_eq_propagate (x y : ℕ → bool) :
  and_seq x y = propagate empty.elim
    (λ _ (y : bool → bool), (empty.elim, y tt && y ff)) (λ b, cond b x y) :=
by ext n; cases n; simp [propagate, propagate_aux, and_seq]

lemma or_eq_propagate (x y : ℕ → bool) :
  or_seq x y = propagate empty.elim
    (λ _ (y : bool → bool), (empty.elim, y tt || y ff)) (λ b, cond b x y) :=
by ext n; cases n; simp [propagate, propagate_aux, or_seq]

lemma xor_eq_propagate (x y : ℕ → bool) :
  xor_seq x y = propagate empty.elim
    (λ _ (y : bool → bool), (empty.elim, bxor (y tt) (y ff))) (λ b, cond b x y) :=
by ext n; cases n; simp [propagate, propagate_aux, xor_seq]

lemma not_eq_propagate (x : ℕ → bool) :
  not_seq x = propagate empty.elim (λ _ (y : unit → bool), (empty.elim, bnot (y ()))) (λ _, x) :=
by ext n; cases n; simp [propagate, propagate_aux, not_seq]

lemma ls_eq_propagate (x : ℕ → bool) :
  ls_seq x = propagate (λ _ : unit, ff) (λ (carry x : unit → bool), (x, carry ())) (λ _, x) :=
begin
  ext n,
  cases n with n,
  { refl },
  { cases n,
    { simp [ls_seq, propagate_succ] },
    { simp [ls_seq, propagate_succ] } }
end

lemma add_seq_aux_eq_propagate_carry (x y : ℕ → bool) (n : ℕ) :
  (add_seq_aux x y n).2 = propagate_carry (λ _, ff)
    (λ (carry : unit → bool) (bits : bool → bool),
      λ _, (bits tt && bits ff) || (bits ff && carry ()) || (bits tt && carry ()))
  (λ b, cond b x y) n () :=
begin
  induction n,
  { simp [add_seq_aux] },
  { simp [add_seq_aux, *] }
end

lemma add_eq_propagate (x y : ℕ → bool) :
  add_seq x y = propagate (λ _, ff)
    (λ (carry : unit → bool) (bits : bool → bool),
      (λ _, (bits tt && bits ff) || (bits ff && carry ()) || (bits tt && carry ()),
        bxor (bits tt) (bxor (bits ff) (carry ()))))
  (λ b, cond b x y) :=
begin
  ext n,
  cases n with n,
  { simp [add_seq, add_seq_aux] },
  { cases n,
    { simp [add_seq, add_seq_aux, propagate_succ] },
    { simp [add_seq, add_seq_aux, add_seq_aux_eq_propagate_carry,
        propagate_succ] } }
end

lemma sub_seq_aux_eq_propagate_carry (x y : ℕ → bool) (n : ℕ) :
  (sub_seq_aux x y n).2 = propagate_carry (λ _, ff)
    (λ (carry : unit → bool) (bits : bool → bool),
      λ _, (bnot (bits tt) && (bits ff)) ||
        (bnot (bxor (bits tt) (bits ff))) && carry ())
  (λ b, cond b x y) n () :=
begin
  induction n,
  { simp [sub_seq_aux] },
  { simp [sub_seq_aux, *] }
end

lemma sub_eq_propagate (x y : ℕ → bool) :
  sub_seq x y = propagate (λ _, ff)
    (λ (carry : unit → bool) (bits : bool → bool),
      (λ _, (bnot (bits tt) && (bits ff)) ||
        ((bnot (bxor (bits tt) (bits ff))) && carry ()),
        bxor (bits tt) (bxor (bits ff) (carry ()))))
  (λ b, cond b x y) :=
begin
  ext n,
  cases n with n,
  { simp [sub_seq, sub_seq_aux] },
  { cases n,
    { simp [sub_seq, sub_seq_aux, propagate_succ] },
    { simp [sub_seq, sub_seq_aux, sub_seq_aux_eq_propagate_carry,
        propagate_succ] } }
end

lemma neg_seq_aux_eq_propagate_carry (x : ℕ → bool) (n : ℕ) :
  (neg_seq_aux x n).2 = propagate_carry (λ _, tt)
    (λ (carry : unit → bool) (bits : unit → bool),
      λ _, (bnot (bits ())) && (carry ()))
  (λ _, x) n () :=
begin
  induction n,
  { simp [neg_seq_aux] },
  { simp [neg_seq_aux, *] }
end

lemma neg_eq_propagate (x : ℕ → bool) :
  neg_seq x = propagate (λ _, tt)
    (λ (carry : unit → bool) (bits : unit → bool),
      (λ _, (bnot (bits ())) && (carry ()), bxor (bnot (bits ())) (carry ())))
  (λ _, x) :=
begin
  ext n,
  cases n with n,
  { simp [neg_seq, neg_seq_aux] },
  { cases n,
    { simp [neg_seq, neg_seq_aux, propagate_succ] },
    { simp [neg_seq, neg_seq_aux, neg_seq_aux_eq_propagate_carry,
        propagate_succ] } }
end

lemma incr_seq_aux_eq_propagate_carry (x : ℕ → bool) (n : ℕ) :
  (incr_seq_aux x n).2 = propagate_carry (λ _, tt)
    (λ (carry : unit → bool) (bits : unit → bool),
      λ _, (bits ()) && carry ())
  (λ _, x) n () :=
begin
  induction n,
  { simp [incr_seq_aux] },
  { simp [incr_seq_aux, *] }
end

lemma incr_eq_propagate (x : ℕ → bool) :
  incr_seq x = propagate (λ _, tt)
    (λ (carry : unit → bool) (bits : unit → bool),
      (λ _, (bits ()) && carry (), bxor (bits ()) (carry ())))
  (λ _, x) :=
begin
  ext n,
  cases n with n,
  { simp [incr_seq, incr_seq_aux] },
  { cases n,
    { simp [incr_seq, incr_seq_aux, propagate_succ] },
    { simp [incr_seq, incr_seq_aux, incr_seq_aux_eq_propagate_carry,
        propagate_succ] } }
end

lemma decr_seq_aux_eq_propagate_carry (x : ℕ → bool) (n : ℕ) :
  (decr_seq_aux x n).2 = propagate_carry (λ _, tt)
    (λ (carry : unit → bool) (bits : unit → bool),
      λ _, (bnot (bits ())) && carry ())
  (λ _, x) n () :=
begin
  induction n,
  { simp [decr_seq_aux] },
  { simp [decr_seq_aux, *] }
end

lemma decr_eq_propagate (x : ℕ → bool) :
  decr_seq x = propagate (λ _, tt)
    (λ (carry : unit → bool) (bits : unit → bool),
      (λ _, (bnot (bits ())) && carry (), bxor (bits ()) (carry ())))
  (λ _, x) :=
begin
  ext n,
  cases n with n,
  { simp [decr_seq, decr_seq_aux] },
  { cases n,
    { simp [decr_seq, decr_seq_aux, propagate_succ] },
    { simp [decr_seq, decr_seq_aux, decr_seq_aux_eq_propagate_carry,
        propagate_succ] } }
end

structure propagate_struc (arity : Type) : Type 1 :=
( α  : Type )
[ i : fintype α ]
( init_carry : α → bool )
( next_bit : Π (carry : α → bool) (bits : arity → bool),
    (α → bool) × bool )

attribute [instance] propagate_struc.i

namespace propagate_struc

variables {arity : Type} (p : propagate_struc arity)

def eval : (arity → ℕ → bool) → ℕ → bool :=
propagate p.init_carry p.next_bit

def change_vars {arity2 : Type} (change_vars : arity → arity2) :
  propagate_struc arity2 :=
{ α := p.α,
  i := p.i,
  init_carry := p.init_carry,
  next_bit := λ carry bits, p.next_bit carry (λ i, bits (change_vars i)) }

def compose [fintype arity]
  (new_arity : Type)
  (q_arity : arity → Type)
  (vars : Π (a : arity), q_arity a → new_arity)
  (q : Π (a : arity), propagate_struc (q_arity a)) :
  propagate_struc (new_arity) :=
{ α := p.α ⊕ (Σ a, (q a).α),
  i := by letI := p.i; apply_instance,
  init_carry := sum.elim p.init_carry (λ x, (q x.1).init_carry x.2),
  next_bit := λ carry bits,
    let f : Π (a : arity), ((q a).α → bool) × bool := λ a, (q a).next_bit (λ d,
        carry (inr ⟨a, d⟩)) (λ d, bits (vars a d)) in
    let g : (p.α → bool) × bool := (p.next_bit (carry ∘ inl) (λ a, (f a).2)) in
    (sum.elim g.1 (λ x, (f x.1).1 x.2), g.2) }

lemma eval_compose [fintype arity]
  (new_arity : Type)
  (q_arity : arity → Type)
  (vars : Π (a : arity), q_arity a → new_arity)
  (q : Π (a : arity), propagate_struc (q_arity a))
  (x : new_arity → ℕ → bool):
  (p.compose new_arity q_arity vars q).eval x =
  p.eval (λ a, (q a).eval (λ i, x (vars _ i))) :=
begin
  ext n,
  simp only [eval, compose, propagate_propagate]
end

def and : propagate_struc bool :=
{ α := empty,
  i := by apply_instance,
  init_carry := empty.elim,
  next_bit := λ carry bits, (empty.elim, bits tt && bits ff) }

@[simp] lemma eval_and (x : bool → ℕ → bool) : and.eval x = and_seq (x tt) (x ff) :=
by ext n; cases n; simp [and, and_seq, eval, propagate_succ]

def or : propagate_struc bool :=
{ α := empty,
  i := by apply_instance,
  init_carry := empty.elim,
  next_bit := λ carry bits, (empty.elim, bits tt || bits ff) }

@[simp] lemma eval_or (x : bool → ℕ → bool) : or.eval x = or_seq (x tt) (x ff) :=
by ext n; cases n; simp [or, or_seq, eval, propagate_succ]

def xor : propagate_struc bool :=
{ α := empty,
  i := by apply_instance,
  init_carry := empty.elim,
  next_bit := λ carry bits, (empty.elim, bxor (bits tt) (bits ff)) }

@[simp] lemma eval_xor (x : bool → ℕ → bool) : xor.eval x = xor_seq (x tt) (x ff) :=
by ext n; cases n; simp [xor, xor_seq, eval, propagate_succ]

def add : propagate_struc bool :=
{ α := unit,
  i := by apply_instance,
  init_carry := λ _, ff,
  next_bit := λ (carry : unit → bool) (bits : bool → bool),
      (λ _, (bits tt && bits ff) || (bits ff && carry ()) || (bits tt && carry ()),
        bxor (bits tt) (bxor (bits ff) (carry ()))) }

@[simp] lemma eval_add (x : bool → ℕ → bool) : add.eval x = add_seq (x tt) (x ff) :=
begin
  dsimp [add, eval],
  rw [add_eq_propagate],
  congr,
  funext b,
  cases b; refl
end

def sub : propagate_struc bool :=
{ α := unit,
  i := by apply_instance,
  init_carry := λ _, ff,
  next_bit := λ (carry : unit → bool) (bits : bool → bool),
      (λ _, (bnot (bits tt) && (bits ff)) ||
        ((bnot (bxor (bits tt) (bits ff))) && carry ()),
        bxor (bits tt) (bxor (bits ff) (carry ()))) }

@[simp] lemma eval_sub (x : bool → ℕ → bool) : sub.eval x = sub_seq (x tt) (x ff) :=
begin
  dsimp [sub, eval],
  rw [sub_eq_propagate],
  congr,
  funext b,
  cases b; refl
end

def neg : propagate_struc unit :=
{ α := unit,
  i := by apply_instance,
  init_carry := λ _, tt,
  next_bit := λ (carry : unit → bool) (bits : unit → bool),
    (λ _, (bnot (bits ())) && (carry ()), bxor (bnot (bits ())) (carry ())) }

@[simp] lemma eval_neg (x : unit → ℕ → bool) : neg.eval x = neg_seq (x ()) :=
begin
  dsimp [neg, eval],
  rw [neg_eq_propagate],
  congr,
  funext b,
  cases b; refl
end

def not : propagate_struc unit :=
{ α := empty,
  i := by apply_instance,
  init_carry := empty.elim,
  next_bit := λ carry bits, (empty.elim, bnot (bits ())) }

@[simp] lemma eval_not (x : unit → ℕ → bool) : not.eval x = not_seq (x ()) :=
by ext n; cases n; simp [not, not_seq, eval, propagate_succ]

def zero : propagate_struc (fin 0) :=
{ α := empty,
  i := by apply_instance,
  init_carry := empty.elim,
  next_bit := λ carry bits, (empty.elim, ff) }

@[simp] lemma eval_zero (x : fin 0 → ℕ → bool) : zero.eval x = zero_seq :=
by ext n; cases n; simp [zero, zero_seq, eval, propagate_succ]

def one : propagate_struc (fin 0) :=
{ α := unit,
  i := by apply_instance,
  init_carry := λ _, tt,
  next_bit := λ carry bits, (λ _, ff, carry ()) }

@[simp] lemma eval_one (x : fin 0 → ℕ → bool) : one.eval x = one_seq :=
by ext n; cases n; simp [one, one_seq, eval, propagate_succ2]

def neg_one : propagate_struc (fin 0) :=
{ α := empty,
  i := by apply_instance,
  init_carry := empty.elim,
  next_bit := λ carry bits, (empty.elim, tt) }

@[simp] lemma eval_neg_one (x : fin 0 → ℕ → bool) : neg_one.eval x = neg_one_seq :=
by ext n; cases n; simp [neg_one, neg_one_seq, eval, propagate_succ2]

def ls : propagate_struc unit :=
{ α := unit,
  i := by apply_instance,
  init_carry := λ _, ff,
  next_bit := λ carry bits, (bits, carry ()) }

@[simp] lemma eval_ls (x : unit → ℕ → bool) : ls.eval x = ls_seq (x ()) :=
by ext n; cases n; simp [ls, ls_seq, eval, propagate_succ2]

def var (n : ℕ) : propagate_struc (fin (n+1)) :=
{ α := empty,
  i := by apply_instance,
  init_carry := empty.elim,
  next_bit := λ carry bits, (empty.elim, bits (fin.last n)) }

@[simp] lemma eval_var (n : ℕ) (x : fin (n+1) → ℕ → bool) : (var n).eval x = x (fin.last n) :=
by ext m; cases m; simp [var, eval, propagate_succ]

def incr : propagate_struc unit :=
{ α := unit,
  i := by apply_instance,
  init_carry := λ _, tt,
  next_bit := λ carry bits, (λ _, bits () && carry (), bxor (bits ()) (carry ())) }

@[simp] lemma eval_incr (x : unit → ℕ → bool) : incr.eval x = incr_seq (x ()) :=
begin
  dsimp [incr, eval],
  rw [incr_eq_propagate],
  congr,
  funext b,
  cases b; refl
end

def decr : propagate_struc unit :=
{ α := unit,
  i := by apply_instance,
  init_carry := λ _, tt,
  next_bit := λ carry bits, (λ _, bnot (bits ()) && carry (), bxor (bits ()) (carry ())) }

@[simp] lemma eval_decr (x : unit → ℕ → bool) : decr.eval x = decr_seq (x ()) :=
begin
  dsimp [decr, eval],
  rw [decr_eq_propagate],
  congr,
  funext b,
  cases b; refl
end

end propagate_struc

structure propagate_solution (t : term) extends propagate_struc (fin (arity t)) :=
( good : t.eval_fin = to_propagate_struc.eval )

def compose_unary
  (p : propagate_struc unit)
  {t : term}
  (q : propagate_solution t) :
  propagate_struc (fin (arity t)) :=
p.compose
  (fin (arity t))
  _
  (λ _ , id)
  (λ _, q.to_propagate_struc)

def compose_binary
  (p : propagate_struc bool)
  {t₁ t₂ : term}
  (q₁ : propagate_solution t₁)
  (q₂ : propagate_solution t₂) :
  propagate_struc (fin (max (arity t₁) (arity t₂))) :=
p.compose (fin (max (arity t₁) (arity t₂)))
  (λ b, fin (cond b (arity t₁) (arity t₂)))
  (λ b i, fin.cast_le (by cases b; simp) i)
  (λ b, bool.rec q₂.to_propagate_struc q₁.to_propagate_struc b)

@[simp] lemma compose_unary_eval
  (p : propagate_struc unit)
  {t : term}
  (q : propagate_solution t)
  (x : fin (arity t) → ℕ → bool) :
  (compose_unary p q).eval x = p.eval (λ _, t.eval_fin x) :=
begin
  rw [compose_unary, propagate_struc.eval_compose, q.good],
  refl
end

@[simp] lemma compose_binary_eval
  (p : propagate_struc bool)
  {t₁ t₂ : term}
  (q₁ : propagate_solution t₁)
  (q₂ : propagate_solution t₂)
  (x : fin (max (arity t₁) (arity t₂)) → ℕ → bool) :
  (compose_binary p q₁ q₂).eval x = p.eval
    (λ b, cond b (t₁.eval_fin (λ i, x (fin.cast_le (by simp) i)))
                 (t₂.eval_fin (λ i, x (fin.cast_le (by simp) i)))) :=
begin
  rw [compose_binary, propagate_struc.eval_compose, q₁.good, q₂.good],
  congr,
  ext b,
  cases b; refl
end

instance {α β : Type*} [fintype α] [fintype β] (b : bool) :
  fintype (cond b α β) :=
by cases b; dsimp; apply_instance

lemma cond_propagate {α α' β β' : Type}
  (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool),
    (α → bool) × bool)
  (init_carry' : α' → bool)
  (next_bit' : Π (carry : α' → bool) (bits : β' → bool),
    (α' → bool) × bool)
  {γ : Type} (fβ : β → γ) (fβ' : β' → γ)
  (x : γ → ℕ → bool) (b : bool) :
  cond b (propagate init_carry next_bit (λ b, (x (fβ b))))
    (propagate init_carry' next_bit' (λ b, (x (fβ' b)))) =
  propagate (show cond b α α' → bool, from bool.rec init_carry' init_carry b)
    (show Π (carry : cond b α α' → bool) (bits : cond b β β' → bool),
        (cond b α α' → bool) × bool,
      from bool.rec next_bit' next_bit b)
    (show cond b β β' → ℕ → bool, from bool.rec (λ b, (x (fβ' b))) (λ b, (x (fβ b))) b) :=
by cases b; refl

def term_eval_eq_propagate : Π (t : term),
  propagate_solution t
| (var n) :=
  { to_propagate_struc := propagate_struc.var n,
    good := by ext; simp [term.eval_fin] }
| zero :=
  { to_propagate_struc := propagate_struc.zero,
    good := by ext; simp [term.eval_fin] }
| one :=
  { to_propagate_struc := propagate_struc.one,
    good := by ext; simp [term.eval_fin] }
| neg_one :=
  { to_propagate_struc := propagate_struc.neg_one,
    good := by ext; simp [term.eval_fin] }
| (and t₁ t₂) :=
  let q₁ := term_eval_eq_propagate t₁ in
  let q₂ := term_eval_eq_propagate t₂ in
  { to_propagate_struc := compose_binary propagate_struc.and q₁ q₂,
    good := by ext; simp; refl }
| (or t₁ t₂) :=
  let q₁ := term_eval_eq_propagate t₁ in
  let q₂ := term_eval_eq_propagate t₂ in
  { to_propagate_struc := compose_binary propagate_struc.or q₁ q₂,
    good := by ext; simp; refl }
| (xor t₁ t₂) :=
  let q₁ := term_eval_eq_propagate t₁ in
  let q₂ := term_eval_eq_propagate t₂ in
  { to_propagate_struc := compose_binary propagate_struc.xor q₁ q₂,
    good := by ext; simp; refl }
| (ls t) :=
  let q := term_eval_eq_propagate t in
  { to_propagate_struc := by dsimp [arity]; exact compose_unary propagate_struc.ls q,
    good := by ext; simp; refl }
| (not t) :=
  let q := term_eval_eq_propagate t in
  { to_propagate_struc := by dsimp [arity]; exact compose_unary propagate_struc.not q,
    good := by ext; simp; refl }
| (add t₁ t₂) :=
  let q₁ := term_eval_eq_propagate t₁ in
  let q₂ := term_eval_eq_propagate t₂ in
  { to_propagate_struc := compose_binary propagate_struc.add q₁ q₂,
    good := by ext; simp; refl }
| (sub t₁ t₂) :=
  let q₁ := term_eval_eq_propagate t₁ in
  let q₂ := term_eval_eq_propagate t₂ in
  { to_propagate_struc := compose_binary propagate_struc.sub q₁ q₂,
    good := by ext; simp; refl }
| (neg t) :=
  let q := term_eval_eq_propagate t in
  { to_propagate_struc := by dsimp [arity]; exact compose_unary propagate_struc.neg q,
    good := by ext; simp; refl }
| (incr t) :=
  let q := term_eval_eq_propagate t in
  { to_propagate_struc := by dsimp [arity]; exact compose_unary propagate_struc.incr q,
    good := by ext; simp; refl }
| (decr t) :=
  let q := term_eval_eq_propagate t in
  { to_propagate_struc := by dsimp [arity]; exact compose_unary propagate_struc.decr q,
    good := by ext; simp; refl }

variables
  (init_carry : α → bool)
  (next_carry : Π (carry : α → bool) (bits : β → bool), (α → bool))
  (next_bit : Π (carry : α → bool) (bits : β → bool), (α → bool) × bool)

variables [fintype α] [fintype α']

open fintype

lemma exists_repeat_carry (seq : β → ℕ → bool) :
  ∃ n m : fin (2 ^ (card α) + 1),
    propagate_carry2 init_carry next_carry seq n =
    propagate_carry2 init_carry next_carry seq m ∧
    n < m :=
begin
  by_contra h,
  letI : decidable_eq α := classical.dec_eq α,
  push_neg at h,
  have := λ a b hab, (le_antisymm (h a b hab) (h b a hab.symm)).symm,
  simpa using fintype.card_le_of_injective _ this
end

lemma propagate_carry2_eq_of_seq_eq_lt (seq₁ seq₂ : β → ℕ → bool)
  (init_carry : α → bool)
  (next_carry : Π (carry : α → bool) (bits : β → bool), (α → bool))
  (i : ℕ) (h : ∀ (b) j < i, seq₁ b j = seq₂ b j) :
  propagate_carry2 init_carry next_carry seq₁ i =
    propagate_carry2 init_carry next_carry seq₂ i :=
begin
  induction i with i ih,
  { simp [propagate_carry2] },
  { simp [propagate_carry2, h _ i (nat.lt_succ_self i)],
    rw ih,
    exact λ b j hj, h b j (nat.lt_succ_of_lt hj) }
end

lemma propagate_eq_of_seq_eq_le (seq₁ seq₂ : β → ℕ → bool)
  (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool), (α → bool) × bool)
  (i : ℕ) (h : ∀ (b) j ≤ i, seq₁ b j = seq₂ b j) :
  propagate init_carry next_bit seq₁ i =
    propagate init_carry next_bit seq₂ i :=
begin
  cases i,
  { simp [propagate_zero, h _ 0 (le_refl _)] },
  { simp only [propagate_succ2, propagate_succ2, h _ _ (le_refl _)],
    congr' 2,
    apply propagate_carry2_eq_of_seq_eq_lt,
    exact λ b j hj, h b j (le_of_lt hj) }
end

lemma propagate_carry2_eq_of_carry_eq (seq₁ seq₂ : β → ℕ → bool)
  (m n : ℕ)
  (h₁ : propagate_carry2 init_carry
    (λ carry bits, (next_bit carry bits).1) seq₁ m =
       propagate_carry2 init_carry
    (λ carry bits, (next_bit carry bits).1) seq₂ n) (x : ℕ)
  (h₃ : ∀ y b, y ≤ x → seq₁ b (m + y) = seq₂ b (n + y))  :
  propagate_carry2 init_carry
    (λ carry bits, (next_bit carry bits).1) seq₁ (m + x) =
  propagate_carry2 init_carry
    (λ carry bits, (next_bit carry bits).1) seq₂ (n + x) :=
begin
  induction x with x ih generalizing seq₁ seq₂,
  { simp * at * },
  { simp only [h₃ x _ (nat.le_succ _),
      nat.add_succ, propagate_carry2, add_zero] at *,
    rw [ih],
    assumption,
    exact λ y b h, h₃ y b (nat.le_succ_of_le h) }
end

lemma propagate_eq_of_carry_eq (seq₁ seq₂ : β → ℕ → bool)
  (m n : ℕ)
  (h₁ : propagate_carry2 init_carry
    (λ carry bits, (next_bit carry bits).1) seq₁ m =
       propagate_carry2 init_carry
    (λ carry bits, (next_bit carry bits).1) seq₂ n) (x : ℕ)
  (h₃ : ∀ y b, y ≤ x → seq₁ b (m + y) = seq₂ b (n + y))  :
  propagate init_carry next_bit seq₁ (m + x) =
  propagate init_carry next_bit seq₂ (n + x) :=
begin
  cases x,
  { cases m,
    { cases n,
      { simp [h₃ 0 _ (le_refl _), propagate_carry2, *] at * },
      { simp [*, h₃ 0 _ (le_refl _), propagate_succ2] at *,
        rw [← h₁] } },
    { cases n,
      { simp [*, propagate_succ2] at *,
        simp [← h₃ 0 _ rfl] },
      { rw [propagate_succ2, h₁, propagate_succ2],
        have := h₃ 0,
        simp * at * } } },
  { simp only [nat.add_succ, propagate_succ2, add_zero],
    simp [← nat.add_succ, h₃ _ _ (le_refl _)],
    congr' 2,
    apply propagate_carry2_eq_of_carry_eq,
    assumption,
    assumption }
end

lemma propagate_carry_propagate_carry_add (x : β → ℕ → bool) :
  ∀ (init_carry : α → bool)
    (next_carry : Π (carry : α → bool) (bits : β → bool), (α → bool)),
  ∀ n i : ℕ,
  propagate_carry2 (propagate_carry2 init_carry next_carry x n)
    next_carry (λ b k, x b (k + n)) i =
  propagate_carry2 init_carry next_carry x (i + n)
| init_carry next_carry 0 0 := by simp [propagate_carry2]
| init_carry next_carry (n+1) 0 :=
  by simp [propagate_carry, propagate_carry2_succ]
| init_carry next_carry n (i+1) := begin
  rw [propagate_carry2, add_assoc,
    propagate_carry_propagate_carry_add],
  simp only [nat.one_add, nat.add_one, nat.succ_add, nat.add_succ,
    add_zero, propagate_carry2, zero_add]
end

lemma exists_repeat : ∀ (seq : β → ℕ → bool)
  (n : ℕ),
  ∃ (m < 2 ^ (card α)) (seq2 : β → ℕ → bool),
    propagate init_carry next_bit seq2 m = propagate init_carry next_bit seq n
| seq n :=
begin
  by_cases hn2 : n < 2 ^ card α,
  { exact ⟨n, hn2, seq, rfl⟩ },
  { rcases exists_repeat_carry (propagate_carry2 init_carry (λ c b, (next_bit c b).1) seq
        (n - 2 ^ card α))
      (λ carry bits, (next_bit  carry bits).1)
      (λ b i, seq b (i + (n - 2^ (card α)))) with ⟨a, b, h₁, h₂⟩,
    simp only [propagate_carry_propagate_carry_add] at h₁,
    rcases have wf : n - (b - a) < n,
        from nat.sub_lt (lt_of_lt_of_le (pow_pos two_pos _) (le_of_not_gt hn2))
          (nat.sub_pos_of_lt h₂),
      exists_repeat (λ c i, if i < a + (n - 2 ^ card α) then seq c i else
        seq c (i + (b - a))) (n - (b - a)) with ⟨m, hmle, seq2, hm⟩,
    use [m, hmle, seq2],
    rw [hm], clear hm,
    have h1 : n - (b - a) = (a + (n - 2 ^ (card α))) + (2 ^ card α - b),
    { zify,
      rw [nat.cast_sub, nat.cast_sub, nat.cast_sub, nat.cast_sub],
      ring,
      exact nat.le_of_lt_succ b.2,
      simp * at *,
      exact le_of_lt h₂,
      exact le_trans (nat.sub_le _ _) (le_trans (nat.le_of_lt_succ b.2)
        (by simp * at *)) },
    rw h1,
    have h2 : n = (b + (n - 2 ^ card α)) + (2 ^ card α - b),
    { zify,
      rw [nat.cast_sub, nat.cast_sub],
      ring,
      exact nat.le_of_lt_succ b.2,
      simp * at *, },
    conv_rhs { rw h2 },
    refine propagate_eq_of_carry_eq _ _ _ _ _ _ _ _ _,
    { have h : ↑b + (n - 2 ^ card α) = (a + (n - 2 ^ card α)) + (b - a),
      { zify,
        rw [nat.cast_sub, nat.cast_sub],
        ring,
        exact le_of_lt h₂,
        simp * at * },
      rw [← h₁],
      apply propagate_carry2_eq_of_seq_eq_lt,
      simp { contextual := tt } },
    { intros y c hc,
      simp only [add_lt_iff_neg_left, not_lt_zero', if_false],
      congr' 1,
      zify,
      rw [nat.cast_sub, nat.cast_sub],
      ring,
      exact le_of_lt h₂,
      simp * at * } },
end
using_well_founded { rel_tac := λ _ _, `[exact ⟨_, measure_wf psigma.snd⟩] }

lemma propagate_eq_zero_iff (init_carry : α → bool)
  (next_bit : Π (carry : α → bool) (bits : β → bool), (α → bool) × bool) :
  (∀ seq, propagate init_carry next_bit seq = zero_seq) ↔
  (∀ seq, ∀ i < 2 ^ (card α), propagate init_carry next_bit seq i = ff) :=
begin
  split,
  { intros h i _,
    simp [h, zero_seq] },
  { intros h seq,
    funext i,
    rcases exists_repeat init_carry next_bit seq i with ⟨j, hj, seq2, hseq2⟩,
    rw [← hseq2, h seq2 j hj, zero_seq] }
end

lemma eq_iff_xor_seq_eq_zero (seq₁ seq₂ : ℕ → bool) :
  (∀ i, seq₁ i = seq₂ i) ↔ (∀ i, xor_seq seq₁ seq₂ i = zero_seq i) :=
begin
  simp [function.funext_iff, xor_seq, zero_seq],
  split,
  { intros, simp * },
  { intros h a,
    specialize h a,
    cases (seq₁ a); cases (seq₂ a); simp * at *, }
end

lemma eval_eq_iff_xor_seq_eq_zero (t₁ t₂ : term) :
  t₁.eval = t₂.eval ↔ (t₁.xor t₂).eval_fin = λ _, zero_seq :=
begin
  simp only [function.funext_iff, term.eval, term.eval_fin,
    ← eq_iff_xor_seq_eq_zero, ← eval_fin_eq_eval],
  split,
  { intros h seq n,
    have := h (λ j, if hj : j < (arity (t₁.xor t₂)) then seq ⟨j, hj⟩ else λ _, ff) n,
    simp at this,
    convert this },
  { intros h seq m,
    exact h (λ j, seq j) _ }
end


import category_theory.abelian.diagram_lemmas.four
import .projectives
import .homological_complex
import .snake_lemma2

noncomputable theory

open category_theory
open category_theory.limits

universes v u

namespace short_exact_sequence

variables {C : Type u} [category.{v} C] [abelian C] [enough_projectives C]
variables {D : Type*} [category D] [abelian D]

-- move this
lemma exact_of_epi_comp_kernel.ι_comp_mono {C : Type u} [category.{v} C] [abelian C] {X Y Z W : C}
  (g : Y ⟶ Z) (h : Z ⟶ W) (f : X ⟶ kernel g) (i : kernel g ⟶ Y) (hf : epi f) (hh : mono h)
  (hi : i = kernel.ι g) : exact (f ≫ i) (g ≫ h) :=
begin
  suffices : exact i g,
  { letI := hf, letI := hh,
    exact exact_comp_mono (exact_epi_comp this) },
  rw [hi],
  exact exact_kernel_ι
end

-- move this
lemma biprod_factors (A B : C) [projective A] [projective B]
  (E X : C) (f : A ⊞ B ⟶ X) (e : E ⟶ X) [epi e] :
  ∃ f' : A ⊞ B ⟶ E, f' ≫ e = f :=
⟨biprod.desc
  (projective.factor_thru (biprod.inl ≫ f) e)
  (projective.factor_thru (biprod.inr ≫ f) e),
  by ext; simp only [projective.factor_thru_comp, biprod.inl_desc_assoc, biprod.inr_desc_assoc]⟩

variables (A B : short_exact_sequence C) (f : A ⟶ B)

def horseshoe_base : short_exact_sequence C :=
short_exact_sequence.mk_split (projective.over A.1) (projective.over A.3)

def horseshoe_base_π : horseshoe_base A ⟶ A :=
{ fst := projective.π _,
  snd := biprod.desc (projective.π _ ≫ A.f) (projective.factor_thru (projective.π _) A.g),
  trd := projective.π _,
  sq1' := by { dsimp [horseshoe_base], simp only [biprod.inl_desc], },
  sq2' :=
  begin
    dsimp [horseshoe_base], apply category_theory.limits.biprod.hom_ext',
    { simp only [zero_comp, exact.w_assoc, biprod.inl_desc_assoc, category.assoc,
        short_exact_sequence.f_comp_g, comp_zero, exact_inl_snd], },
    { simp only [projective.factor_thru_comp, biprod.inr_snd_assoc, biprod.inr_desc_assoc], }
  end }

instance epi_horseshoe_base_π_1 : epi (horseshoe_base_π A).1 :=
show epi (projective.π _), by apply_instance

instance epi_horseshoe_base_π_3 : epi (horseshoe_base_π A).3 :=
show epi (projective.π _), by apply_instance

local attribute [instance] limits.has_zero_object.has_zero

instance epi_horseshoe_base_π_2 : epi (horseshoe_base_π A).2 :=
begin
  let φ := horseshoe_base_π A,
  have h : φ.3 ≫ (0 : A.3 ⟶ 0) = (0 : _ ⟶ 0) ≫ (0 : 0 ⟶ 0) := by simp,
  refine category_theory.abelian.epi_of_epi_of_epi_of_mono φ.sq1' φ.sq2' h _ _ _ _ _ _;
  try { rw ← epi_iff_exact_zero_right }; try { apply_instance },
  exact A.exact',
end

variables {A B}

def horseshoe_ker [epi f.1] : short_exact_sequence C :=
(snake_input.mk_of_short_exact_sequence_hom _ _ _ f).kernel_sequence _
begin
  dsimp [snake_input.mk_of_short_exact_sequence_hom, snake_diagram.mk_of_short_exact_sequence_hom],
  rw snake_diagram.mk_functor_map_f1,
  exact A.mono',
end
$ is_zero_of_iso_of_zero (is_zero_zero _) (limits.cokernel.of_epi _).symm

@[simp] lemma horseshoe_ker_fst [epi f.1] : (horseshoe_ker f).1 = kernel f.1 := rfl

@[simp] lemma horseshoe_ker_snd [epi f.1] : (horseshoe_ker f).2 = kernel f.2 := rfl

@[simp] lemma horseshoe_ker_trd [epi f.1] : (horseshoe_ker f).3 = kernel f.3 := rfl

def horseshoe_ker_ι [epi f.1] : horseshoe_ker f ⟶ A :=
{ fst := kernel.ι _,
  snd := kernel.ι _,
  trd := kernel.ι _,
  sq1' :=
  begin
    dsimp [horseshoe_ker, snake_input.kernel_sequence,
      snake_input.mk_of_short_exact_sequence_hom, snake_diagram.mk_of_short_exact_sequence_hom],
    delta kernel.map,
    rw [snake_diagram.mk_functor_map_f0, kernel.lift_ι],
  end,
  sq2' :=
  begin
    dsimp [horseshoe_ker, snake_input.kernel_sequence,
      snake_input.mk_of_short_exact_sequence_hom, snake_diagram.mk_of_short_exact_sequence_hom],
    delta kernel.map,
    rw [snake_diagram.mk_functor_map_g0, kernel.lift_ι],
  end }
.

lemma horseshoe_ker_ι_fst [epi f.1] : (horseshoe_ker_ι f).1 = kernel.ι f.1 := rfl

lemma horseshoe_ker_ι_snd [epi f.1] : (horseshoe_ker_ι f).2 = kernel.ι f.2 := rfl

lemma horseshoe_ker_ι_trd [epi f.1] : (horseshoe_ker_ι f).3 = kernel.ι f.3 := rfl

variables (A)

lemma horseshoe_ker_ι_comp_base_π :
  (horseshoe_ker_ι (horseshoe_base_π A)) ≫ horseshoe_base_π A = 0 :=
begin
  dsimp [horseshoe_ker_ι, horseshoe_base_π],
  ext1; show kernel.ι _ ≫ _ = 0; exact exact.w exact_kernel_ι,
end

noncomputable
def horseshoe_step (A : short_exact_sequence C) :
  ℕ → Σ (X Y Z : short_exact_sequence C) (ι : X ⟶ Y), Y ⟶ Z
| 0     := ⟨horseshoe_ker (horseshoe_base_π A), _, _, horseshoe_ker_ι _, horseshoe_base_π _⟩
| (n+1) :=
⟨horseshoe_ker (horseshoe_base_π (horseshoe_step n).1), _, _, horseshoe_ker_ι _, horseshoe_base_π _⟩

@[reassoc] lemma horseshoe_step_comp_eq_zero :
  ∀ n, (horseshoe_step A n).2.2.2.1 ≫ (horseshoe_step A n).2.2.2.2 = 0
| 0     := horseshoe_ker_ι_comp_base_π _
| (n+1) := horseshoe_ker_ι_comp_base_π _

lemma step_fst_mono (n : ℕ) : mono (horseshoe_step A n).2.2.2.1.1 :=
begin
  cases n,
  { dsimp [horseshoe_step, horseshoe_ker_ι],
    apply_instance },
  { dsimp [horseshoe_step],
    cases n, --Why do I have to do this again?!
    { rw [horseshoe_ker_ι_fst],
      apply_instance },
    { rw [horseshoe_ker_ι_fst],
      apply_instance }  }
end

lemma step_snd_mono (n : ℕ) : mono (horseshoe_step A n).2.2.2.1.2 :=
begin
  cases n,
  { dsimp [horseshoe_step, horseshoe_ker_ι],
    apply_instance },
  { dsimp [horseshoe_step],
    cases n, --Why do I have to do this again?!
    { rw [horseshoe_ker_ι_snd],
      apply_instance },
    { rw [horseshoe_ker_ι_snd],
      apply_instance }  }
end

lemma step_trd_mono (n : ℕ) : mono (horseshoe_step A n).2.2.2.1.3 :=
begin
  cases n,
  { dsimp [horseshoe_step, horseshoe_ker_ι],
    apply_instance },
  { dsimp [horseshoe_step],
    cases n, --Why do I have to do this again?!
    { rw [horseshoe_ker_ι_trd],
      apply_instance },
    { rw [horseshoe_ker_ι_trd],
      apply_instance }  }
end

def horseshoe_obj (n : ℕ) := (horseshoe_step A n).2.1

def horseshoe_d (n : ℕ) : horseshoe_obj A (n+1) ⟶ horseshoe_obj A n :=
(horseshoe_step A (n+1)).2.2.2.2 ≫ eq_to_hom (by { dsimp [horseshoe_step], refl })
  ≫ (horseshoe_step A n).2.2.2.1

lemma horseshoe_d_d (n : ℕ) : horseshoe_d A (n+1) ≫ horseshoe_d A n = 0 :=
begin
  dsimp [horseshoe_d, horseshoe_ker_ι],
  simp only [category.id_comp, category.assoc, comp_zero, zero_comp,
    horseshoe_step_comp_eq_zero_assoc],
end

def horseshoe (A : short_exact_sequence C) : chain_complex (short_exact_sequence C) ℕ :=
chain_complex.of (horseshoe_obj A) (horseshoe_d A) (horseshoe_d_d A)

variables (A)

def horseshoe_π : (horseshoe A).X 0 ⟶ A := horseshoe_base_π _

lemma horseshoe_d_π : (horseshoe A).d 1 0 ≫ horseshoe_π A = 0 :=
begin
  dsimp [horseshoe],
  erw [chain_complex.of_d],
  dsimp [horseshoe_d, horseshoe_π, horseshoe_step],
  simp only [category.id_comp, category.assoc, comp_zero, zero_comp,
    horseshoe_step_comp_eq_zero_assoc, horseshoe_ker_ι_comp_base_π],
end

def horseshoe_to_single₁ :=
(chain_complex.to_single₀_equiv ((homological_complex.Fst C).obj (horseshoe A)) A.1).symm
⟨(short_exact_sequence.Fst C).map (horseshoe_π A),
begin
  have := horseshoe_d_π A, apply_fun (λ f, (short_exact_sequence.Fst C).map f) at this,
  rwa [functor.map_comp, functor.map_zero] at this,
end⟩

def horseshoe_to_single₂ :=
(chain_complex.to_single₀_equiv ((homological_complex.Snd C).obj (horseshoe A)) A.2).symm
⟨(short_exact_sequence.Snd C).map (horseshoe_π A),
begin
  have := horseshoe_d_π A, apply_fun (λ f, (short_exact_sequence.Snd C).map f) at this,
  rwa [functor.map_comp, functor.map_zero] at this,
end⟩

def horseshoe_to_single₃ :=
(chain_complex.to_single₀_equiv ((homological_complex.Trd C).obj (horseshoe A)) A.3).symm
⟨(short_exact_sequence.Trd C).map (horseshoe_π A),
begin
  have := horseshoe_d_π A, apply_fun (λ f, (short_exact_sequence.Trd C).map f) at this,
  rwa [functor.map_comp, functor.map_zero] at this,
end⟩

lemma horseshoe_exact₁ (A : short_exact_sequence C) (n : ℕ) :
  exact (((homological_complex.Fst C).obj (horseshoe A)).d (n + 2) (n + 1))
    (((homological_complex.Fst C).obj (horseshoe A)).d (n + 1) n) :=
begin
  dsimp [horseshoe_to_single₁],
  erw [chain_complex.of_d, chain_complex.of_d],
  dsimp [horseshoe_d, horseshoe_step],

  set f := horseshoe_base_π (horseshoe_step A n).1,
  set g := (horseshoe_step A n).2.2.2.1,

  cases n;
  convert exact_of_epi_comp_kernel.ι_comp_mono f.1 _ (horseshoe_base_π (horseshoe_ker f)).1 _
    infer_instance _ _ using 1,
  { simp [step_fst_mono] },
  { simpa },
  { simp [step_fst_mono] },
  { simpa }
end

lemma horseshoe_exact₂ (A : short_exact_sequence C) (n : ℕ) :
  exact (((homological_complex.Snd C).obj (horseshoe A)).d (n + 2) (n + 1))
    (((homological_complex.Snd C).obj (horseshoe A)).d (n + 1) n) :=
begin
  dsimp [horseshoe_to_single₂],
  erw [chain_complex.of_d, chain_complex.of_d],
  dsimp [horseshoe_d, horseshoe_step],

  set f := horseshoe_base_π (horseshoe_step A n).1,
  set g := (horseshoe_step A n).2.2.2.1,

  cases n;
  convert exact_of_epi_comp_kernel.ι_comp_mono f.2 _ (horseshoe_base_π (horseshoe_ker f)).2 _
    infer_instance _ _ using 1,
  { simp [step_snd_mono] },
  { simpa },
  { simp [step_snd_mono] },
  { simpa }
end

lemma horseshoe_exact₃ (A : short_exact_sequence C) (n : ℕ) :
  exact (((homological_complex.Trd C).obj (horseshoe A)).d (n + 2) (n + 1))
    (((homological_complex.Trd C).obj (horseshoe A)).d (n + 1) n) :=
begin
  dsimp [horseshoe_to_single₃],
  erw [chain_complex.of_d, chain_complex.of_d],
  dsimp [horseshoe_d, horseshoe_step],

  set f := horseshoe_base_π (horseshoe_step A n).1,
  set g := (horseshoe_step A n).2.2.2.1,

  cases n;
  convert exact_of_epi_comp_kernel.ι_comp_mono f.3 _ (horseshoe_base_π (horseshoe_ker f)).3 _
    infer_instance _ _ using 1,
  { simp [step_trd_mono] },
  { simpa },
  { simp [step_trd_mono] },
  { simpa }
end

lemma horseshoe_is_projective_resolution₁ (A : short_exact_sequence C) :
  chain_complex.is_projective_resolution
    ((homological_complex.Fst C).obj (horseshoe A)) A.1 (horseshoe_to_single₁ A) :=
{ projective := by rintro (_|n); { show projective (projective.over _), apply_instance },
  exact₀ :=
  begin
    dsimp [horseshoe_to_single₁, chain_complex.to_single₀_equiv, horseshoe_π],
    erw [chain_complex.of_d],
    dsimp [horseshoe_d, horseshoe_step],
    rw [category.id_comp, ← short_exact_sequence.comp_fst],
    refine abelian.pseudoelement.exact_of_pseudo_exact _ _ ⟨λ a , _, λ a ha, _⟩,
    { rw [← abelian.pseudoelement.comp_apply, ← short_exact_sequence.comp_fst, category.assoc,
        horseshoe_ker_ι_comp_base_π, comp_zero, short_exact_sequence.hom_zero_fst,
        abelian.pseudoelement.zero_apply] },
    { obtain ⟨b, hb⟩ := is_snake_input.exists_of_exact exact_kernel_ι _ ha,
      obtain ⟨c, hc⟩ := abelian.pseudoelement.pseudo_surjective_of_epi
        (horseshoe_base_π (horseshoe_ker _)).1 b,
      refine ⟨c, _⟩,
      rw [short_exact_sequence.comp_fst, abelian.pseudoelement.comp_apply, hc, ← hb],
      refl }
  end,
  exact := λ n, horseshoe_exact₁ A n,
  epi := show epi (projective.π _), from infer_instance }

lemma horseshoe_is_projective_resolution₂ (A : short_exact_sequence C) :
  chain_complex.is_projective_resolution
    ((homological_complex.Snd C).obj (horseshoe A)) A.2 (horseshoe_to_single₂ A) :=
{ projective := by rintro (_|n); { show projective (projective.over _ ⊞ projective.over _),
    apply_instance },
  exact₀ :=
  begin
    dsimp [horseshoe_to_single₂, chain_complex.to_single₀_equiv, horseshoe_π],
    erw [chain_complex.of_d],
    dsimp [horseshoe_d, horseshoe_step],
    rw [category.id_comp, ← short_exact_sequence.comp_snd],
    refine abelian.pseudoelement.exact_of_pseudo_exact _ _ ⟨λ a , _, λ a ha, _⟩,
    { rw [← abelian.pseudoelement.comp_apply, ← short_exact_sequence.comp_snd, category.assoc,
        horseshoe_ker_ι_comp_base_π, comp_zero, short_exact_sequence.hom_zero_snd,
        abelian.pseudoelement.zero_apply] },
    { obtain ⟨b, hb⟩ := is_snake_input.exists_of_exact exact_kernel_ι _ ha,
      obtain ⟨c, hc⟩ := abelian.pseudoelement.pseudo_surjective_of_epi
        (horseshoe_base_π (horseshoe_ker _)).2 b,
      refine ⟨c, _⟩,
      rw [short_exact_sequence.comp_snd, abelian.pseudoelement.comp_apply, hc, ← hb],
      refl }
  end,
  exact := λ n, horseshoe_exact₂ A n,
  epi := show epi (horseshoe_base_π _).2, from infer_instance }

lemma horseshoe_is_projective_resolution₃ (A : short_exact_sequence C) :
  chain_complex.is_projective_resolution
    ((homological_complex.Trd C).obj (horseshoe A)) A.3 (horseshoe_to_single₃ A) :=
{ projective := by rintro (_|n); { show projective (projective.over _), apply_instance },
  exact₀ :=
  begin
    dsimp [horseshoe_to_single₃, chain_complex.to_single₀_equiv, horseshoe_π],
    erw [chain_complex.of_d],
    dsimp [horseshoe_d, horseshoe_step],
    rw [category.id_comp, ← short_exact_sequence.comp_trd],
    refine abelian.pseudoelement.exact_of_pseudo_exact _ _ ⟨λ a , _, λ a ha, _⟩,
    { rw [← abelian.pseudoelement.comp_apply, ← short_exact_sequence.comp_trd, category.assoc,
        horseshoe_ker_ι_comp_base_π, comp_zero, short_exact_sequence.hom_zero_trd,
        abelian.pseudoelement.zero_apply] },
    { obtain ⟨b, hb⟩ := is_snake_input.exists_of_exact exact_kernel_ι _ ha,
      obtain ⟨c, hc⟩ := abelian.pseudoelement.pseudo_surjective_of_epi
        (horseshoe_base_π (horseshoe_ker _)).3 b,
      refine ⟨c, _⟩,
      rw [short_exact_sequence.comp_trd, abelian.pseudoelement.comp_apply, hc, ← hb],
      refl }
  end,
  exact := λ n, horseshoe_exact₃ A n,
  epi := show epi (projective.π _), from infer_instance }
.

lemma horseshoe_split (A : short_exact_sequence C) (n : ℕ) :
  ((horseshoe A).X n).split :=
begin
  cases n;
  exact ⟨biprod.fst, biprod.inr, biprod.inl_fst, biprod.inr_snd, biprod.inr_fst, biprod.total⟩
end

lemma horseshoe_f_comp_to_single₂_f (A : short_exact_sequence C) (i : ℕ) :
  ((horseshoe A).X i).f ≫ (horseshoe_to_single₂ A).f i =
  (horseshoe_to_single₁ A).f i ≫ ((chain_complex.single₀ C).map A.f).f i :=
begin
  cases i,
  { dsimp [horseshoe_to_single₂, horseshoe_to_single₁, horseshoe, horseshoe_obj, horseshoe_step,
      horseshoe_base, horseshoe_π, horseshoe_base_π, chain_complex.to_single₀_equiv],
    simp },
  { dsimp [horseshoe_to_single₂, horseshoe_to_single₁, horseshoe, horseshoe_obj, horseshoe_step,
      horseshoe_base, horseshoe_π, horseshoe_base_π, chain_complex.to_single₀_equiv],
    simp }
end

lemma horseshoe_g_comp_to_single₃_f (A : short_exact_sequence C) (i : ℕ) :
  ((horseshoe A).X i).g ≫ (horseshoe_to_single₃ A).f i =
  (horseshoe_to_single₂ A).f i ≫ ((chain_complex.single₀ C).map A.g).f i :=
begin
  cases i,
  { dsimp [horseshoe_to_single₂, horseshoe_to_single₃, chain_complex.to_single₀_equiv, horseshoe,
      horseshoe_obj, horseshoe_π, horseshoe_step, horseshoe_base, horseshoe_base_π],
    ext,
    { simp },
    { simp  } },
  { dsimp [horseshoe_to_single₂, horseshoe_to_single₃, horseshoe, horseshoe_obj, horseshoe_step,
      horseshoe_base, horseshoe_π, horseshoe_base_π, chain_complex.to_single₀_equiv],
    simp }
end

end short_exact_sequence


import category_theory.triangulated.rotate

namespace category_theory

namespace triangulated

open category_theory.triangulated.triangle_morphism

variables {C : Type*} [category C] [has_shift C ℤ] {T₁ T₂ : triangle C} (f : T₁ ⟶ T₂)

lemma triangle_morphism_is_iso [is_iso f.hom₁] [is_iso f.hom₂] [is_iso f.hom₃] :
  is_iso f :=
by { refine ⟨⟨⟨inv f.hom₁, inv f.hom₂, inv f.hom₃, _, _, _⟩, _, _⟩⟩; tidy }
.
instance [is_iso f] : is_iso f.hom₁ :=
by { refine ⟨⟨(inv f).hom₁, _, _⟩⟩; simpa only [← comp_hom₁, ← triangle_category_comp,
  is_iso.hom_inv_id, is_iso.inv_hom_id] }

instance [is_iso f] : is_iso f.hom₂ :=
by { refine ⟨⟨(inv f).hom₂, _, _⟩⟩; simpa only [← comp_hom₂, ← triangle_category_comp,
  is_iso.hom_inv_id, is_iso.inv_hom_id] }

instance [is_iso f] : is_iso f.hom₃ :=
by { refine ⟨⟨(inv f).hom₃, _, _⟩⟩; simpa only [← comp_hom₃, ← triangle_category_comp,
  is_iso.hom_inv_id, is_iso.inv_hom_id] }

@[simp] lemma inv_hom₁ [is_iso f] : (inv f).hom₁ = inv (f.hom₁) :=
by { ext, change (f ≫ inv f).hom₁ = _, rw is_iso.hom_inv_id, refl }

@[simp] lemma inv_hom₂ [is_iso f] : (inv f).hom₂ = inv (f.hom₂) :=
by { ext, change (f ≫ inv f).hom₂ = _, rw is_iso.hom_inv_id, refl }

@[simp] lemma inv_hom₃ [is_iso f] : (inv f).hom₃ = inv (f.hom₃) :=
by { ext, change (f ≫ inv f).hom₃ = _, rw is_iso.hom_inv_id, refl }

lemma triangle_morphism_is_iso_iff : is_iso f ↔
    is_iso f.hom₁ ∧ is_iso f.hom₂ ∧ is_iso f.hom₃ :=
begin
  split,
  { intro _, refine ⟨_, _, _⟩; exactI infer_instance },
  { rintro ⟨_, _, _⟩, exactI triangle_morphism_is_iso f }
end

@[simps]
def mk_triangle_iso (e₁ : T₁.obj₁ ≅ T₂.obj₁) (e₂ : T₁.obj₂ ≅ T₂.obj₂) (e₃ : T₁.obj₃ ≅ T₂.obj₃)
  (comm₁ : T₁.mor₁ ≫ e₂.hom = e₁.hom ≫ T₂.mor₁)
  (comm₂ : T₁.mor₂ ≫ e₃.hom = e₂.hom ≫ T₂.mor₂)
  (comm₃ : T₁.mor₃ ≫ e₁.hom⟦1⟧' = e₃.hom ≫ T₂.mor₃) : T₁ ≅ T₂ :=
⟨⟨_, _, _, comm₁, comm₂, comm₃⟩, ⟨e₁.inv, e₂.inv, e₃.inv,
  by { rw e₂.comp_inv_eq, simp [comm₁] }, by { rw e₃.comp_inv_eq, simp [comm₂] },
  by { rw [e₃.eq_inv_comp, ← category.assoc, ← comm₃], simp [← functor.map_comp] }⟩,
  by { ext; simp }, by { ext; simp }⟩

@[simps] noncomputable
def triangle.nonneg_inv_rotate (T : triangle C) : triangle C :=
triangle.mk _ (T.mor₃⟦(-1:ℤ)⟧' ≫ (shift_shift_neg _ _).hom) T.mor₁
  (T.mor₂ ≫ (shift_neg_shift _ _).inv)

@[simps]
def triangle.nonneg_rotate {C : Type*} [category C]
  [has_shift C ℤ] (T : triangle C) : triangle C := triangle.mk _ T.mor₂ T.mor₃ (T.mor₁⟦1⟧')

variables (C) [preadditive C]

@[simps]
def neg₃_functor : triangle C ⥤ triangle C :=
{ obj := λ T, triangle.mk C T.mor₁ T.mor₂ (-T.mor₃),
  map := λ S T f, { hom₁ := f.hom₁, hom₂ := f.hom₂, hom₃ := f.hom₃ } }

@[simps]
def neg₃_unit_iso : neg₃_functor C ⋙ neg₃_functor C ≅ 𝟭 _ :=
begin
  refine nat_iso.of_components
    (λ X, ⟨⟨𝟙 _, 𝟙 _, 𝟙 _, _, _, _⟩, ⟨𝟙 _, 𝟙 _, 𝟙 _, _, _, _⟩, _, _⟩) (λ X Y f, _),
  any_goals { ext },
  all_goals { dsimp,
    simp only [category.comp_id, category.id_comp, category_theory.functor.map_id, neg_neg] },
end

@[simps]
def neg₃_equiv : triangle C ≌ triangle C :=
{ functor := neg₃_functor C,
  inverse := neg₃_functor C,
  unit_iso := (neg₃_unit_iso C).symm,
  counit_iso := neg₃_unit_iso C }

--move this (do we want this?)
instance {C : Type*} [category C] [preadditive C] {X Y : C} : has_neg (X ≅ Y) :=
⟨λ e, ⟨-e.hom, -e.inv, by simp, by simp⟩⟩
.
@[simp] lemma neg_iso_hom {C : Type*} [category C] [preadditive C] {X Y : C} {e : X ≅ Y} :
  (-e).hom = -(e.hom) := rfl

@[simp] lemma neg_iso_inv {C : Type*} [category C] [preadditive C] {X Y : C} {e : X ≅ Y} :
  (-e).inv = -(e.inv) := rfl

--move this
@[simps]
def _root_.category_theory.equivalence.iso_equiv {C D : Type*} [category C] [category D]
  (e : C ≌ D) (X : C) (Y : D) : (e.functor.obj X ≅ Y) ≃ (X ≅ e.inverse.obj Y) :=
{ to_fun := λ f, e.unit_iso.app X ≪≫ e.inverse.map_iso f,
  inv_fun := λ f, e.functor.map_iso f ≪≫ e.counit_iso.app Y,
  left_inv := λ f, by { ext, dsimp, simp only [iso.inv_hom_id_app, category.assoc, functor.map_comp,
    e.fun_inv_map], rw reassoc_of e.functor_unit_iso_comp, dsimp, simp },
  right_inv := λ f, by { ext, dsimp, simp } }

variables {C} (T : triangle C)

noncomputable
def triangle.nonneg_inv_rotate_neg₃ [(shift_functor C (1 : ℤ)).additive] :
  (neg₃_functor C).obj T.nonneg_inv_rotate ≅ T.inv_rotate :=
begin
  fapply mk_triangle_iso,
  exact -iso.refl _,
  exact iso.refl _,
  exact iso.refl _,
  all_goals { dsimp, simp },
end

noncomputable
def triangle.nonneg_inv_rotate_iso [(shift_functor C (1 : ℤ)).additive] :
  T.nonneg_inv_rotate ≅ (neg₃_functor C).obj T.inv_rotate :=
(neg₃_equiv C).iso_equiv _ _ T.nonneg_inv_rotate_neg₃

@[simps]
def neg₃_rotate : neg₃_functor C ⋙ rotate C ≅ rotate C ⋙ neg₃_functor C :=
nat_iso.of_components
  (λ X, mk_triangle_iso (iso.refl _) (iso.refl _) (-iso.refl _)
    (by { dsimp, simp }) (by { dsimp, simp }) (by { dsimp, simp }))
  (λ X Y f, by { dsimp, ext; dsimp; simp })

lemma triangle.nonneg_rotate_neg₃ :
  (neg₃_functor C).obj T.nonneg_rotate = T.rotate := rfl

def triangle.nonneg_rotate_iso : T.nonneg_rotate ≅ (neg₃_functor C).obj T.rotate :=
(neg₃_equiv C).iso_equiv _ _ (iso.refl _)

--

@[simps]
def triangle.obj₁_functor : triangle C ⥤ C :=
{ obj := λ T, T.obj₁,
  map := λ S T f, f.hom₁,
  map_id' := λ _, rfl,
  map_comp' := λ A B C f g, rfl }

@[simps]
def triangle.obj₂_functor : triangle C ⥤ C :=
{ obj := λ T, T.obj₂,
  map := λ S T f, f.hom₂,
  map_id' := λ _, rfl,
  map_comp' := λ A B C f g, rfl }

@[simps]
def triangle.obj₃_functor : triangle C ⥤ C :=
{ obj := λ T, T.obj₃,
  map := λ S T f, f.hom₃,
  map_id' := λ _, rfl,
  map_comp' := λ A B C f g, rfl }

end triangulated

end category_theory


theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
  sorry


import category_theory.limits.preserves.limits
import category_theory.adjunction.evaluation
import algebra.group.ulift

import for_mathlib.ab4
import for_mathlib.AddCommGroup.exact
import for_mathlib.AddCommGroup.pt
import for_mathlib.AddCommGroup.ab4

import condensed.extr.equivalence

.

universe u

open category_theory
open category_theory.limits

instance : has_colimits (ExtrSheafProd.{u} Ab.{u+1}) :=
has_colimits_of_has_colimits_creates_colimits
(Condensed_ExtrSheafProd_equiv _).inverse

instance : has_limits (ExtrSheafProd.{u} Ab.{u+1}) :=
has_limits_of_has_limits_creates_limits
(Condensed_ExtrSheafProd_equiv _).inverse

instance : has_colimits_of_size.{u} Ab.{u+1} :=
has_colimits_of_size_shrink.{u u (u+1) (u+1)} Ab.{u+1}

open_locale classical

instance {C : Type (u+1)} [category.{u} C] : AB4 (C ⥤ Ab.{u+1}) :=
begin
  constructor,
  intros α X Y f hf,
  let t := _, change mono t,
  rw category_theory.nat_trans.mono_iff_app_mono,
  intros c,
  let eX : (∐ λ (a : α), X a).obj c ≅ (∐ λ (a : α), (X a).obj c) :=
    (is_colimit_of_preserves ((evaluation _ _).obj c)
      (colimit.is_colimit _)).cocone_point_unique_up_to_iso (colimit.is_colimit _)
    ≪≫ has_colimit.iso_of_nat_iso (discrete.nat_iso (λ _, iso.refl _)),
   let eY : (∐ λ (a : α), Y a).obj c ≅ (∐ λ (a : α), (Y a).obj c) :=
    (is_colimit_of_preserves ((evaluation _ _).obj c)
      (colimit.is_colimit _)).cocone_point_unique_up_to_iso (colimit.is_colimit _)
    ≪≫ has_colimit.iso_of_nat_iso (discrete.nat_iso (λ _, iso.refl _)),
  let tt : (∐ λ (a : α), (X a).obj c) ⟶ (∐ λ (a : α), (Y a).obj c) :=
    sigma.desc (λ a, (f a).app c ≫ sigma.ι _ a),
  haveI : mono tt,
  { dsimp [tt],
    apply AB4.cond, intros a, specialize hf a,
    rw category_theory.nat_trans.mono_iff_app_mono at hf,
    apply hf },
  suffices : t.app c = eX.hom ≫ tt ≫ eY.inv,
  { rw this, apply_instance },
  dsimp [eX, tt, t, eY],
  apply ((is_colimit_of_preserves ((evaluation _ _).obj c) (colimit.is_colimit _))).hom_ext,
  intros a,
  dsimp [is_colimit.cocone_point_unique_up_to_iso],
  simp only [category.assoc, ← nat_trans.comp_app, colimit.ι_desc],
  slice_rhs 0 1
  { erw ((is_colimit_of_preserves ((evaluation _ _).obj c) (colimit.is_colimit _))).fac },
  slice_rhs 0 1
  { erw colimit.ι_desc },
  dsimp,
  simp only [category.id_comp, colimit.ι_desc, cofan.mk_ι_app, category.assoc,
    has_colimit.iso_of_nat_iso_ι_inv, discrete.nat_iso_inv_app, functor.map_cocone_ι_app,
    colimit.cocone_ι, evaluation_obj_map],
  dsimp, simp, apply_instance
end

noncomputable
instance : creates_limits (ExtrSheafProd_to_presheaf.{u} Ab.{u+1}) :=
begin
  change creates_limits ((ExtrSheaf_ExtrSheafProd_equiv _).inverse ⋙
    Sheaf_to_presheaf _ _),
  apply_with category_theory.comp_creates_limits { instances := ff },
  apply_instance,
  exact @Sheaf.category_theory.Sheaf_to_presheaf.category_theory.creates_limits.{(u+2) u (u+1)}
    ExtrDisc.{u} _ ExtrDisc.proetale_topology Ab.{u+1} _ _,
end

instance : AB4 (ExtrSheafProd.{u} Ab.{u+1}) :=
AB4_of_preserves_colimits_of_reflects_limits_of_AB4
  (ExtrSheafProd_to_presheaf _)

-- TODO: Prove a lemma about transporting AB4 across an equivalence.
instance : AB4 (Condensed.{u} Ab.{u+1}) :=
AB4_of_preserves_colimits_of_reflects_limits_of_AB4
    (Condensed_ExtrSheafProd_equiv.{u} Ab.{u+1}).functor


import for_mathlib.derived.example
import breen_deligne.eval

noncomputable theory

open category_theory category_theory.preadditive

namespace breen_deligne
namespace package

variables (BD : package)
variables {𝒜 : Type*} [category 𝒜] [abelian 𝒜]
variables (F : 𝒜 ⥤ 𝒜)

def eval' : 𝒜 ⥤ cochain_complex 𝒜 ℤ :=
(data.eval_functor F).obj BD.data ⋙ homological_complex.embed complex_shape.embedding.nat_down_int_up

def eval : 𝒜 ⥤ bounded_homotopy_category 𝒜 :=
(data.eval_functor F).obj BD.data ⋙ chain_complex.to_bounded_homotopy_category

instance eval_additive : (BD.eval F).additive :=
functor.additive_of_map_fst_add_snd _ $ λ A,
begin
  refine homotopy_category.eq_of_homotopy _ _ _,
  rw [← functor.map_add],
  exact homological_complex.embed_homotopy _ _ (eval_functor_homotopy F BD A) _,
end

lemma eval_functor_obj_X (X : 𝒜) (n : ℕ) :
  (((data.eval_functor F).obj BD.data).obj X).X n = F.obj ((Pow (BD.data.X n)).obj X) := rfl

lemma eval_functor_obj_d (X : 𝒜) (m n : ℕ) :
  (((data.eval_functor F).obj BD.data).obj X).d m n =
    (universal_map.eval_Pow F (BD.data.d m n)).app X := rfl

lemma eval'_obj_X (X : 𝒜) (n : ℕ) :
  ((BD.eval' F).obj X).X (-n:ℤ) = F.obj ((Pow (BD.data.X n)).obj X) :=
by { cases n; apply eval_functor_obj_X }

lemma eval'_obj_X_0 (X : 𝒜) :
  ((BD.eval' F).obj X).X 0 = F.obj ((Pow (BD.data.X 0)).obj X) := rfl

lemma eval'_obj_X_succ (X : 𝒜) (n : ℕ) :
  ((BD.eval' F).obj X).X -[1+ n] = F.obj ((Pow (BD.data.X (n+1))).obj X) := rfl

lemma eval'_obj_d (X : 𝒜) (m n : ℕ) :
  ((BD.eval' F).obj X).d (-(m+1:ℕ):ℤ) (-(n+1:ℕ):ℤ) =
    (universal_map.eval_Pow F (BD.data.d (m+1) (n+1))).app X := rfl

lemma eval'_obj_d_0 (X : 𝒜) (n : ℕ) :
  ((BD.eval' F).obj X).d (-(n+1:ℕ):ℤ) (-(1:ℕ)+1:ℤ) =
    (universal_map.eval_Pow F (BD.data.d (n+1) 0)).app X := rfl

end package
end breen_deligne


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Option.Basic

universe u v

theorem Option.eq_of_eq_some {α : Type u} : ∀ {x y : Option α}, (∀z, x = some z ↔ y = some z) → x = y
  | none,   none,   h => rfl
  | none,   some z, h => Option.noConfusion ((h z).2 rfl)
  | some z, none,   h => Option.noConfusion ((h z).1 rfl)
  | some z, some w, h => Option.noConfusion ((h w).2 rfl) (congrArg some)

theorem Option.eq_none_of_isNone {α : Type u} : ∀ {o : Option α}, o.isNone → o = none
  | none, h => rfl


/-
File: signature_recover_public_key_compute_doubling_slope_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_verify_zero_soundness
import .signature_recover_public_key_unreduced_sqr_soundness
import .signature_recover_public_key_unreduced_mul_soundness
import .signature_recover_public_key_nondet_bigint3_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.compute_doubling_slope autogenerated soundness theorem -/

theorem auto_sound_compute_doubling_slope
    -- arguments
    (range_check_ptr : F) (point : EcPoint F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_compute_doubling_slope σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 176))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 164))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 144))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 128))
    -- 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 σ (λ κ τ,
      τ.ap = σ.ap + 85 ∧
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 9)) (mem $ τ.ap - 4)
        (spec_compute_doubling_slope mem κ range_check_ptr point (mem (τ.ap - 4)) (cast_BigInt3 mem (τ.ap - 3)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_compute_doubling_slope 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⟩,
  -- function call
  step_assert_eq hpc0 with arg0,
  step_sub hpc1 (auto_sound_nondet_bigint3 mem _ range_check_ptr _ _),
  { rw hpc2, norm_num2, exact h_mem_4 },
  { 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] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call3 ap3 h_call3,
  rcases h_call3 with ⟨h_call3_ap_offset, h_call3⟩,
  rcases h_call3 with ⟨rc_m3, rc_mle3, hl_range_check_ptr₁, h_call3⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap3 - 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 (ap3 - 3) = slope,
  simp only [hr_rev_slope] at h_call3,
  have htv_slope := hr_rev_slope.symm, clear hr_rev_slope,
  try { simp only [arg0] at hl_range_check_ptr₁ },
  rw [←htv_range_check_ptr₁, ←hin_range_check_ptr] at hl_range_check_ptr₁,
  try { simp only [arg0] at h_call3 },
  rw [hin_range_check_ptr] at h_call3,
  clear arg0,
  -- function call
  step_assert_eq hpc3 with arg0,
  step_assert_eq hpc4 with arg1,
  step_assert_eq hpc5 with arg2,
  step_sub hpc6 (auto_sound_unreduced_sqr mem _ point.x _ _),
  { rw hpc7, 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 { arith_simps }, try { simp only [arg0, arg1, arg2] },
      try { simp only [h_call3_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call8 ap8 h_call8,
  rcases h_call8 with ⟨h_call8_ap_offset, h_call8⟩,
  generalize' hr_rev_x_sqr: cast_UnreducedBigInt3 mem (ap8 - 3) = x_sqr,
  simp only [hr_rev_x_sqr] at h_call8,
  have htv_x_sqr := hr_rev_x_sqr.symm, clear hr_rev_x_sqr,
  clear arg0 arg1 arg2,
  -- function call
  step_assert_eq hpc8 with arg0,
  step_assert_eq hpc9 with arg1,
  step_assert_eq hpc10 with arg2,
  step_assert_eq hpc11 with arg3,
  step_assert_eq hpc12 with arg4,
  step_assert_eq hpc13 with arg5,
  step_sub hpc14 (auto_sound_unreduced_mul mem _ slope point.y _ _ _),
  { rw hpc15, 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_x_sqr] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { simp only [h_call3_ap_offset, h_call8_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_x_sqr] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5] },
      try { simp only [h_call3_ap_offset, h_call8_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call16 ap16 h_call16,
  rcases h_call16 with ⟨h_call16_ap_offset, h_call16⟩,
  generalize' hr_rev_slope_y: cast_UnreducedBigInt3 mem (ap16 - 3) = slope_y,
  simp only [hr_rev_slope_y] at h_call16,
  have htv_slope_y := hr_rev_slope_y.symm, clear hr_rev_slope_y,
  clear arg0 arg1 arg2 arg3 arg4 arg5,
  -- function call
  step_assert_eq hpc16 hpc17 with arg0,
  step_assert_eq hpc18 with arg1,
  step_assert_eq hpc19 hpc20 with arg2,
  step_assert_eq hpc21 with arg3,
  step_assert_eq hpc22 hpc23 with arg4,
  step_assert_eq hpc24 with arg5,
  step_assert_eq hpc25 hpc26 with arg6,
  step_assert_eq hpc27 with arg7,
  step_assert_eq hpc28 hpc29 with arg8,
  step_assert_eq hpc30 with arg9,
  step_assert_eq hpc31 hpc32 with arg10,
  step_assert_eq hpc33 with arg11,
  step_assert_eq hpc34 with arg12,
  step_assert_eq hpc35 with arg13,
  step_assert_eq hpc36 with arg14,
  step_assert_eq hpc37 with arg15,
  step_sub hpc38 (auto_sound_verify_zero mem _ range_check_ptr₁ {
    d0 := 3 * x_sqr.d0 - 2 * slope_y.d0,
    d1 := 3 * x_sqr.d1 - 2 * slope_y.d1,
    d2 := 3 * x_sqr.d2 - 2 * slope_y.d2
  } _ _ _),
  { rw hpc39, 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_x_sqr, htv_slope_y] },
    try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
    try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, (eq_sub_of_eq_add arg13), (eq_sub_of_eq_add arg14), (eq_sub_of_eq_add arg15)] },
    try { simp only [h_call3_ap_offset, h_call8_ap_offset, h_call16_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_x_sqr, htv_slope_y] },
      try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, (eq_sub_of_eq_add arg13), (eq_sub_of_eq_add arg14), (eq_sub_of_eq_add arg15)] },
      try { simp only [h_call3_ap_offset, h_call8_ap_offset, h_call16_ap_offset] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call40 ap40 h_call40,
  rcases h_call40 with ⟨h_call40_ap_offset, h_call40⟩,
  rcases h_call40 with ⟨rc_m40, rc_mle40, hl_range_check_ptr₂, h_call40⟩,
  generalize' hr_rev_range_check_ptr₂: mem (ap40 - 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 ,arg13 ,arg14 ,arg15] at hl_range_check_ptr₂ },
  try { rw [h_call16_ap_offset, h_call8_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 ,arg7 ,arg8 ,arg9 ,arg10 ,arg11 ,arg12 ,arg13 ,arg14 ,arg15] at h_call40 },
  try { rw [h_call16_ap_offset, h_call8_ap_offset] at h_call40 }, try { arith_simps at h_call40 },
  rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call40,
  clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15,
  -- return
  step_assert_eq hpc40 with hret0,
  step_assert_eq hpc41 with hret1,
  step_assert_eq hpc42 with hret2,
  step_ret hpc43,
  -- finish
  step_done, use_only [rfl, rfl],
  split,
  { try { simp only [h_call3_ap_offset ,h_call8_ap_offset ,h_call16_ap_offset ,h_call40_ap_offset] },
    try { arith_simps }, try { refl } },
  -- range check condition
  use_only (rc_m3+rc_m40+0+0), split,
  linarith [rc_mle3, rc_mle40],
  split,
  { arith_simps, try { simp only [hret0 ,hret1 ,hret2] },
    rw [←htv_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
  -- user-provided reduction
  suffices auto_spec: auto_spec_compute_doubling_slope mem _ range_check_ptr point _ _,
  { apply sound_compute_doubling_slope, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_compute_doubling_slope],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call3],
  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 spec3 := h_call3 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec3,
  try { dsimp at spec3, arith_simps at spec3 },
  use_only [spec3],
  use_only [κ_call8],
  use_only [x_sqr],
  try { dsimp at h_call8, arith_simps at h_call8 },
  try { use_only [h_call8] },
  use_only [κ_call16],
  use_only [slope_y],
  try { dsimp at h_call16, arith_simps at h_call16 },
  try { use_only [h_call16] },
  use_only [κ_call40],
  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 spec40 := h_call40 rc_h_range_check_ptr₁',
  rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec40,
  try { dsimp at spec40, arith_simps at spec40 },
  use_only [spec40],
  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_x_sqr, htv_slope_y, htv_range_check_ptr₂] }, },
  try { dsimp [cast_EcPoint, cast_BigInt3, cast_UnreducedBigInt3] },
  try { arith_simps }, try { simp only [hret0, hret1, hret2] },
  try { simp only [h_call3_ap_offset, h_call8_ap_offset, h_call16_ap_offset, h_call40_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end