import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ≠ y ∧ x ∈ {n : ℤ // n * α} :=
begin
  assume y h,
  have h1 : ∀ i j : ℤ, i ≠ j → {i * α} ≠ {j * α}, from by {
    assume i j h2,
    assume h3,
    have h4 : i * α - (i * α).floor = {i * α}, from by {
      rw ← h3,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw ← floor_eq_of_mem_Icc,
      rw
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) :
∀ y ∈ Icc 0 1, ∃ x ∈ set.range (λ n : ℤ, n • α % 1), abs (x - y) < 1 :=
begin
  assume y h1,
  have h2 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from
    assume i j h2,
    have h3 : i • α - (i • α % 1) = (i • α % 1), from by {rw ← sub_eq_add_neg, rw ← floor_add, rw floor_eq_self, rw add_comm, rw add_neg_self, rw zero_add,},
    have h4 : j • α - (j • α % 1) = (j • α % 1), from by {rw ← sub_eq_add_neg, rw ← floor_add, rw floor_eq_self, rw add_comm, rw add_neg_self, rw zero_add,},
    have h5 : i • α = j • α, from by {rw [h3,h4], rw sub_eq_zero, rw h2,},
    have h6 : α = (j - i)⁻¹ • (j • α - i • α), from by {rw [mul_sub,mul_sub,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm,mul_assoc,mul_comm
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ≠ y :=
begin
  assume y h,
  have h1 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
    have h2 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
      have h3 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
        have h4 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
          have h5 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
            have h6 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
              have h7 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                have h8 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                  have h9 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                    have h10 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                      have h11 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                        have h12 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                          have h13 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                            have h14 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                              have h15 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                have h16 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                  have h17 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                    have h18 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                      have h19 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                        have h20 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                          have h21 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                            have h22 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                              have h23 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                have h24 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                  have h25 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                    have h26 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                      have h27 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                        have h28 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                          have h29 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                            have h30 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                              have h31 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                have h32 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                  have h33 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                    have h34 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                      have h35 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                        have h36 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                          have h37 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                            have h38 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                              have h39 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h40 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h41 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h42 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h43 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h44 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h45 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h46 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h47 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h48 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h49 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h50 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h51 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h52 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h53 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h54 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h55 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h56 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h57 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h58 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h59 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h60 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h61 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h62 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h63 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h64 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h65 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h66 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h67 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h68 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h69 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h70 : ∃ x ∈ Icc 0 1, x ≠ y, from by {
                                                                                have h71 : ∃ x ∈ I
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by
  {
    intro x0,
    have h6 : |x0 - l| < ε ↔ ((x0 - l) < ε) ∧ ((l - x0) < ε),
    from abs_sub_lt_iff, rw h6,
    split,
    rintro ⟨ S_1, S_2 ⟩,
    split; linarith,
    rintro ⟨ S_3, S_4 ⟩,
    split; linarith,
    },

  --Let $\epsilon > 0$.
  assume (h7 : ε > 0),

  --As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that $\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$
  cases h2 ε h7 with N1 h8,

  --As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that $\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$
  cases h3 ε h7 with N2 h9,

  --Let $N = \max \set {N_1, N_2}$.
  let N := max N1 N2,
  use N,

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by {
    assume n h,
    split,
    exact lt_of_le_of_lt (le_max_left N1 N2) h,
    exact lt_of_le_of_lt (le_max_right N1 N2) h,
  },

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\forall n \in \N: y_n \le x_n \le z_n$
  --So $\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by {
    intros n h12,
    split,
    {

      have h13 := (h8 n (h10 n h12).left), rw h5 (y n) at h13,
      split,
      exact h13.left,
      exact (h4 n).left,
    },
    {
      have h14 := (h9 n (h10 n h12).right),rw h5 (z n) at h14,
      split,
      exact (h4 n).right,
      exact h14.right,
    },

  },

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by {
    intros n1 h16, cases (h11 n1 h16);
    split; linarith,
  },

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by {
    intros n h17,
    cases h5 (x n) with h18 h19,
    apply h19, exact h15 n h17,
  },
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import category_theory.sites.sheafification

namespace category_theory

open category_theory

universes v u
variables {C : Type u} [category.{v} C] (J : grothendieck_topology C)

noncomputable theory

@[simps]
def presheaf_to_SheafOfTypes : (Cᵒᵖ ⥤ Type (max v u)) ⥤ SheafOfTypes J :=
{ obj := λ P,
  { val := J.sheafify P,
    cond := begin
      rw ← is_sheaf_iff_is_sheaf_of_type,
      exact grothendieck_topology.plus.is_sheaf_plus_plus J P,
    end },
  map := λ P Q η, ⟨J.sheafify_map η⟩,
  map_id' := λ P, SheafOfTypes.hom.ext _ _ $ J.sheafify_map_id _,
  map_comp' := λ P Q R η γ, SheafOfTypes.hom.ext _ _ $ J.sheafify_map_comp _ _ }

-- Sanity check
def presheaf_to_SheafOfTypes_iso : presheaf_to_SheafOfTypes J ≅
  presheaf_to_Sheaf J _ ⋙ (Sheaf_equiv_SheafOfTypes J).functor := eq_to_iso rfl

-- The adjunction for sheaves of types
def sheafification_adjunction_types :
  (presheaf_to_SheafOfTypes J) ⊣ SheafOfTypes_to_presheaf J :=
show presheaf_to_Sheaf J _ ⋙ (Sheaf_equiv_SheafOfTypes J).functor ⊣
  (Sheaf_equiv_SheafOfTypes J).inverse ⋙ Sheaf_to_presheaf J _,
from adjunction.comp _ _ (sheafification_adjunction _ _) $
  (Sheaf_equiv_SheafOfTypes J).to_adjunction

@[simp]
lemma sheafification_adjunction_types_hom_equiv_apply (X : Cᵒᵖ ⥤ Type (max v u))
  (Y : SheafOfTypes J) (e : (presheaf_to_SheafOfTypes _).obj X ⟶ Y) :
  (sheafification_adjunction_types J).hom_equiv _ _ e =
  J.to_sheafify _ ≫ e.val := rfl

@[simp]
lemma sheafification_adjunction_types_hom_equiv_symm_apply (X : Cᵒᵖ ⥤ Type (max v u))
  (Y : SheafOfTypes J) (e : X ⟶ (SheafOfTypes_to_presheaf _).obj Y) :
  (((sheafification_adjunction_types J).hom_equiv _ _).symm e).val =
  J.sheafify_lift e (by { rw is_sheaf_iff_is_sheaf_of_type, exact Y.2 }) := rfl

@[simp]
lemma sheafification_adjunction_types_unit_app (X : Cᵒᵖ ⥤ Type (max v u)) :
  (sheafification_adjunction_types J).unit.app X = J.to_sheafify X := rfl

@[simp]
lemma sheafification_adjunction_types_counit_app (Y : SheafOfTypes J) :
  ((sheafification_adjunction_types J).counit.app Y).val =
  J.sheafify_lift (𝟙 _) (by { rw is_sheaf_iff_is_sheaf_of_type, exact Y.2 }) := rfl

instance is_iso_sheafification_types_adjunction_counit_app (X : SheafOfTypes J) :
  is_iso ((sheafification_adjunction_types J).counit.app X) :=
begin
  apply is_iso_of_reflects_iso _ (Sheaf_equiv_SheafOfTypes J).inverse,
  change is_iso ((sheafification_adjunction J (Type (max v u))).counit.app
    ((Sheaf_equiv_SheafOfTypes J).inverse.obj X)),
  apply_instance
end

instance sheafification_types_reflective : is_iso (sheafification_adjunction_types J).counit :=
nat_iso.is_iso_of_is_iso_app _

end category_theory


import data.cpi.concretion data.cpi.transition.label

namespace cpi

variables {ℍ : Type} {ω : context}

/-- The right hand side of a transition, determined by a specific kind. -/
@[derive decidable_eq, nolint has_inhabited_instance]
inductive production (ℍ : Type) (ω : context) (Γ : context) : kind → Type
| species (A : species ℍ ω Γ) : production kind.species
| concretion {b y} (F : concretion ℍ ω Γ b y) : production kind.concretion

instance production.has_repr [has_repr ℍ] {Γ k} : has_repr (production ℍ ω Γ k) :=
  ⟨ λ x, by from production.rec_on x repr (λ _ _ x, repr x), ⟩

/-- Rename a production. This just wraps renaming for species and concretions. -/
def production.rename
  {Γ Δ} (ρ : name Γ → name Δ)
  : ∀ {k}, production ℍ ω Γ k → production ℍ ω Δ k
| ._ (production.species A) := production.species (species.rename ρ A)
| ._ (production.concretion A) := production.concretion (concretion.rename ρ A)

lemma production.rename_compose {Γ Δ η} (ρ : name Γ → name Δ) (σ : name Δ → name η)
  : ∀ {k} (E : production ℍ ω Γ k)
  , production.rename σ (production.rename ρ E)
  = production.rename (σ ∘ ρ) E
| ._ (production.species A) := congr_arg _ (species.rename_compose ρ σ A)
| ._ (production.concretion F) := congr_arg _ (concretion.rename_compose ρ σ F)

lemma production.rename_id
  {Γ} : ∀ {k} (E : production ℍ ω Γ k), production.rename id E = E
| ._ (production.species A) := congr_arg _ (species.rename_id A)
| ._ (production.concretion F) := congr_arg _ (concretion.rename_id F)

/-- Equivalence of productions. This just wraps equivalence of species and
    concretions. -/
inductive production.equiv [∀ Γ, setoid (species ℍ ω Γ)] [∀ Γ b y, setoid (concretion ℍ ω Γ b y)] {Γ} :
  ∀ {k : kind}, production ℍ ω Γ k → production ℍ ω Γ k → Prop
| species {A B : species ℍ ω Γ}
  : A ≈ B → production.equiv (production.species A) (production.species B)
| concretion {b y} {F G : concretion ℍ ω Γ b y}
  : F ≈ G → production.equiv (production.concretion F) (production.concretion G)

namespace production
  variables [∀ Γ, setoid (cpi.species ℍ ω Γ)] [∀ Γ b y, setoid (cpi.concretion ℍ ω Γ b y)]

  lemma equiv.refl {Γ} : ∀ {k : kind} (E : production ℍ ω Γ k), equiv E E
  | ._ (species A) := equiv.species (refl A)
  | ._ (concretion F) := equiv.concretion (refl F)

  lemma equiv.symm {Γ} : ∀ {k : kind} (E F : production ℍ ω Γ k), equiv E F → equiv F E
  | ._ ._ ._ (equiv.species eq) := equiv.species (symm eq)
  | ._ ._ ._ (equiv.concretion eq) := equiv.concretion (symm eq)

  lemma equiv.trans {Γ} : ∀ {k : kind} (E F G : production ℍ ω Γ k), equiv E F → equiv F G → equiv E G
  | ._ ._ ._ ._ (equiv.species ef) (equiv.species fg) := equiv.species (trans ef fg)
  | ._ ._ ._ ._ (equiv.concretion ef) (equiv.concretion fg) := equiv.concretion (trans ef fg)

  instance {Γ} {k} : is_equiv (production ℍ ω Γ k) equiv :=
    { refl := equiv.refl, symm := equiv.symm, trans := equiv.trans }
  instance {Γ} {k} : is_refl (production ℍ ω Γ k) equiv := ⟨ equiv.refl ⟩
  instance {Γ} {k} : setoid (production ℍ ω Γ k) :=
    ⟨ equiv, ⟨ equiv.refl, equiv.symm, equiv.trans ⟩ ⟩
  instance setoid.is_equiv {Γ} {k} : is_equiv (production ℍ ω Γ k) has_equiv.equiv :=
    production.is_equiv
end production

section equivalence
variables [∀ Γ, setoid (cpi.species ℍ ω Γ)] [∀ Γ b y, setoid (cpi.concretion ℍ ω Γ b y)]

lemma production.equiv.unwrap_s :
  ∀ {Γ} {A B : species ℍ ω Γ}, production.species A ≈ production.species B → A ≈ B
| Γ A B (production.equiv.species eq) := eq

lemma production.equiv.arity :
  ∀ {Γ} {a b x y} {F : concretion ℍ ω Γ a x} {G : concretion ℍ ω Γ b y}
  , production.concretion F ≈ production.concretion G
  → a = b ∧ x = y
| Γ a b x y F G (production.equiv.concretion eq) := ⟨ rfl, rfl ⟩

lemma production.equiv.unwrap_c :
  ∀ {Γ} {b y} {F : concretion ℍ ω Γ b y} {G : concretion ℍ ω Γ b y}
  , production.concretion F ≈ production.concretion G
  → F ≈ G
| Γ b y F G (production.equiv.concretion eq) := eq

end equivalence

end cpi

#lint-


import category_theory.abelian.diagram_lemmas.four
import for_mathlib.projectives
import for_mathlib.homological_complex
import for_mathlib.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


def bad_theorem : Prop :=
  ∀ (α : Type) (r : α → α → Prop), symmetric r → transitive r → reflexive r

def fail (a b : unit): Prop := false
theorem fail_symm : symmetric fail := λ x y h, h
theorem fail_trans : transitive fail := λ x y z h1 _, false.rec (fail x z) h1
-- theorem not_refl_fail : ¬ reflexive fail := λ a, a ()

theorem correct_version : ¬ bad_theorem := λ a, a unit fail fail_symm fail_trans ()


import for_mathlib.algebra.homology.trunc_le

noncomputable theory

open category_theory category_theory.limits category_theory.category
open_locale zero_object

lemma int.three_cases (a n : ℤ) :
  (n<a ∨ a<n) ∨ n = a :=
begin
  by_cases h₁ : n < a,
  { exact or.inl (or.inl h₁), },
  { cases (not_lt.1 h₁).lt_or_eq; tauto, },
end

lemma category_theory.nat_iso.map_eq_iff {C D : Type*} [category C] [category D] {F G : C ⥤ D}
  (e : F ≅ G) {X Y : C} (f₁ f₂ : X ⟶ Y) : F.map f₁ = F.map f₂ ↔ G.map f₁ = G.map f₂ :=
begin
  suffices : ∀ ⦃F G : C ⥤ D⦄ (e : F ≅ G) ⦃X Y : C⦄ (f₁ f₂ : X ⟶ Y)
    (h : F.map f₁ = F.map f₂), G.map f₁ = G.map f₂,
  { exact ⟨this e f₁ f₂, this e.symm f₁ f₂⟩, },
  intros F G e X Y f₁ f₂ eq,
  have : ∀ (f : X ⟶ Y), G.map f = e.inv.app X ≫ F.map f ≫ e.hom.app Y := λ f, by tidy,
  simp only [this, eq],
end

open category_theory category_theory.limits category_theory.category

variables {C : Type*} [category C] [abelian C]

namespace homological_complex

lemma single_obj_X_self_naturality {ι : Type*} (c : complex_shape ι) (n : ι)
  [decidable_eq ι] {A B : C} (φ : A ⟶ B) :
    ((single C c n).map φ).f n ≫ (single_obj_X_self C c n B).hom =
      (single_obj_X_self C c n A).hom ≫ φ :=
begin
  dsimp [single],
  simpa only [dif_pos rfl, assoc, eq_to_hom_trans, eq_to_hom_refl, comp_id],
end

variable (C)

def single_homology_functor_iso {ι : Type*} (c : complex_shape ι) (n : ι)
  [decidable_eq ι] :
  homological_complex.single C c n ⋙ homology_functor C c n ≅ 𝟭 C :=
nat_iso.of_components
  (λ A, homology_single_self C c A n)
  (λ A B φ, begin
    let h₁ := short_complex.homology_data.of_zeros (((single C c n).obj A).sc' n) rfl rfl,
    let h₂ := short_complex.homology_data.of_zeros (((single C c n).obj B).sc' n) rfl rfl,
    let h : short_complex.homology_map_data ((short_complex_functor _ _ n).map
      ((single C c n).map φ)) h₁ h₂ := short_complex.homology_map_data.of_zeros _ rfl rfl rfl rfl,
    have eq := short_complex.homology_map_data.homology_map_comm h,
    dsimp only [homology_single_self, iso.trans],
    simp only [assoc],
    erw [← single_obj_X_self_naturality c n φ, reassoc_of eq],
    refl,
  end)

end homological_complex

variable {C}

namespace cochain_complex

instance is_strictly_le_trunc_ge (K : cochain_complex C ℤ) (p q : ℤ) [K.is_strictly_le q] :
  (K.trunc_ge p).is_strictly_le q :=
⟨λ i hi, begin
  rw [is_zero.iff_id_eq_zero, ← cancel_epi (trunc_ge.π_f K p i)],
  apply (is_strictly_le.is_zero K q i hi).eq_of_src,
end⟩

instance is_strictly_ge_trunc_le (K : cochain_complex C ℤ) (p q : ℤ) [K.is_strictly_ge p] :
  (K.trunc_le q).is_strictly_ge p :=
⟨λ i hi, begin
  rw [is_zero.iff_id_eq_zero, ← cancel_mono (trunc_le.ι_f K q i)],
  apply (is_strictly_ge.is_zero K p i hi).eq_of_tgt,
end⟩

lemma is_le_iff_of_is_le_next (K : cochain_complex C ℤ) {a b : ℤ} (h : a+1=b)
  [K.is_le b] : K.is_le a ↔ is_zero (K.homology b) :=
begin
  split,
  { introI,
    exact is_le.is_zero K a b (by linarith), },
  { refine λ hb, ⟨λ n hn, _⟩,
    unfreezingI { subst h, },
    rw ← int.add_one_le_iff at hn,
    cases hn.lt_or_eq,
    { exact is_le.is_zero K (a+1) n h, },
    { subst h,
      exact hb, }, },
end

lemma is_ge_iff_of_is_ge_prev (K : cochain_complex C ℤ) {a b : ℤ} (h : a+1=b)
  [K.is_ge a] : K.is_ge b ↔ is_zero (K.homology a) :=
begin
  split,
  { introI,
    exact is_ge.is_zero K b a (by linarith), },
  { refine λ ha, ⟨λ n hn, _⟩,
    subst h,
    rw [← int.add_one_le_iff, add_le_add_iff_right] at hn,
    cases hn.lt_or_eq,
    { exact is_ge.is_zero K a n h, },
    { unfreezingI { subst h, },
      exact ha, }, },
end

lemma shift_is_strict_le (K : cochain_complex C ℤ) (a b c : ℤ) (h : a = c + b)
  [K.is_strictly_le a] : (K⟦b⟧).is_strictly_le c :=
⟨λ n hn, begin
  change is_zero (K.X (n+b)),
  exact is_strictly_le.is_zero K a (n+b) (by linarith),
end⟩

lemma shift_is_strict_ge (K : cochain_complex C ℤ) (a b c : ℤ) (h : a = c + b)
  [K.is_strictly_ge a] : (K⟦b⟧).is_strictly_ge c :=
⟨λ n hn, begin
  change is_zero (K.X (n+b)),
  exact is_strictly_ge.is_zero K a (n+b) (by linarith),
end⟩

end cochain_complex

namespace derived_category

lemma orthogonality {K L : derived_category C} (φ : K ⟶ L) (p q : ℤ) (hpq : p < q)
  [K.is_le p] [L.is_ge q] : φ = 0 :=
begin
  obtain ⟨K', hK', ⟨eK⟩⟩ := exists_iso_Q_obj_of_le K p,
  obtain ⟨L', hL', ⟨eL⟩⟩ := exists_iso_Q_obj_of_ge L q,
  haveI := hK',
  have hφ : ∃ (φ' : Q.obj K' ⟶ Q.obj L'), φ = eK.hom ≫ φ' ≫ eL.inv :=
    ⟨eK.inv ≫ φ ≫ eL.hom, by simp only [assoc, iso.hom_inv_id, comp_id, iso.hom_inv_id_assoc]⟩,
  obtain ⟨φ, rfl⟩ := hφ,
  obtain ⟨M, hM, s, f, hs, eq⟩ := right_factorisation_of_is_le φ p,
  haveI := hM,
  have hf : f = 0,
  { ext n,
    by_cases p < n,
    { apply (cochain_complex.is_strictly_le.is_zero M p n h).eq_of_src, },
    { apply (cochain_complex.is_strictly_ge.is_zero L' q n (by linarith)).eq_of_tgt, }, },
  simp only [eq, preadditive.is_iso.comp_left_eq_zero, preadditive.is_iso.comp_right_eq_zero, hf,
    functor.map_zero],
end

lemma right_factorisation_of_is_strictly_le_of_is_strictly_ge {K L : cochain_complex C ℤ}
  (φ : Q.obj K ⟶ Q.obj L) (p q : ℤ) [K.is_strictly_le p]
  [K.is_strictly_ge q] [L.is_strictly_ge q] :
  ∃ (K' : cochain_complex C ℤ) (K'_le : K'.is_strictly_le p)
    (K'_ge : K'.is_strictly_ge q) (s : K' ⟶ K) (f : K' ⟶ L) (hs : quasi_iso s),
    φ = (by { haveI := hs, exact inv (Q.map s), }) ≫ Q.map f :=
begin
  obtain ⟨K', hK', s, f, hs, eq⟩ := right_factorisation_of_is_strictly_ge φ q,
  haveI := hK',
  haveI : K'.is_le p,
  { rw cochain_complex.is_le_iff_of_quasi_iso s,
    apply_instance, },
  exact ⟨(cochain_complex.trunc_le K' p), infer_instance, infer_instance,
    cochain_complex.trunc_le.ι K' p ≫ s, cochain_complex.trunc_le.ι K' p ≫ f, infer_instance,
    by simp only [eq, functor.map_comp, assoc, is_iso.eq_inv_comp, is_iso.hom_inv_id_assoc]⟩,
end

lemma left_factorisation_of_is_strictly_le_of_is_strictly_ge {K L : cochain_complex C ℤ}
  (φ : Q.obj K ⟶ Q.obj L) (p q : ℤ) [K.is_strictly_le p] [L.is_strictly_le p]
  [L.is_strictly_ge q] :
  ∃ (L' : cochain_complex C ℤ) (L'_le : L'.is_strictly_le p)
    (L'_ge : L'.is_strictly_ge q) (f : K ⟶ L') (s : L ⟶ L') (hs : quasi_iso s),
    φ = Q.map f ≫ (by { haveI := hs, exact inv (Q.map s), }) :=
begin
  obtain ⟨L', hL', f, s, hs, eq⟩ := left_factorisation_of_is_strictly_le φ p,
  haveI := hL',
  haveI : L'.is_ge q,
  { rw ← cochain_complex.is_ge_iff_of_quasi_iso s,
    apply_instance, },
  exact ⟨(cochain_complex.trunc_ge L' q), infer_instance, infer_instance,
    f ≫ cochain_complex.trunc_ge.π L' q, s ≫ cochain_complex.trunc_ge.π L' q, infer_instance,
    by simp only [eq, functor.map_comp, is_iso.inv_comp, assoc, is_iso.hom_inv_id_assoc]⟩,
end

lemma shift_is_le (K : derived_category C) (a b c : ℤ) (h : a = c + b)
  [K.is_le a] : (K⟦b⟧).is_le c :=
⟨λ n hn, is_zero.of_iso (is_le.is_zero _ a _ (by linarith))
  ((derived_category.shift_homology_functor_iso C b n _ rfl).app K)⟩

lemma shift_is_ge (K : derived_category C) (a b c : ℤ) (h : a = c + b)
  [K.is_ge a] : (K⟦b⟧).is_ge c :=
⟨λ n hn, is_zero.of_iso (is_ge.is_zero _ a _ (by linarith))
  ((derived_category.shift_homology_functor_iso C b n _ rfl).app K)⟩

end derived_category

namespace cochain_complex

instance single_is_strictly_le (A : C) (n : ℤ) :
  is_strictly_le ((homological_complex.single C (complex_shape.up ℤ) n).obj A) n :=
⟨λ i hi, begin
  dsimp,
  rw if_neg (show ¬ i = n, by linarith),
  exact is_zero_zero C,
end⟩

instance single_is_strictly_ge (A : C) (n : ℤ) :
  is_strictly_ge ((homological_complex.single C (complex_shape.up ℤ) n).obj A) n :=
⟨λ i hi, begin
  dsimp,
  rw if_neg (show ¬ i = n, by linarith),
  exact is_zero_zero C,
end⟩

lemma from_single_ext {K L : cochain_complex C ℤ} (f₁ f₂ : K ⟶ L) (p : ℤ)
  [K.is_strictly_le p] [K.is_strictly_ge p] (h : f₁.f p = f₂.f p) : f₁ = f₂ :=
begin
  ext i,
  by_cases hi : i < p,
  { apply (is_strictly_ge.is_zero K p i hi).eq_of_src, },
  { cases (not_lt.1 hi).lt_or_eq with hi' hi',
    { apply (is_strictly_le.is_zero K p i hi').eq_of_src, },
    { subst hi',
      exact h, }, },
end

lemma to_single_ext {K L : cochain_complex C ℤ} (f₁ f₂ : K ⟶ L) (p : ℤ)
  [L.is_strictly_le p] [L.is_strictly_ge p] (h : f₁.f p = f₂.f p) : f₁ = f₂ :=
begin
  ext i,
  by_cases hi : i < p,
  { apply (is_strictly_ge.is_zero L p i hi).eq_of_tgt, },
  { cases (not_lt.1 hi).lt_or_eq with hi' hi',
    { apply (is_strictly_le.is_zero L p i hi').eq_of_tgt, },
    { subst hi',
      exact h, }, },
end

def desc_single (K L : cochain_complex C ℤ) {p : ℤ} (f : K.X p ⟶ L.X p) (q : ℤ)
  [K.is_strictly_le p] [K.is_strictly_ge p]
  (hpq : p+1=q) (hf : f ≫ L.d p q = 0) : K ⟶ L :=
{ f := λ i, begin
    by_cases i = p,
    { unfreezingI { subst h, }, exact f, },
    { exact 0, },
  end,
  comm' := λ i j (hij : i+1 = j), begin
    by_cases i = p,
    { have hj : j = q := by linarith,
      unfreezingI { substs h hj, },
      dsimp,
      simp only [if_pos rfl, hf,
        (is_strictly_le.is_zero K i j (by linarith)).eq_of_tgt (K.d i j) 0, zero_comp], },
    { apply is_zero.eq_of_src,
      by_cases hi : i < p,
      { exact is_strictly_ge.is_zero K p i hi, },
      { apply is_strictly_le.is_zero K p i,
        cases (not_lt.1 hi).lt_or_eq with hi' hi',
        { exact hi', },
        { exfalso, exact h hi'.symm, }, }, },
  end, }

@[simp]
lemma desc_single_f (K L : cochain_complex C ℤ) {p : ℤ} (f : K.X p ⟶ L.X p) (q : ℤ)
  [K.is_strictly_le p] [K.is_strictly_ge p]
  (hpq : p+1=q) (hf : f ≫ L.d p q = 0) :
  (desc_single K L f q hpq hf).f p = f :=
begin
  dsimp [desc_single],
  rw if_pos rfl,
end

def lift_single (K L : cochain_complex C ℤ) {q : ℤ} (f : K.X q ⟶ L.X q) (p : ℤ)
  [L.is_strictly_le q] [L.is_strictly_ge q]
  (hpq : p+1=q) (hf : K.d p q ≫ f = 0) : K ⟶ L :=
{ f := λ i, begin
    by_cases i = q,
    { unfreezingI { subst h, }, exact f, },
    { exact 0, },
  end,
  comm' := λ i j (hij : i+1 = j), begin
    by_cases j = q,
    { have hi : i = p := by linarith,
      unfreezingI { substs h hi, },
      dsimp,
      simp only [if_pos rfl, hf,
        (is_strictly_ge.is_zero L j i (by linarith)).eq_of_src (L.d i j) 0, comp_zero], },
    { apply is_zero.eq_of_tgt,
      by_cases hj : j < q,
      { exact is_strictly_ge.is_zero L q j hj, },
      { apply is_strictly_le.is_zero L q j,
        cases (not_lt.1 hj).lt_or_eq with hj' hj',
        { exact hj', },
        { exfalso, exact h hj'.symm, }, }, },
  end, }

@[simp]
lemma lift_single_f (K L : cochain_complex C ℤ) {q : ℤ} (f : K.X q ⟶ L.X q) (p : ℤ)
  [L.is_strictly_le q] [L.is_strictly_ge q]
  (hpq : p+1=q) (hf : K.d p q ≫ f = 0) :
  (lift_single K L f p hpq hf).f q = f :=
by { dsimp [lift_single], rw if_pos rfl, }

def iso_single (K : cochain_complex C ℤ) (n : ℤ)
  [K.is_strictly_le n] [K.is_strictly_ge n] :
  K ≅ (homological_complex.single C _ n).obj (K.X n) :=
{ hom := desc_single K _ (homological_complex.single_obj_X_self C _ n (K.X n)).inv (n+1) rfl (by simp),
  inv := lift_single _ K (homological_complex.single_obj_X_self C _ n (K.X n)).hom (n-1) (by linarith) (by simp),
  hom_inv_id' := from_single_ext _ _ n
    (by simp only [homological_complex.id_f, homological_complex.comp_f,
      desc_single_f, lift_single_f, iso.inv_hom_id]),
  inv_hom_id' := from_single_ext _ _ n
    (by simp only [homological_complex.id_f, homological_complex.comp_f,
      desc_single_f, lift_single_f, iso.hom_inv_id]), }

lemma quasi_iso_single_map_iff_is_iso {A B : C} (φ : A ⟶ B) (n : ℤ) :
  quasi_iso ((homological_complex.single C (complex_shape.up ℤ) n).map φ) ↔ is_iso φ :=
begin
  split,
  { introI,
    exact (is_iso_map_iff_of_nat_iso (homological_complex.single_homology_functor_iso C
      (complex_shape.up ℤ) n) φ).1 (quasi_iso.is_iso _), },
  { introI,
    apply_instance, },
end

lemma is_iso_iff_quasi_iso_of_single {K L : cochain_complex C ℤ} (φ : K ⟶ L) (n : ℤ)
  [K.is_strictly_le n] [K.is_strictly_ge n] [L.is_strictly_le n] [L.is_strictly_ge n] :
  is_iso φ ↔ quasi_iso φ :=
begin
  split,
  { introI,
    apply_instance, },
  { introI,
    let e₁ := K.iso_single n,
    let e₂ := L.iso_single n,
    let φ' := e₁.inv ≫ φ ≫ e₂.hom,
    obtain ⟨α, hα⟩ := (homological_complex.single C _ n).map_surjective φ',
    haveI : is_iso φ',
    { have hφ' : quasi_iso φ' := infer_instance,
      rw [← hα, quasi_iso_single_map_iff_is_iso] at hφ',
      haveI := hφ',
      rw ← hα,
      apply_instance, },
    rw [show φ = e₁.hom ≫ φ' ≫ e₂.inv, by simp],
    apply_instance, },
end

lemma quasi_iso_iff_of_is_le_of_is_ge {K L : cochain_complex C ℤ} (φ : K ⟶ L) (n : ℤ)
  [K.is_le n] [K.is_ge n] [L.is_le n] [L.is_ge n] :
  quasi_iso φ ↔ is_iso (homology_map φ n) :=
begin
  split,
  { introI,
    apply_instance, },
  { introI,
    refine ⟨λ i, _⟩,
    rcases int.three_cases n i with ⟨ _ | _ ⟩ | _,
    { exact ⟨⟨0, (is_ge.is_zero K n i h).eq_of_src _ _, (is_ge.is_zero L n i h).eq_of_src _ _⟩⟩, },
    { exact ⟨⟨0, (is_le.is_zero K n i h).eq_of_src _ _, (is_le.is_zero L n i h).eq_of_src _ _⟩⟩, },
    { unfreezingI { subst h, },
      apply_instance, }, },
end

end cochain_complex

namespace derived_category

variable (C)

@[simps obj map]
def single_functor (n : ℤ) : C ⥤ derived_category C :=
homological_complex.single _ _ n ⋙ Q

instance single_functor_obj_is_le (A : C) (n : ℤ) : ((single_functor C n).obj A).is_le n :=
by { dsimp, apply_instance, }

instance single_functor_obj_is_ge (A : C) (n : ℤ) : ((single_functor C n).obj A).is_ge n :=
by { dsimp, apply_instance, }

instance single_functor_additive (n : ℤ) : (single_functor C n).additive :=
by { dsimp [single_functor], apply_instance, }

def single_functor_homology_iso (n : ℤ) :
  single_functor C n ⋙ homology_functor C n ≅ 𝟭 C :=
functor.associator _ _ _ ≪≫ iso_whisker_left _ (homology_functor_factors C n) ≪≫
  homological_complex.single_homology_functor_iso C _ n

variable {C}

instance faithful_single_functor (n : ℤ) : faithful (single_functor C n) :=
⟨λ A B f₁ f₂ eq, (nat_iso.map_eq_iff (single_functor_homology_iso C n) f₁ f₂).1
  (by simp only [functor.comp_map, eq])⟩

instance full_single_functor (n : ℤ) : full (single_functor C n) :=
functor.full_of_exists _ (λ A B φ, begin
  obtain ⟨K', K'_le, K'_ge, s, f, hs, eq⟩ :=
    right_factorisation_of_is_strictly_le_of_is_strictly_ge φ n n,
  haveI := hs,
  haveI : is_iso s,
  { rw cochain_complex.is_iso_iff_quasi_iso_of_single s n,
    apply_instance, },
  haveI : full (homological_complex.single C (complex_shape.up ℤ) n) := infer_instance,
  exact ⟨(homological_complex.single C _ n).preimage (inv s ≫ f),
    by simp only [eq, single_functor_map, functor.image_preimage,
      functor.map_comp, functor.map_inv]⟩,
end)

end derived_category

namespace cochain_complex

variables {D : Type*} [category D] [abelian D] [has_zero_object D]

def single_shift_iso_app (A : D) (a b c : ℤ) (h : a = c + b) :
  ((homological_complex.single D (complex_shape.up ℤ) a).obj A)⟦b⟧ ≅
    ((homological_complex.single D (complex_shape.up ℤ) c).obj A) :=
{ hom := lift_single _ _ (((shift_functor_obj_X_iso _) _ _ _ h).hom ≫
      (homological_complex.single_obj_X_self D (complex_shape.up ℤ) a A).hom ≫
      (homological_complex.single_obj_X_self D (complex_shape.up ℤ) c A).inv)
      (c-1) (sub_add_cancel c 1) (by simp),
  inv := desc_single _ _ ((homological_complex.single_obj_X_self D (complex_shape.up ℤ) c A).hom ≫
    (homological_complex.single_obj_X_self D (complex_shape.up ℤ) a A).inv ≫
    ((shift_functor_obj_X_iso _) _ _ _ h).inv) (c+1) rfl (by simp),
  hom_inv_id' := begin
    haveI := shift_is_strict_le ((homological_complex.single D
      (complex_shape.up ℤ) a).obj A) _ _ _ h,
    haveI := shift_is_strict_ge ((homological_complex.single D
      (complex_shape.up ℤ) a).obj A) _ _ _ h,
    exact to_single_ext _ _ c (by simpa),
  end,
  inv_hom_id' := to_single_ext _ _ c (by simp), }

@[simp]
lemma single_shift_iso_app_hom_f (A : D) (a b c : ℤ) (h : a = c + b) :
  (single_shift_iso_app A a b c h).hom.f c = ((shift_functor_obj_X_iso _) _ _ _ h).hom ≫
    (homological_complex.single_obj_X_self D (complex_shape.up ℤ) a A).hom ≫
    (homological_complex.single_obj_X_self D (complex_shape.up ℤ) c A).inv :=
lift_single_f _ _ _ _ _ _

@[simp]
lemma single_shift_iso_app_inv_f (A : D) (a b c : ℤ) (h : a = c + b) :
  (single_shift_iso_app A a b c h).inv.f c =
    (homological_complex.single_obj_X_self D (complex_shape.up ℤ) c A).hom ≫
    (homological_complex.single_obj_X_self D (complex_shape.up ℤ) a A).inv ≫
    ((shift_functor_obj_X_iso _) _ _ _ h).inv :=
desc_single_f _ _ _ _ _ _

variable (D)

def single_shift_iso (a b c : ℤ) (h : a = c + b):
  (homological_complex.single D (complex_shape.up ℤ) a) ⋙ category_theory.shift_functor _ b ≅
    (homological_complex.single D (complex_shape.up ℤ) c) :=
nat_iso.of_components (λ A, single_shift_iso_app A a b c h) (λ A₁ A₂ f, begin
  subst h,
  refine to_single_ext _ _ c _,
  simp only [functor.comp_map, homological_complex.comp_f, shift_functor_map_f',
    homological_complex.single_map_f_self, homological_complex.single_obj_X_self_hom,
    homological_complex.single_obj_X_self_inv, shift_functor_obj_X_iso,
    single_shift_iso_app_hom_f, homological_complex.X_iso_of_eq_refl, eq_to_hom_trans,
    assoc, eq_to_hom_trans_assoc],
  dsimp [iso.refl],
  erw [id_comp, id_comp, eq_to_hom_trans],
  refl,
end)

end cochain_complex

namespace derived_category

variable (C)

def single_functor_shift_iso (a b c : ℤ) (h : a = c + b) :
  (single_functor C a) ⋙ category_theory.shift_functor _ b ≅ (single_functor C c) :=
functor.associator _ _ _ ≪≫ iso_whisker_left _ (Q.comm_shift_iso b).symm ≪≫
  (functor.associator _ _ _).symm ≪≫
  iso_whisker_right (cochain_complex.single_shift_iso C _ _ _ h) Q

variable {C}

@[simp]
lemma single_functor_shift_iso_hom_app (a b c : ℤ) (h : a = c + b) (X : C) :
  (single_functor_shift_iso C a b c h).hom.app X =
    (Q.comm_shift_iso b).inv.app ((homological_complex.single C _ a).obj X) ≫
      Q.map ((cochain_complex.single_shift_iso C a b c h).hom.app X) :=
begin
  dsimp [single_functor_shift_iso],
  simp only [id_comp],
end

@[simp]
lemma single_functor_shift_iso_inv_app (a b c : ℤ) (h : a = c + b) (X : C) :
  (single_functor_shift_iso C a b c h).inv.app X =
    Q.map ((cochain_complex.single_shift_iso C a b c h).inv.app X) ≫
    (Q.comm_shift_iso b).hom.app ((homological_complex.single C _ a).obj X) :=
begin
  dsimp [single_functor_shift_iso],
  simp only [comp_id],
end

end derived_category


import spec

open separation separation.hProp

variables {value : Type}

example {p q a b : hProp value}
  (h₀ : p =*> a)
  (h₁ : b =*> q)
  (h₂ : p =*> b)
  (h₃ : p =*> q)
  (h₄ : a =*> q)
  (h₅ : a =*> b)
  (h₆ : a =*> b ⊛ q)
  (h₇ : p =*> emp) :
  p ⊛ a =*> q ⊛ b :=
begin
  duplicate_goal 9,
  { s_apply h₀, admit },
  { s_apply h₁, admit },
  { s_apply h₂, admit },
  { s_apply h₃, admit },
  { s_apply h₄, admit },
  { s_apply h₅, admit },
  { s_apply h₆, s_apply h₇ },
  { s_assumptions, admit },
  { s_assumption, admit },
  s_show p =*> b,
  { assumption, },
  { assumption, },
end


import .basic

namespace polya.field

namespace nterm

namespace pform

variables {α : Type} [discrete_field α]
variables {γ : Type} [const_space γ]
variables [morph γ α] {ρ : dict α}

instance : has_coe (option (nterm γ)) (nterm γ) := ⟨λ x, x.get_or_else (const 1)⟩

private lemma eval_none : eval ρ ((none : option (nterm γ)) : nterm γ) = 1 :=
by apply morph.morph_one'

private lemma eval_some {x : nterm γ} : eval ρ (some x : nterm γ) = eval ρ x := rfl

local attribute [simp] eval_none
local attribute [simp] eval_some

private def to_pform : nterm γ → option (nterm γ) | x :=
if x = const 1 then none else some x --TODO

private lemma eval_to_pform {x : nterm γ} : eval ρ (to_pform x : nterm γ) = eval ρ x :=
begin
  unfold to_pform,
  by_cases h1 : x = const 1,
  repeat { simp [h1, eval] },
end

@[simp] theorem eval_pow_mul_option {x : option (nterm γ)} {n : znum} : eval ρ (x.map (pow_mul n) : nterm γ) = eval ρ (x : nterm γ) ^ (n : ℤ) :=
by cases x; simp

private def mul' : option (nterm γ) → nterm γ → nterm γ
| (some x) y :=
  let d := znum.gcd x.exp y.exp in
    some $ pow_mul d $ mul (x.pow_div d) (y.pow_div d)
| none y := y

private lemma eval_mul' {x : option (nterm γ)} {y : nterm γ} :
  eval ρ (mul' x y) = eval ρ (x : nterm γ) * eval ρ y :=
begin
  cases x with x,
  { simp [mul'] },
  rw eval_some, unfold mul',
  --generalize : d = znum.gcd (exp x) (exp y) : znum,
  --have h1 : (d : znum) ∣ exp x, from sorry,
  --have h2 : (d : znum) ∣ exp y, from sorry,
  rw [eval_some, eval_pow_mul], unfold eval,
  rw [mul_fpow, eval_pow_div, eval_pow_div],
  { sorry },
  { sorry }
end

private def left : nterm γ → option (nterm γ)
| (mul x _) := some x
| _ := none

private def right : nterm γ → (nterm γ)
| (mul _ x) := x
| x := x

def rest (P : nterm γ) : option (nterm γ) := (left P.mem).map (pow_mul P.exp)

def lead (P : nterm γ) : nterm γ := pow_mul P.exp (right P.mem)

theorem eval_left_right (x : nterm γ) :
  eval ρ x = eval ρ (left x : nterm γ) * eval ρ (right x) :=
begin
  cases x,
  case mul : x y { simp [left, right, eval] },
  repeat { simp [left, right, eval] }
end

theorem eval_rest_lead {P : nterm γ} :
  eval ρ P = eval ρ (rest P : nterm γ) * eval ρ (lead P) :=
begin
  rw [eval_mem_exp, eval_left_right, mul_fpow],
  congr' 1,
  { unfold rest, cases (mem P); simp [left] },
  { unfold lead, rw eval_pow_mul }
end

inductive r : option (nterm γ) → option (nterm γ) → Prop
| none {S : nterm γ} : r none (some S)
| rest {S : nterm γ} : r (rest S) (some S)

namespace wf

private lemma acc_r_none : @acc (option (nterm γ)) r none :=
begin
  apply acc.intro, intros x h, cases h
end

private def g : nterm γ → ℕ
| (add x _) := g x + 1
| (mul x (const _)) := g x
| _ := 0

private def f : option (nterm γ) → ℕ
| (some x) := g x + 1
| none := 0

private lemma g_scale {x : nterm γ} {a : γ} : g (x.scale a) ≤ g x :=
begin
  sorry
end

private lemma f_none {S : nterm γ} : f (none : option (nterm γ)) < f (some S) :=
by { unfold f, linarith }

private lemma f_map_scale {x : option (nterm γ)} {a : γ} : f (x.map (scale a)) ≤ f x :=
by { cases x; simp [f, g_scale] }

private lemma f_rest {S : nterm γ} : f (rest S) < f (some S) :=
begin
  sorry
end

theorem r_wf : @well_founded (option (nterm γ)) r :=
begin
  apply subrelation.wf,
  intros x y h,
  show f x < f y,
  cases h, { apply f_none }, { apply f_rest },
  apply measure_wf
end

meta def rel_tac : tactic unit := `[exact ⟨psigma.lex r (λ _, r), psigma.lex_wf wf.r_wf (λ _, wf.r_wf)⟩]

meta def dec_tac : tactic unit :=
`[apply psigma.lex.left, assumption, done]
<|> `[apply psigma.lex.right, assumption, done]

end wf

private def aux (x y : nterm γ) (p1 p2 p3 : option (nterm γ)) : nterm γ :=
if x.mem = y.mem then
  if x.exp + y.exp = 0 then (p1 : nterm γ)
  else mul' p1 (pow x.mem (x.exp + y.exp))
else if x.term < y.term then --TODO
  mul' p2 x
else
  mul' p3 y

private lemma eval_aux_1 {x y : nterm γ} {p1 p2 p3 : option (nterm γ)}
  ( H0 : x.exp + y.exp ≠ 0)
  ( H1 : eval ρ (p2 : nterm γ) = eval ρ (p1 : nterm γ) * eval ρ y )
  ( H2 : eval ρ (p3 : nterm γ) = eval ρ (p1 : nterm γ) * eval ρ x ) :
  eval ρ (aux x y p1 p2 p3) =  eval ρ (p1 : nterm γ) * eval ρ y * eval ρ x :=
begin
  unfold aux,
  by_cases h1 : x.mem = y.mem,
  { rw [if_pos h1, mul_assoc],
    { rw if_neg H0, rw [eval_mul'], congr,
      unfold eval,
      by_cases h2 : exp x = 0,
      { have : eval ρ x = 1, { rw [eval_mem_exp x, h2], simp }, rw [h1, h2, this, eval_mem_exp y], simp, },
      { by_cases h3 : eval ρ (mem x) = 0,
        { have : eval ρ x = 0, { rw [eval_mem_exp x, h3, zero_fpow], rw ← znum.cast_zero, exact_mod_cast h2 },
          rw [h3, zero_fpow, this, mul_zero],
          rw ← znum.cast_zero, exact_mod_cast H0 },
        { rw [znum.cast_add, fpow_add h3],
          rw [← eval_mem_exp, h1, ← eval_mem_exp, mul_comm] }}}},
  { rw if_neg h1,
    by_cases h2 : x.term < y.term,
    { rw if_pos h2, rw [eval_mul'], congr, apply H1 },
    { rw if_neg h2, rw [mul_assoc, mul_comm (eval ρ y), ← mul_assoc, eval_mul'], congr, apply H2 }}
end

private def mul_option : option (nterm γ) → option (nterm γ) → option (nterm γ)
| (some x) (some y) := mul' (some x) y --TODO
| none x := x
| x none := x

private lemma mul_pform_def1 {x : option (nterm γ)} :
  mul_option none x = x :=
by cases x; unfold mul_option

private lemma mul_pform_def2 {x : option (nterm γ)} :
  mul_option x none = x :=
by cases x; unfold mul_option

local attribute [simp] mul_pform_def1
local attribute [simp] mul_pform_def2

private lemma eval_mul_option {P Q : option (nterm γ)} : eval ρ (mul_option P Q : nterm γ) = eval ρ (P : nterm γ) * eval ρ (Q : nterm γ) :=
begin
  cases P, { simp },
  cases Q, { simp },
  exact eval_mul'
end

protected def mul (x y : nterm γ) : nterm γ :=
if x = const 0 ∨ y = const 0 then
  const 0
else
  mul (mul_option (to_pform x.term) (to_pform y.term)) (const (x.coeff * y.coeff))

theorem eval_mul {x y : nterm γ} : eval ρ (pform.mul x y) = eval ρ x * eval ρ y :=
begin
  unfold pform.mul,
  by_cases h1 : x = const 0 ∨ y = const 0,
  { cases h1; simp [h1, eval] },
  { rw if_neg h1, unfold eval,
    rw [eval_mul_option, eval_to_pform, eval_to_pform, morph.morph_mul],
    rw [mul_assoc, mul_comm (↑(coeff x)), ← mul_assoc (eval ρ (term y))],
    rw [← eval_term_coeff, mul_comm (eval ρ y), ← mul_assoc],
    rw [← eval_term_coeff] }
end

end pform

end nterm

end polya.field


import Runtime.Execution.Basic

namespace Execution.Executable
open Network

def nextTime (exec : Executable net) : Option (Time.From exec.time) :=
  match exec.state with
  | .shuttingDown    => none
  | .shutdownPending => some exec.time
  | .executing       => exec.queue.nextTime

theorem nextTime_le_queue_nextTime {exec : Executable net} {t q} :
  (exec.nextTime = some t) → (exec.queue.nextTime = some q) → (t ≤ q) := by
  intro ht hq
  simp [nextTime] at ht
  split at ht <;> simp_all
  simp [←ht]
  exact q.property

private def propagationEvents (exec : Executable net) : Queue (Event net) exec.time where
  events :=
    exec.toPropagate.uniqueMergeMap (le := (·.time ≤ ·.time)) fun port =>
      match exec.reactors port.reactor |>.interface .outputs port.port with
      | none => #[] -- TODO: This case is unreachable by the semantics of `toPropagate`.
      | some value =>
        let events := port.delayedDestinations.map fun { dst, delay, eqType } =>
          Event.propagation (exec.time + delay) dst (eqType ▸ value)
        events.insertionSort (·.time ≤ ·.time) -- TODO: Use `qsort` when it drops `[Inhabited α]`.
  sorted := sorry
  bounded := sorry

private def nextTimerEvents (exec : Executable net) (timers : Array (TimerId net)) (anchor : Time) :
  Queue (Event net) anchor where
  events :=
    timers.filterMap fun ⟨reactor, timer⟩ =>
      match exec.reactors reactor |>.timer timer |>.val.period with
      | none => none
      | some period => return .timer (anchor + period) ⟨reactor, timer⟩
  sorted := sorry
  bounded := sorry

structure Next (net : Network) where
  tag    : Tag
  events : Array (Event net)
  queue  : Queue (Event net) tag.time

namespace Next

def empty (tag : Tag) : Next net where
  tag := tag
  events := #[]
  queue := °[]

protected def «for» (exec : Executable net) : Option (Next net) :=
  -- TODO: It feels like this doesn't belong here.
  let exec := { exec with queue := exec.queue.merge exec.propagationEvents }
  match h : exec.nextTime with
  | none => none
  | some time =>
    -- TODO: We can't destruct here, as this causes problems in the proof of `bounded` below.
    let eventSplit := exec.queue.split time (fun _ h' => nextTime_le_queue_nextTime h h')
    let events := eventSplit.fst
    let later := eventSplit.snd
    let timers := events.filterMap (·.timer?)
    let timerEvents := exec.nextTimerEvents timers time
    some {
      tag    := exec.tag.advance time
      events := events
      queue  := Tag.advance_time ▸ later.merge timerEvents
    }

theorem for_tag_strictly_monotonic (exec : Executable net) :
  (Next.for exec = some next) → (exec.tag < next.tag) := by
  intro h
  simp [Next.for] at h
  split at h
  · contradiction
  · simp at h
    simp [←h, Tag.lt_advance]

theorem for_isSome_if_shutdownPending {exec : Executable net} :
  (exec.state = .shutdownPending) → (Next.for exec).isSome :=
  sorry

/- TODO: Requires List.Perm
theorem for_preserves_events :
  (Next.for exec = some next) →
  ∃ timerEvents propagationEvents,
    (next.events ++ next.queue.events) ~ (exec.queue.events ++ timerEvents ++ propagationEvents) := by
  sorry
-/

-- The actions-interface for a given reactor according to the `Next` instance.
def actions (next : Next net) (reactor : ReactorId net) :
  Interface? (reactor.class.interface .actions) :=
  fun action =>
    match h : next.events.findP? (·.id = .action ⟨reactor, action⟩) with
    | none       => none
    | some event => have h := Array.findP?_property h; event.actionValue (of_decide_eq_true h)

-- The inputs-interface for a given reactor according to the `Next` instance.
def inputs (next : Next net) (reactor : ReactorId net) :
  Interface? (reactor.class.interface .inputs) :=
  fun input =>
    match h : next.events.findP? (·.id = .propagation ⟨reactor, input⟩) with
    | none => none
    | some event => have h := Array.findP?_property h; event.propagationValue (of_decide_eq_true h)

def timers (next : Next net) (exec : Executable net) (reactor : ReactorId net) :
  reactor.class.timers → Reactor.Timer :=
  fun timer => {
    val      := exec.reactors reactor |>.timer timer |>.val
    isFiring := next.events.any (·.timer? = some ⟨reactor, timer⟩)
  }

end Next
end Execution.Executable


/-
File: signature_recover_public_key_ec_add_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_fast_ec_add_soundness
import .signature_recover_public_key_is_zero_soundness
import .signature_recover_public_key_ec_double_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_add autogenerated soundness theorem -/

theorem auto_sound_ec_add
    -- arguments
    (range_check_ptr : F) (point0 point1 : EcPoint F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_ec_add σ.pc)
    -- all dependencies are in memory
    (h_mem_4 : mem_at mem code_nondet_bigint3 (σ.pc  - 404))
    (h_mem_5 : mem_at mem code_unreduced_mul (σ.pc  - 392))
    (h_mem_6 : mem_at mem code_unreduced_sqr (σ.pc  - 372))
    (h_mem_7 : mem_at mem code_verify_zero (σ.pc  - 356))
    (h_mem_8 : mem_at mem code_is_zero (σ.pc  - 333))
    (h_mem_12 : mem_at mem code_compute_doubling_slope (σ.pc  - 228))
    (h_mem_13 : mem_at mem code_compute_slope (σ.pc  - 184))
    (h_mem_14 : mem_at mem code_ec_double (σ.pc  - 160))
    (h_mem_15 : mem_at mem code_fast_ec_add (σ.pc  - 87))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 15))
    (hin_point0 : point0 = cast_EcPoint mem (σ.fp - 14))
    (hin_point1 : point1 = cast_EcPoint mem (σ.fp - 8))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 15)) (mem $ τ.ap - 7)
        (spec_ec_add mem κ range_check_ptr point0 point1 (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_add 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⟩,
  -- let
  generalize' hl_rev_x_diff: ({
    d0 := point0.x.d0 - point1.x.d0,
    d1 := point0.x.d1 - point1.x.d1,
    d2 := point0.x.d2 - point1.x.d2
  } : BigInt3 F) = x_diff,
  have hl_x_diff := hl_rev_x_diff.symm, clear hl_rev_x_diff,
  try { dsimp at hl_x_diff }, try { arith_simps at hl_x_diff },
  -- function call
  step_assert_eq hpc0 with arg0,
  step_assert_eq hpc1 with arg1,
  step_assert_eq hpc2 with arg2,
  step_assert_eq hpc3 with arg3,
  step_sub hpc4 (auto_sound_is_zero mem _ range_check_ptr x_diff _ _ _ _ _ _),
  { rw hpc5, norm_num2, exact h_mem_8 },
  { rw hpc5, norm_num2, exact h_mem_4 },
  { rw hpc5, norm_num2, exact h_mem_5 },
  { rw hpc5, norm_num2, exact h_mem_7 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, hl_x_diff] },
    try { dsimp [cast_EcPoint, cast_BigInt3] },
    try { arith_simps }, try { simp only [arg0, (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), (eq_sub_of_eq_add arg3)] },
    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_point0, hin_point1, hl_x_diff] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, (eq_sub_of_eq_add arg1), (eq_sub_of_eq_add arg2), (eq_sub_of_eq_add arg3)] },
      try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
  intros κ_call6 ap6 h_call6,
  rcases h_call6 with ⟨rc_m6, rc_mle6, hl_range_check_ptr₁, h_call6⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap6 - 2) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  generalize' hr_rev_same_x: mem (ap6 - 1) = same_x,
  simp only [hr_rev_same_x] at h_call6,
  have htv_same_x := hr_rev_same_x.symm, clear hr_rev_same_x,
  try { simp only [arg0 ,arg1 ,arg2 ,arg3] 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] at h_call6 },
  rw [hin_range_check_ptr] at h_call6,
  clear arg0 arg1 arg2 arg3,
  -- if statement
  step_jnz hpc6 hpc7 with hcond hcond,
  {
    -- if: positive branch
    have a6 : same_x = 0, {
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x] },
      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 a6 }, try { arith_simps at a6 },
    clear hcond,
    -- tail 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_assert_eq hpc14 with arg6,
    step_assert_eq hpc15 with arg7,
    step_assert_eq hpc16 with arg8,
    step_assert_eq hpc17 with arg9,
    step_assert_eq hpc18 with arg10,
    step_assert_eq hpc19 with arg11,
    step_assert_eq hpc20 with arg12,
    step_sub hpc21 (auto_sound_fast_ec_add mem _ range_check_ptr₁ point0 point1 _ _ _ _ _ _ _ _ _),
    { rw hpc22, norm_num2, exact h_mem_15 },
    { 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 },
    { rw hpc22, norm_num2, exact h_mem_13 },
    { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
      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_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x] },
        try { dsimp [cast_EcPoint, cast_BigInt3] },
        try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
        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_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x] },
        try { dsimp [cast_EcPoint, cast_BigInt3] },
        try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12] },
        try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
    intros κ_call23 ap23 h_call23,
    rcases h_call23 with ⟨rc_m23, rc_mle23, hl_range_check_ptr₂, h_call23⟩,
    step_ret hpc23,
    generalize' hr_rev_range_check_ptr₂: mem (ap23 - 7) = 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_call23 },
    rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call23,
    clear arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12,
    -- finish
    step_done, use_only [rfl, rfl],
    -- range check condition
    use_only (rc_m6+rc_m23+0+0), split,
    linarith [rc_mle6, rc_mle23],
    split,
    { arith_simps,
      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_ec_add mem _ range_check_ptr point0 point1 _ _,
    { apply sound_ec_add, apply auto_spec },
    -- prove the auto generated assertion
    dsimp [auto_spec_ec_add],
    try { norm_num1 }, try { arith_simps },
    use_only [x_diff, hl_x_diff],
    use_only [κ_call6],
    use_only [range_check_ptr₁],
    use_only [same_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 spec6 := h_call6 rc_h_range_check_ptr',
    rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec6,
    try { dsimp at spec6, arith_simps at spec6 },
    use_only [spec6],
    left,
    use_only [a6],
    use_only [κ_call23],
    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, ←hl_range_check_ptr₁] at spec23,
    try { dsimp at spec23, arith_simps at spec23 },
    use_only [spec23],
    try { linarith },
  },
  {
    -- if: negative branch
    have a6 : same_x ≠ 0, {
      try { simp only [ne.def] },
      try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x] },
      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 a6 }, try { arith_simps at a6 },
    clear hcond,
    -- let
    generalize' hl_rev_y_sum: ({
      d0 := point0.y.d0 + point1.y.d0,
      d1 := point0.y.d1 + point1.y.d1,
      d2 := point0.y.d2 + point1.y.d2
    } : BigInt3 F) = y_sum,
    have hl_y_sum := hl_rev_y_sum.symm, clear hl_rev_y_sum,
    try { dsimp at hl_y_sum }, try { arith_simps at hl_y_sum },
    -- function call
    step_assert_eq hpc24 with arg0,
    step_assert_eq hpc25 with arg1,
    step_assert_eq hpc26 with arg2,
    step_assert_eq hpc27 with arg3,
    step_sub hpc28 (auto_sound_is_zero mem _ range_check_ptr₁ y_sum _ _ _ _ _ _),
    { rw hpc29, norm_num2, exact h_mem_8 },
    { rw hpc29, norm_num2, exact h_mem_4 },
    { rw hpc29, norm_num2, exact h_mem_5 },
    { rw hpc29, norm_num2, exact h_mem_7 },
    { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x, hl_y_sum] },
      try { dsimp [cast_EcPoint, cast_BigInt3] },
      try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
      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_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x, hl_y_sum] },
        try { dsimp [cast_EcPoint, cast_BigInt3] },
        try { arith_simps }, try { simp only [arg0, arg1, arg2, arg3] },
        try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },}, },
    intros κ_call30 ap30 h_call30,
    rcases h_call30 with ⟨rc_m30, rc_mle30, hl_range_check_ptr₂, h_call30⟩,
    generalize' hr_rev_range_check_ptr₂: mem (ap30 - 2) = range_check_ptr₂,
    have htv_range_check_ptr₂ := hr_rev_range_check_ptr₂.symm, clear hr_rev_range_check_ptr₂,
    generalize' hr_rev_opposite_y: mem (ap30 - 1) = opposite_y,
    simp only [hr_rev_opposite_y] at h_call30,
    have htv_opposite_y := hr_rev_opposite_y.symm, clear hr_rev_opposite_y,
    try { simp only [arg0 ,arg1 ,arg2 ,arg3] 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] at h_call30 },
    rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr] at h_call30,
    clear arg0 arg1 arg2 arg3,
    -- if statement
    step_jnz hpc30 hpc31 with hcond hcond,
    {
      -- if: positive branch
      have a30 : opposite_y = 0, {
        try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x, hl_y_sum, htv_range_check_ptr₂, htv_opposite_y] },
        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 a30 }, try { arith_simps at a30 },
      clear hcond,
      -- tail function call
      step_assert_eq hpc32 with arg0,
      step_assert_eq hpc33 with arg1,
      step_assert_eq hpc34 with arg2,
      step_assert_eq hpc35 with arg3,
      step_assert_eq hpc36 with arg4,
      step_assert_eq hpc37 with arg5,
      step_assert_eq hpc38 with arg6,
      step_sub hpc39 (auto_sound_ec_double mem _ range_check_ptr₂ point0 _ _ _ _ _ _ _ _),
      { rw hpc40, norm_num2, exact h_mem_14 },
      { rw hpc40, norm_num2, exact h_mem_4 },
      { rw hpc40, norm_num2, exact h_mem_5 },
      { rw hpc40, norm_num2, exact h_mem_6 },
      { rw hpc40, norm_num2, exact h_mem_7 },
      { rw hpc40, norm_num2, exact h_mem_12 },
      { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x, hl_y_sum, htv_range_check_ptr₂, htv_opposite_y] },
        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_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x, hl_y_sum, htv_range_check_ptr₂, htv_opposite_y] },
          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 κ_call41 ap41 h_call41,
      rcases h_call41 with ⟨rc_m41, rc_mle41, hl_range_check_ptr₃, h_call41⟩,
      step_ret hpc41,
      generalize' hr_rev_range_check_ptr₃: mem (ap41 - 7) = 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₃ },
      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_call41 },
      rw [←htv_range_check_ptr₂, hl_range_check_ptr₂, hl_range_check_ptr₁, hin_range_check_ptr] at h_call41,
      clear arg0 arg1 arg2 arg3 arg4 arg5 arg6,
      -- finish
      step_done, use_only [rfl, rfl],
      -- range check condition
      use_only (rc_m6+rc_m30+rc_m41+0+0), split,
      linarith [rc_mle6, rc_mle30, rc_mle41],
      split,
      { arith_simps,
        rw [←htv_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
      -- user-provided reduction
      suffices auto_spec: auto_spec_ec_add mem _ range_check_ptr point0 point1 _ _,
      { apply sound_ec_add, apply auto_spec },
      -- prove the auto generated assertion
      dsimp [auto_spec_ec_add],
      try { norm_num1 }, try { arith_simps },
      use_only [x_diff, hl_x_diff],
      use_only [κ_call6],
      use_only [range_check_ptr₁],
      use_only [same_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 spec6 := h_call6 rc_h_range_check_ptr',
      rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec6,
      try { dsimp at spec6, arith_simps at spec6 },
      use_only [spec6],
      right,
      use_only [a6],
      use_only [y_sum, hl_y_sum],
      use_only [κ_call30],
      use_only [range_check_ptr₂],
      use_only [opposite_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 spec30 := h_call30 rc_h_range_check_ptr₁',
      rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec30,
      try { dsimp at spec30, arith_simps at spec30 },
      use_only [spec30],
      right,
      use_only [a30],
      use_only [κ_call41],
      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 spec41 := h_call41 rc_h_range_check_ptr₂',
      rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←hl_range_check_ptr₂] at spec41,
      try { dsimp at spec41, arith_simps at spec41 },
      use_only [spec41],
      try { linarith },
    },
    {
      -- if: negative branch
      have a30 : opposite_y ≠ 0, {
        try { simp only [ne.def] },
        try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x, hl_y_sum, htv_range_check_ptr₂, htv_opposite_y] },
        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 a30 }, try { arith_simps at a30 },
      clear hcond,
      -- let
      generalize' hl_rev_ZERO_POINT: ({
        x := { d0 := 0, d1 := 0, d2 := 0 },
        y := { d0 := 0, d1 := 0, d2 := 0 }
      } : EcPoint F) = ZERO_POINT,
      have hl_ZERO_POINT := hl_rev_ZERO_POINT.symm, clear hl_rev_ZERO_POINT,
      try { dsimp at hl_ZERO_POINT }, try { arith_simps at hl_ZERO_POINT },
      -- return
      step_assert_eq hpc42 with hret0,
      step_assert_eq hpc43 hpc44 with hret1,
      step_assert_eq hpc45 hpc46 with hret2,
      step_assert_eq hpc47 hpc48 with hret3,
      step_assert_eq hpc49 hpc50 with hret4,
      step_assert_eq hpc51 hpc52 with hret5,
      step_assert_eq hpc53 hpc54 with hret6,
      step_ret hpc55,
      -- finish
      step_done, use_only [rfl, rfl],
      -- range check condition
      use_only (rc_m6+rc_m30+0+0), split,
      linarith [rc_mle6, rc_mle30],
      split,
      { arith_simps, try { simp only [hret0 ,hret1 ,hret2 ,hret3 ,hret4 ,hret5 ,hret6] },
        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_ec_add mem _ range_check_ptr point0 point1 _ _,
      { apply sound_ec_add, apply auto_spec },
      -- prove the auto generated assertion
      dsimp [auto_spec_ec_add],
      try { norm_num1 }, try { arith_simps },
      use_only [x_diff, hl_x_diff],
      use_only [κ_call6],
      use_only [range_check_ptr₁],
      use_only [same_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 spec6 := h_call6 rc_h_range_check_ptr',
      rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec6,
      try { dsimp at spec6, arith_simps at spec6 },
      use_only [spec6],
      right,
      use_only [a6],
      use_only [y_sum, hl_y_sum],
      use_only [κ_call30],
      use_only [range_check_ptr₂],
      use_only [opposite_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 spec30 := h_call30 rc_h_range_check_ptr₁',
      rw [←hin_range_check_ptr, ←hl_range_check_ptr₁, ←htv_range_check_ptr₂] at spec30,
      try { dsimp at spec30, arith_simps at spec30 },
      use_only [spec30],
      left,
      use_only [a30],
      use_only [ZERO_POINT, hl_ZERO_POINT],
      try { split, linarith },
      try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_point0, hin_point1, hl_x_diff, htv_range_check_ptr₁, htv_same_x, hl_y_sum, htv_range_check_ptr₂, htv_opposite_y, hl_ZERO_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 } },
    }
  }
end